more preliminary work for callcc compilation

library/bootstrap/image.factor

@@ -26,14 +26,17 @@ SYMBOL: 64-bits
 
 : emit ( cell -- ) image get push ;
 
+: d>w/w ( d -- w w )
+    #! I cannot use bignum literals here because of bootstrap
+    #! deficencies.
+    dup 1 32 shift 1- bitand
+    swap -32 shift 1 32 shift 1- bitand ;
+
 : emit-64 ( cell -- )
     64-bits get [
         emit
     ] [
-        dup 1 32 shift 1- bitand
-        swap -32 shift 1 32 shift 1- bitand
-        big-endian get [ swap ] when
-        emit emit
+        d>w/w big-endian get [ swap ] unless emit emit
     ] ifte ;
 
 : emit-seq ( seq -- ) image get swap nappend ;

library/inference/branches.factor

@@ -7,7 +7,7 @@ namespaces parser prettyprint sequences strings vectors words ;
 : unify-lengths ( seq -- seq )
     #! Pad all vectors to the same length. If one vector is
     #! shorter, pad it with unknown results at the bottom.
-    dup [ length ] map supremum swap [ add-inputs ] map-with ;
+    dup 0 [ length max ] reduce swap [ add-inputs ] map-with ;
 
 : unify-length ( seq seq -- seq )
     2array unify-lengths first2 ;
@@ -27,15 +27,23 @@ namespaces parser prettyprint sequences strings vectors words ;
     [ dup [ length - ] [ 2drop f ] ifte ] 2map
     [ ] subset all-equal? ;
 
+: unify-in-d ( seq -- n )
+    #! Input is a sequence of positive integers or f.
+    #! Output is the maximum or 0.
+    0 [ [ max ] when* ] reduce ;
+
+: unbalanced-branches ( in out -- )
+    { "Unbalanced branches:" } -rot [
+        swap number>string " " rot length number>string
+        append3
+    ] 2map append "\n" join inference-error ;
+
 : unify-effect ( in out -- in out )
     #! In is a sequence of integers; out is a sequence of stacks.
-    2dup balanced?
-    [ unify-stacks >r supremum r> ]
-    [
-        { "Unbalanced branches:" } -rot [
-            swap number>string " " rot length number>string
-            append3
-        ] 2map append "\n" join inference-error
+    2dup balanced? [
+        unify-stacks >r unify-in-d r>
+    ] [
+        unbalanced-branches
     ] ifte ;
 
 : datastack-effect ( seq -- )

library/inference/inference.factor

@@ -84,7 +84,7 @@ M: wrapper apply-object wrapped apply-literal ;
 
 : terminate ( -- )
     #! Ignore this branch's stack effect.
-    meta-d off meta-r off #terminate node, ;
+    d-in off meta-d off meta-r off #terminate node, ;
 
 : infer-quot ( quot -- )
     #! Recursive calls to this word are made for nested

library/math/matrices.factor

@@ -28,8 +28,6 @@ USING: arrays generic kernel sequences ;
 
 : sum ( v -- n ) 0 [ + ] reduce ;
 : product ( v -- n ) 1 [ * ] reduce ;
-: infimum ( v -- n ) dup first [ min ] reduce ;
-: supremum ( v -- n ) dup first [ max ] reduce ;
 
 : set-axis ( x y axis -- v )
     2dup v* >r >r drop dup r> v* v- r> v+ ;

library/tools/inspector.factor

@@ -23,7 +23,7 @@ M: hashtable sheet dup hash-keys swap hash-values 2array ;
 
 : format-column ( list -- list )
     [ unparse-short ] map
-    [ [ length ] map supremum ] keep
+    [ 0 [ length ] reduce ] keep
     [ swap CHAR: \s pad-right ] map-with ;
 
 : sheet-numbers ( sheet -- sheet )

library/unix/io.factor

@@ -74,7 +74,6 @@ C: port ( handle buffer -- port )
     80 <sbuf> over set-port-sbuf ;
 
 : touch-port ( port -- )
-    ! "touch-port called\n" 14 getenv fwrite 14 getenv fflush
     dup port-timeout dup 0 =
     [ 2drop ] [ millis + swap set-port-cutoff ] ifte ;
 

native/float.h

@@ -1,5 +1,9 @@
 typedef struct {
-	CELL header;
+/* C sucks. */
+	union {
+		CELL header;
+		long long padding;
+	};
 	double n;
 } F_FLOAT;