core/locals/rewrite/closures/closures.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel locals.rewrite.point-free
   4 locals.rewrite.sugar locals.types macros.expander make
   5 quotations sequences sets words ;
   6 IN: locals.rewrite.closures
   7
   8 ! Step 2: identify free variables and make them into explicit
   9 ! parameters of lambdas which are curried on
  10
  11 GENERIC: rewrite-closures* ( obj -- )
  12
  13 : (rewrite-closures) ( form -- form' )
  14     [ [ rewrite-closures* ] each ] [ ] make ;
  15
  16 : rewrite-closures ( form -- form' )
  17     expand-macros (rewrite-sugar) (rewrite-closures) point-free ;
  18
  19 GENERIC: defs-vars* ( seq form -- seq' )
  20
  21 : defs-vars ( form -- vars ) { } [ defs-vars* ] reduce members ;
  22
  23 M: def defs-vars* local>> unquote suffix ;
  24
  25 M: multi-def defs-vars* locals>> [ unquote suffix ] each ;
  26
  27 M: quotation defs-vars* [ defs-vars* ] each ;
  28
  29 M: object defs-vars* drop ;
  30
  31 GENERIC: uses-vars* ( seq form -- seq' )
  32
  33 : uses-vars ( form -- vars ) { } [ uses-vars* ] reduce members ;
  34
  35 M: local-writer uses-vars* "local-reader" word-prop suffix ;
  36
  37 M: lexical uses-vars* suffix ;
  38
  39 M: quote uses-vars* local>> uses-vars* ;
  40
  41 M: object uses-vars* drop ;
  42
  43 M: quotation uses-vars* [ uses-vars* ] each ;
  44
  45 : free-vars ( form -- seq )
  46     [ uses-vars ] [ defs-vars ] bi diff ;
  47
  48 M: callable rewrite-closures*
  49     ! Turn free variables into bound variables, curry them
  50     ! onto the body
  51     dup free-vars [ <quote> ] map
  52     [ % ]
  53     [ var-defs prepend (rewrite-closures) point-free , ]
  54     [ length \ curry <repetition> % ]
  55     tri ;
  56
  57 M: object rewrite-closures* , ;