From 4a2823b2eb381869661491a69613ac582b5fcf3d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 4 Sep 2009 03:01:18 -0500
Subject: [PATCH] compiler: tweak generated code

---
 basis/compiler/cfg/def-use/def-use.factor     | 19 +++++++++++--------
 .../cfg/instructions/syntax/syntax.factor     |  5 +++--
 .../preferred/preferred.factor                | 13 +++++++++++--
 .../expressions/expressions.factor            |  2 +-
 basis/compiler/codegen/codegen.factor         |  5 ++---
 5 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index 559160408d..825ff71b9b 100644
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs classes combinators compiler.units fry
-generalizations generic kernel locals namespaces quotations
-sequences sets slots words compiler.cfg.instructions
-compiler.cfg.instructions.syntax compiler.cfg.rpo ;
+USING: accessors assocs arrays classes combinators
+compiler.units fry generalizations generic kernel locals
+namespaces quotations sequences sets slots words
+compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.rpo ;
 IN: compiler.cfg.def-use
 
 GENERIC: defs-vreg ( insn -- vreg/f )
@@ -15,10 +16,12 @@ M: ##phi uses-vregs inputs>> values ;
 <PRIVATE
 
 : slot-array-quot ( slots -- quot )
-    [ [ drop f ] ] [
-        [ reader-word 1quotation ] map
-        dup length '[ _ cleave _ narray ]
-    ] if-empty ;
+    [ reader-word 1quotation ] map dup length {
+        { 0 [ drop [ drop f ] ] }
+        { 1 [ first [ 1array ] compose ] }
+        { 2 [ first2 '[ _ _ bi 2array ] ] }
+        [ '[ _ cleave _ narray ] ]
+    } case ;
 
 : define-defs-vreg-method ( insn -- )
     [ \ defs-vreg create-method ]
diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor
index 53d124ea9d..cc1d0df21c 100644
--- a/basis/compiler/cfg/instructions/syntax/syntax.factor
+++ b/basis/compiler/cfg/instructions/syntax/syntax.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.tuple classes.tuple.parser kernel words
 make fry sequences parser accessors effects namespaces
-combinators splitting classes.parser lexer ;
+combinators splitting classes.parser lexer quotations ;
 IN: compiler.cfg.instructions.syntax
 
 SYMBOLS: def use temp literal constant ;
@@ -67,7 +67,8 @@ TUPLE: insn-slot-spec type name rep ;
     [ name>> ] map "insn#" suffix define-tuple-class ;
 
 : define-insn-ctor ( class specs -- )
-    [ dup '[ f _ boa , ] ] dip [ name>> ] map f <effect> define-declared ;
+    [ dup '[ _ ] [ f ] [ boa , ] surround ] dip
+    [ name>> ] map f <effect> define-declared ;
 
 : define-insn ( class superclass specs -- )
     parse-insn-slot-specs {
diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor
index 54da7bdf69..389b78c333 100644
--- a/basis/compiler/cfg/representations/preferred/preferred.factor
+++ b/basis/compiler/cfg/representations/preferred/preferred.factor
@@ -17,7 +17,7 @@ GENERIC: uses-vreg-reps ( insn -- reps )
     {
         { f [ [ rep>> ] ] }
         { scalar-rep [ [ rep>> scalar-rep-of ] ] }
-        [ '[ _ nip ] ]
+        [ [ drop ] swap suffix ]
     } case ;
 
 : define-defs-vreg-rep-method ( insn -- )
@@ -26,7 +26,16 @@ GENERIC: uses-vreg-reps ( insn -- reps )
     bi define ;
 
 : reps-getter-quot ( reps -- quot )
-    [ rep>> rep-getter-quot ] map dup length '[ _ cleave _ narray ] ;
+    dup [ rep>> { f scalar-rep } memq? not ] all? [
+        [ rep>> ] map [ drop ] swap suffix
+    ] [
+        [ rep>> rep-getter-quot ] map dup length {
+            { 0 [ drop [ drop f ] ] }
+            { 1 [ first [ 1array ] compose ] }
+            { 2 [ first2 '[ _ _ bi 2array ] ] }
+            [ '[ _ cleave _ narray ] ]
+        } case
+    ] if ;
 
 : define-uses-vreg-reps-method ( insn -- )
     [ \ uses-vreg-reps create-method ]
diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
index f869f64fb1..03aa28d70a 100644
--- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor
+++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
@@ -64,7 +64,7 @@ M: ##load-reference >expr obj>> <reference> ;
                 { constant [ [ constant>vn ] ] }
             } case
         ] bi append
-    ] map swap '[ _ cleave _ boa ] ;
+    ] map cleave>quot swap suffix \ boa suffix ;
 
 : define->expr-method ( insn expr slot-specs -- )
     [ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 36f5a0c49b..3587d62706 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -100,9 +100,8 @@ M: _spill-area-size generate-insn drop ;
 : codegen-method-body ( class word -- quot )
     [
         "insn-slots" word-prop
-        [ insn-slot-quot ] map
-    ] dip
-    '[ _ cleave _ execute ] ;
+        [ insn-slot-quot ] map cleave>quot
+    ] dip suffix ;
 
 SYNTAX: CODEGEN:
     scan-word [ \ generate-insn create-method-in ] keep scan-word