More test fixes
parent
1951e63d2d
commit
e63be4d157
|
|
@ -34,7 +34,7 @@ M: node = eq? ;
|
||||||
: meta-d-node meta-d get clone in-node ;
|
: meta-d-node meta-d get clone in-node ;
|
||||||
|
|
||||||
: d-tail ( n -- list ) meta-d get tail* ;
|
: d-tail ( n -- list ) meta-d get tail* ;
|
||||||
: c-tail ( n -- list ) meta-c get tail* ;
|
: r-tail ( n -- list ) meta-r get tail* ;
|
||||||
|
|
||||||
: node-child node-children first ;
|
: node-child node-children first ;
|
||||||
|
|
||||||
|
|
@ -97,12 +97,12 @@ C: #declare make-node ;
|
||||||
|
|
||||||
: node-inputs ( d-count r-count node -- )
|
: node-inputs ( d-count r-count node -- )
|
||||||
tuck
|
tuck
|
||||||
>r c-tail r> set-node-in-r
|
>r r-tail r> set-node-in-r
|
||||||
>r d-tail r> set-node-in-d ;
|
>r d-tail r> set-node-in-d ;
|
||||||
|
|
||||||
: node-outputs ( d-count r-count node -- )
|
: node-outputs ( d-count r-count node -- )
|
||||||
tuck
|
tuck
|
||||||
>r c-tail r> set-node-out-r
|
>r r-tail r> set-node-out-r
|
||||||
>r d-tail r> set-node-out-d ;
|
>r d-tail r> set-node-out-d ;
|
||||||
|
|
||||||
! Variable holding dataflow graph being built.
|
! Variable holding dataflow graph being built.
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,7 @@ SYMBOL: base-case-continuation
|
||||||
TUPLE: inference-error message rstate data-stack call-stack ;
|
TUPLE: inference-error message rstate data-stack call-stack ;
|
||||||
|
|
||||||
: inference-error ( msg -- )
|
: inference-error ( msg -- )
|
||||||
recursive-state get meta-d get meta-c get
|
recursive-state get meta-d get meta-r get
|
||||||
<inference-error> throw ;
|
<inference-error> throw ;
|
||||||
|
|
||||||
M: inference-error error. ( error -- )
|
M: inference-error error. ( error -- )
|
||||||
|
|
@ -109,6 +109,7 @@ M: quotation infer-quot ( quot -- )
|
||||||
[
|
[
|
||||||
inferring-base-case off
|
inferring-base-case off
|
||||||
base-case-continuation off
|
base-case-continuation off
|
||||||
|
{ } recursive-state set
|
||||||
f init-inference
|
f init-inference
|
||||||
call
|
call
|
||||||
check-return
|
check-return
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2004, 2005 Slava Pestov.
|
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: inference
|
IN: inference
|
||||||
USING: arrays errors generic hashtables interpreter kernel lists
|
USING: arrays errors generic hashtables interpreter kernel
|
||||||
math math-internals namespaces parser prettyprint sequences
|
math math-internals namespaces parser prettyprint sequences
|
||||||
strings vectors words ;
|
strings vectors words ;
|
||||||
|
|
||||||
|
|
@ -37,7 +37,7 @@ TUPLE: rstate label base-case? ;
|
||||||
r> current-node set ;
|
r> current-node set ;
|
||||||
|
|
||||||
: with-recursive-state ( word label base-case quot -- )
|
: with-recursive-state ( word label base-case quot -- )
|
||||||
>r <rstate> 2array recursive-state [ cons ] change r>
|
>r <rstate> 2array recursive-state [ swap add ] change r>
|
||||||
nest-node 2slip unnest-node ; inline
|
nest-node 2slip unnest-node ; inline
|
||||||
|
|
||||||
: inline-block ( word base-case -- node-block variables )
|
: inline-block ( word base-case -- node-block variables )
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
IN: temporary
|
IN: temporary
|
||||||
USE: kernel
|
USE: kernel
|
||||||
USE: lists
|
|
||||||
USE: math
|
USE: math
|
||||||
USE: namespaces
|
USE: namespaces
|
||||||
USE: io
|
USE: io
|
||||||
|
|
|
||||||
|
|
@ -69,5 +69,5 @@ namespaces prettyprint sequences test ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ V{ "4\n" } ] [
|
[ V{ "4\n" } ] [
|
||||||
[ [ 2 2 + . ] string-out ] test-interpreter
|
[ [ 2 2 + number>string print ] string-out ] test-interpreter
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
! Copyright (C) 2004, 2005 Slava Pestov.
|
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||||
! See http://factor.sf.net/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: interpreter
|
IN: interpreter
|
||||||
USING: errors generic io kernel kernel-internals lists math
|
USING: errors generic io kernel kernel-internals lists math
|
||||||
namespaces prettyprint sequences strings vectors words ;
|
namespaces prettyprint sequences strings vectors words ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue