basis/macros/macros.factor

   1 ! Copyright (C) 2007, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators compiler.units definitions effects
   4 effects.parser fry kernel memoize words ;
   5 IN: macros
   6
   7 <PRIVATE
   8
   9 : real-macro-effect ( effect -- effect' )
  10     in>> { "quot" } <effect> ;
  11
  12 : check-macro-effect ( word effect -- )
  13     [ real-macro-effect ] keep 2dup effect=
  14     [ 3drop ] [ bad-stack-effect ] if ;
  15
  16 PRIVATE>
  17
  18 : define-macro ( word definition effect -- )
  19     {
  20         [ nip check-macro-effect ]
  21         [
  22             [ '[ _ _ call-effect ] ] keep
  23             [ memoize-quot '[ @ call ] ] keep
  24             define-declared
  25         ]
  26         [ drop "macro" set-word-prop ]
  27         [ 2drop changed-effect ]
  28     } 3cleave ;
  29
  30 SYNTAX: MACRO: (:) define-macro ;
  31
  32 PREDICATE: macro < word "macro" word-prop >boolean ;
  33
  34 M: macro make-inline cannot-be-inline ;
  35
  36 M: macro definer drop \ MACRO: \ ; ;
  37
  38 M: macro definition "macro" word-prop ;
  39
  40 M: macro reset-word
  41     [ call-next-method ] [ f "macro" set-word-prop ] bi ;
  42
  43 M: macro always-bump-effect-counter? drop t ;