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

new accessors

db4
Doug Coleman 2008-08-29 10:28:01 -05:00
parent b839f608d0
commit f85493e980
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/inverse/inverse.factor
View File

@ -40,8 +40,8 @@ M: no-inverse summary
: constant-word? ( word -- ? ) : constant-word? ( word -- ? )
stack-effect stack-effect
[ effect-out length 1 = ] keep [ out>> length 1 = ] keep
effect-in length 0 = and ; in>> length 0 = and ;
: assure-constant ( constant -- quot ) : assure-constant ( constant -- quot )
dup word? [ "Badly formed math inverse" throw ] when 1quotation ; dup word? [ "Badly formed math inverse" throw ] when 1quotation ;
@ -65,7 +65,7 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
: enough? ( stack word -- ? ) : enough? ( stack word -- ? )
dup deferred? [ 2drop f ] [ dup deferred? [ 2drop f ] [
[ >r length r> 1quotation infer effect-in >= ] [ >r length r> 1quotation infer in>> >= ]
[ 3drop f ] recover [ 3drop f ] recover
] if ; ] if ;
@ -235,11 +235,11 @@ DEFER: _
] recover ; inline ] recover ; inline
: true-out ( quot effect -- quot' ) : true-out ( quot effect -- quot' )
effect-out [ ndrop ] curry out>> [ ndrop ] curry
[ t ] 3compose ; [ t ] 3compose ;
: false-recover ( effect -- quot ) : false-recover ( effect -- quot )
effect-in [ ndrop f ] curry [ recover-fail ] curry ; in>> [ ndrop f ] curry [ recover-fail ] curry ;
: [matches?] ( quot -- undoes?-quot ) : [matches?] ( quot -- undoes?-quot )
[undo] dup infer [ true-out ] keep false-recover curry ; [undo] dup infer [ true-out ] keep false-recover curry ;