53 lines
1.2 KiB
Factor
53 lines
1.2 KiB
Factor
! Copyright (C) 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel sequences namespaces make quotations accessors
|
|
words continuations vectors effects math
|
|
stack-checker.transforms ;
|
|
IN: macros.expander
|
|
|
|
GENERIC: expand-macros ( quot -- quot' )
|
|
|
|
<PRIVATE
|
|
|
|
SYMBOL: stack
|
|
|
|
: begin ( -- ) V{ } clone stack set ;
|
|
|
|
: end ( -- )
|
|
stack get
|
|
[ [ literalize , ] each ]
|
|
[ delete-all ]
|
|
bi ;
|
|
|
|
: literal ( obj -- ) stack get push ;
|
|
|
|
GENERIC: expand-macros* ( obj -- )
|
|
|
|
: (expand-macros) ( quot -- )
|
|
[ expand-macros* ] each ;
|
|
|
|
M: wrapper expand-macros* wrapped>> literal ;
|
|
|
|
: expand-macro ( quot -- )
|
|
stack [ swap with-datastack >vector ] change
|
|
stack get pop >quotation end (expand-macros) ;
|
|
|
|
: expand-macro? ( word -- quot ? )
|
|
dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
|
|
swap [ "transform-n" word-prop ] [ stack-effect in>> length ] bi or
|
|
stack get length <=
|
|
] [ 2drop f f ] if ;
|
|
|
|
M: word expand-macros*
|
|
dup expand-macro? [ nip expand-macro ] [ drop end , ] if ;
|
|
|
|
M: object expand-macros* literal ;
|
|
|
|
M: callable expand-macros*
|
|
expand-macros literal ;
|
|
|
|
M: callable expand-macros ( quot -- quot' )
|
|
[ begin (expand-macros) end ] [ ] make ;
|
|
|
|
PRIVATE>
|