From 16c067e71a1f69e601b11f0048bceb92d686cbe5 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 13 Jan 2009 10:29:27 +0100 Subject: [PATCH 1/5] FUEL: Bug fix. --- extra/fuel/help/help.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index 298124ffb4..ff7239ac8f 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -95,7 +95,7 @@ PRIVATE> [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline : (fuel-word-def) ( name -- str ) - fuel-find-word [ [ def>> pprint ] with-string-writer ] when* ; inline + fuel-find-word [ [ def>> pprint ] with-string-writer ] [ f ] if* ; inline : (fuel-vocab-summary) ( name -- str ) >vocab-link summary ; inline From 7e751b4195c6279cdee4cf9dc880bed2f9fa2e50 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 13 Jan 2009 11:57:59 +0100 Subject: [PATCH 2/5] FUEL: Fix the fix to multiline string literals font-lock. --- misc/fuel/fuel-syntax.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 7f0fa313c2..b74b0afc11 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -94,7 +94,7 @@ "\\_<-?[0-9]+\\.[0-9]*\\([eE][+-]?[0-9]+\\)?\\_>") (defconst fuel-syntax--bad-string-regex - "\"[^\"]*$") + "\"\\([^\"]\\|\\\\\"\\)*\n") (defconst fuel-syntax--word-definition-regex (fuel-syntax--second-word-regex @@ -226,7 +226,7 @@ ;; CHARs: ("CHAR: \\(.\\)\\( \\|$\\)" (1 "w")) ;; Strings - ("\\(\"\\)[^\n\r\f]*\\(\"\\)" (1 "\"") (2 "\"")) + ("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\\"?\\)*\\(\"\\)" (1 "\"") (3 "\"")) ;; Let and lambda: ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">")) ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]")) From 5fbfc1acf1ad56959d342bb2b1f73a464ed5f4c5 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Tue, 13 Jan 2009 16:34:28 +0100 Subject: [PATCH 3/5] Remove duplicate inverse definition --- extra/inverse/inverse.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index a38af644b0..b9e0788192 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -148,7 +148,6 @@ MACRO: undo ( quot -- ) [undo] ; \ exp [ log ] define-inverse \ log [ exp ] define-inverse -\ not [ not ] define-inverse \ sq [ sqrt ] define-inverse \ sqrt [ sq ] define-inverse From 280564b6ecd6321dbf1d2a5615b09d61d8e52dbe Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Tue, 13 Jan 2009 16:39:34 +0100 Subject: [PATCH 4/5] Define reciprocal inverses with "define-dual" --- extra/inverse/inverse-docs.factor | 7 ++++++- extra/inverse/inverse-tests.factor | 3 +++ extra/inverse/inverse.factor | 15 +++++++-------- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/extra/inverse/inverse-docs.factor b/extra/inverse/inverse-docs.factor index 8204f7174c..c2615fc411 100644 --- a/extra/inverse/inverse-docs.factor +++ b/extra/inverse/inverse-docs.factor @@ -14,7 +14,12 @@ 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-pop-inverse } ; +{ $see-also define-dual 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 } ; HELP: define-pop-inverse { $values { "word" "a word" } { "n" "number of arguments to be taken from the inverted quotation" } { "quot" "a quotation" } } diff --git a/extra/inverse/inverse-tests.factor b/extra/inverse/inverse-tests.factor index 5e662ed78f..3dce620857 100644 --- a/extra/inverse/inverse-tests.factor +++ b/extra/inverse/inverse-tests.factor @@ -75,3 +75,6 @@ C: nil [ { 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 + +[ [ sq ] ] [ [ sqrt ] [undo] ] unit-test +[ [ sqrt ] ] [ [ sq ] [undo] ] unit-test diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index b9e0788192..ec4df1ba69 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -20,6 +20,9 @@ M: fail summary drop "Matching failed" ; : define-inverse ( word quot -- ) "inverse" set-word-prop ; +: define-dual ( word1 word2 -- ) + 2dup swap [ 1quotation define-inverse ] 2bi@ ; + : define-math-inverse ( word quot1 quot2 -- ) pick 1quotation 3array "math-inverse" set-word-prop ; @@ -139,17 +142,14 @@ MACRO: undo ( quot -- ) [undo] ; \ not [ not ] define-inverse \ >boolean [ { t f } memq? assure ] define-inverse -\ tuple>array [ >tuple ] define-inverse -\ >tuple [ tuple>array ] define-inverse +\ tuple>array \ >tuple define-dual \ reverse [ reverse ] define-inverse \ undo 1 [ [ call ] curry ] define-pop-inverse \ map 1 [ [undo] [ over sequence? assure map ] curry ] define-pop-inverse -\ exp [ log ] define-inverse -\ log [ exp ] define-inverse -\ sq [ sqrt ] define-inverse -\ sqrt [ sq ] define-inverse +\ exp \ log define-dual +\ sq \ sqrt define-dual ERROR: missing-literal ; @@ -203,8 +203,7 @@ DEFER: _ \ first3 [ 3array ] define-inverse \ first4 [ 4array ] define-inverse -\ prefix [ unclip ] define-inverse -\ unclip [ prefix ] define-inverse +\ prefix \ unclip define-dual \ suffix [ dup but-last swap peek ] define-inverse \ append 1 [ [ ?tail assure ] curry ] define-pop-inverse From dccb72befef2081e5e3a59c63d3b5cd5955d8c7d Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Tue, 13 Jan 2009 16:58:31 +0100 Subject: [PATCH 5/5] Define involutary words with "define-involution" --- extra/inverse/inverse-docs.factor | 9 +++++++-- extra/inverse/inverse-tests.factor | 2 ++ extra/inverse/inverse.factor | 8 +++++--- 3 files changed, 14 insertions(+), 5 deletions(-) diff --git a/extra/inverse/inverse-docs.factor b/extra/inverse/inverse-docs.factor index c2615fc411..6b575d6d08 100644 --- a/extra/inverse/inverse-docs.factor +++ b/extra/inverse/inverse-docs.factor @@ -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" } } diff --git a/extra/inverse/inverse-tests.factor b/extra/inverse/inverse-tests.factor index 3dce620857..a9234fcff4 100644 --- a/extra/inverse/inverse-tests.factor +++ b/extra/inverse/inverse-tests.factor @@ -78,3 +78,5 @@ C: 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 diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index ec4df1ba69..924a6d3814 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -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