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

mongodb.tuple: fix inference error under stricter stack checking regime

db4
Slava Pestov 2009-11-09 00:55:24 -06:00
parent da4506592d
commit 7a37e4245d
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/mongodb/tuple/persistent/persistent.factor
View File

@ -50,13 +50,13 @@ TUPLE: cond-value value quot ;
CONSTRUCTOR: cond-value ( value quot -- cond-value ) ; CONSTRUCTOR: cond-value ( value quot -- cond-value ) ;
: write-mdb-persistent ( value quot: ( tuple -- assoc ) -- value' ) : write-mdb-persistent ( value quot -- value' )
over [ call( tuple -- assoc ) ] dip over [ call( tuple -- assoc ) ] dip
[ [ tuple-collection name>> ] [ >toid ] bi ] keep [ [ tuple-collection name>> ] [ >toid ] bi ] keep
[ add-storable ] dip [ add-storable ] dip
[ tuple-collection name>> ] [ id>> ] bi <objref> ; inline [ tuple-collection name>> ] [ id>> ] bi <objref> ;
: write-field ( value quot: ( tuple -- assoc ) -- value' ) : write-field ( value quot -- value' )
<cond-value> { <cond-value> {
{ [ dup value>> mdb-special-value? ] [ value>> ] } { [ dup value>> mdb-special-value? ] [ value>> ] }
{ [ dup value>> mdb-persistent? ] { [ dup value>> mdb-persistent? ]
@ -66,7 +66,7 @@ CONSTRUCTOR: cond-value ( value quot -- cond-value ) ;
{ [ dup value>> [ hashtable? ] [ linked-assoc? ] bi or ] { [ dup value>> [ hashtable? ] [ linked-assoc? ] bi or ]
[ [ value>> ] [ quot>> ] bi '[ _ write-field ] assoc-map ] } [ [ value>> ] [ quot>> ] bi '[ _ write-field ] assoc-map ] }
[ value>> ] [ value>> ]
} cond ; inline recursive } cond ;
: write-tuple-fields ( mirror tuple assoc quot: ( tuple -- assoc ) -- ) : write-tuple-fields ( mirror tuple assoc quot: ( tuple -- assoc ) -- )
swap ! m t q q a swap ! m t q q a