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

inverses for append and prepend

db4
Daniel Ehrenberg 2009-01-04 15:59:55 -05:00
parent 796a7e9d37
commit 142007f94d
2 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
extra/inverse/inverse-tests.factor
View File

@ -70,3 +70,8 @@ C: <nil> nil
[ t ] [ pi [ pi ] matches? ] unit-test [ t ] [ pi [ pi ] matches? ] unit-test
[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
[ ] [ 3 [ _ ] 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

7
extra/inverse/inverse.factor
View File

@ -4,13 +4,13 @@ USING: accessors kernel words summary slots quotations
sequences assocs math arrays stack-checker effects generalizations sequences assocs math arrays stack-checker effects generalizations
continuations debugger classes.tuple namespaces make vectors continuations debugger classes.tuple namespaces make vectors
bit-arrays byte-arrays strings sbufs math.functions macros bit-arrays byte-arrays strings sbufs math.functions macros
sequences.private combinators mirrors sequences.private combinators mirrors splitting
combinators.short-circuit fry words.symbol ; combinators.short-circuit fry words.symbol ;
RENAME: _ fry => __ RENAME: _ fry => __
IN: inverse IN: inverse
ERROR: fail ; ERROR: fail ;
M: fail summary drop "Unification failed" ; M: fail summary drop "Matching failed" ;
: assure ( ? -- ) [ fail ] unless ; : assure ( ? -- ) [ fail ] unless ;
@ -204,6 +204,9 @@ DEFER: _
\ unclip [ prefix ] define-inverse \ unclip [ prefix ] define-inverse
\ suffix [ dup but-last swap peek ] 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 ! Constructor inverse
: deconstruct-pred ( class -- quot ) : deconstruct-pred ( class -- quot )
"predicate" word-prop [ dupd call assure ] curry ; "predicate" word-prop [ dupd call assure ] curry ;