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