Fix to inverse, and syntax change
parent
d81a4aa914
commit
368599baf8
|
@ -1,5 +1,5 @@
|
|||
USING: inverse tools.test arrays math kernel sequences
|
||||
math.functions math.constants ;
|
||||
math.functions math.constants continuations ;
|
||||
IN: inverse-tests
|
||||
|
||||
[ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
|
||||
|
@ -51,7 +51,7 @@ C: <nil> nil
|
|||
{
|
||||
{ [ <cons> ] [ list-sum + ] }
|
||||
{ [ <nil> ] [ 0 ] }
|
||||
{ [ ] [ "Malformed list" throw ] }
|
||||
[ "Malformed list" throw ]
|
||||
} switch ;
|
||||
|
||||
[ 10 ] [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
|
||||
|
@ -59,6 +59,7 @@ C: <nil> nil
|
|||
[ 1 2 ] [ 1 2 <cons> [ <cons> ] undo ] unit-test
|
||||
[ t ] [ 1 2 <cons> [ <cons> ] matches? ] unit-test
|
||||
[ f ] [ 1 2 <cons> [ <foo> ] matches? ] unit-test
|
||||
[ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test
|
||||
|
||||
: empty-cons ( -- cons ) cons construct-empty ;
|
||||
: cons* ( cdr car -- cons ) { set-cons-cdr set-cons-car } cons construct ;
|
||||
|
@ -68,3 +69,4 @@ C: <nil> nil
|
|||
|
||||
[ t ] [ pi [ pi ] matches? ] unit-test
|
||||
[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
|
||||
[ ] [ 3 [ _ ] undo ] unit-test
|
||||
|
|
|
@ -60,11 +60,13 @@ PREDICATE: math-inverse < word "math-inverse" word-prop ;
|
|||
PREDICATE: pop-inverse < word "pop-length" word-prop ;
|
||||
UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
||||
|
||||
: enough? ( stack quot -- ? )
|
||||
[ >r length r> 1quotation infer effect-in >= ] [ 3drop f ]
|
||||
recover ;
|
||||
: enough? ( stack word -- ? )
|
||||
dup deferred? [ 2drop f ] [
|
||||
[ >r length r> 1quotation infer effect-in >= ]
|
||||
[ 3drop f ] recover
|
||||
] if ;
|
||||
|
||||
: fold-word ( stack quot -- stack )
|
||||
: fold-word ( stack word -- stack )
|
||||
2dup enough?
|
||||
[ 1quotation with-datastack ] [ >r % r> , { } ] if ;
|
||||
|
||||
|
@ -72,10 +74,10 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
|||
[ { } swap [ fold-word ] each % ] [ ] make ;
|
||||
|
||||
: flattenable? ( object -- ? )
|
||||
[ [ word? ] [ primitive? not ] and? ] [
|
||||
{ [ word? ] [ primitive? not ] [
|
||||
{ "inverse" "math-inverse" "pop-inverse" }
|
||||
[ word-prop ] with contains? not
|
||||
] and? ;
|
||||
] } <-&& ;
|
||||
|
||||
: (flatten) ( quot -- )
|
||||
[ dup flattenable? [ word-def (flatten) ] [ , ] if ] each ;
|
||||
|
@ -159,7 +161,7 @@ MACRO: undo ( quot -- ) [undo] ;
|
|||
2curry
|
||||
] define-pop-inverse
|
||||
|
||||
: _ f ;
|
||||
DEFER: _
|
||||
\ _ [ drop ] define-inverse
|
||||
|
||||
: both ( object object -- object )
|
||||
|
@ -256,6 +258,7 @@ M: no-match summary drop "Fall through in switch" ;
|
|||
[ no-match ] [ swap \ recover-fail 3array >quotation ] reduce ;
|
||||
|
||||
: [switch] ( quot-alist -- quot )
|
||||
[ dup quotation? [ [ ] swap 2array ] when ] map
|
||||
reverse [ >r [undo] r> compose ] { } assoc>map
|
||||
recover-chain ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue