inverses for append and prepend
parent
796a7e9d37
commit
142007f94d
|
@ -70,3 +70,8 @@ C: <nil> nil
|
|||
[ t ] [ pi [ pi ] matches? ] unit-test
|
||||
[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
|
||||
[ ] [ 3 [ _ ] undo ] unit-test
|
||||
|
||||
[ { 1 } ] [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
|
||||
[ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
|
||||
[ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
|
||||
[ { 1 2 3 } [ { 2 3 } prepend ] undo ] must-fail
|
||||
|
|
|
@ -4,13 +4,13 @@ USING: accessors kernel words summary slots quotations
|
|||
sequences assocs math arrays stack-checker effects generalizations
|
||||
continuations debugger classes.tuple namespaces make vectors
|
||||
bit-arrays byte-arrays strings sbufs math.functions macros
|
||||
sequences.private combinators mirrors
|
||||
sequences.private combinators mirrors splitting
|
||||
combinators.short-circuit fry words.symbol ;
|
||||
RENAME: _ fry => __
|
||||
IN: inverse
|
||||
|
||||
ERROR: fail ;
|
||||
M: fail summary drop "Unification failed" ;
|
||||
M: fail summary drop "Matching failed" ;
|
||||
|
||||
: assure ( ? -- ) [ fail ] unless ;
|
||||
|
||||
|
@ -204,6 +204,9 @@ DEFER: _
|
|||
\ unclip [ prefix ] define-inverse
|
||||
\ suffix [ dup but-last swap peek ] define-inverse
|
||||
|
||||
\ append 1 [ [ ?tail assure ] curry ] define-pop-inverse
|
||||
\ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse
|
||||
|
||||
! Constructor inverse
|
||||
: deconstruct-pred ( class -- quot )
|
||||
"predicate" word-prop [ dupd call assure ] curry ;
|
||||
|
|
Loading…
Reference in New Issue