compiler: Ghetto functor hack for now.

Quotations are strings temporarily. This is because unparse is not in core, so you can't just interpolate a quotation text into a template.

basis/compiler/cfg/linear-scan/assignment/assignment.factor

@@ -1,14 +1,18 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators compiler.cfg
-compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
+compiler.cfg.def-use compiler.cfg.instructions
-compiler.cfg.linear-scan.live-intervals compiler.cfg.linearization
+compiler.cfg.instructions.syntax
-compiler.cfg.liveness compiler.cfg.registers
+compiler.cfg.linear-scan.allocation.state
-compiler.cfg.renaming.functor compiler.cfg.ssa.destruction.leaders
+compiler.cfg.linear-scan.live-intervals
-compiler.cfg.utilities fry heaps kernel make math namespaces sequences
+compiler.cfg.linearization compiler.cfg.liveness
-;
+compiler.cfg.registers compiler.cfg.renaming.functor
-IN: compiler.cfg.linear-scan.assignment
+compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities
+generic.parser heaps kernel make math namespaces sequences sets
+words ;
+FROM: namespaces => set ;
 QUALIFIED: sets
+IN: compiler.cfg.linear-scan.assignment
 
 ! This contains both active and inactive intervals; any interval
 ! such that start <= insn# <= end is in this set.
@@ -88,7 +92,7 @@ SYMBOL: machine-live-outs
     [ pending-interval-heap get expire-old-intervals ]
     [ unhandled-intervals get activate-new-intervals ] bi ;
 
-RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
+RENAMING: assign "[ vreg>reg ]" "[ vreg>reg ]" "[ vreg>reg ]"
 
 : assign-all-registers ( insn -- )
     [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;

basis/compiler/cfg/renaming/functor/functor.factor

@@ -1,9 +1,6 @@
 ! Copyright (C) 2009, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs compiler.cfg.def-use
+USING: functors2 kernel sequences slots strings ;
-compiler.cfg.instructions compiler.cfg.instructions.syntax fry
-functors generic.parser kernel lexer namespaces parser sequences
-sets slots words ;
 IN: compiler.cfg.renaming.functor
 
 ! Like compiler.cfg.def-use, but for changing operands
@@ -12,77 +9,79 @@ IN: compiler.cfg.renaming.functor
     '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
     [ drop ] append ;
 
-<FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
+SAME-FUNCTOR: renaming ( NAME: name DEF-QUOT: string USE-QUOT: string TEMP-QUOT: string -- ) [[
 
-rename-insn-defs DEFINES ${NAME}-insn-defs
+! rename-insn-defs DEFINES ${NAME}-insn-defs
-rename-insn-uses DEFINES ${NAME}-insn-uses
+! rename-insn-uses DEFINES ${NAME}-insn-uses
-rename-insn-temps DEFINES ${NAME}-insn-temps
+! rename-insn-temps DEFINES ${NAME}-insn-temps
 
-WHERE
+! WHERE
 
-GENERIC: rename-insn-defs ( insn -- )
+GENERIC: ${NAME}-insn-defs ( insn -- )
-GENERIC: rename-insn-uses ( insn -- )
+GENERIC: ${NAME}-insn-uses ( insn -- )
-GENERIC: rename-insn-temps ( insn -- )
+GENERIC: ${NAME}-insn-temps ( insn -- )
 
-M: insn rename-insn-defs drop ;
+M: insn ${NAME}-insn-defs drop ;
-M: insn rename-insn-uses drop ;
+M: insn ${NAME}-insn-uses drop ;
-M: insn rename-insn-temps drop ;
+M: insn ${NAME}-insn-temps drop ;
 
 ! Instructions with unusual operands
 
-! Special rename-insn-defs methods
+! Special ${NAME}-insn-defs methods
-M: ##parallel-copy rename-insn-defs
+M: ##parallel-copy ${NAME}-insn-defs
-    [ [ first2 DEF-QUOT dip 2array ] map ] change-values drop ;
+    [ [ first2 ${DEF-QUOT} dip 2array ] map ] change-values drop ;
 
-M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
+M: ##phi ${NAME}-insn-defs ${DEF-QUOT} change-dst drop ;
 
-M: alien-call-insn rename-insn-defs
+M: alien-call-insn ${NAME}-insn-defs
-    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
+    [ [ first3 ${DEF-QUOT} 2dip 3array ] map ] change-reg-outputs
     drop ;
 
-M: ##callback-inputs rename-insn-defs
+M: ##callback-inputs ${NAME}-insn-defs
-    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
+    [ [ first3 ${DEF-QUOT} 2dip 3array ] map ] change-reg-outputs
-    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
+    [ [ first3 ${DEF-QUOT} 2dip 3array ] map ] change-stack-outputs
     drop ;
 
-! Special rename-insn-uses methods
+! Special ${NAME}-insn-uses methods
-M: ##parallel-copy rename-insn-uses
+M: ##parallel-copy ${NAME}-insn-uses
-    [ [ first2 USE-QUOT call 2array ] map ] change-values drop ;
+    [ [ first2 ${USE-QUOT} call 2array ] map ] change-values drop ;
 
-M: ##phi rename-insn-uses
+M: ##phi ${NAME}-insn-uses
-    [ USE-QUOT assoc-map ] change-inputs drop ;
+    [ ${USE-QUOT} assoc-map ] change-inputs drop ;
 
-M: alien-call-insn rename-insn-uses
+M: alien-call-insn ${NAME}-insn-uses
-    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
+    [ [ first3 ${USE-QUOT} 2dip 3array ] map ] change-reg-inputs
-    [ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
+    [ [ first3 ${USE-QUOT} 2dip 3array ] map ] change-stack-inputs
     drop ;
 
-M: ##alien-indirect rename-insn-uses
+M: ##alien-indirect ${NAME}-insn-uses
-    USE-QUOT change-src call-next-method ;
+    ${USE-QUOT} change-src call-next-method ;
 
-M: ##callback-outputs rename-insn-uses
+M: ##callback-outputs ${NAME}-insn-uses
-    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
+    [ [ first3 ${USE-QUOT} 2dip 3array ] map ] change-reg-inputs
     drop ;
 
+<<
 ! Generate methods for everything else
 insn-classes get special-vreg-insns diff [ insn-def-slots empty? ] reject [
-    [ \ rename-insn-defs create-method-in ]
+    [ \ ${NAME}-insn-defs create-method-in ]
-    [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
+    [ insn-def-slots [ name>> ] map ${DEF-QUOT} slot-change-quot ] bi
     define
 ] each
 
 insn-classes get special-vreg-insns diff [ insn-use-slots empty? ] reject [
-    [ \ rename-insn-uses create-method-in ]
+    [ \ ${NAME}-insn-uses create-method-in ]
-    [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
+    [ insn-use-slots [ name>> ] map ${USE-QUOT} slot-change-quot ] bi
     define
 ] each
 
 insn-classes get [ insn-temp-slots empty? ] reject [
-    [ \ rename-insn-temps create-method-in ]
+    [ \ ${NAME}-insn-temps create-method-in ]
-    [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
+    [ insn-temp-slots [ name>> ] map ${TEMP-QUOT} slot-change-quot ] bi
     define
 ] each
+>>
 
-;FUNCTOR>
+]]
 
-SYNTAX: \RENAMING: scan-token scan-object scan-object scan-object define-renaming ;
+! SYNTAX: \RENAMING: scan-token scan-object scan-object scan-object define-renaming ;

basis/compiler/cfg/renaming/renaming.factor

@@ -1,7 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs compiler.cfg.registers
+USING: accessors arrays assocs compiler.cfg.def-use
-compiler.cfg.renaming.functor kernel namespaces ;
+compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.registers compiler.cfg.renaming.functor
+generic.parser kernel namespaces sequences sets words ;
 IN: compiler.cfg.renaming
 
 SYMBOL: renamings
@@ -9,4 +11,4 @@ SYMBOL: renamings
 : rename-value ( vreg -- vreg' )
     renamings get ?at drop ;
 
-RENAMING: rename [ rename-value ] [ rename-value ] [ drop next-vreg ]
+RENAMING: rename "[ rename-value ]" "[ rename-value ]" "[ drop next-vreg ]"

basis/compiler/cfg/representations/rewrite/rewrite.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs compiler.cfg.instructions
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.instructions.syntax
 compiler.cfg.registers compiler.cfg.renaming.functor
 compiler.cfg.representations.conversion
-compiler.cfg.representations.preferred compiler.cfg.rpo kernel
+compiler.cfg.representations.preferred compiler.cfg.rpo
-locals make namespaces sequences ;
+generic.parser kernel make namespaces sequences sets words ;
+FROM: namespaces => set ;
 IN: compiler.cfg.representations.rewrite
 
 ! Insert conversions. This introduces new temporaries, so we need
@@ -65,7 +67,7 @@ SYMBOLS: renaming-set needs-renaming? ;
 : converted-value ( vreg -- vreg' )
     renaming-set get pop first2 [ assert= ] dip ;
 
-RENAMING: convert [ converted-value ] [ converted-value ] [ ]
+RENAMING: convert "[ converted-value ]" "[ converted-value ]" "[ ]"
 
 : perform-renaming ( insn -- )
     needs-renaming? get [

basis/compiler/cfg/ssa/construction/construction.factor

@@ -1,11 +1,13 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators compiler.cfg
+USING: accessors arrays assocs combinators compiler.cfg
 compiler.cfg.def-use compiler.cfg.dominance
-compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.instructions compiler.cfg.instructions.syntax
-compiler.cfg.renaming.functor compiler.cfg.rpo
+compiler.cfg.registers compiler.cfg.renaming.functor
-compiler.cfg.ssa.construction.tdmsc deques dlists fry kernel
+compiler.cfg.rpo compiler.cfg.ssa.construction.tdmsc deques
-math namespaces sequences sets ;
+dlists generic.parser kernel math namespaces sequences sets
+words ;
+FROM: namespaces => set ;
 IN: compiler.cfg.ssa.construction
 
 <PRIVATE
@@ -73,7 +75,7 @@ SYMBOLS: stacks pushed ;
     (top-name)
     dup [ dup used-vregs get push-front ] when ;
 
-RENAMING: ssa-rename [ gen-name ] [ top-name ] [ ]
+RENAMING: ssa-rename "[ gen-name ]" "[ top-name ]" "[ ]"
 
 GENERIC: rename-insn ( insn -- )
 

extra/compiler/cfg/gvn/avail/avail.factor

@@ -1,15 +1,12 @@
 ! Copyright (C) 2011 Alex Vondrak.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs hashtables kernel namespaces sequences
+USING: accessors arrays assocs compiler.cfg
-sets
+compiler.cfg.dataflow-analysis compiler.cfg.def-use
-compiler.cfg
+compiler.cfg.gvn.graph compiler.cfg.instructions
-compiler.cfg.dataflow-analysis
+compiler.cfg.instructions.syntax compiler.cfg.predecessors
-compiler.cfg.def-use
+compiler.cfg.renaming.functor compiler.cfg.rpo
-compiler.cfg.gvn.graph
+compiler.utilities generic.parser hashtables kernel namespaces
-compiler.cfg.predecessors
+sequences sets words ;
-compiler.cfg.renaming.functor
-compiler.cfg.rpo
-compiler.utilities ;
 IN: compiler.cfg.gvn.avail
 
 : defined ( bb -- vregs )
@@ -41,4 +38,4 @@ M: avail transfer-set drop defined assoc-union ;
 : make-available ( vreg -- )
     basic-block get avail-ins get [ dupd clone ?set-at ] assocs:change-at ;
 
-RENAMING: >avail [ ] [ dup >avail-vreg swap or ] [ ]
+RENAMING: >avail "[ ]" "[ dup >avail-vreg swap or ]" "[ ]"