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

compiler.tree.propagation.*: better to use 2array than the "cuter" /\ word

db4
Björn Lindqvist 2015-09-18 10:12:56 +02:00
parent 9369f8216f
commit 44092bf78d
5 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/compiler/tree/propagation/branches/branches.factor
View File

@ -110,7 +110,7 @@ M: #phi propagate-before ( #phi -- )
[ [
drop condition-value get drop condition-value get
[ [ =t ] [ =t ] bi* <--> ] [ [ =t ] [ =t ] bi* <--> ]
[ [ =f ] [ =f ] bi* <--> ] 2bi /\ [ [ =f ] [ =f ] bi* <--> ] 2bi 2array
] ]
} }
{ {
@ -118,14 +118,14 @@ M: #phi propagate-before ( #phi -- )
[ [
drop condition-value get drop condition-value get
[ [ =t ] [ =f ] bi* <--> ] [ [ =t ] [ =f ] bi* <--> ]
[ [ =f ] [ =t ] bi* <--> ] 2bi /\ [ [ =f ] [ =t ] bi* <--> ] 2bi 2array
] ]
} }
{ {
{ { t f } { f } } { { t f } { f } }
[ [
first =t first =t
condition-value get =t /\ condition-value get =t 2array
swap t--> swap t-->
] ]
} }
@ -133,7 +133,7 @@ M: #phi propagate-before ( #phi -- )
{ { f } { t f } } { { f } { t f } }
[ [
second =t second =t
condition-value get =f /\ condition-value get =f 2array
swap t--> swap t-->
] ]
} }
@ -141,7 +141,7 @@ M: #phi propagate-before ( #phi -- )
{ { t f } { t } } { { t f } { t } }
[ [
first =f first =f
condition-value get =t /\ condition-value get =t 2array
swap f--> swap f-->
] ]
} }
@ -149,7 +149,7 @@ M: #phi propagate-before ( #phi -- )
{ { t } { t f } } { { t } { t f } }
[ [
second =f second =f
condition-value get =f /\ condition-value get =f 2array
swap f--> swap f-->
] ]
} }
@ -158,7 +158,7 @@ M: #phi propagate-before ( #phi -- )
[ [
first first
[ [ =t ] bi@ <--> ] [ [ =t ] bi@ <--> ]
[ [ =f ] bi@ <--> ] 2bi /\ [ [ =f ] bi@ <--> ] 2bi 2array
0 include-child-constraints 0 include-child-constraints
] ]
} }
@ -167,7 +167,7 @@ M: #phi propagate-before ( #phi -- )
[ [
second second
[ [ =t ] bi@ <--> ] [ [ =t ] bi@ <--> ]
[ [ =f ] bi@ <--> ] 2bi /\ [ [ =f ] bi@ <--> ] 2bi 2array
1 include-child-constraints 1 include-child-constraints
] ]
} }

2
basis/compiler/tree/propagation/constraints/constraints-docs.factor
View File

@ -26,6 +26,8 @@ HELP: satisfied?
ARTICLE: "compiler.tree.propagation.constraints" "Support for predicated value info" ARTICLE: "compiler.tree.propagation.constraints" "Support for predicated value info"
"A constraint is a statement about a value." "A constraint is a statement about a value."
$nl $nl
"Boolean constraints:"
{ $subsections true-constraint true-constraint }
"Utilities:" "Utilities:"
{ $subsections t--> f--> } ; { $subsections t--> f--> } ;

3
basis/compiler/tree/propagation/constraints/constraints.factor
View File

@ -16,7 +16,6 @@ M: object satisfied? drop f ;
: assume ( constraint -- ) dup satisfied? [ drop ] [ assume* ] if ; : assume ( constraint -- ) dup satisfied? [ drop ] [ assume* ] if ;
! Boolean constraints
TUPLE: true-constraint value ; TUPLE: true-constraint value ;
: =t ( value -- constraint ) resolve-copy true-constraint boa ; : =t ( value -- constraint ) resolve-copy true-constraint boa ;
@ -96,8 +95,6 @@ M: equivalence assume*
! Conjunction constraints -- sequences act as conjunctions ! Conjunction constraints -- sequences act as conjunctions
M: sequence assume* [ assume ] each ; M: sequence assume* [ assume ] each ;
: /\ ( p q -- constraint ) 2array ;
: t--> ( constraint boolean-value -- constraint' ) =t swap --> ; : t--> ( constraint boolean-value -- constraint' ) =t swap --> ;
: f--> ( constraint boolean-value -- constraint' ) =f swap --> ; : f--> ( constraint boolean-value -- constraint' ) =f swap --> ;

4
basis/compiler/tree/propagation/known-words/known-words.factor
View File

@ -184,11 +184,11 @@ IN: compiler.tree.propagation.known-words
in2 value-info interval>> :> i2 in2 value-info interval>> :> i2
in1 i1 i2 op assumption is-in-interval in1 i1 i2 op assumption is-in-interval
in2 i2 i1 op swap-comparison assumption is-in-interval in2 i2 i1 op swap-comparison assumption is-in-interval
/\ ; 2array ;
:: comparison-constraints ( in1 in2 out op -- constraint ) :: comparison-constraints ( in1 in2 out op -- constraint )
in1 in2 op (comparison-constraints) out t--> in1 in2 op (comparison-constraints) out t-->
in1 in2 op negate-comparison (comparison-constraints) out f--> /\ ; in1 in2 op negate-comparison (comparison-constraints) out f--> 2array ;
: define-comparison-constraints ( word op -- ) : define-comparison-constraints ( word op -- )
'[ _ comparison-constraints ] "constraints" set-word-prop ; '[ _ comparison-constraints ] "constraints" set-word-prop ;

2
basis/compiler/tree/propagation/simple/simple.factor
View File

@ -54,7 +54,7 @@ M: #declare propagate-before
: predicate-constraints ( value class boolean-value -- constraint ) : predicate-constraints ( value class boolean-value -- constraint )
[ [ is-instance-of ] dip t--> ] [ [ is-instance-of ] dip t--> ]
[ [ class-not is-instance-of ] dip f--> ] [ [ class-not is-instance-of ] dip f--> ]
3bi /\ ; 3bi 2array ;
: custom-constraints ( #call quot -- ) : custom-constraints ( #call quot -- )
[ [ in-d>> ] [ out-d>> ] bi append ] dip [ [ in-d>> ] [ out-d>> ] bi append ] dip