extra/rewrite-closures/rewrite-closures.factor

   1
   2 USING: kernel parser math quotations namespaces sequences macros
   3 bake bake.fry ;
   4
   5 IN: rewrite-closures
   6
   7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   8
   9 : [set-parameters] ( seq -- quot ) reverse [ [ set ] curry ] map concat ;
  10
  11 MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
  12
  13 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  14
  15 : parametric-quot ( parameters quot -- quot ) '[ , set-parameters , call ] ;
  16
  17 : scoped-quot ( quot -- quot ) '[ , with-scope ] ;
  18
  19 : closed-quot ( quot -- quot )
  20   namestack swap '[ namestack [ , set-namestack @ ] dip set-namestack ] ;
  21
  22 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  23
  24 : lambda ( parameters quot -- quot ) parametric-quot scoped-quot closed-quot ;
  25
  26 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  27
  28 : C[ \ ] [ >quotation ] parse-literal \ closed-quot parsed ; parsing