Finish vreg simplification

basis/compiler/cfg/instructions/instructions.factor

@@ -82,7 +82,7 @@ M: ##dispatch uses-vregs src>> 1array ;
 M: insn uses-vregs drop f ;
 
 : intrinsic-vregs ( assoc -- seq' )
-    values sift ;
+    [ nip dup vreg? swap and ] { } assoc>map sift ;
 
 : intrinsic-defs-vregs ( insn -- seq )
     defs-vregs>> intrinsic-vregs ;

basis/compiler/cfg/registers/registers.factor

@@ -13,7 +13,6 @@ GENERIC: value-class* ( operand -- class )
 
 : value-class ( operand -- class ) value-class* object or ;
 
-M: value >vreg drop f ;
 M: value set-value-class 2drop ;
 M: value value-class* drop f ;
 
@@ -29,6 +28,8 @@ INSTANCE: vreg value
 ! Stack locations
 TUPLE: loc n class ;
 
+M: loc >vreg drop f ;
+
 ! A data stack location.
 TUPLE: ds-loc < loc ;
 : <ds-loc> ( n -- loc ) f ds-loc boa ;
@@ -85,5 +86,6 @@ TUPLE: constant value ;
 C: <constant> constant
 
 M: constant value-class* value>> class ;
+M: constant >vreg ;
 
 INSTANCE: constant value

basis/compiler/cfg/templates/templates.factor

@@ -33,7 +33,7 @@ TUPLE: template input output scratch clobber gc ;
     ] with-scope ;
 
 : alloc-scratch ( template -- assoc )
-    scratch>> [ swap alloc-vreg >vreg ] assoc-map ;
+    scratch>> [ swap alloc-vreg ] assoc-map ;
 
 : do-template-inputs ( template -- defs uses )
     #! Load input values into registers and allocates scratch
@@ -44,12 +44,13 @@ TUPLE: template input output scratch clobber gc ;
     [ output>> ] 2dip assoc-union '[ _ at ] map
     phantom-datastack get phantom-append ;
 
-: apply-template ( pair quot -- vregs )
+: apply-template ( pair quot -- )
     [
         first2
         dup gc>> [ t fresh-object ] when
         dup do-template-inputs
-        [ do-template-outputs ] 2keep
+        [ do-template-outputs ]
+        [ [ [ >vreg ] assoc-map ] dip ] 2bi
     ] dip call ; inline
 
 : phantom&spec ( phantom specs -- phantom' specs' )