compiler optimizations

library/collections/hashtables.factor

@@ -188,6 +188,9 @@ M: hashtable hashcode ( hash -- n )
 : ?hash ( key hash/f -- value/f )
     dup [ hash ] [ 2drop f ] ifte ; flushable
 
+: ?hash* ( key hash/f -- value/f )
+    dup [ hash* ] [ 2drop f ] ifte ; flushable
+
 : ?set-hash ( value key hash/f -- hash )
     [ 1 <hashtable> ] unless* [ set-hash ] keep ;
 

library/collections/sequences.factor

@@ -37,6 +37,9 @@ GENERIC: resize ( n seq -- seq )
     #! Push a value on the end of a sequence.
     dup length swap set-nth ; inline
 
+: ?push ( elt seq/f -- seq )
+    [ 1 <vector> ] unless* [ push ] keep ;
+
 : first2 ( { x y } -- x y )
     dup first swap second ; inline
 

library/compiler/intrinsics.factor

@@ -13,7 +13,7 @@ namespaces sequences words ;
 
 : value-tag ( value node -- n/f )
     #! If the tag is known, output it, otherwise f.
-    node-classes hash dup [
+    node-classes ?hash dup [
         types [ type-tag ] map dup all-equal?
         [ first ] [ drop f ] ifte
     ] [

library/continuations.factor

@@ -38,16 +38,9 @@ TUPLE: continuation data c call name catch ;
         dup continuation-data f over push f swap push t
     ] call 2swap ifte ; inline
 
-: (continue-with) 9 getenv ;
-
-: callcc1 ( quot -- | quot: continuation -- )
-    #! Call a quotation with the current continuation, which may
-    #! be restored using continue-with.
-    [ drop (continue-with) ] ifcc ; inline
-
 : callcc0 ( quot -- | quot: continuation -- )
     #! Call a quotation with the current continuation, which may
-    #! be restored using continue-with.
+    #! be restored using continue.
     [ drop ] ifcc ; inline
 
 : continue ( continuation -- )
@@ -55,6 +48,13 @@ TUPLE: continuation data c call name catch ;
     >continuation< set-catchstack set-namestack set-callstack
     >r set-datastack r> set-c-stack ; inline
 
+: (continue-with) 9 getenv ;
+
+: callcc1 ( quot -- | quot: continuation -- )
+    #! Call a quotation with the current continuation, which may
+    #! be restored using continue-with.
+    [ drop (continue-with) ] ifcc ; inline
+
 : continue-with ( object continuation -- object )
     #! Restore a continuation, and place the object in the
     #! restored data stack.

library/inference/call-optimizers.factor

@@ -19,7 +19,7 @@ math math-internals sequences words ;
     dup node-param "foldable" word-prop [
         dup node-in-d [
             dup literal?
-            [ 2drop t ] [ swap node-literals hash* ] ifte
+            [ 2drop t ] [ swap node-literals ?hash* ] ifte
         ] all-with?
     ] [
         drop f
@@ -28,7 +28,7 @@ math math-internals sequences words ;
 : literal-in-d ( #call -- inputs )
     dup node-in-d [
         dup literal?
-        [ nip literal-value ] [ swap node-literals hash ] ifte
+        [ nip literal-value ] [ swap node-literals ?hash ] ifte
     ] map-with ;
 
 : partial-eval ( #call -- node )
@@ -55,7 +55,7 @@ math math-internals sequences words ;
 
 : disjoint-eq? ( node -- ? )
     dup node-classes swap node-in-d
-    [ swap hash ] map-with
+    [ swap ?hash ] map-with
     first2 2dup and [ classes-intersect? not ] [ 2drop f ] ifte ;
 
 \ eq? {

library/inference/dataflow.factor

@@ -36,12 +36,7 @@ TUPLE: node param shuffle
 M: node = eq? ;
 
 : make-node ( param in-d out-d in-r out-r node -- node )
-    [
-        >r
-        swapd <shuffle> {{ }} clone {{ }} clone { } clone f f <node>
-        r>
-        set-delegate
-    ] keep ;
+    [ >r swapd <shuffle> f f f f f <node> r> set-delegate ] keep ;
 
 : node-in-d  node-shuffle shuffle-in-d  ;
 : node-in-r  node-shuffle shuffle-in-r  ;
@@ -219,7 +214,9 @@ SYMBOL: current-node
     #! Annotate each node with the fact it was inlined from
     #! 'word'.
     [
-        dup #call? [ node-history push ] [ 2drop ] ifte
+        dup #call?
+        [ [ node-history ?push ] keep set-node-history ]
+        [ 2drop ] ifte
     ] each-node-with ;
 
 : (clone-node) ( node -- node )

library/inference/inline-methods.factor

@@ -16,7 +16,7 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
 
 : node-classes* ( node seq -- seq )
     >r node-classes r>
-    [ swap hash [ object ] unless* ] map-with ;
+    [ swap ?hash [ object ] unless* ] map-with ;
 
 : dispatching-classes ( node -- seq )
     dup dup node-param dispatching-values node-classes* ;

library/ui/hierarchy.factor

@@ -22,9 +22,6 @@ namespaces sequences vectors ;
 : clear-gadget ( gadget -- )
     dup (clear-gadget) relayout ;
 
-: ?push ( elt seq/f -- seq )
-    [ 1 <vector> ] unless* [ push ] keep ;
-
 : (add-gadget) ( gadget box -- )
     over unparent
     dup pick set-gadget-parent