diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor index f6b3989e45..79bc065bd6 100644 --- a/basis/compiler/tree/propagation/branches/branches.factor +++ b/basis/compiler/tree/propagation/branches/branches.factor @@ -110,7 +110,7 @@ M: #phi propagate-before ( #phi -- ) [ drop condition-value get [ [ =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 [ [ =t ] [ =f ] bi* <--> ] - [ [ =f ] [ =t ] bi* <--> ] 2bi /\ + [ [ =f ] [ =t ] bi* <--> ] 2bi 2array ] } { { { t f } { f } } [ first =t - condition-value get =t /\ + condition-value get =t 2array swap t--> ] } @@ -133,7 +133,7 @@ M: #phi propagate-before ( #phi -- ) { { f } { t f } } [ second =t - condition-value get =f /\ + condition-value get =f 2array swap t--> ] } @@ -141,7 +141,7 @@ M: #phi propagate-before ( #phi -- ) { { t f } { t } } [ first =f - condition-value get =t /\ + condition-value get =t 2array swap f--> ] } @@ -149,7 +149,7 @@ M: #phi propagate-before ( #phi -- ) { { t } { t f } } [ second =f - condition-value get =f /\ + condition-value get =f 2array swap f--> ] } @@ -158,7 +158,7 @@ M: #phi propagate-before ( #phi -- ) [ first [ [ =t ] bi@ <--> ] - [ [ =f ] bi@ <--> ] 2bi /\ + [ [ =f ] bi@ <--> ] 2bi 2array 0 include-child-constraints ] } @@ -167,7 +167,7 @@ M: #phi propagate-before ( #phi -- ) [ second [ [ =t ] bi@ <--> ] - [ [ =f ] bi@ <--> ] 2bi /\ + [ [ =f ] bi@ <--> ] 2bi 2array 1 include-child-constraints ] } diff --git a/basis/compiler/tree/propagation/constraints/constraints-docs.factor b/basis/compiler/tree/propagation/constraints/constraints-docs.factor index 8f06749ab7..274c865690 100644 --- a/basis/compiler/tree/propagation/constraints/constraints-docs.factor +++ b/basis/compiler/tree/propagation/constraints/constraints-docs.factor @@ -26,6 +26,8 @@ HELP: satisfied? ARTICLE: "compiler.tree.propagation.constraints" "Support for predicated value info" "A constraint is a statement about a value." $nl +"Boolean constraints:" +{ $subsections true-constraint true-constraint } "Utilities:" { $subsections t--> f--> } ; diff --git a/basis/compiler/tree/propagation/constraints/constraints.factor b/basis/compiler/tree/propagation/constraints/constraints.factor index 2b445f8a98..3814973e87 100644 --- a/basis/compiler/tree/propagation/constraints/constraints.factor +++ b/basis/compiler/tree/propagation/constraints/constraints.factor @@ -16,7 +16,6 @@ M: object satisfied? drop f ; : assume ( constraint -- ) dup satisfied? [ drop ] [ assume* ] if ; -! Boolean constraints TUPLE: true-constraint value ; : =t ( value -- constraint ) resolve-copy true-constraint boa ; @@ -96,8 +95,6 @@ M: equivalence assume* ! Conjunction constraints -- sequences act as conjunctions M: sequence assume* [ assume ] each ; -: /\ ( p q -- constraint ) 2array ; - : t--> ( constraint boolean-value -- constraint' ) =t swap --> ; : f--> ( constraint boolean-value -- constraint' ) =f swap --> ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 9b6e943a01..6557abdead 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -184,11 +184,11 @@ IN: compiler.tree.propagation.known-words in2 value-info interval>> :> i2 in1 i1 i2 op assumption is-in-interval in2 i2 i1 op swap-comparison assumption is-in-interval - /\ ; + 2array ; :: comparison-constraints ( in1 in2 out op -- constraint ) 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 -- ) '[ _ comparison-constraints ] "constraints" set-word-prop ; diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index 3e105445ed..ee6301e69e 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -54,7 +54,7 @@ M: #declare propagate-before : predicate-constraints ( value class boolean-value -- constraint ) [ [ is-instance-of ] dip t--> ] [ [ class-not is-instance-of ] dip f--> ] - 3bi /\ ; + 3bi 2array ; : custom-constraints ( #call quot -- ) [ [ in-d>> ] [ out-d>> ] bi append ] dip