some recursive value inferencer fixes

cvs
Slava Pestov 2005-08-06 05:59:49 +00:00
parent eecf8d59ae
commit fe34a8cc74
8 changed files with 53 additions and 59 deletions

View File

@ -69,8 +69,8 @@ The Factor source distribution ships with four boot image files:
boot.image.le32 - for x86 boot.image.le32 - for x86
boot.image.be32 - for PowerPC, SPARC boot.image.be32 - for PowerPC, SPARC
boot.image.le64 - for x86-64 boot.image.le64 - for x86-64, Alpha
boot.image.be64 - for Alpha, PowerPC/64, UltraSparc boot.image.be64 - for PowerPC/64, UltraSparc
Once you have compiled the Factor runtime, you must bootstrap the Factor Once you have compiled the Factor runtime, you must bootstrap the Factor
system using the image that corresponds to your CPU architecture. system using the image that corresponds to your CPU architecture.

View File

@ -1,7 +1,7 @@
! Simple IRC bot written in Factor. ! Simple IRC bot written in Factor.
USING: generic hashtables http io kernel math namespaces USING: errors generic hashtables http io kernel math namespaces
prettyprint sequences strings words ; parser prettyprint sequences strings unparser words ;
IN: factorbot IN: factorbot
SYMBOL: irc-stream SYMBOL: irc-stream

View File

@ -84,7 +84,6 @@ parser prettyprint sequences io vectors words ;
"/library/tools/memory.factor" "/library/tools/memory.factor"
"/library/inference/dataflow.factor" "/library/inference/dataflow.factor"
"/library/inference/values.factor"
"/library/inference/inference.factor" "/library/inference/inference.factor"
"/library/inference/branches.factor" "/library/inference/branches.factor"
"/library/inference/words.factor" "/library/inference/words.factor"

View File

@ -290,7 +290,7 @@ M: hashtable ' ( hashtable -- pointer )
: with-minimal-image ( quot -- image ) : with-minimal-image ( quot -- image )
[ [
300000 <vector> image set 800000 <vector> image set
<namespace> "objects" set <namespace> "objects" set
call call
image get image get

View File

@ -19,6 +19,51 @@ M: inference-error error. ( error -- )
"! Recursive state:" print "! Recursive state:" print
inference-error-rstate [.] ; inference-error-rstate [.] ;
TUPLE: value recursion safe? ;
C: value ( rstate -- value )
t over set-value-safe?
recursive-state get over set-value-recursion ;
M: value = eq? ;
TUPLE: computed ;
C: computed ( -- value ) <value> over set-delegate ;
TUPLE: literal value ;
C: literal ( obj -- value )
<value> over set-delegate
[ set-literal-value ] keep ;
M: value literal-value ( value -- )
{
"A literal value was expected where a computed value was found.\n"
"This means that an attempt was made to compile a word that\n"
"applies 'call' or 'execute' to a value that is not known\n"
"at compile time. The value might become known if the word\n"
"is marked 'inline'. See the handbook for details."
} concat inference-error ;
TUPLE: meet values ;
C: meet ( values -- value )
<value> over set-delegate [ set-meet-values ] keep ;
PREDICATE: tuple safe-literal ( obj -- ? )
dup literal? [ value-safe? ] [ drop f ] ifte ;
: subst-values ( new old node -- )
[
dup .
3dup [ node-in-d subst ] keep set-node-in-d
3dup [ node-in-r subst ] keep set-node-in-r
3dup [ node-out-d subst ] keep set-node-out-d
3dup [ node-out-r subst ] keep set-node-out-r
drop
] each-node 2drop ;
! Word properties that affect inference: ! Word properties that affect inference:
! - infer-effect -- must be set. controls number of inputs ! - infer-effect -- must be set. controls number of inputs
! expected, and number of outputs produced. ! expected, and number of outputs produced.

View File

@ -230,17 +230,6 @@ M: #values can-kill* ( literal node -- ? )
drop t drop t
] ifte ; ] ifte ;
: subst-values ( new old node -- )
dup [
3dup [ node-in-d subst ] keep set-node-in-d
3dup [ node-in-r subst ] keep set-node-in-r
3dup [ node-out-d subst ] keep set-node-out-d
3dup [ node-out-r subst ] keep set-node-out-r
node-successor subst-values
] [
3drop
] ifte ;
: values/merge ( #values #merge -- new old ) : values/merge ( #values #merge -- new old )
>r >r node-in-d r> node-in-d 2vector unify-lengths 2unseq r> ; >r >r node-in-d r> node-in-d 2vector unify-lengths 2unseq r> ;

View File

@ -22,10 +22,10 @@ M: node solve-recursion* ( node -- ) drop ;
M: #label solve-recursion* ( node -- ) M: #label solve-recursion* ( node -- )
dup node-param over collect-recursion >r dup node-param over collect-recursion >r
node-children first dup node-in-d r> swap add node-children first dup node-in-d r> swap add
unify-stacks swap [ node-in-d ] keep unify-stacks swap [ node-in-d ] keep
node-successor subst-values ; node-successor dup . subst-values ;
: solve-recursion ( node -- ) : solve-recursion ( node -- )
#! Figure out which values survive inner recursions in #! Figure out which values survive inner recursions in
#! #labels, and those that don't should be fudged. #! #labels, and those that don't should be fudged.
( [ solve-recursion* ] each-node ) drop ; [ solve-recursion* ] each-node ;

View File

@ -1,39 +0,0 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USING: generic kernel lists namespaces sequences unparser words ;
TUPLE: value recursion safe? ;
C: value ( rstate -- value )
t over set-value-safe?
recursive-state get over set-value-recursion ;
M: value = eq? ;
TUPLE: computed ;
C: computed ( -- value ) <value> over set-delegate ;
TUPLE: literal value ;
C: literal ( obj -- value )
<value> over set-delegate
[ set-literal-value ] keep ;
M: value literal-value ( value -- )
{
"A literal value was expected where a computed value was found.\n"
"This means that an attempt was made to compile a word that\n"
"applies 'call' or 'execute' to a value that is not known\n"
"at compile time. The value might become known if the word\n"
"is marked 'inline'. See the handbook for details."
} concat inference-error ;
TUPLE: meet values ;
C: meet ( values -- value )
<value> over set-delegate [ set-meet-values ] keep ;
PREDICATE: tuple safe-literal ( obj -- ? )
dup literal? [ value-safe? ] [ drop f ] ifte ;