compiling when/unless

library/compiler/assembly-x86.factor

@@ -205,5 +205,8 @@ USE: combinators
 : JE ( -- fixup )
     HEX: 0f compile-byte HEX: 84 compile-byte  (JUMP) ;
 
+: JNE ( -- fixup )
+    HEX: 0f compile-byte HEX: 85 compile-byte  (JUMP) ;
+
 : RET ( -- )
     HEX: c3 compile-byte ;

library/compiler/ifte.factor

@@ -33,14 +33,23 @@ USE: kernel
 USE: math
 USE: lists
 
-: compile-f-test ( -- fixup )
-    #! Push addr where we write the branch target address.
+: compile-test ( -- )
     POP-DS
     ! ptr to condition is now in EAX
-    f address EAX CMP-I-[R]
+    f address EAX CMP-I-[R] ;
+
+: compile-f-test ( -- fixup )
+    #! Push addr where we write the branch target address.
+    compile-test
     ! jump w/ address added later
     JE ;
 
+: compile-t-test ( -- fixup )
+    #! Push addr where we write the branch target address.
+    compile-test
+    ! jump w/ address added later
+    JNE ;
+
 : branch-target ( fixup -- )
     compiled-offset swap JUMP-FIXUP ;
 
@@ -61,4 +70,18 @@ USE: lists
     ( f -- ) compile-quot
     r> end-if ;
 
+: compile-when ( compile-time: true -- )
+    pop-literal  commit-literals
+    compile-f-test >r
+    ( t -- ) compile-quot
+    r> end-if ;
+
+: compile-unless ( compile-time: false -- )
+    pop-literal  commit-literals
+    compile-t-test >r
+    ( t -- ) compile-quot
+    r> end-if ;
+
 [ compile-ifte ] \ ifte "compiling" set-word-property
+[ compile-when ] \ when "compiling" set-word-property
+[ compile-unless ] \ unless "compiling" set-word-property

library/inspect-vocabularies.factor

@@ -47,7 +47,7 @@ USE: unparser
 : usages-in-vocab ( of vocab -- usages )
     #! Push a list of all usages of a word in a vocabulary.
     words [
-        dup defined? [
+        dup compound? [
             dupd word-uses?
         ] [
             drop f ! Ignore words without a definition

library/platform/native/boot-stage2.factor

@@ -158,8 +158,11 @@ USE: stdio
 IN: init
 DEFER: warm-boot
 
+IN: compiler
+DEFER: init-assembler
+
 : set-boot ( quot -- ) 8 setenv ;
-[ warm-boot ] set-boot
+[ init-assembler warm-boot ] set-boot
 
 garbage-collection
 "factor.image" save-image

library/platform/native/math.factor

@@ -337,23 +337,23 @@ USE: words
 
 : bitnot ( x -- ~x )
     {
-        [ fixnum-bitnot ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ bignum-bitnot ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
+        fixnum-bitnot
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        bignum-bitnot
+        no-method
+        no-method
+        no-method
     } generic ;
 
 : shift ( x n -- x<<n )

library/platform/native/prettyprint.factor

@@ -66,6 +66,9 @@ USE: words
 : see-primitive ( word -- )
     "PRIMITIVE: " write dup unparse write stack-effect. terpri ;
 
+: see-symbol ( word -- )
+    "SYMBOL: " write . ;
+
 : see-undefined ( word -- )
     drop "Not defined" print ;
 
@@ -74,6 +77,7 @@ USE: words
     intern
     [
         [ compound? ] [ see-compound ]
+        [ symbol? ] [ see-symbol ]
         [ primitive? ] [ see-primitive ]
         [ drop t ] [ see-undefined ]
     ] cond ;

library/platform/native/words.factor

@@ -30,6 +30,7 @@ USE: combinators
 USE: kernel
 USE: lists
 USE: logic
+USE: math
 USE: namespaces
 USE: stack
 
@@ -46,7 +47,7 @@ USE: stack
     dup word? [ word-primitive 1 = ] [ drop f ] ifte ;
 
 : primitive? ( obj -- ? )
-    dup word? [ word-primitive 1 = not ] [ drop f ] ifte ;
+    dup word? [ word-primitive 2 > ] [ drop f ] ifte ;
 
 : symbol? ( obj -- ? )
     dup word? [ word-primitive 2 = ] [ drop f ] ifte ;

library/test/test.factor

@@ -104,6 +104,9 @@ USE: unparser
     native? [
         [
             "threads"
+            "x86-compiler/simple"
+            "x86-compiler/ifte"
+            "x86-compiler/generic"
         ] [
             test
         ] each

library/test/x86-compiler/ifte.factor

@@ -61,3 +61,34 @@ DEFER: countdown-b
 : countdown-b ( n -- ) dup 0 eq? [ drop ] [ 1 fixnum- countdown-a ] ifte ; compiled
 
 [ ] [ 10 countdown-b ] unit-test
+
+: dummy-when-1 t [ ] when ; compiled
+
+[ ] [ dummy-when-1 ] unit-test
+
+: dummy-when-2 f [ ] when ; compiled
+
+[ ] [ dummy-when-2 ] unit-test
+
+: dummy-when-3 dup [ dup fixnum* ] when ; compiled
+
+[ 16 ] [ 4 dummy-when-3 ] unit-test
+[ f ] [ f dummy-when-3 ] unit-test
+
+: dummy-when-4 dup [ dup dup fixnum* fixnum* ] when swap ; compiled
+
+[ 64 f ] [ f 4 dummy-when-4 ] unit-test
+[ f t ] [ t f dummy-when-4 ] unit-test
+
+: dummy-unless-1 t [ ] unless ; compiled
+
+[ ] [ dummy-unless-1 ] unit-test
+
+: dummy-unless-2 f [ ] unless ; compiled
+
+[ ] [ dummy-unless-2 ] unit-test
+
+: dummy-unless-3 dup [ drop 3 ] unless ; compiled
+
+[ 3 ] [ f dummy-unless-3 ] unit-test
+[ 4 ] [ 4 dummy-unless-3 ] unit-test