} bit-array>integer ] unit-test
[ 49 ] [ 49 <bit-array> dup set-bits [ ] count ] unit-test
+
+[ HEX: 100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test
] if ;
: bit-array>integer ( bit-array -- n )
- 0 swap underlying>> dup length [
+ 0 swap underlying>> dup length <reversed> [
alien-unsigned-1 swap 8 shift bitor
] with each ;
--- /dev/null
+Samuel Tardieu
--- /dev/null
+Samuel Tardieu
--- /dev/null
+USING: help.markup help.syntax ;
+IN: math.primes.erato
+
+HELP: sieve
+{ $values { "n" "the greatest odd number to consider" } { "arr" "a bit array" } }
+{ $description "Return a bit array containing a primality bit for every odd number between 3 and " { $snippet "n" } " (inclusive). " { $snippet ">index" } " can be used to retrieve the index of an odd number to be tested." } ;
+
+HELP: >index
+{ $values { "n" "an odd number" } { "i" "the corresponding index" } }
+{ $description "Retrieve the index corresponding to the odd number on the stack." } ;
+
+{ sieve >index } related-words
--- /dev/null
+USING: bit-arrays math.primes.erato tools.test ;
+
+[ ?{ t t t f t t f t t f t f f t } ] [ 29 sieve ] unit-test
--- /dev/null
+! Copyright (C) 2009 Samuel Tardieu.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bit-arrays kernel math math.functions math.ranges sequences ;
+IN: math.primes.erato
+
+: >index ( n -- i )
+ 3 - 2 /i ; inline
+
+: index> ( i -- n )
+ 2 * 3 + ; inline
+
+: mark-multiples ( i arr -- )
+ [ index> [ sq >index ] keep ] dip
+ [ length 1 - swap <range> f swap ] keep
+ [ set-nth ] curry with each ;
+
+: maybe-mark-multiples ( i arr -- )
+ 2dup nth [ mark-multiples ] [ 2drop ] if ;
+
+: init-sieve ( n -- arr )
+ >index 1 + <bit-array> dup set-bits ;
+
+: sieve ( n -- arr )
+ [ init-sieve ] [ sqrt >index [0,b] ] bi
+ over [ maybe-mark-multiples ] curry each ; foldable
--- /dev/null
+Eratosthene sieve
--- /dev/null
+Samuel Tardieu
--- /dev/null
+USING: help.markup help.syntax math sequences ;
+IN: math.primes.factors
+
+{ factors group-factors unique-factors } related-words
+
+HELP: factors
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return an ordered list of a number's prime factors, possibly repeated." } }
+{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 factors ." "{ 2 2 3 5 5 }" } } ;
+
+HELP: group-factors
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } }
+{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ;
+
+HELP: unique-factors
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return an ordered list of a number's unique prime factors." } }
+{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 unique-factors ." "{ 2 3 5 }" } } ;
+
+HELP: totient
+{ $values { "n" "a positive integer" } { "t" integer } }
+{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
--- /dev/null
+USING: math.primes.factors tools.test ;
+
+{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
+{ { } } [ -5 factors ] unit-test
+{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
+{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
+{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
+{ 0 } [ 1 totient ] unit-test
--- /dev/null
+! Copyright (C) 2007-2009 Samuel Tardieu.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays combinators kernel make math math.primes sequences ;
+IN: math.primes.factors
+
+<PRIVATE
+
+: count-factor ( n d -- n' c )
+ [ 1 ] 2dip [ /i ] keep
+ [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] [ drop ] while
+ swap ;
+
+: write-factor ( n d -- n' d )
+ 2dup mod zero? [ [ [ count-factor ] keep swap 2array , ] keep ] when ;
+
+PRIVATE>
+
+: group-factors ( n -- seq )
+ [ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ;
+
+: unique-factors ( n -- seq ) group-factors [ first ] map ;
+
+: factors ( n -- seq ) group-factors [ first2 swap <array> ] map concat ;
+
+: totient ( n -- t )
+ {
+ { [ dup 2 < ] [ drop 0 ] }
+ [ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ]
+ } cond ; foldable
--- /dev/null
+Prime factors decomposition
--- /dev/null
+USING: help.markup help.syntax ;
+IN: math.primes
+
+{ next-prime prime? } related-words
+
+HELP: next-prime
+{ $values { "n" "an integer not smaller than 2" } { "p" "a prime number" } }
+{ $description "Return the next prime number greater than " { $snippet "n" } "." } ;
+
+HELP: prime?
+{ $values { "n" "an integer" } { "?" "a boolean" } }
+{ $description "Test if an integer is a prime number." } ;
+
+{ primes-upto primes-between } related-words
+
+HELP: primes-upto
+{ $values { "n" "an integer" } { "seq" "a sequence" } }
+{ $description "Return a sequence containing all the prime numbers smaller or equal to " { $snippet "n" } "." } ;
+
+HELP: primes-between
+{ $values { "low" "an integer" } { "high" "an integer" } { "seq" "a sequence" } }
+{ $description "Return a sequence containing all the prime numbers between " { $snippet "low" } " and " { $snippet "high" } "." } ;
--- /dev/null
+USING: arrays math.primes tools.test ;
+
+{ 1237 } [ 1234 next-prime ] unit-test
+{ f t } [ 1234 prime? 1237 prime? ] 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
--- /dev/null
+! Copyright (C) 2007-2009 Samuel Tardieu.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators kernel math math.functions math.miller-rabin
+math.order math.primes.erato math.ranges sequences ;
+IN: math.primes
+
+<PRIVATE
+
+: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
+
+: really-prime? ( n -- ? )
+ dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable
+
+PRIVATE>
+
+: prime? ( n -- ? )
+ {
+ { [ dup 2 < ] [ drop f ] }
+ { [ dup even? ] [ 2 = ] }
+ [ really-prime? ]
+ } cond ; foldable
+
+: next-prime ( n -- p )
+ next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable
+
+: primes-between ( low high -- seq )
+ [ dup 3 max dup even? [ 1 + ] when ] dip
+ 2 <range> [ prime? ] filter
+ swap 3 < [ 2 prefix ] when ;
+
+: primes-upto ( n -- seq ) 2 swap primes-between ;
+
+: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
--- /dev/null
+Prime numbers test and generation
+
-USING: help.syntax help.markup ;
+USING: help.syntax help.markup strings ;
IN: unicode.case
ABOUT: "unicode.case"
{ $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? }
{ $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" } "." } ;
<PRIVATE
: at-default ( key assoc -- value/key ) [ at ] [ drop ] 2bi or ;
+PRIVATE>
: 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?
+
<PRIVATE
: i-dot? ( -- ? )
locale get { "tr" "az" } member? ;
--- /dev/null
+USING: help.syntax help.markup strings ;
+IN: unicode.data
+
+ABOUT: "unicode.data"
+
+ARTICLE: "unicode.data" "Unicode data tables"
+"The " { $vocab-link "unicode.data" "unicode.data" } " vocabulary contains core Unicode data tables and code for parsing this from files."
+{ $subsection load-script }
+{ $subsection canonical-entry }
+{ $subsection combine-chars }
+{ $subsection combining-class }
+{ $subsection non-starter? }
+{ $subsection name>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." } ;
: 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 )
: 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 <interval-map> ;
{ $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" } }
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." } ;
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
! 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
<PRIVATE
! Conjoining Jamo behavior
-: hangul-base HEX: ac00 ; inline
-: hangul-end HEX: D7AF ; inline
-: initial-base HEX: 1100 ; inline
-: medial-base HEX: 1161 ; inline
-: final-base HEX: 11a7 ; inline
+CONSTANT: hangul-base HEX: ac00
+CONSTANT: hangul-end HEX: D7AF
+CONSTANT: initial-base HEX: 1100
+CONSTANT: medial-base HEX: 1161
+CONSTANT: final-base HEX: 11a7
-: initial-count 19 ; inline
-: medial-count 21 ; inline
-: final-count 28 ; inline
+CONSTANT: initial-count 19
+CONSTANT: medial-count 21
+CONSTANT: final-count 28
+
+: ?between? ( n/f from to -- ? )
+ pick [ between? ] [ 3drop f ] if ;
: hangul? ( ch -- ? ) hangul-base hangul-end ?between? ;
: jamo? ( ch -- ? ) HEX: 1100 HEX: 11FF ?between? ;
[ 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 ;
{ $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 }
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 ]
+++ /dev/null
-Samuel Tardieu
+++ /dev/null
-Samuel Tardieu
+++ /dev/null
-USING: help.markup help.syntax ;
-IN: math.primes.erato
-
-HELP: sieve
-{ $values { "n" "the greatest odd number to consider" } { "arr" "a bit array" } }
-{ $description "Return a bit array containing a primality bit for every odd number between 3 and " { $snippet "n" } " (inclusive). " { $snippet ">index" } " can be used to retrieve the index of an odd number to be tested." } ;
-
-HELP: >index
-{ $values { "n" "an odd number" } { "i" "the corresponding index" } }
-{ $description "Retrieve the index corresponding to the odd number on the stack." } ;
-
-{ sieve >index } related-words
+++ /dev/null
-USING: bit-arrays math.primes.erato tools.test ;
-
-[ ?{ t t t f t t f t t f t f f t } ] [ 29 sieve ] unit-test
+++ /dev/null
-! Copyright (C) 2009 Samuel Tardieu.
-! See http://factorcode.org/license.txt for BSD license.
-USING: bit-arrays kernel math math.functions math.ranges sequences ;
-IN: math.primes.erato
-
-: >index ( n -- i )
- 3 - 2 /i ; inline
-
-: index> ( i -- n )
- 2 * 3 + ; inline
-
-: mark-multiples ( i arr -- )
- [ index> [ sq >index ] keep ] dip
- [ length 1 - swap <range> f swap ] keep
- [ set-nth ] curry with each ;
-
-: maybe-mark-multiples ( i arr -- )
- 2dup nth [ mark-multiples ] [ 2drop ] if ;
-
-: init-sieve ( n -- arr )
- >index 1 + <bit-array> dup set-bits ;
-
-: sieve ( n -- arr )
- [ init-sieve ] [ sqrt >index [0,b] ] bi
- over [ maybe-mark-multiples ] curry each ; foldable
+++ /dev/null
-Eratosthene sieve
+++ /dev/null
-Samuel Tardieu
+++ /dev/null
-USING: help.markup help.syntax math sequences ;
-IN: math.primes.factors
-
-{ factors group-factors unique-factors } related-words
-
-HELP: factors
-{ $values { "n" "a positive integer" } { "seq" sequence } }
-{ $description { "Return an ordered list of a number's prime factors, possibly repeated." } }
-{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 factors ." "{ 2 2 3 5 5 }" } } ;
-
-HELP: group-factors
-{ $values { "n" "a positive integer" } { "seq" sequence } }
-{ $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } }
-{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ;
-
-HELP: unique-factors
-{ $values { "n" "a positive integer" } { "seq" sequence } }
-{ $description { "Return an ordered list of a number's unique prime factors." } }
-{ $examples { $example "USING: math.primes.factors prettyprint ;" "300 unique-factors ." "{ 2 3 5 }" } } ;
-
-HELP: totient
-{ $values { "n" "a positive integer" } { "t" integer } }
-{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
+++ /dev/null
-USING: math.primes.factors tools.test ;
-
-{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
-{ { } } [ -5 factors ] unit-test
-{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
-{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
-{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
-{ 0 } [ 1 totient ] unit-test
+++ /dev/null
-! Copyright (C) 2007-2009 Samuel Tardieu.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel lists make math math.primes sequences ;
-IN: math.primes.factors
-
-<PRIVATE
-
-: count-factor ( n d -- n' c )
- 0 [ [ 2dup mod zero? ] dip swap ] [ [ [ / ] keep ] dip 1+ ] [ ] while nip ;
-
-: (factor) ( n d -- n' ) dup [ , ] curry [ count-factor ] dip times ;
-
-: (count) ( n d -- n' )
- dup [ swap 2array , ] curry
- [ count-factor dup zero? [ drop ] ] dip if ;
-
-: (unique) ( n d -- n' )
- dup [ , ] curry [ count-factor zero? ] dip unless ;
-
-: (factors) ( quot list n -- )
- dup 1 > [
- swap uncons swap [ pick call ] dip swap (factors)
- ] [ 3drop ] if ; inline recursive
-
-: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline
-
-PRIVATE>
-
-: factors ( n -- seq ) [ (factor) ] decompose ; flushable
-
-: group-factors ( n -- seq ) [ (count) ] decompose ; flushable
-
-: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable
-
-: totient ( n -- t )
- dup 2 < [
- drop 0
- ] [
- dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / *
- ] if ; foldable
+++ /dev/null
-Prime factors decomposition
--- /dev/null
+Samuel Tardieu
--- /dev/null
+USING: help.markup help.syntax ;
+IN: math.primes.lists
+
+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" } "." } ;
--- /dev/null
+USING: lists.lazy math.primes.lists tools.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
--- /dev/null
+! 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 ;
--- /dev/null
+Infinite stream of prime numbers through lazy lists
+++ /dev/null
-USING: help.markup help.syntax ;
-IN: math.primes
-
-{ next-prime prime? } related-words
-
-HELP: next-prime
-{ $values { "n" "an integer not smaller than 2" } { "p" "a prime number" } }
-{ $description "Return the next prime number greater than " { $snippet "n" } "." } ;
-
-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" } "." } ;
-
-HELP: primes-upto
-{ $values { "n" "an integer" } { "seq" "a sequence" } }
-{ $description "Return a sequence containing all the prime numbers smaller or equal to " { $snippet "n" } "." } ;
-
-HELP: primes-between
-{ $values { "low" "an integer" } { "high" "an integer" } { "seq" "a sequence" } }
-{ $description "Return a sequence containing all the prime numbers between " { $snippet "low" } " and " { $snippet "high" } "." } ;
+++ /dev/null
-USING: arrays math.primes tools.test lists.lazy ;
-
-{ 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
+++ /dev/null
-! Copyright (C) 2007 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 ;
-IN: math.primes
-
-<PRIVATE
-
-: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
-
-: really-prime? ( n -- ? )
- dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable
-
-PRIVATE>
-
-: prime? ( n -- ? )
- {
- { [ dup 2 < ] [ drop f ] }
- { [ dup even? ] [ 2 = ] }
- [ really-prime? ]
- } cond ; foldable
-
-: 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 <range> [ prime? ] filter
- swap 3 < [ 2 prefix ] when ;
-
-: primes-upto ( n -- seq ) 2 swap primes-between ;
-
-: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
+++ /dev/null
-Prime numbers test and generation
-
! 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
! 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
- 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
(require 'fuel-eval)
(require 'fuel-help)
(require 'fuel-xref)
+(require 'fuel-refactor)
(require 'fuel-stack)
(require 'fuel-autodoc)
(require 'fuel-font-lock)
(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)
--- /dev/null
+;;; 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 <jao@gnu.org>
+;; 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)
+
+\f
+;;; 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: "))
+ (begin (save-excursion
+ (goto-char begin)
+ (when (zerop (skip-syntax-backward "w"))
+ (skip-syntax-forward "-"))
+ (point)))
+ (end (save-excursion
+ (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)
+ (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))
+ (move-overlay fuel-stack--overlay start (point))
+ (goto-char (mark))
+ (sit-for fuel-stack-highlight-period)
+ (delete-overlay fuel-stack--overlay))))
+
+\f
+(provide 'fuel-refactor)
+;;; fuel-refactor.el ends here
projects / factor.git / commitdiff