Fold class predicates applied to literals

db4
Slava Pestov 2008-10-02 05:12:38 -05:00
parent 2e48915f9c
commit f539406ee1
2 changed files with 16 additions and 2 deletions

View File

@ -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

View File

@ -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