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

Define involutary words with "define-involution"

db4
Samuel Tardieu 2009-01-13 16:58:31 +01:00
parent 280564b6ec
commit dccb72befe
3 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/inverse/inverse-docs.factor
View File

@ -14,12 +14,17 @@ HELP: undo
HELP: define-inverse
{ $values { "word" "a word" } { "quot" "the inverse" } }
{ $description "Defines the inverse of a given word, taking no arguments from the quotation, only the stack." }
{ $see-also define-dual define-pop-inverse } ;
{ $see-also define-dual define-involution define-pop-inverse } ;
HELP: define-dual
{ $values { "word1" "a word" } { "word2" "a word" } }
{ $description "Defines the inverse of each word as being the other one." }
{ $see-also define-inverse } ;
{ $see-also define-inverse define-involution } ;
HELP: define-involution
{ $values { "word" "a word" } }
{ $description "Defines a word as being its own inverse." }
{ $see-also define-dual define-inverse } ;
HELP: define-pop-inverse
{ $values { "word" "a word" } { "n" "number of arguments to be taken from the inverted quotation" } { "quot" "a quotation" } }

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

@ -78,3 +78,5 @@ C: <nil> nil
[ [ sq ] ] [ [ sqrt ] [undo] ] unit-test
[ [ sqrt ] ] [ [ sq ] [undo] ] unit-test
[ [ not ] ] [ [ not ] [undo] ] unit-test
[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] undo ] unit-test

8
extra/inverse/inverse.factor
View File

@ -23,6 +23,8 @@ M: fail summary drop "Matching failed" ;
: define-dual ( word1 word2 -- )
2dup swap [ 1quotation define-inverse ] 2bi@ ;
: define-involution ( word -- ) dup 1quotation define-inverse ;
: define-math-inverse ( word quot1 quot2 -- )
pick 1quotation 3array "math-inverse" set-word-prop ;
@ -132,18 +134,18 @@ MACRO: undo ( quot -- ) [undo] ;
! Inverse of selected words
\ swap [ swap ] define-inverse
\ swap define-involution
\ dup [ [ =/fail ] keep ] define-inverse
\ 2dup [ over =/fail over =/fail ] define-inverse
\ 3dup [ pick =/fail pick =/fail pick =/fail ] define-inverse
\ pick [ [ pick ] dip =/fail ] define-inverse
\ tuck [ swapd [ =/fail ] keep ] define-inverse
\ not [ not ] define-inverse
\ not define-involution
\ >boolean [ { t f } memq? assure ] define-inverse
\ tuple>array \ >tuple define-dual
\ reverse [ reverse ] define-inverse
\ reverse define-involution
\ undo 1 [ [ call ] curry ] define-pop-inverse
\ map 1 [ [undo] [ over sequence? assure map ] curry ] define-pop-inverse