extra/rewrite-closures/rewrite-closures.factor

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