72 lines
2.2 KiB
Factor
72 lines
2.2 KiB
Factor
! Copyright (C) 2007 Robbert van Dalen.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: enchilada.printer
|
|
USING: prettyprint strings generic kernel math math.parser sequences isequences.interface isequences.base enchilada.engine ;
|
|
|
|
: s-append ( s1 s2 s3 -- s )
|
|
swap append append ;
|
|
|
|
DEFER: e-print
|
|
DEFER: l-print
|
|
|
|
GENERIC: (e-print) ( op -- string )
|
|
|
|
M: .- (e-print) drop "-" ;
|
|
M: .# (e-print) drop "#" ;
|
|
M: .$ (e-print) drop "$" ;
|
|
M: .^ (e-print) drop "^" ;
|
|
M: .` (e-print) drop "`" ;
|
|
M: .~ (e-print) drop "~" ;
|
|
M: .: (e-print) drop ":" ;
|
|
M: .! (e-print) drop "!" ;
|
|
M: .\ (e-print) drop "\\" ;
|
|
|
|
M: .+ (e-print) drop "+" ;
|
|
M: .* (e-print) drop "*" ;
|
|
M: ./ (e-print) drop "/" ;
|
|
M: .< (e-print) drop "<" ;
|
|
M: .> (e-print) drop ">" ;
|
|
M: .| (e-print) drop "|" ;
|
|
M: .& (e-print) drop "&" ;
|
|
M: .@ (e-print) drop "@" ;
|
|
M: .? (e-print) drop "?" ;
|
|
M: .% (e-print) drop "%" ;
|
|
|
|
: (eprint-macro-expr) ( emacro -- string )
|
|
dup emacro-expr dup i-length 0 =
|
|
[ 2drop "" ]
|
|
[ e-print swap emacro-eager? [ "==" ] [ "=" ] if swap append ] if ;
|
|
|
|
: (l-print1) ( e-list -- string )
|
|
0 i-at dup left-side swap right-side dup 0 =
|
|
[ drop dup i-length 0 = [ drop " " ] [ e-print ] if ] [ e-print swap e-print swap "=" s-append ] if ;
|
|
|
|
: (l-print0) ( e-list -- string )
|
|
left-right [ l-print ] 2apply ";" s-append ;
|
|
|
|
: l-print ( e-list -- string )
|
|
dup i-length dup 0 =
|
|
[ 2drop "0" ] [ 1 = [ (l-print1) ] [ (l-print0) ] if ] if ;
|
|
|
|
: prefix-neg ( s -- s prefix )
|
|
dup i-length 0 < [ -- "_" ] [ "" ] if ;
|
|
|
|
: (e-print3) ( symbol -- string )
|
|
esymbol-seq to-sequence >string ;
|
|
|
|
: (e-print2) ( e-list -- string )
|
|
dup integer? [ prefix-neg swap number>string append ] [ prefix-neg "[" append swap l-print "]" append append ] if ;
|
|
|
|
: (e-print1) ( e-expression -- string )
|
|
0 i-at dup e-operator? [ (e-print) ] [ dup e-symbol? [ (e-print3) ] [ (e-print2) ] if ] if ;
|
|
|
|
: e-print ( e-expression -- string )
|
|
dup i-length dup 0 =
|
|
[ 2drop "" ]
|
|
[ 1 = [ (e-print1) ] [ left-right [ e-print ] 2apply " " s-append ] if ] if ;
|
|
|
|
M: c-op (e-print) dup c-op-d-op swap c-op-v (e-print2) swap (e-print) " " s-append ;
|
|
M: emacro (e-print) "{" swap dup emacro-symbols e-print swap (eprint-macro-expr) "}" append append append ;
|
|
|