extra/gml/macros/macros.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs classes.tuple combinators.short-circuit
   4 effects.parser fry generalizations gml.runtime kernel
   5 kernel.private lexer locals macros namespaces parser
   6 prettyprint sequences system words ;
   7 IN: gml.macros
   8
   9 TUPLE: macro macro-id timestamp log ;
  10
  11 SYMBOL: next-macro-id
  12 next-macro-id [ 0 ] initialize
  13
  14 SYMBOL: macros
  15 macros [ H{ } clone ] initialize
  16
  17 SYMBOL: current-macro
  18
  19 : <macro> ( -- macro )
  20     macro new
  21         next-macro-id [ get ] [ inc ] bi >>macro-id
  22         nano-count >>timestamp
  23         V{ } clone >>log ; inline
  24
  25 : save-euler-op ( euler-op -- ) current-macro get log>> push ;
  26
  27 MACRO:: log-euler-op ( class def inputs -- quot )
  28     class inputs def inputs '[ [ current-macro get [ _ boa save-euler-op ] [ _ ndrop ] if ] _ _ nbi ] ;
  29
  30 SYNTAX: LOG-GML:
  31     [let
  32         (GML:) :> ( word name effect def )
  33
  34         name "-record" append create-word-in :> record-class
  35         record-class tuple effect in>> define-tuple-class
  36
  37         record-class def effect in>> length
  38         '[ _ _ _ log-euler-op ] :> logging-def
  39
  40         word name effect logging-def define-gml-primitive
  41     ] ;