Fix type inference regression
parent
4daa1943d8
commit
1db4c9cc8a
|
@ -185,20 +185,14 @@ M: pair constraint-satisfied?
|
|||
[ swap predicate-constraints ] [ 2drop ] if
|
||||
] if* ;
|
||||
|
||||
: default-output-classes ( word -- classes )
|
||||
"inferred-effect" word-prop {
|
||||
{ [ dup not ] [ drop f ] }
|
||||
{ [ dup effect-out [ class? ] all? not ] [ drop f ] }
|
||||
{ [ t ] [ effect-out ] }
|
||||
} cond ;
|
||||
|
||||
: compute-output-classes ( node word -- classes intervals )
|
||||
dup node-param "output-classes" word-prop dup
|
||||
[ call ] [ 2drop f f ] if ;
|
||||
dup node-param "output-classes" word-prop
|
||||
dup [ call ] [ 2drop f f ] if ;
|
||||
|
||||
: output-classes ( node -- classes intervals )
|
||||
dup compute-output-classes
|
||||
>r [ ] [ node-param default-output-classes ] ?if r> ;
|
||||
dup compute-output-classes >r
|
||||
[ ] [ node-param "default-output-classes" word-prop ] ?if
|
||||
r> ;
|
||||
|
||||
M: #call infer-classes-before
|
||||
dup compute-constraints
|
||||
|
|
|
@ -147,6 +147,7 @@ M: object infer-call
|
|||
] "infer" set-word-prop
|
||||
|
||||
: set-primitive-effect ( word effect -- )
|
||||
2dup effect-out "default-output-classes" set-word-prop
|
||||
dupd [ make-call-node ] 2curry "infer" set-word-prop ;
|
||||
|
||||
! Stack effects for all primitives
|
||||
|
|
Loading…
Reference in New Issue