steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

more inference cleanups

cvs
Slava Pestov 2005-08-05 04:05:04 +00:00
parent 4b20f07b0f
commit 2057449bbc
4 changed files with 10 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
library/inference/branches.factor
View File

@ -103,12 +103,9 @@ namespaces prettyprint sequences strings unparser vectors words ;
#ifte pop-d drop infer-branches #ifte pop-d drop infer-branches
] "infer" set-word-prop ] "infer" set-word-prop
: vtable-value ( rstate vtable -- seq )
[ swap <literal> ] map-with ;
USE: kernel-internals USE: kernel-internals
\ dispatch [ \ dispatch [
pop-literal vtable-value pop-literal nip [ <literal> ] map
#dispatch pop-d drop infer-branches #dispatch pop-d drop infer-branches
] "infer" set-word-prop ] "infer" set-word-prop

2
library/inference/inference.factor
View File

@ -66,7 +66,7 @@ GENERIC: apply-object
: apply-literal ( obj -- ) : apply-literal ( obj -- )
#! Literals are annotated with the current recursive #! Literals are annotated with the current recursive
#! state. #! state.
recursive-state get <literal> push-d 1 #push node, ; <literal> push-d 1 #push node, ;
M: object apply-object apply-literal ; M: object apply-object apply-literal ;

15
library/inference/values.factor
View File

@ -5,21 +5,20 @@ USING: generic kernel lists namespaces sequences unparser words ;
TUPLE: value recursion safe? ; TUPLE: value recursion safe? ;
C: value ( recursion -- value ) C: value ( rstate -- value )
[ t swap set-value-safe? ] keep t over set-value-safe?
[ set-value-recursion ] keep ; recursive-state get over set-value-recursion ;
M: value = eq? ; M: value = eq? ;
TUPLE: computed ; TUPLE: computed ;
C: computed ( -- value ) C: computed ( -- value ) <value> over set-delegate ;
recursive-state get <value> over set-delegate ;
TUPLE: literal value ; TUPLE: literal value ;
C: literal ( obj rstate -- value ) C: literal ( obj -- value )
[ >r <value> r> set-delegate ] keep <value> over set-delegate
[ set-literal-value ] keep ; [ set-literal-value ] keep ;
M: value literal-value ( value -- ) M: value literal-value ( value -- )
@ -34,7 +33,7 @@ M: value literal-value ( value -- )
TUPLE: meet values ; TUPLE: meet values ;
C: meet ( values -- value ) C: meet ( values -- value )
[ set-meet-values ] keep f <value> over set-delegate ; <value> over set-delegate [ set-meet-values ] keep ;
PREDICATE: tuple safe-literal ( obj -- ? ) PREDICATE: tuple safe-literal ( obj -- ? )
dup literal? [ value-safe? ] [ drop f ] ifte ; dup literal? [ value-safe? ] [ drop f ] ifte ;

2
library/test/compiler/optimizer.factor
View File

@ -23,7 +23,7 @@ USE: sequences
[ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test [ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test
[ [ t t f ] ] [ [ [ t t f ] ] [
[ 1 2 3 ] [ f <literal> ] map [ 1 2 3 ] [ <literal> ] map
[ [ literal-value 2 <= ] subset ] keep in-d-node <#drop> kill-mask [ [ literal-value 2 <= ] subset ] keep in-d-node <#drop> kill-mask
] unit-test ] unit-test