compiler.cfg.instructions: change vreg-insn from a mixin into a superclass

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 30c3811cdf2afa482047719a19af083fe040c172..f2ba0fefbb6288a047928169e6b80c86a267ba78 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -16,9 +16,12 @@ V{ } clone insn-classes set-global
 ! Virtual CPU instructions, used by CFG IR
 TUPLE: insn ;
 
+! Instructions which use vregs
+TUPLE: vreg-insn < insn ;
+
 ! Instructions which are referentially transparent; used for
 ! value numbering
-TUPLE: pure-insn < insn ;
+TUPLE: pure-insn < vreg-insn ;
 
 ! Constants
 INSN: ##load-integer
@@ -859,13 +862,3 @@ UNION: def-is-use-insn
 ##box-alien
 ##box-displaced-alien
 ##unbox-any-c-ptr ;
-
-SYMBOL: vreg-insn
-
-[
-    vreg-insn
-    insn-classes get [
-        "insn-slots" word-prop [ type>> { def use temp } member-eq? ] any?
-    ] filter
-    define-union-class
-] with-compilation-unit

diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor
index 7b8327cf06cf15f1a7eecb92d65e9401e9bf64e1..223ae26b42b60150e1c45bceddbd51893df52b3c 100644 (file)
--- a/basis/compiler/cfg/instructions/syntax/syntax.factor
+++ b/basis/compiler/cfg/instructions/syntax/syntax.factor
@@ -56,21 +56,32 @@ TUPLE: insn-slot-spec type name rep ;
 : insn-word ( -- word )
     "insn" "compiler.cfg.instructions" lookup ;
 
+: vreg-insn-word ( -- word )
+    "vreg-insn" "compiler.cfg.instructions" lookup ;
+
 : pure-insn-word ( -- word )
     "pure-insn" "compiler.cfg.instructions" lookup ;
 
 : insn-effect ( word -- effect )
     boa-effect in>> but-last { } <effect> ;
 
-: define-insn-tuple ( class superclass specs -- )
+: uses-vregs? ( specs -- ? )
+    [ type>> { def use temp } member-eq? ] any? ;
+
+: insn-superclass ( pure? specs -- superclass )
+    pure-insn-word swap uses-vregs? vreg-insn-word insn-word ? ? ;
+
+: define-insn-tuple ( class pure? specs -- )
+    [ insn-superclass ] keep
     [ name>> ] map "insn#" suffix define-tuple-class ;
 
 : define-insn-ctor ( class specs -- )
     [ dup '[ _ ] [ f ] [ boa , ] surround ] dip
     [ name>> ] map { } <effect> define-declared ;
 
-: define-insn ( class superclass specs -- )
-    parse-insn-slot-specs {
+: define-insn ( class pure? specs -- )
+    parse-insn-slot-specs
+    {
         [ nip "insn-slots" set-word-prop ]
         [ 2drop insn-classes-word get push ]
         [ define-insn-tuple ]
@@ -78,6 +89,6 @@ TUPLE: insn-slot-spec type name rep ;
         [ nip define-insn-ctor ]
     } 3cleave ;
 
-SYNTAX: INSN: CREATE-CLASS insn-word ";" parse-tokens define-insn ;
+SYNTAX: INSN: CREATE-CLASS f ";" parse-tokens define-insn ;
 
-SYNTAX: PURE-INSN: CREATE-CLASS pure-insn-word ";" parse-tokens define-insn ;
+SYNTAX: PURE-INSN: CREATE-CLASS t ";" parse-tokens define-insn ;