Fold class predicates applied to literals
parent
2e48915f9c
commit
f539406ee1
|
@ -8,7 +8,7 @@ math.functions math.private strings layouts
|
|||
compiler.tree.propagation.info compiler.tree.def-use
|
||||
compiler.tree.debugger compiler.tree.checker
|
||||
slots.private words hashtables classes assocs locals
|
||||
float-arrays ;
|
||||
float-arrays system ;
|
||||
IN: compiler.tree.propagation.tests
|
||||
|
||||
\ propagate must-infer
|
||||
|
@ -590,6 +590,8 @@ MIXIN: empty-mixin
|
|||
|
||||
[ V{ float-array } ] [ [| | F{ } ] final-classes ] unit-test
|
||||
|
||||
[ V{ t } ] [ [ netbsd unix? ] final-literals ] unit-test
|
||||
|
||||
! [ V{ string } ] [
|
||||
! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
|
||||
! ] unit-test
|
||||
|
|
|
@ -76,13 +76,25 @@ M: #declare propagate-before
|
|||
: fold-call ( #call word -- )
|
||||
[ (fold-call) ] [ drop out-d>> ] 2bi set-value-infos ;
|
||||
|
||||
: predicate-output-infos ( info class -- info )
|
||||
: predicate-output-infos/literal ( info class -- info )
|
||||
[ literal>> ] dip
|
||||
'[ _ _ instance? <literal-info> ]
|
||||
[ drop object-info ]
|
||||
recover ;
|
||||
|
||||
: predicate-output-infos/class ( info class -- info )
|
||||
[ class>> ] dip {
|
||||
{ [ 2dup class<= ] [ t <literal-info> ] }
|
||||
{ [ 2dup classes-intersect? not ] [ f <literal-info> ] }
|
||||
[ object-info ]
|
||||
} cond 2nip ;
|
||||
|
||||
: predicate-output-infos ( info class -- info )
|
||||
over literal?>>
|
||||
[ predicate-output-infos/literal ]
|
||||
[ predicate-output-infos/class ]
|
||||
if ;
|
||||
|
||||
: propagate-predicate ( #call word -- infos )
|
||||
#! We need to force the caller word to recompile when the class
|
||||
#! is redefined, since now we're making assumptions but the
|
||||
|
|
Loading…
Reference in New Issue