Tweaking propagation
parent
97871d4063
commit
da255d9647
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs math math.intervals kernel accessors
|
||||
sequences namespaces disjoint-sets classes classes.algebra
|
||||
sequences namespaces classes classes.algebra
|
||||
combinators words
|
||||
compiler.tree compiler.tree.propagation.info
|
||||
compiler.tree.copy-equiv ;
|
||||
|
|
|
@ -200,6 +200,12 @@ generic-comparison-ops [
|
|||
: info-classes-intersect? ( info1 info2 -- ? )
|
||||
[ class>> ] bi@ classes-intersect? ;
|
||||
|
||||
\ eq? [
|
||||
over value-info literal>> fixnum? [
|
||||
[ value-info literal>> is-equal-to ] dip t-->
|
||||
] [ 3drop f ] if
|
||||
] +constraints+ set-word-prop
|
||||
|
||||
\ eq? [
|
||||
[ info-intervals-intersect? ]
|
||||
[ info-classes-intersect? ]
|
||||
|
|
|
@ -324,6 +324,10 @@ cell-bits 32 = [
|
|||
|
||||
[ V{ t } ] [ [ [ 1 f <array> ] [ 2 f <array> ] if length 3 < ] final-literals ] unit-test
|
||||
|
||||
[ V{ 10 } ] [
|
||||
[ { fixnum } declare dup 10 = [ "A" throw ] unless ] final-literals
|
||||
] unit-test
|
||||
|
||||
! Slot propagation
|
||||
TUPLE: prop-test-tuple { x integer } ;
|
||||
|
||||
|
@ -528,3 +532,7 @@ M: array iterate first t ;
|
|||
[ V{ fixnum } ] [
|
||||
[ { fixnum fixnum } declare [ nth-unsafe ] curry call ] final-classes
|
||||
] unit-test
|
||||
|
||||
[ V{ f } ] [
|
||||
[ 10 eq? [ drop 3 ] unless ] final-literals
|
||||
] unit-test
|
||||
|
|
Loading…
Reference in New Issue