Stricter error checking for 'execute' in compiled code

core/compiler/inference/inference.factor

@@ -56,7 +56,7 @@ SYMBOL: recorded
     dataflow-graph off
     current-node off ;
 
-GENERIC: apply-object
+GENERIC: apply-object ( obj -- )
 
 : apply-literal ( obj -- )
     #push dup node,
@@ -67,6 +67,10 @@ M: object apply-object apply-literal ;
 
 M: wrapper apply-object wrapped apply-literal ;
 
+GENERIC: apply-word ( word -- )
+
+M: word apply-object apply-word ;
+
 : terminate ( -- )
     terminated? on #terminate node, ;
 

core/compiler/inference/known-words.factor

@@ -38,9 +38,7 @@ sequences strings vectors words prettyprint namespaces ;
 
 \ execute { word } { } <effect> "inferred-effect" set-word-prop
 
-\ execute [
-    pop-literal unit infer-quot-value
-] "infer" set-word-prop
+\ execute [ pop-literal nip apply-word ] "infer" set-word-prop
 
 \ if { object object object } { } <effect> "inferred-effect" set-word-prop
 

core/compiler/inference/words.factor

@@ -144,7 +144,7 @@ M: compound infer-word
     over "inferred-vars" word-prop
     apply-effect/vars ;
 
-: apply-word ( word -- )
+: default-apply-word ( word -- )
     {
         { [ dup "no-effect" word-prop ] [ no-effect ] }
         { [ dup "infer" word-prop ] [ custom-infer ] }
@@ -152,9 +152,9 @@ M: compound infer-word
         { [ t ] [ dup infer-word apply-effect/vars ] }
     } cond ;
 
-M: word apply-object apply-word ;
+M: word apply-word default-apply-word ;
 
-M: symbol apply-object apply-literal ;
+M: symbol apply-word apply-literal ;
 
 TUPLE: recursive-declare-error word ;
 
@@ -170,7 +170,8 @@ TUPLE: recursive-declare-error word ;
     [ declared-infer ] [ inline-closure ] if ;
 
 : apply-compound ( word -- )
-    dup recursing? [ declared-infer ] [ apply-word ] if ;
+    dup recursing?
+    [ declared-infer ] [ default-apply-word ] if ;
 
 : custom-infer-vars ( word -- )
     dup "infer-vars" word-prop dup [
@@ -180,6 +181,6 @@ TUPLE: recursive-declare-error word ;
         2drop
     ] if ;
 
-M: compound apply-object
+M: compound apply-word
     dup custom-infer-vars
     [ apply-inline ] [ apply-compound ] if-inline ;

core/compiler/test/inference.factor

@@ -380,3 +380,5 @@ SYMBOL: x
 [ V{ 2 3 } ] [ [ [ [ 2 get 3 throw ] [ 3 get ] if ] with-scope ] infer drop inferred-vars-reads ] unit-test
 
 [ V{ } ] [ [ 5 set 5 get ] infer drop inferred-vars-reads ] unit-test
+
+[ [ 3.1 execute ] infer ] unit-test-fails

core/compiler/test/simple.factor

@@ -45,3 +45,13 @@ full-gc
 
 : foox dup [ foox ] when ; inline
 : bar foox ;
+
+: xyz 3 ;
+
+: execute-test execute ; inline
+: execute-test-2 \ xyz execute-test ;
+
+\ execute-test-2 compile
+
+[ f ] [ \ execute-test compiled? ] unit-test
+[ 3 ] [ execute-test-2 ] unit-test