basis/macros/expander/expander.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences namespaces make quotations accessors
   4 words continuations vectors effects math
   5 stack-checker.transforms ;
   6 IN: macros.expander
   7
   8 GENERIC: expand-macros ( quot -- quot' )
   9
  10 <PRIVATE
  11
  12 SYMBOL: stack
  13
  14 : begin ( -- ) V{ } clone stack set ;
  15
  16 : end ( -- )
  17     stack get
  18     [ [ literalize , ] each ]
  19     [ delete-all ]
  20     bi ;
  21
  22 : literal ( obj -- ) stack get push ;
  23
  24 GENERIC: expand-macros* ( obj -- )
  25
  26 : (expand-macros) ( quot -- )
  27     [ expand-macros* ] each ;
  28
  29 M: wrapper expand-macros* wrapped>> literal ;
  30
  31 : expand-macro ( quot -- )
  32     stack [ swap with-datastack >vector ] change
  33     stack get pop >quotation end (expand-macros) ;
  34
  35 : expand-macro? ( word -- quot ? )
  36     dup [ "macro" word-prop ] [ "transform-quot" word-prop ] bi or dup [
  37         swap [ stack-effect in>> length ] [ "transform-n" word-prop ] bi or
  38         stack get length <=
  39     ] [ 2drop f f ] if ;
  40
  41 M: word expand-macros*
  42     dup expand-macro? [ nip expand-macro ] [ drop end , ] if ;
  43
  44 M: object expand-macros* literal ;
  45
  46 M: callable expand-macros*
  47     expand-macros literal ;
  48
  49 M: callable expand-macros ( quot -- quot' )
  50     [ begin (expand-macros) end ] [ ] make ;
  51
  52 PRIVATE>