From ca7ffd6ea223271951204ac53d858bb518a8984a Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 20:57:49 +0100 Subject: [PATCH 01/13] Separate lazy lists from core primes number generation --- extra/math/primes/factors/factors.factor | 2 +- extra/math/primes/lists/authors.txt | 1 + extra/math/primes/lists/lists-docs.factor | 10 ++++++++++ extra/math/primes/lists/lists-tests.factor | 6 ++++++ extra/math/primes/lists/lists.factor | 9 +++++++++ extra/math/primes/lists/summary.txt | 1 + extra/math/primes/primes-docs.factor | 10 +--------- extra/math/primes/primes-tests.factor | 9 ++------- extra/math/primes/primes.factor | 11 +++-------- extra/project-euler/007/007.factor | 2 +- extra/project-euler/134/134.factor | 2 +- 11 files changed, 36 insertions(+), 27 deletions(-) create mode 100644 extra/math/primes/lists/authors.txt create mode 100644 extra/math/primes/lists/lists-docs.factor create mode 100644 extra/math/primes/lists/lists-tests.factor create mode 100644 extra/math/primes/lists/lists.factor create mode 100644 extra/math/primes/lists/summary.txt diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor index 282c46c82e..8e22757249 100644 --- a/extra/math/primes/factors/factors.factor +++ b/extra/math/primes/factors/factors.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel lists make math math.primes sequences ; +USING: arrays kernel lists make math math.primes.lists sequences ; IN: math.primes.factors array ] unit-test +{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test +{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test +{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test diff --git a/extra/math/primes/lists/lists.factor b/extra/math/primes/lists/lists.factor new file mode 100644 index 0000000000..13f314f6ba --- /dev/null +++ b/extra/math/primes/lists/lists.factor @@ -0,0 +1,9 @@ +! Copyright (C) 2007-2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel lists.lazy math math.primes ; +IN: math.primes.lists + +: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ; + +: lprimes-from ( n -- list ) + dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; diff --git a/extra/math/primes/lists/summary.txt b/extra/math/primes/lists/summary.txt new file mode 100644 index 0000000000..39a780a26b --- /dev/null +++ b/extra/math/primes/lists/summary.txt @@ -0,0 +1 @@ +Infinite stream of prime numbers through lazy lists diff --git a/extra/math/primes/primes-docs.factor b/extra/math/primes/primes-docs.factor index 516b081624..c7dbc950e8 100644 --- a/extra/math/primes/primes-docs.factor +++ b/extra/math/primes/primes-docs.factor @@ -11,15 +11,7 @@ HELP: prime? { $values { "n" "an integer" } { "?" "a boolean" } } { $description "Test if an integer is a prime number." } ; -{ lprimes lprimes-from primes-upto primes-between } related-words - -HELP: lprimes -{ $values { "list" "a lazy list" } } -{ $description "Return a sorted list containing all the prime numbers." } ; - -HELP: lprimes-from -{ $values { "n" "an integer" } { "list" "a lazy list" } } -{ $description "Return a sorted list containing all the prime numbers greater or equal to " { $snippet "n" } "." } ; +{ primes-upto primes-between } related-words HELP: primes-upto { $values { "n" "an integer" } { "seq" "a sequence" } } diff --git a/extra/math/primes/primes-tests.factor b/extra/math/primes/primes-tests.factor index b0b25285c0..db738399ef 100644 --- a/extra/math/primes/primes-tests.factor +++ b/extra/math/primes/primes-tests.factor @@ -1,14 +1,9 @@ -USING: arrays math.primes tools.test lists.lazy ; +USING: arrays math.primes tools.test ; { 1237 } [ 1234 next-prime ] unit-test { f t } [ 1234 prime? 1237 prime? ] unit-test -{ { 2 3 5 7 11 13 17 19 23 29 } } [ 10 lprimes ltake list>array ] unit-test -{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test -{ { 1000117 1000121 } } [ 2 1000100 lprimes-from ltake list>array ] unit-test -{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test { { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test { { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test { { 4999963 4999999 5000011 5000077 5000081 } } -[ 4999962 5000082 primes-between >array ] -unit-test +[ 4999962 5000082 primes-between >array ] unit-test diff --git a/extra/math/primes/primes.factor b/extra/math/primes/primes.factor index fa42d7385a..807ebf097b 100644 --- a/extra/math/primes/primes.factor +++ b/extra/math/primes/primes.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007 Samuel Tardieu. +! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators kernel lists.lazy math math.functions -math.miller-rabin math.order math.primes.erato math.ranges sequences ; +USING: combinators kernel math math.functions math.miller-rabin +math.order math.primes.erato math.ranges sequences ; IN: math.primes : next-prime ( n -- p ) next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable -: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ; - -: lprimes-from ( n -- list ) - dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; - : primes-between ( low high -- seq ) [ dup 3 max dup even? [ 1 + ] when ] dip 2 [ prime? ] filter diff --git a/extra/project-euler/007/007.factor b/extra/project-euler/007/007.factor index f2b659fe94..f40108e4d7 100644 --- a/extra/project-euler/007/007.factor +++ b/extra/project-euler/007/007.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: lists math math.primes ; +USING: lists math math.primes.lists ; IN: project-euler.007 ! http://projecteuler.net/index.php?section=problems&id=7 diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor index 7bdf17ef68..e00e86865d 100644 --- a/extra/project-euler/134/134.factor +++ b/extra/project-euler/134/134.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel lists lists.lazy math.algebra math math.functions - math.order math.primes math.ranges project-euler.common sequences ; + math.order math.primes.lists math.ranges project-euler.common sequences ; IN: project-euler.134 ! http://projecteuler.net/index.php?section=problems&id=134 From 594bd3aee87eeeecaa1d93e26aa03feeacf52454 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 21:12:48 +0100 Subject: [PATCH 02/13] Move math.primes from extra to basis --- {extra => basis}/math/primes/authors.txt | 0 {extra => basis}/math/primes/erato/authors.txt | 0 {extra => basis}/math/primes/erato/erato-docs.factor | 0 {extra => basis}/math/primes/erato/erato-tests.factor | 0 {extra => basis}/math/primes/erato/erato.factor | 0 {extra => basis}/math/primes/erato/summary.txt | 0 {extra => basis}/math/primes/primes-docs.factor | 0 {extra => basis}/math/primes/primes-tests.factor | 0 {extra => basis}/math/primes/primes.factor | 0 {extra => basis}/math/primes/summary.txt | 0 10 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/math/primes/authors.txt (100%) rename {extra => basis}/math/primes/erato/authors.txt (100%) rename {extra => basis}/math/primes/erato/erato-docs.factor (100%) rename {extra => basis}/math/primes/erato/erato-tests.factor (100%) rename {extra => basis}/math/primes/erato/erato.factor (100%) rename {extra => basis}/math/primes/erato/summary.txt (100%) rename {extra => basis}/math/primes/primes-docs.factor (100%) rename {extra => basis}/math/primes/primes-tests.factor (100%) rename {extra => basis}/math/primes/primes.factor (100%) rename {extra => basis}/math/primes/summary.txt (100%) diff --git a/extra/math/primes/authors.txt b/basis/math/primes/authors.txt similarity index 100% rename from extra/math/primes/authors.txt rename to basis/math/primes/authors.txt diff --git a/extra/math/primes/erato/authors.txt b/basis/math/primes/erato/authors.txt similarity index 100% rename from extra/math/primes/erato/authors.txt rename to basis/math/primes/erato/authors.txt diff --git a/extra/math/primes/erato/erato-docs.factor b/basis/math/primes/erato/erato-docs.factor similarity index 100% rename from extra/math/primes/erato/erato-docs.factor rename to basis/math/primes/erato/erato-docs.factor diff --git a/extra/math/primes/erato/erato-tests.factor b/basis/math/primes/erato/erato-tests.factor similarity index 100% rename from extra/math/primes/erato/erato-tests.factor rename to basis/math/primes/erato/erato-tests.factor diff --git a/extra/math/primes/erato/erato.factor b/basis/math/primes/erato/erato.factor similarity index 100% rename from extra/math/primes/erato/erato.factor rename to basis/math/primes/erato/erato.factor diff --git a/extra/math/primes/erato/summary.txt b/basis/math/primes/erato/summary.txt similarity index 100% rename from extra/math/primes/erato/summary.txt rename to basis/math/primes/erato/summary.txt diff --git a/extra/math/primes/primes-docs.factor b/basis/math/primes/primes-docs.factor similarity index 100% rename from extra/math/primes/primes-docs.factor rename to basis/math/primes/primes-docs.factor diff --git a/extra/math/primes/primes-tests.factor b/basis/math/primes/primes-tests.factor similarity index 100% rename from extra/math/primes/primes-tests.factor rename to basis/math/primes/primes-tests.factor diff --git a/extra/math/primes/primes.factor b/basis/math/primes/primes.factor similarity index 100% rename from extra/math/primes/primes.factor rename to basis/math/primes/primes.factor diff --git a/extra/math/primes/summary.txt b/basis/math/primes/summary.txt similarity index 100% rename from extra/math/primes/summary.txt rename to basis/math/primes/summary.txt From 397790241f2aa13b67b9b3dc58c1110640b2beee Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 22:16:39 +0100 Subject: [PATCH 03/13] math.primes.factors rewrite --- extra/math/primes/factors/factors.factor | 39 +++++++++--------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor index 8e22757249..05d6b26010 100644 --- a/extra/math/primes/factors/factors.factor +++ b/extra/math/primes/factors/factors.factor @@ -1,40 +1,29 @@ ! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel lists make math math.primes.lists sequences ; +USING: arrays combinators kernel make math math.primes sequences ; IN: math.primes.factors [ - swap uncons swap [ pick call ] dip swap (factors) - ] [ 3drop ] if ; inline recursive - -: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline +: write-factor ( n d -- n' d ) + 2dup mod zero? [ [ [ count-factor ] keep swap 2array , ] keep ] when ; PRIVATE> -: factors ( n -- seq ) [ (factor) ] decompose ; flushable +: group-factors ( n -- seq ) + [ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ; -: group-factors ( n -- seq ) [ (count) ] decompose ; flushable +: unique-factors ( n -- seq ) group-factors [ first ] map ; -: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable +: factors ( n -- seq ) group-factors [ first2 swap ] map concat ; : totient ( n -- t ) - dup 2 < [ - drop 0 - ] [ - dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * - ] if ; foldable + { + { [ dup 2 < ] [ drop 0 ] } + [ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ] + } cond ; foldable From 6a2f46ed7f5a472806830282eb2579a36861a5ba Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 23:01:27 +0100 Subject: [PATCH 04/13] Move math.primes.factors from extra to basis --- {extra => basis}/math/primes/factors/authors.txt | 0 {extra => basis}/math/primes/factors/factors-docs.factor | 0 {extra => basis}/math/primes/factors/factors-tests.factor | 0 {extra => basis}/math/primes/factors/factors.factor | 0 {extra => basis}/math/primes/factors/summary.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/math/primes/factors/authors.txt (100%) rename {extra => basis}/math/primes/factors/factors-docs.factor (100%) rename {extra => basis}/math/primes/factors/factors-tests.factor (100%) rename {extra => basis}/math/primes/factors/factors.factor (100%) rename {extra => basis}/math/primes/factors/summary.txt (100%) diff --git a/extra/math/primes/factors/authors.txt b/basis/math/primes/factors/authors.txt similarity index 100% rename from extra/math/primes/factors/authors.txt rename to basis/math/primes/factors/authors.txt diff --git a/extra/math/primes/factors/factors-docs.factor b/basis/math/primes/factors/factors-docs.factor similarity index 100% rename from extra/math/primes/factors/factors-docs.factor rename to basis/math/primes/factors/factors-docs.factor diff --git a/extra/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor similarity index 100% rename from extra/math/primes/factors/factors-tests.factor rename to basis/math/primes/factors/factors-tests.factor diff --git a/extra/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor similarity index 100% rename from extra/math/primes/factors/factors.factor rename to basis/math/primes/factors/factors.factor diff --git a/extra/math/primes/factors/summary.txt b/basis/math/primes/factors/summary.txt similarity index 100% rename from extra/math/primes/factors/summary.txt rename to basis/math/primes/factors/summary.txt From e4b3f01e9e0b275275716b1bca8c8957ad31a3a1 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 23:16:27 +0100 Subject: [PATCH 05/13] Fix bit-array>integer byte ordering --- basis/bit-arrays/bit-arrays-tests.factor | 2 ++ basis/bit-arrays/bit-arrays.factor | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor index 24c27fa15b..1de49d353d 100644 --- a/basis/bit-arrays/bit-arrays-tests.factor +++ b/basis/bit-arrays/bit-arrays-tests.factor @@ -78,3 +78,5 @@ IN: bit-arrays.tests } bit-array>integer ] unit-test [ 49 ] [ 49 dup set-bits [ ] count ] unit-test + +[ HEX: 100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 18796fbfed..f1ba71ce1e 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -83,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ; ] if ; : bit-array>integer ( bit-array -- n ) - 0 swap underlying>> dup length [ + 0 swap underlying>> dup length [ alien-unsigned-1 swap 8 shift bitor ] with each ; From 676ead93a515f35954f52ecbf714875bae23aa98 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 01:30:12 +0100 Subject: [PATCH 06/13] FUEL: Extract word refactoring. --- extra/fuel/fuel.factor | 2 +- misc/fuel/README | 2 ++ misc/fuel/fuel-mode.el | 2 ++ misc/fuel/fuel-refactor.el | 45 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 misc/fuel/fuel-refactor.el diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 60420b3c39..becbf2161a 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -269,7 +269,7 @@ MEMO: fuel-article-title ( name -- title/f ) help-path [ dup article-title swap 2array ] map ; inline : (fuel-word-help) ( word -- element ) - dup \ article swap article-title rot + \ article swap dup article-title swap [ { [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ] diff --git a/misc/fuel/README b/misc/fuel/README index 14a9ca8b5d..f5d366a22e 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -74,6 +74,8 @@ beast. - C-cM-<, C-cC-d< : show callers of word at point - C-cM->, C-cC-d> : show callees of word at point + - C-cC-xw : extract region as a separate word + *** In the listener: - TAB : complete word at point diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 651cc323d0..c0728dbbc5 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -224,6 +224,8 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?e ?w 'fuel-edit-word) (fuel-mode--key ?e ?x 'fuel-eval-definition) +(fuel-mode--key ?x ?w 'fuel-refactor-extract-word) + (fuel-mode--key ?d ?> 'fuel-show-callees) (fuel-mode--key ?d ?< 'fuel-show-callers) (fuel-mode--key ?d ?a 'fuel-autodoc-mode) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el new file mode 100644 index 0000000000..4bf84ad8ec --- /dev/null +++ b/misc/fuel/fuel-refactor.el @@ -0,0 +1,45 @@ +;;; fuel-refactor.el -- code refactoring support + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Thu Jan 08, 2009 00:57 + +;;; Comentary: + +;; Utilities performing refactoring on factor code. + +;;; Code: + +(require 'fuel-stack) +(require 'fuel-syntax) +(require 'fuel-base) + + +;;; Extract word: + +(defun fuel-refactor-extract-word (begin end) + "Extracts current region as a separate word." + (interactive "r") + (let* ((word (read-string "New word name: ")) + (code (buffer-substring begin end)) + (code-str (fuel--region-to-string begin end)) + (stack-effect (or (fuel-stack--infer-effect code-str) + (read-string "Stack effect: ")))) + (goto-char begin) + (delete-region begin end) + (insert word) + (indent-region begin (point)) + (set-mark (point)) + (fuel-syntax--beginning-of-defun) + (open-line 1) + (let ((start (point))) + (insert ": " word " " stack-effect "\n" code " ;\n") + (indent-region start (point))) + (goto-char (mark)))) + + +(provide 'fuel-refactor) +;;; fuel-refactor.el ends here From 73dc586be1cc3fae122ac129a3bf20a9b71871cc Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 01:50:35 +0100 Subject: [PATCH 07/13] FUEL: Highlight new word during fuel-refactor-extract-word. --- misc/fuel/fuel-refactor.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 4bf84ad8ec..04313e4fdc 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -37,8 +37,11 @@ (open-line 1) (let ((start (point))) (insert ": " word " " stack-effect "\n" code " ;\n") - (indent-region start (point))) - (goto-char (mark)))) + (indent-region start (point)) + (move-overlay fuel-stack--overlay start (point)) + (goto-char (mark)) + (sit-for fuel-stack-highlight-period) + (delete-overlay fuel-stack--overlay)))) (provide 'fuel-refactor) From c30c9f0c03a6de699791d5e310e3d469a1bc247d Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 01:54:22 +0100 Subject: [PATCH 08/13] FUEL: Ooops, missing require. --- misc/fuel/fuel-mode.el | 1 + 1 file changed, 1 insertion(+) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index c0728dbbc5..c1abcf414b 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -21,6 +21,7 @@ (require 'fuel-eval) (require 'fuel-help) (require 'fuel-xref) +(require 'fuel-refactor) (require 'fuel-stack) (require 'fuel-autodoc) (require 'fuel-font-lock) From 75b0f1e058bb0d6d8064cf7df837151fc4a3f0af Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 02:00:04 +0100 Subject: [PATCH 09/13] FUEL: Adjust region to word boundaries if needed in fuel-refactor-extract-word. --- misc/fuel/fuel-refactor.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 04313e4fdc..68713e1e4e 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -24,6 +24,10 @@ "Extracts current region as a separate word." (interactive "r") (let* ((word (read-string "New word name: ")) + (begin (save-excursion + (goto-char begin) (fuel-syntax--beginning-of-symbol-pos))) + (end (save-excursion + (goto-char end) (fuel-syntax--end-of-symbol-pos))) (code (buffer-substring begin end)) (code-str (fuel--region-to-string begin end)) (stack-effect (or (fuel-stack--infer-effect code-str) From 6a7de816fc783768b7f87e31408178c0317f06fa Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Thu, 8 Jan 2009 02:08:57 +0100 Subject: [PATCH 10/13] FUEL: Better region boundary adjustment in extract-word. --- misc/fuel/fuel-refactor.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index 68713e1e4e..547da19552 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -25,9 +25,14 @@ (interactive "r") (let* ((word (read-string "New word name: ")) (begin (save-excursion - (goto-char begin) (fuel-syntax--beginning-of-symbol-pos))) + (goto-char begin) + (when (zerop (skip-syntax-backward "w")) + (skip-syntax-forward "-")) + (point))) (end (save-excursion - (goto-char end) (fuel-syntax--end-of-symbol-pos))) + (goto-char end) + (skip-syntax-forward "w") + (point))) (code (buffer-substring begin end)) (code-str (fuel--region-to-string begin end)) (stack-effect (or (fuel-stack--infer-effect code-str) From c47f14afcd232d1bbfc778d371a9f2efe86417c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 7 Jan 2009 21:20:05 -0600 Subject: [PATCH 11/13] Add link --- core/kernel/kernel-docs.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index bac4048706..7a53ff5172 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -691,11 +691,10 @@ HELP: assert= { $values { "a" object } { "b" object } } { $description "Throws an " { $link assert } " error if " { $snippet "a" } " does not equal " { $snippet "b" } "." } ; - ARTICLE: "shuffle-words" "Shuffle words" "Shuffle words rearrange items at the top of the data stack. They control the flow of data between words that perform actions." $nl -"The " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." +"The " { $link "cleave-combinators" } ", " { $link "spread-combinators" } " and " { $link "apply-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." $nl "Removing stack elements:" { $subsection drop } From c0ad6b7c5585dbe7212507f29e969d5c9aa26541 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 21:45:33 -0600 Subject: [PATCH 12/13] More docs; more case words public --- basis/unicode/case/case-docs.factor | 55 +++++++++++++++++++++++++++-- basis/unicode/case/case.factor | 4 ++- basis/unicode/data/data-docs.factor | 51 ++++++++++++++++++++++++++ 3 files changed, 107 insertions(+), 3 deletions(-) create mode 100644 basis/unicode/data/data-docs.factor diff --git a/basis/unicode/case/case-docs.factor b/basis/unicode/case/case-docs.factor index a5790f9a54..86b791ed81 100644 --- a/basis/unicode/case/case-docs.factor +++ b/basis/unicode/case/case-docs.factor @@ -1,4 +1,4 @@ -USING: help.syntax help.markup ; +USING: help.syntax help.markup strings ; IN: unicode.case ABOUT: "unicode.case" @@ -9,6 +9,10 @@ ARTICLE: "unicode.case" "Case mapping" { $subsection >lower } { $subsection >title } { $subsection >case-fold } +"There are analogous routines which operate on individual code points, but these should " { $emphasis "not be used" } " in general as they have slightly different behavior. In some cases, for example, they do not perform the case operation, as a single code point must expand to more than one." +{ $subsection ch>upper } +{ $subsection ch>lower } +{ $subsection ch>title } "To test if a string is in a given case:" { $subsection upper? } { $subsection lower? } @@ -16,4 +20,51 @@ ARTICLE: "unicode.case" "Case mapping" { $subsection case-fold? } "For certain languages (Turkish, Azeri, Lithuanian), case mapping is dependent on locale; To change this, set the following variable to the ISO-639-1 code for your language:" { $subsection locale } -"This is unnecessary for most languages." ; +"This is unnecessary for most locales." ; + +HELP: >upper +{ $values { "string" string } { "upper" string } } +{ $description "Converts a string to upper case." } ; + +HELP: >lower +{ $values { "string" string } { "lower" string } } +{ $description "Converts a string to lower case." } ; + +HELP: >title +{ $values { "string" string } { "title" string } } +{ $description "Converts a string to title case." } ; + +HELP: >case-fold +{ $values { "string" string } { "case-fold" string } } +{ $description "Converts a string to case-folded form." } ; + +HELP: upper? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in upper case." } ; + +HELP: lower? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in lower case." } ; + +HELP: title? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in title case." } ; + +HELP: case-fold? +{ $values { "string" string } { "?" "a boolean" } } +{ $description "Tests if a string is in case-folded form." } ; + +HELP: ch>lower +{ $values { "ch" "a code point" } { "lower" "a code point" } } +{ $description "Converts a code point to lower case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">lower" } " is not the same as " { $code "[ ch>lower ] map" } "." } ; + +HELP: ch>upper +{ $values { "ch" "a code point" } { "upper" "a code point" } } +{ $description "Converts a code point to upper case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">upper" } " is not the same as " { $code "[ ch>upper ] map" } "." } ; + +HELP: ch>title +{ $values { "ch" "a code point" } { "title" "a code point" } } +{ $description "Converts a code point to title case." } +{ $warning "Don't use this unless you know what you're doing! " { $code ">title" } " is not the same as " { $code "[ ch>title ] map" } "." } ; diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 42fd13fc97..7e61831f36 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -7,12 +7,14 @@ IN: unicode.case : ch>lower ( ch -- lower ) simple-lower at-default ; : ch>upper ( ch -- upper ) simple-upper at-default ; : ch>title ( ch -- title ) simple-title at-default ; -PRIVATE> + SYMBOL: locale ! Just casing locale, or overall? + char } +{ $subsection char>name } +{ $subsection property? } ; + +HELP: load-script +{ $value { "filename" string } { "table" "an interval map" } } +{ $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ; + +HELP: canonical-entry +{ $value { "char" "a code point" } { "seq" string } } +{ $description "Finds the canonical decomposition (NFD) for a code point" } ; + +HELP: combine-chars +{ $value { "a" "a code point" } { "b" "a code point" } { "char/f" "a code point" } } +{ $description "If a followed by b can be combined in NFC, this returns the code point of their combination." } ; + +HELP: compatibility-entry +{ $value { "char" "a code point" } { "seq" string } } +{ $description "This returns the compatibility decomposition (NFKD) for a code point" } ; + +HELP: combining-class +{ $value { "char" "a code point" } { "n" "an integer" } } +{ $description "Finds the combining class of a code point." } ; + +HELP: non-starter? +{ $value { "char" "a code point" } { "?" "a boolean" } } +{ $description "Returns true if the code point has a combining class." } ; + +HELP: char>name +{ $value { "char" "a code point" } { "name" string } } +{ $description "Looks up the name of a given code point. Warning: this is not optimized for speed, to save space." } ; + +HELP: name>char +{ $value { "name" string } { "char" "a code point" } } +{ $description "Looks up the code point corresponding to a given name." } ; + +HELP: property? +{ $value { "char" "a code point" } { "property" string } { "?" "a boolean" } } +{ $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ; From 8b351b1ad6e2355d97d20ef97822b470892bd0f2 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 7 Jan 2009 23:13:04 -0600 Subject: [PATCH 13/13] Fixing normalize errors --- basis/unicode/data/data.factor | 10 +++----- basis/unicode/normalize/normalize-docs.factor | 8 +------ .../unicode/normalize/normalize-tests.factor | 2 +- basis/unicode/normalize/normalize.factor | 23 ++++++++++--------- 4 files changed, 17 insertions(+), 26 deletions(-) diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index 3e19c5c30d..8f99b6c160 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -28,10 +28,6 @@ VALUE: properties : char>name ( char -- string ) name-map value-at ; : property? ( char property -- ? ) properties at interval-key? ; -! Convenience functions -: ?between? ( n/f from to -- ? ) - pick [ between? ] [ 3drop f ] if ; - ! Loading data from UnicodeData.txt : split-; ( line -- array ) @@ -206,9 +202,9 @@ SYMBOL: interned : expand-ranges ( assoc -- interval-map ) [ [ - CHAR: . pick member? [ - swap ".." split1 [ hex> ] bi@ 2array - ] [ swap hex> ] if range, + swap CHAR: . over member? [ + ".." split1 [ hex> ] bi@ 2array + ] [ hex> ] if range, ] assoc-each ] { } make ; diff --git a/basis/unicode/normalize/normalize-docs.factor b/basis/unicode/normalize/normalize-docs.factor index 423332fb6e..65f50ab0ae 100644 --- a/basis/unicode/normalize/normalize-docs.factor +++ b/basis/unicode/normalize/normalize-docs.factor @@ -8,9 +8,7 @@ ARTICLE: "unicode.normalize" "Unicode normalization" { $subsection nfc } { $subsection nfd } { $subsection nfkc } -{ $subsection nfkd } -"If two strings in a normalization form are appended, the result may not be in that normalization form still. To append two strings in NFD and make sure the result is in NFD, the following procedure is supplied:" -{ $subsection string-append } ; +{ $subsection nfkd } ; HELP: nfc { $values { "string" string } { "nfc" "a string in NFC" } } @@ -27,7 +25,3 @@ HELP: nfkc HELP: nfkd { $values { "string" string } { "nfc" "a string in NFKD" } } { $description "Converts a string to Normalization Form KD" } ; - -HELP: string-append -{ $values { "s1" "a string in NFD" } { "s2" "a string in NFD" } { "string" "a string in NFD" } } -{ $description "Appends two strings, putting the result in NFD." } ; diff --git a/basis/unicode/normalize/normalize-tests.factor b/basis/unicode/normalize/normalize-tests.factor index 9662389531..25d5ce365c 100644 --- a/basis/unicode/normalize/normalize-tests.factor +++ b/basis/unicode/normalize/normalize-tests.factor @@ -1,6 +1,6 @@ USING: unicode.normalize kernel tools.test sequences unicode.data io.encodings.utf8 io.files splitting math.parser -locals math quotations assocs combinators ; +locals math quotations assocs combinators unicode.normalize.private ; IN: unicode.normalize.tests [ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index eacdb2724a..f13eb07594 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -1,21 +1,24 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: sequences namespaces make unicode.data kernel math arrays -locals sorting.insertion accessors assocs ; +locals sorting.insertion accessors assocs math.order ; IN: unicode.normalize [ compatibility-entry ] decompose ; : string-append ( s1 s2 -- string ) - ! This could be more optimized, - ! but in practice, it'll almost always just be append [ append ] keep 0 over ?nth non-starter? [ length dupd reorder-back ] [ drop ] if ;