compiler.propagation.call-effect: handle class-info only value-infos

Checks if the `slots>>` value-info slot is non-empty before trying to infer
effect from non-literal value-info.

Fixes #2351

diff --git a/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor b/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
index 0511fbc8f7a17de2ea35c3ea187f2eb5446a4830..7f38ba9d7cd133ec17851084efef34e3dba37bd7 100644 (file)
--- a/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
+++ b/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
@@ -3,6 +3,7 @@
 USING: accessors combinators combinators.private compiler.test
 compiler.tree compiler.tree.builder compiler.tree.debugger
 compiler.tree.optimizer compiler.tree.propagation.call-effect
+compiler.tree.propagation.info
 compiler.units effects eval fry kernel kernel.private math sequences
 tools.test ;
 IN: compiler.tree.propagation.call-effect.tests
@@ -157,3 +158,8 @@ TUPLE: my-tuple a b c ;
 { } [ "IN: compiler.tree.propagation.call-effect.tests TUPLE: my-tuple a b ;" eval( -- ) ] unit-test
 
 [ 1 2 3 my-quot my-word ] [ wrong-values? ] must-fail-with
+
+! Regression
+[ composed <class-info> (infer-value) ] [ uninferable? ] must-fail-with
+{ t } [ [ 1 ] [ 2 ] compose <literal-info> (infer-value) ( -- x x ) effect= ] unit-test
+{ } [ "IN: compiler.tree.propagation.call-effect.tests USE: kernel.private : blub ( x -- ) { composed } declare call( -- ) ;" eval( -- ) ] unit-test

diff --git a/basis/compiler/tree/propagation/call-effect/call-effect.factor b/basis/compiler/tree/propagation/call-effect/call-effect.factor
index 443f452cb577af00e4d90f24fb5ec973aee709b3..08ff0901f4890cfc66d15e8e46904852a4c51dd6 100644 (file)
--- a/basis/compiler/tree/propagation/call-effect/call-effect.factor
+++ b/basis/compiler/tree/propagation/call-effect/call-effect.factor
@@ -148,7 +148,7 @@ ERROR: uninferable ;
         [ already-inlined-quot? [ uninferable ] when ]
         [ safe-infer dup +unknown+ = [ uninferable ] when ] tri
     ] [
-        dup class>> {
+        dup { [ slots>> empty? not ] [ class>> ] } 1&& {
             { \ curried [ slots>> third (infer-value) remove-effect-input ] }
             { \ composed [ slots>> last2 [ (infer-value) ] bi@ compose-effects ] }
             [ uninferable ]