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

Fix construct-empty transform

db4
Slava Pestov 2008-01-18 17:09:45 -05:00
parent 423b0c4697
commit 011681f07a
2 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/inference/transforms/transforms-tests.factor
View File

@ -1,6 +1,6 @@
IN: temporary IN: temporary
USING: sequences inference.transforms tools.test math kernel USING: sequences inference.transforms tools.test math kernel
quotations ; quotations tools.test.inference ;
: compose-n-quot <repetition> >quotation ; : compose-n-quot <repetition> >quotation ;
: compose-n compose-n-quot call ; : compose-n compose-n-quot call ;
@ -18,3 +18,5 @@ quotations ;
[ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test [ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test
[ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test [ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test
\ construct-empty must-infer

26
core/inference/transforms/transforms.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel words sequences generic math namespaces USING: arrays kernel words sequences generic math namespaces
quotations assocs combinators math.bitfields inference.backend quotations assocs combinators math.bitfields inference.backend
inference.dataflow inference.state tuples.private ; inference.dataflow inference.state tuples.private effects ;
IN: inference.transforms IN: inference.transforms
: pop-literals ( n -- rstate seq ) : pop-literals ( n -- rstate seq )
@ -61,11 +61,21 @@ M: pair (bitfield-quot) ( spec -- quot )
\ set-slots [ <reversed> [get-slots] ] 1 define-transform \ set-slots [ <reversed> [get-slots] ] 1 define-transform
: [construct] ( word quot -- newquot ) \ construct-boa [
>r dup +inlined+ depends-on dup tuple-size r> 2curry ; dup +inlined+ depends-on
dup tuple-size [ <tuple-boa> ] 2curry
] 1 define-transform
\ construct-boa \ construct-empty [
[ [ <tuple-boa> ] [construct] ] 1 define-transform 1 ensure-values
peek-d value? [
pop-literal
dup +inlined+ depends-on
dup tuple-size [ <tuple> ] 2curry
swap infer-quot
] [
\ construct-empty declared-infer
] if
] "infer" set-word-prop
\ construct-empty \ construct-empty 1 1 <effect> "inferred-effect" set-word-prop
[ [ <tuple> ] [construct] ] 1 define-transform