More test fixes

slava 2006-05-15 05:49:07 +00:00
parent 1951e63d2d
commit e63be4d157
6 changed files with 12 additions and 12 deletions

View File

@ -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.

View File

@ -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

View File

@ -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 )

View File

@ -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

View File

@ -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

View File

@ -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 ;