Assorted fixes

core/bootstrap/image/image.factor

@@ -390,8 +390,6 @@ M: curry '
     heap-size data-heap-size-offset fixup ;
 
 : end-image ( -- )
-    "Building generic words..." print flush
-    all-words [ generic? ] subset [ make-generic ] each
     "Serializing words..." print flush
     emit-words
     "Serializing JIT data..." print flush

core/bootstrap/primitives.factor

@@ -22,6 +22,7 @@ crossref off
 
 H{ } clone dictionary set
 H{ } clone changed-words set
+H{ } clone changed-generics set
 [ drop ] recompile-hook set
 
 call
@@ -608,3 +609,6 @@ builtins get num-tags get tail f union-class define-class
 
 ! Bump build number
 "build" "kernel" create build 1+ 1quotation define-compound
+
+! Make generics
+changed-generics get keys [ make-generic ] each

core/classes/classes-tests.factor

@@ -78,9 +78,7 @@ M: union-1 generic-update-test drop "union-1" ;
 
 [ union-1 ] [ fixnum float class-or ] unit-test
 
-"IN: temporary UNION: union-1 rational array ;" eval
-
-do-parse-hook
+"IN: temporary USE: math USE: arrays UNION: union-1 rational array ;" eval
 
 [ t ] [ bignum union-1 class< ] unit-test
 [ f ] [ union-1 number class< ] unit-test
@@ -88,9 +86,7 @@ do-parse-hook
 
 [ object ] [ fixnum float class-or ] unit-test
 
-"IN: temporary PREDICATE: integer union-1 even? ;" eval
-
-do-parse-hook
+"IN: temporary USE: math PREDICATE: integer union-1 even? ;" eval
 
 [ f ] [ union-1 union-class? ] unit-test
 [ t ] [ union-1 predicate-class? ] unit-test
@@ -130,7 +126,7 @@ INSTANCE: integer mx1
 [ t ] [ mx1 integer class< ] unit-test
 [ t ] [ mx1 number class< ] unit-test
 
-"INSTANCE: array mx1" eval
+"IN: temporary USE: arrays INSTANCE: array mx1" eval
 
 [ t ] [ array mx1 class< ] unit-test
 [ f ] [ mx1 number class< ] unit-test
@@ -161,7 +157,7 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
 [ t ] [ quotation redefine-bug-2 class< ] unit-test
 [ redefine-bug-2 ] [ fixnum quotation class-or ] unit-test
 
-"IN: temporary UNION: redefine-bug-1 bignum ;" eval
+"IN: temporary USE: math UNION: redefine-bug-1 bignum ;" eval
 
 [ t ] [ bignum redefine-bug-1 class< ] unit-test
 [ f ] [ fixnum redefine-bug-2 class< ] unit-test

core/compiler/compiler-docs.factor

@@ -109,5 +109,5 @@ HELP: compile-begins
 
 HELP: (compile)
 { $values { "word" word } }
-{ $description "Compile a word. This word recursively calls itself to compile all dependencies." }
+{ $description "Compile a single word." }
 { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;

core/compiler/compiler.factor

@@ -34,8 +34,7 @@ SYMBOL: compiler-hook
             dup compile-begins
             dup word-dataflow optimize >r over dup r> generate
         ] [
-            print-error
-            dup f compiled-xts get set-at f
+            print-error f
         ] recover
         2dup ripple-up save-effect
     ] [ drop ] if ;

core/compiler/test/redefine.factor

@@ -3,46 +3,3 @@ namespaces parser tools.test words kernel sequences arrays io
 effects tools.test.inference ;
 IN: temporary
 
-[ t ] [
-    changed-words get assoc-size
-    [ ] define-temp drop
-    changed-words get assoc-size =
-] unit-test
-
-parse-hook get [
-    DEFER: foo \ foo reset-generic
-    DEFER: bar \ bar reset-generic
-
-    [   ] [ \ foo [ 1 2 ] define-compound ] unit-test
-    { 0 2 } [ foo ] unit-test-effect
-    [   ] [ \ foo compile ] unit-test
-    [   ] [ \ bar [ foo foo ] define-compound ] unit-test
-    [   ] [ \ bar compile ] unit-test
-    [   ] [ \ foo [ 1 2 3 ] define-compound ] unit-test
-    [ t ] [ \ bar changed-words get key? ] unit-test
-    [   ] [ recompile ] unit-test
-    { 0 3 } [ foo ] unit-test-effect
-    [ f ] [ \ bar changed-words get key? ] unit-test
-    [   ] [ \ bar [ 1 2 ] define-compound ] unit-test
-    [ t ] [ \ bar changed-words get key? ] unit-test
-    [   ] [ recompile ] unit-test
-    { 0 2 } [ bar ] unit-test-effect
-    [ f ] [ \ bar changed-words get key? ] unit-test
-    [   ] [ \ foo [ 1 2 3 ] define-compound ] unit-test
-    [ f ] [ \ bar changed-words get key? ] unit-test
-    [   ] [ \ bar [ 1 2 3 ] define-compound ] unit-test
-    [ t ] [ \ bar changed-words get key? ] unit-test
-    [   ] [ [ \ bar forget ] with-compilation-unit ] unit-test
-    [ f ] [ \ bar changed-words get key? ] unit-test
-
-    : xy ;
-    : yx xy ;
-
-    \ yx compile
-    
-    \ xy [ 1 ] define-compound
-
-    [ ] [ recompile ] unit-test
-
-    [ 1 ] [ yx ] unit-test
-] when

core/cpu/x86/bootstrap.factor

@@ -21,7 +21,8 @@ big-endian off
     stack-frame-size PUSH                      ! save stack frame size       
     xt-reg PUSH                                ! save XT
     arg0 PUSH                                  ! save array
-    stack-reg 4 bootstrap-cells SUB            ! reserve space for scan-save
+    scan-reg PUSH                              ! initial scan
+    stack-reg 3 bootstrap-cells SUB            ! reserved
 ] { } make jit-prolog set                      
                                                
 : advance-scan scan-reg bootstrap-cell ADD ;   

core/definitions/definitions.factor

@@ -45,6 +45,7 @@ M: object redefined* drop ;
     dup unxref crossref get delete-at ;
 
 SYMBOL: changed-words
+SYMBOL: changed-generics
 SYMBOL: old-definitions
 SYMBOL: new-definitions
 
@@ -77,14 +78,18 @@ TUPLE: forward-error word ;
     [ drop f ] if ;
 
 SYMBOL: recompile-hook
+SYMBOL: make-generic-hook
 
 : <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
 
 : with-compilation-unit ( quot -- new-defs )
     [
         H{ } clone changed-words set
+        H{ } clone changed-generics set
         <definitions> new-definitions set
         <definitions> old-definitions set
-        [ changed-words get keys recompile-hook get call ] [ ]
-        cleanup
+        [
+            changed-generics get keys make-generic-hook get call
+            changed-words get keys recompile-hook get call
+        ] [ ] cleanup
     ] with-scope ; inline

core/generator/generator.factor

@@ -13,19 +13,14 @@ SYMBOL: compiled-xts
 
 : 6array 3array >r 3array r> append ;
 
-: begin-compiling ( word -- )
-    f swap compiled-xts get set-at ;
-
 : finish-compiling ( word literals words rel labels code -- )
     6array swap compiled-xts get set-at ;
 
 : compiling? ( word -- ? )
-    {
-        { [ dup compiled-xts get key? ] [ drop t ] }
-        { [ t ] [ compiled? ] }
-    } cond ;
+    dup compiled-xts get key? swap compiled? ;
 
 : queue-compile ( word -- )
+    dup f compiled-xts get set-at
     compile-queue get push-front ;
 
 SYMBOL: compiling-word
@@ -46,7 +41,7 @@ t compiled-stack-traces? set-global
     literal-table get push ;
 
 : generate-1 ( word label node quot -- )
-    pick begin-compiling [
+    [
         roll compiling-word set
         pick compiling-label set
         init-generator

core/generic/generic.factor

@@ -28,8 +28,11 @@ M: object perform-combination
     dup "combination" word-prop perform-combination
     define-compound ;
 
+[ [ make-generic ] each ] make-generic-hook set-global
+
 : ?make-generic ( word -- )
-    [ [ ] define-compound ] [ make-generic ] if-bootstrapping ;
+    dup compound? [ dup [ ] define-compound ] unless
+    dup changed-generics get set-at ;
 
 : init-methods ( word -- )
      dup "methods" word-prop
@@ -111,6 +114,4 @@ M: class forget ( class -- )
     forget-word ;
 
 M: class update-methods ( class -- )
-    [ drop ]
-    [ class-usages implementors* [ make-generic ] each ]
-    if-bootstrapping ;
+    class-usages implementors* [ ?make-generic ] each ;

core/kernel/kernel-tests.factor

@@ -102,3 +102,9 @@ IN: temporary
 
 [ 3drop datastack ] unit-test-fails
 [ ] [ :c ] unit-test
+
+! Doesn't compile; important
+: foo 5 + 0 [ ] each ;
+
+[ drop foo ] unit-test-fails
+[ ] [ :c ] unit-test