Words which didn't compile cannot be run at all

basis/compiler/compiler.factor

@@ -62,18 +62,25 @@ SYMBOLS: +optimized+ +unoptimized+ ;
         } 1||
     ] [ error-type +compiler-warning+ eq? ] bi* and ;
 
-: (fail) ( word -- * )
+: (fail) ( word compiled -- * )
+    swap
     [ compiled-unxref ]
-    [ f swap compiled get set-at ]
+    [ compiled get set-at ]
     [ +unoptimized+ save-compiled-status ]
     tri
     return ;
 
+: not-compiled-def ( word error -- def )
+    '[ _ _ not-compiled ] [ ] like ;
+
 : fail ( word error -- * )
-    [ 2dup ignore-error? [ drop f ] when swap compiler-error ] [ drop (fail) ] 2bi ;
+    2dup ignore-error?
+    [ drop f over def>> ]
+    [ 2dup not-compiled-def ] if
+    [ swap compiler-error ] [ (fail) ] bi-curry* bi ;
 
 : frontend ( word -- nodes )
-    dup contains-breakpoints? [ (fail) ] [
+    dup contains-breakpoints? [ dup def>> (fail) ] [
         [ build-tree-from-word ] [ fail ] recover optimize-tree
     ] if ;
 
@@ -124,7 +131,7 @@ t compile-dependencies? set-global
     [ (compile) yield-hook get call( -- ) ] slurp-deque ;
 
 : decompile ( word -- )
-    f 2array 1array modify-code-heap ;
+    dup def>> 2array 1array modify-code-heap ;
 
 : compile-call ( quot -- )
     [ dup infer define-temp ] with-compilation-unit execute ;

basis/compiler/errors/errors.factor

@@ -52,3 +52,5 @@ T{ error-type
 : compiler-error ( error word -- )
     compiler-errors get-global pick
     [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
+
+ERROR: not-compiled word error ;

basis/compiler/tree/builder/builder.factor

@@ -45,8 +45,8 @@ IN: compiler.tree.builder
     infer-quot-here ;
 
 : check-effect ( word effect -- )
-    over required-stack-effect 2dup effect<=
-    [ 3drop ] [ effect-error ] if ;
+    swap required-stack-effect 2dup effect<=
+    [ 2drop ] [ effect-error ] if ;
 
 : finish-word ( word -- )
     current-effect check-effect ;

basis/stack-checker/errors/errors.factor

@@ -52,9 +52,9 @@ TUPLE: missing-effect word ;
 : missing-effect ( word -- * )
     pretty-word \ missing-effect inference-error ;
 
-TUPLE: effect-error word inferred declared ;
+TUPLE: effect-error inferred declared ;
 
-: effect-error ( word inferred declared -- * )
+: effect-error ( inferred declared -- * )
     \ effect-error inference-error ;
 
 TUPLE: recursive-quotation-error quot ;

basis/stack-checker/errors/prettyprint/prettyprint.factor

@@ -40,10 +40,7 @@ M: missing-effect summary
     ] "" make ;
 
 M: effect-error summary
-    [
-        "Stack effect declaration of the word " %
-        word>> name>> % " is wrong" %
-    ] "" make ;
+    drop "Stack effect declaration is wrong" ;
 
 M: recursive-quotation-error error.
     "The quotation " write

basis/tools/errors/errors.factor

@@ -40,3 +40,9 @@ M: source-file-error error.
 : :warnings ( -- ) +compiler-warning+ compiler-errors. ;
 
 : :linkage ( -- ) +linkage-error+ compiler-errors. ;
+
+M: not-compiled summary
+    word>> name>> "The word " " cannot be executed because it failed to compile" surround ;
+
+M: not-compiled error.
+    [ summary print nl ] [ error>> error. ] bi ;

core/compiler/units/units-docs.factor

@@ -60,8 +60,8 @@ HELP: modify-code-heap ( alist -- )
 { $values { "alist" "an alist" } }
 { $description "Stores compiled code definitions in the code heap. The alist maps words to the following:"
 { $list
-    { { $link f } " - in this case, the word is compiled with the non-optimizing compiler part of the VM." }
-    { { $snippet "{ code labels rel words literals }" } " - in this case, a code heap block is allocated with the given data." }
+    { "a quotation - in this case, the quotation is compiled with the non-optimizing compiler and the word will call the quotation when executed." }
+    { { $snippet "{ code labels rel words literals }" } " - in this case, a code heap block is allocated with the given data and the word will call the code block when executed." }
 } }
 { $notes "This word is called at the end of " { $link with-compilation-unit } "." } ;
 

core/compiler/units/units-tests.factor

@@ -14,7 +14,7 @@ IN: compiler.units.tests
 
 ! Non-optimizing compiler bugs
 [ 1 1 ] [
-    "A" "B" <word> [ [ 1 ] dip ] >>def dup f 2array 1array modify-code-heap
+    "A" "B" <word> [ [ 1 ] dip ] 2array 1array modify-code-heap
     1 swap execute
 ] unit-test
 

core/compiler/units/units.factor

@@ -41,7 +41,7 @@ SYMBOL: compiler-impl
 HOOK: recompile compiler-impl ( words -- alist )
 
 ! Non-optimizing compiler
-M: f recompile [ f ] { } map>assoc ;
+M: f recompile [ dup def>> ] { } map>assoc ;
 
 ! Trivial compiler. We don't want to touch the code heap
 ! during stage1 bootstrap, it would just waste time.

vm/code_heap.c

@@ -21,14 +21,16 @@ void set_word_code(F_WORD *word, F_CODE_BLOCK *compiled)
 	word->optimizedp = T;
 }
 
-/* Allocates memory */
-void default_word_code(F_WORD *word, bool relocate)
+/* Compile a word definition with the non-optimizing compiler. Allocates memory */
+void jit_compile_word(F_WORD *word, CELL def, bool relocate)
 {
+	REGISTER_ROOT(def);
 	REGISTER_UNTAGGED(word);
-	jit_compile(word->def,relocate);
+	jit_compile(def,relocate);
 	UNREGISTER_UNTAGGED(word);
+	UNREGISTER_ROOT(def);
 
-	word->code = untag_quotation(word->def)->code;
+	word->code = untag_quotation(def)->code;
 	word->optimizedp = F;
 }
 
@@ -83,15 +85,15 @@ void primitive_modify_code_heap(void)
 
 		CELL data = array_nth(pair,1);
 
-		if(data == F)
+		if(type_of(data) == QUOTATION_TYPE)
 		{
 			REGISTER_UNTAGGED(alist);
 			REGISTER_UNTAGGED(word);
-			default_word_code(word,false);
+			jit_compile_word(word,data,false);
 			UNREGISTER_UNTAGGED(word);
 			UNREGISTER_UNTAGGED(alist);
 		}
-		else
+		else if(type_of(data) == ARRAY_TYPE)
 		{
 			F_ARRAY *compiled_code = untag_array(data);
 
@@ -115,6 +117,8 @@ void primitive_modify_code_heap(void)
 
 			set_word_code(word,compiled);
 		}
+		else
+			critical_error("Expected a quotation or an array",data);
 
 		REGISTER_UNTAGGED(alist);
 		update_word_xt(word);

vm/code_heap.h

@@ -5,7 +5,7 @@ void init_code_heap(CELL size);
 
 bool in_code_heap_p(CELL ptr);
 
-void default_word_code(F_WORD *word, bool relocate);
+void jit_compile_word(F_WORD *word, CELL def, bool relocate);
 
 void set_word_code(F_WORD *word, F_CODE_BLOCK *compiled);
 

vm/quotations.c

@@ -532,8 +532,7 @@ void compile_all_words(void)
 	{
 		F_WORD *word = untag_word(array_nth(untag_array(words),i));
 		REGISTER_UNTAGGED(word);
-		if(word->optimizedp == F)
-			default_word_code(word,false);
+		jit_compile_word(word,word->def,false);
 		UNREGISTER_UNTAGGED(word);
 		update_word_xt(word);
 	}

vm/types.c

@@ -54,7 +54,7 @@ F_WORD *allot_word(CELL vocab, CELL name)
 	word->code = NULL;
 
 	REGISTER_UNTAGGED(word);
-	default_word_code(word,true);
+	jit_compile_word(word,word->def,true);
 	UNREGISTER_UNTAGGED(word);
 
 	REGISTER_UNTAGGED(word);