Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32

db4
Maxim Savchenko 2009-03-19 06:06:28 -04:00
commit 12c19777ea
136 changed files with 782 additions and 586 deletions

View File

@ -14,7 +14,7 @@ words splitting grouping sorting accessors ;
[ t ] [ [ t ] [
symbolic-stack-trace symbolic-stack-trace
[ word? ] filter [ word? ] filter
{ baz bar foo throw } tail? { baz bar foo } tail?
] unit-test ] unit-test
: bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ; : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;

View File

@ -58,7 +58,7 @@ HELP: npick
"placed on the top of the stack." "placed on the top of the stack."
} }
{ $examples { $examples
{ $example "USING: kernel prettyprint generalizations ;" "1 2 3 4 4 npick .s clear" "1\n2\n3\n4\n1" } { $example "USING: kernel prettyprint generalizations ;" "1 2 3 4 4 npick 5 narray ." "{ 1 2 3 4 1 }" }
"Some core words expressed in terms of " { $link npick } ":" "Some core words expressed in terms of " { $link npick } ":"
{ $table { $table
{ { $link dup } { $snippet "1 npick" } } { { $link dup } { $snippet "1 npick" } }
@ -75,7 +75,7 @@ HELP: ndup
"placed on the top of the stack." "placed on the top of the stack."
} }
{ $examples { $examples
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 ndup .s clear" "1\n2\n3\n4\n1\n2\n3\n4" } { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 ndup 8 narray ." "{ 1 2 3 4 1 2 3 4 }" }
"Some core words expressed in terms of " { $link ndup } ":" "Some core words expressed in terms of " { $link ndup } ":"
{ $table { $table
{ { $link dup } { $snippet "1 ndup" } } { { $link dup } { $snippet "1 ndup" } }
@ -91,7 +91,7 @@ HELP: nnip
"for any number of items." "for any number of items."
} }
{ $examples { $examples
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 nnip .s clear" "4" } { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 nnip ." "4" }
"Some core words expressed in terms of " { $link nnip } ":" "Some core words expressed in terms of " { $link nnip } ":"
{ $table { $table
{ { $link nip } { $snippet "1 nnip" } } { { $link nip } { $snippet "1 nnip" } }
@ -106,7 +106,7 @@ HELP: ndrop
"for any number of items." "for any number of items."
} }
{ $examples { $examples
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 ndrop .s clear" "1" } { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 ndrop ." "1" }
"Some core words expressed in terms of " { $link ndrop } ":" "Some core words expressed in terms of " { $link ndrop } ":"
{ $table { $table
{ { $link drop } { $snippet "1 ndrop" } } { { $link drop } { $snippet "1 ndrop" } }
@ -121,7 +121,7 @@ HELP: nrot
"number of items on the stack. " "number of items on the stack. "
} }
{ $examples { $examples
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 nrot .s clear" "2\n3\n4\n1" } { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 4 4 nrot 4array ." "{ 2 3 4 1 }" }
"Some core words expressed in terms of " { $link nrot } ":" "Some core words expressed in terms of " { $link nrot } ":"
{ $table { $table
{ { $link swap } { $snippet "1 nrot" } } { { $link swap } { $snippet "1 nrot" } }
@ -135,7 +135,7 @@ HELP: -nrot
"number of items on the stack. " "number of items on the stack. "
} }
{ $examples { $examples
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 -nrot .s clear" "4\n1\n2\n3" } { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 4 4 -nrot 4array ." "{ 4 1 2 3 }" }
"Some core words expressed in terms of " { $link -nrot } ":" "Some core words expressed in terms of " { $link -nrot } ":"
{ $table { $table
{ { $link swap } { $snippet "1 -nrot" } } { { $link swap } { $snippet "1 -nrot" } }
@ -151,8 +151,8 @@ HELP: ndip
"stack. The quotation can consume and produce any number of items." "stack. The quotation can consume and produce any number of items."
} }
{ $examples { $examples
{ $example "USING: generalizations kernel prettyprint kernel ;" "1 2 [ dup ] 1 ndip .s clear" "1\n1\n2" } { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip 3array ." "{ 1 1 2 }" }
{ $example "USING: generalizations kernel prettyprint kernel ;" "1 2 3 [ drop ] 2 ndip .s clear" "2\n3" } { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip 2array ." "{ 2 3 }" }
"Some core words expressed in terms of " { $link ndip } ":" "Some core words expressed in terms of " { $link ndip } ":"
{ $table { $table
{ { $link dip } { $snippet "1 ndip" } } { { $link dip } { $snippet "1 ndip" } }
@ -168,7 +168,7 @@ HELP: nslip
"removed from the stack, the quotation called, and the items restored." "removed from the stack, the quotation called, and the items restored."
} }
{ $examples { $examples
{ $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s clear" "99\n1\n2\n3\n4\n5" } { $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip 6 narray ." "{ 99 1 2 3 4 5 }" }
"Some core words expressed in terms of " { $link nslip } ":" "Some core words expressed in terms of " { $link nslip } ":"
{ $table { $table
{ { $link slip } { $snippet "1 nslip" } } { { $link slip } { $snippet "1 nslip" } }
@ -184,7 +184,7 @@ HELP: nkeep
"saved, the quotation called, and the items restored." "saved, the quotation called, and the items restored."
} }
{ $examples { $examples
{ $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s clear" "99\n1\n2\n3\n4\n5" } { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep 6 narray ." "{ 99 1 2 3 4 5 }" }
"Some core words expressed in terms of " { $link nkeep } ":" "Some core words expressed in terms of " { $link nkeep } ":"
{ $table { $table
{ { $link keep } { $snippet "1 nkeep" } } { { $link keep } { $snippet "1 nkeep" } }

View File

@ -61,6 +61,4 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
[ H{ } [ ] with-nesting nl ] make-html-string [ H{ } [ ] with-nesting nl ] make-html-string
] unit-test ] unit-test
[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test [ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
[ ] [ [ \ predicate-instance? def>> . ] with-html-writer drop ] unit-test

View File

@ -5,8 +5,7 @@ sequences splitting sorting sets strings vectors hashtables
quotations arrays byte-arrays math.parser calendar quotations arrays byte-arrays math.parser calendar
calendar.format present urls fry calendar.format present urls fry
io io.encodings io.encodings.iana io.encodings.binary io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit io.crlf io.encodings.8-bit io.crlf ascii
unicode.case unicode.categories
http.parsers http.parsers
base64 ; base64 ;
IN: http IN: http
@ -215,11 +214,10 @@ TUPLE: post-data data params content-type content-encoding ;
: parse-content-type-attributes ( string -- attributes ) : parse-content-type-attributes ( string -- attributes )
" " split harvest [ " " split harvest [
"=" split1 "=" split1
[ >lower ] [ "\"" ?head drop "\"" ?tail drop ] bi* "\"" ?head drop "\"" ?tail drop
] { } map>assoc ; ] { } map>assoc ;
: parse-content-type ( content-type -- type encoding ) : parse-content-type ( content-type -- type encoding )
";" split1 ";" split1
parse-content-type-attributes "charset" swap at parse-content-type-attributes "charset" swap at name>encoding
[ name>encoding ] [ dup "text/" head? latin1 binary ? ] unless* ;
[ dup "text/" head? latin1 binary ? ] if* ;

View File

@ -9,24 +9,15 @@ ARTICLE: "io.encodings.iana" "IANA-registered encoding names"
{ $subsection name>encoding } { $subsection name>encoding }
{ $subsection encoding>name } { $subsection encoding>name }
"To let a new encoding be used with the above words, use the following:" "To let a new encoding be used with the above words, use the following:"
{ $subsection register-encoding } { $subsection register-encoding } ;
"Exceptions when encodings or names are not found:"
{ $subsection missing-encoding }
{ $subsection missing-name } ;
HELP: missing-encoding
{ $error-description "The error called from " { $link name>encoding } " when there is no encoding descriptor registered corresponding to the given name." } ;
HELP: missing-name
{ $error-description "The error called from " { $link encoding>name } " when there is no name registered corresponding to the given encoding." } ;
HELP: name>encoding HELP: name>encoding
{ $values { "name" "an encoding name" } { "encoding" "an encoding descriptor" } } { $values { "name" "an encoding name" } { "encoding" "an encoding descriptor" } }
{ $description "Given an IANA-registered encoding name, find the encoding descriptor that represents it, or " { $code f } " if it is not found (either not implemented in Factor or not registered)." } ; { $description "Given an IANA-registered encoding name, find the encoding descriptor that represents it, or " { $snippet "f" } " if it is not found (either not implemented in Factor or not registered)." } ;
HELP: encoding>name HELP: encoding>name
{ $values { "encoding" "an encoding descriptor" } { "name" "an encoding name" } } { $values { "encoding" "an encoding descriptor" } { "name" "an encoding name" } }
{ $description "Given an encoding descriptor, return the preferred IANA name." } ; { $description "Given an encoding descriptor, return the preferred IANA name. If no name is found, returns " { $snippet "f" } "." } ;
{ name>encoding encoding>name } related-words { name>encoding encoding>name } related-words

View File

@ -19,10 +19,10 @@ ebcdic-fisea "EBCDIC-FI-SE-A" register-encoding
"csEBCDICFISEA" n>e-table get delete-at "csEBCDICFISEA" n>e-table get delete-at
ebcdic-fisea e>n-table get delete-at ebcdic-fisea e>n-table get delete-at
] unit-test ] unit-test
[ "EBCDIC-FI-SE-A" name>encoding ] must-fail [ f ] [ "EBCDIC-FI-SE-A" name>encoding ] unit-test
[ "csEBCDICFISEA" name>encoding ] must-fail [ f ] [ "csEBCDICFISEA" name>encoding ] unit-test
[ ebcdic-fisea encoding>name ] must-fail [ f ] [ ebcdic-fisea encoding>name ] unit-test
[ ebcdic-fisea "foobar" register-encoding ] must-fail [ ebcdic-fisea "foobar" register-encoding ] must-fail
[ "foobar" name>encoding ] must-fail [ f ] [ "foobar" name>encoding ] unit-test
[ ebcdic-fisea encoding>name ] must-fail [ f ] [ ebcdic-fisea encoding>name ] unit-test

View File

@ -10,15 +10,11 @@ SYMBOL: e>n-table
SYMBOL: aliases SYMBOL: aliases
PRIVATE> PRIVATE>
ERROR: missing-encoding name ; : name>encoding ( name -- encoding/f )
n>e-table get-global at ;
: name>encoding ( name -- encoding ) : encoding>name ( encoding -- name/f )
dup n>e-table get-global at [ ] [ missing-encoding ] ?if ; e>n-table get-global at ;
ERROR: missing-name encoding ;
: encoding>name ( encoding -- name )
dup e>n-table get-global at [ ] [ missing-name ] ?if ;
<PRIVATE <PRIVATE
: parse-iana ( file -- synonym-set ) : parse-iana ( file -- synonym-set )

View File

@ -1,11 +1,14 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors io.sockets.secure kernel ; USING: accessors io.sockets.secure kernel ;
IN: io.sockets.secure.unix.debug IN: io.sockets.secure.unix.debug
: with-test-context ( quot -- ) : <test-secure-config> ( -- config )
<secure-config> <secure-config>
"vocab:openssl/test/server.pem" >>key-file "vocab:openssl/test/server.pem" >>key-file
"vocab:openssl/test/dh1024.pem" >>dh-file "vocab:openssl/test/dh1024.pem" >>dh-file
"password" >>password "password" >>password ;
: with-test-context ( quot -- )
<test-secure-config>
swap with-secure-context ; inline swap with-secure-context ; inline

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays accessors fry sequences regexp.classes ; USING: kernel arrays accessors fry sequences regexp.classes
FROM: math.ranges => [a,b] ; math.ranges math ;
IN: regexp.ast IN: regexp.ast
TUPLE: negation term ; TUPLE: negation term ;
@ -49,10 +49,20 @@ SINGLETONS: unix-lines dotall multiline case-insensitive reversed-regexp ;
<array> <concatenation> ; <array> <concatenation> ;
GENERIC: <times> ( term times -- term' ) GENERIC: <times> ( term times -- term' )
M: at-least <times> M: at-least <times>
n>> swap [ repetition ] [ <star> ] bi 2array <concatenation> ; n>> swap [ repetition ] [ <star> ] bi 2array <concatenation> ;
: to-times ( term n -- ast )
dup zero?
[ 2drop epsilon ]
[ dupd 1- to-times 2array <concatenation> <maybe> ]
if ;
M: from-to <times> M: from-to <times>
[ n>> ] [ m>> ] bi [a,b] swap '[ _ repetition ] map <alternation> ; [ n>> swap repetition ]
[ [ m>> ] [ n>> ] bi - to-times ] 2bi
2array <concatenation> ;
: char-class ( ranges ? -- term ) : char-class ( ranges ? -- term )
[ <or-class> ] dip [ <not-class> ] when ; [ <or-class> ] dip [ <not-class> ] when ;

View File

@ -2,20 +2,33 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math math.order words combinators locals USING: accessors kernel math math.order words combinators locals
ascii unicode.categories combinators.short-circuit sequences ascii unicode.categories combinators.short-circuit sequences
fry macros arrays assocs sets classes mirrors ; fry macros arrays assocs sets classes mirrors unicode.script
unicode.data ;
IN: regexp.classes IN: regexp.classes
SINGLETONS: any-char any-char-no-nl SINGLETONS: dot letter-class LETTER-class Letter-class digit-class
letter-class LETTER-class Letter-class digit-class
alpha-class non-newline-blank-class alpha-class non-newline-blank-class
ascii-class punctuation-class java-printable-class blank-class ascii-class punctuation-class java-printable-class blank-class
control-character-class hex-digit-class java-blank-class c-identifier-class control-character-class hex-digit-class java-blank-class c-identifier-class
unmatchable-class terminator-class word-boundary-class ; unmatchable-class terminator-class word-boundary-class ;
SINGLETONS: beginning-of-input ^ end-of-input $ end-of-file ^unix $unix word-break ; SINGLETONS: beginning-of-input ^ end-of-input $ end-of-file
^unix $unix word-break ;
TUPLE: range from to ; TUPLE: range-class from to ;
C: <range> range C: <range-class> range-class
TUPLE: primitive-class class ;
C: <primitive-class> primitive-class
TUPLE: category-class category ;
C: <category-class> category-class
TUPLE: category-range-class category ;
C: <category-range-class> category-range-class
TUPLE: script-class script ;
C: <script-class> script-class
GENERIC: class-member? ( obj class -- ? ) GENERIC: class-member? ( obj class -- ? )
@ -23,15 +36,9 @@ M: t class-member? ( obj class -- ? ) 2drop t ;
M: integer class-member? ( obj class -- ? ) = ; M: integer class-member? ( obj class -- ? ) = ;
M: range class-member? ( obj class -- ? ) M: range-class class-member? ( obj class -- ? )
[ from>> ] [ to>> ] bi between? ; [ from>> ] [ to>> ] bi between? ;
M: any-char class-member? ( obj class -- ? )
2drop t ;
M: any-char-no-nl class-member? ( obj class -- ? )
drop CHAR: \n = not ;
M: letter-class class-member? ( obj class -- ? ) M: letter-class class-member? ( obj class -- ? )
drop letter? ; drop letter? ;
@ -99,21 +106,24 @@ M: unmatchable-class class-member? ( obj class -- ? )
M: terminator-class class-member? ( obj class -- ? ) M: terminator-class class-member? ( obj class -- ? )
drop "\r\n\u000085\u002029\u002028" member? ; drop "\r\n\u000085\u002029\u002028" member? ;
M: ^ class-member? ( obj class -- ? )
2drop f ;
M: $ class-member? ( obj class -- ? )
2drop f ;
M: f class-member? 2drop f ; M: f class-member? 2drop f ;
TUPLE: primitive-class class ; M: script-class class-member?
C: <primitive-class> primitive-class [ script-of ] [ script>> ] bi* = ;
M: category-class class-member?
[ category# ] [ category>> ] bi* = ;
M: category-range-class class-member?
[ category first ] [ category>> ] bi* = ;
TUPLE: not-class class ; TUPLE: not-class class ;
PREDICATE: not-integer < not-class class>> integer? ; PREDICATE: not-integer < not-class class>> integer? ;
PREDICATE: not-primitive < not-class class>> primitive-class? ;
UNION: simple-class
primitive-class range-class category-class category-range-class dot ;
PREDICATE: not-simple < not-class class>> simple-class? ;
M: not-class class-member? M: not-class class-member?
class>> class-member? not ; class>> class-member? not ;
@ -140,14 +150,14 @@ DEFER: substitute
[ drop class new seq { } like >>seq ] [ drop class new seq { } like >>seq ]
} case ; inline } case ; inline
TUPLE: class-partition integers not-integers primitives not-primitives and or other ; TUPLE: class-partition integers not-integers simples not-simples and or other ;
: partition-classes ( seq -- class-partition ) : partition-classes ( seq -- class-partition )
prune prune
[ integer? ] partition [ integer? ] partition
[ not-integer? ] partition [ not-integer? ] partition
[ primitive-class? ] partition ! extend primitive-class to epsilon tags [ simple-class? ] partition
[ not-primitive? ] partition [ not-simple? ] partition
[ and-class? ] partition [ and-class? ] partition
[ or-class? ] partition [ or-class? ] partition
class-partition boa ; class-partition boa ;
@ -161,17 +171,17 @@ TUPLE: class-partition integers not-integers primitives not-primitives and or ot
: filter-not-integers ( partition -- partition' ) : filter-not-integers ( partition -- partition' )
dup dup
[ primitives>> ] [ not-primitives>> ] [ or>> ] tri [ simples>> ] [ not-simples>> ] [ or>> ] tri
3append and-class boa 3append and-class boa
'[ [ class>> _ class-member? ] filter ] change-not-integers ; '[ [ class>> _ class-member? ] filter ] change-not-integers ;
: answer-ors ( partition -- partition' ) : answer-ors ( partition -- partition' )
dup [ not-integers>> ] [ not-primitives>> ] [ primitives>> ] tri 3append dup [ not-integers>> ] [ not-simples>> ] [ simples>> ] tri 3append
'[ [ _ [ t substitute ] each ] map ] change-or ; '[ [ _ [ t substitute ] each ] map ] change-or ;
: contradiction? ( partition -- ? ) : contradiction? ( partition -- ? )
{ {
[ [ primitives>> ] [ not-primitives>> ] bi intersects? ] [ [ simples>> ] [ not-simples>> ] bi intersects? ]
[ other>> f swap member? ] [ other>> f swap member? ]
} 1|| ; } 1|| ;
@ -192,17 +202,17 @@ TUPLE: class-partition integers not-integers primitives not-primitives and or ot
: filter-integers ( partition -- partition' ) : filter-integers ( partition -- partition' )
dup dup
[ primitives>> ] [ not-primitives>> ] [ and>> ] tri [ simples>> ] [ not-simples>> ] [ and>> ] tri
3append or-class boa 3append or-class boa
'[ [ _ class-member? not ] filter ] change-integers ; '[ [ _ class-member? not ] filter ] change-integers ;
: answer-ands ( partition -- partition' ) : answer-ands ( partition -- partition' )
dup [ integers>> ] [ not-primitives>> ] [ primitives>> ] tri 3append dup [ integers>> ] [ not-simples>> ] [ simples>> ] tri 3append
'[ [ _ [ f substitute ] each ] map ] change-and ; '[ [ _ [ f substitute ] each ] map ] change-and ;
: tautology? ( partition -- ? ) : tautology? ( partition -- ? )
{ {
[ [ primitives>> ] [ not-primitives>> ] bi intersects? ] [ [ simples>> ] [ not-simples>> ] bi intersects? ]
[ other>> t swap member? ] [ other>> t swap member? ]
} 1|| ; } 1|| ;
@ -241,8 +251,6 @@ M: f <not-class> drop t ;
M: primitive-class class-member? M: primitive-class class-member?
class>> class-member? ; class>> class-member? ;
UNION: class primitive-class not-class or-class and-class range ;
TUPLE: condition question yes no ; TUPLE: condition question yes no ;
C: <condition> condition C: <condition> condition

View File

@ -13,14 +13,14 @@ IN: regexp.combinators
PRIVATE> PRIVATE>
CONSTANT: <nothing> R/ (?~.*)/ CONSTANT: <nothing> R/ (?~.*)/s
: <literal> ( string -- regexp ) : <literal> ( string -- regexp )
[ "\\Q" "\\E" surround ] [ <concatenation> ] bi make-regexp ; foldable [ "\\Q" "\\E" surround ] [ <concatenation> ] bi make-regexp ; foldable
: <char-range> ( char1 char2 -- regexp ) : <char-range> ( char1 char2 -- regexp )
[ [ "[" "-" surround ] [ "]" append ] bi* append ] [ [ "[" "-" surround ] [ "]" append ] bi* append ]
[ <range> ] [ <range-class> ]
2bi make-regexp ; 2bi make-regexp ;
: <or> ( regexps -- disjunction ) : <or> ( regexps -- disjunction )

View File

@ -3,11 +3,11 @@
USING: accessors arrays assocs grouping kernel locals math namespaces USING: accessors arrays assocs grouping kernel locals math namespaces
sequences fry quotations math.order math.ranges vectors sequences fry quotations math.order math.ranges vectors
unicode.categories regexp.transition-tables words sets hashtables unicode.categories regexp.transition-tables words sets hashtables
combinators.short-circuit unicode.case unicode.case.private regexp.ast combinators.short-circuit unicode.data regexp.ast
regexp.classes ; regexp.classes memoize ;
IN: regexp.nfa IN: regexp.nfa
! This uses unicode.case.private for ch>upper and ch>lower ! This uses unicode.data for ch>upper and ch>lower
! but case-insensitive matching should be done by case-folding everything ! but case-insensitive matching should be done by case-folding everything
! before processing starts ! before processing starts
@ -117,8 +117,17 @@ M: or-class modify-class
M: not-class modify-class M: not-class modify-class
class>> modify-class <not-class> ; class>> modify-class <not-class> ;
M: any-char modify-class MEMO: unix-dot ( -- class )
drop dotall option? t any-char-no-nl ? ; CHAR: \n <not-class> ;
MEMO: nonl-dot ( -- class )
{ CHAR: \n CHAR: \r } <or-class> <not-class> ;
M: dot modify-class
drop dotall option? [ t ] [
unix-lines option?
unix-dot nonl-dot ?
] if ;
: modify-letter-class ( class -- newclass ) : modify-letter-class ( class -- newclass )
case-insensitive option? [ drop Letter-class ] when ; case-insensitive option? [ drop Letter-class ] when ;
@ -131,17 +140,17 @@ M: LETTER-class modify-class modify-letter-class ;
[ [ LETTER? ] bi@ and ] [ [ LETTER? ] bi@ and ]
} 2|| ; } 2|| ;
M: range modify-class M: range-class modify-class
case-insensitive option? [ case-insensitive option? [
dup cased-range? [ dup cased-range? [
[ from>> ] [ to>> ] bi [ from>> ] [ to>> ] bi
[ [ ch>lower ] bi@ <range> ] [ [ ch>lower ] bi@ <range-class> ]
[ [ ch>upper ] bi@ <range> ] 2bi [ [ ch>upper ] bi@ <range-class> ] 2bi
2array <or-class> 2array <or-class>
] when ] when
] when ; ] when ;
M: class nfa-node M: object nfa-node
modify-class add-simple-entry ; modify-class add-simple-entry ;
M: with-options nfa-node ( node -- start end ) M: with-options nfa-node ( node -- start end )

View File

@ -18,6 +18,13 @@ ERROR: bad-number ;
ERROR: bad-class name ; ERROR: bad-class name ;
: parse-unicode-class ( name -- class )
! Implement this!
drop f ;
: unicode-class ( name -- class )
dup parse-unicode-class [ ] [ bad-class ] ?if ;
: name>class ( name -- class ) : name>class ( name -- class )
>string >case-fold { >string >case-fold {
{ "lower" letter-class } { "lower" letter-class }
@ -32,8 +39,7 @@ ERROR: bad-class name ;
{ "cntrl" control-character-class } { "cntrl" control-character-class }
{ "xdigit" hex-digit-class } { "xdigit" hex-digit-class }
{ "space" java-blank-class } { "space" java-blank-class }
! TODO: unicode-character-class } [ unicode-class ] at-error ;
} [ bad-class ] at-error ;
: lookup-escape ( char -- ast ) : lookup-escape ( char -- ast )
{ {
@ -119,10 +125,10 @@ AnyRangeCharacter = EscapeSequence | .
RangeCharacter = !("]") AnyRangeCharacter RangeCharacter = !("]") AnyRangeCharacter
Range = RangeCharacter:a "-" RangeCharacter:b => [[ a b <range> ]] Range = RangeCharacter:a "-" RangeCharacter:b => [[ a b <range-class> ]]
| RangeCharacter | RangeCharacter
StartRange = AnyRangeCharacter:a "-" RangeCharacter:b => [[ a b <range> ]] StartRange = AnyRangeCharacter:a "-" RangeCharacter:b => [[ a b <range-class> ]]
| AnyRangeCharacter | AnyRangeCharacter
Ranges = StartRange:s Range*:r => [[ r s prefix ]] Ranges = StartRange:s Range*:r => [[ r s prefix ]]
@ -144,7 +150,7 @@ Parenthized = "?:" Alternation:a => [[ a ]]
Element = "(" Parenthized:p ")" => [[ p ]] Element = "(" Parenthized:p ")" => [[ p ]]
| "[" CharClass:r "]" => [[ r ]] | "[" CharClass:r "]" => [[ r ]]
| ".":d => [[ any-char <primitive-class> ]] | ".":d => [[ dot ]]
| Character | Character
Number = (!(","|"}").)* => [[ string>number ensure-number ]] Number = (!(","|"}").)* => [[ string>number ensure-number ]]

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -0,0 +1,13 @@
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel make prettyprint.backend
prettyprint.custom regexp regexp.parser regexp.private ;
IN: regexp.prettyprint
M: regexp pprint*
[
[
[ raw>> dup find-regexp-syntax swap % swap % % ]
[ options>> options>string % ] bi
] "" make
] keep present-text ;

View File

@ -1,10 +1,9 @@
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators kernel kernel.private math sequences USING: accessors combinators kernel kernel.private math sequences
sequences.private strings sets assocs prettyprint.backend sequences.private strings sets assocs make lexer namespaces parser
prettyprint.custom make lexer namespaces parser arrays fry locals arrays fry locals regexp.parser splitting sorting regexp.ast
regexp.parser splitting sorting regexp.ast regexp.negation regexp.negation regexp.compiler compiler.units words math.ranges ;
regexp.compiler compiler.units words math.ranges ;
IN: regexp IN: regexp
TUPLE: regexp TUPLE: regexp
@ -217,11 +216,8 @@ PRIVATE>
: R{ CHAR: } parsing-regexp ; parsing : R{ CHAR: } parsing-regexp ; parsing
: R| CHAR: | parsing-regexp ; parsing : R| CHAR: | parsing-regexp ; parsing
M: regexp pprint* USING: vocabs vocabs.loader ;
[
[
[ raw>> dup find-regexp-syntax swap % swap % % ]
[ options>> options>string % ] bi
] "" make
] keep present-text ;
"prettyprint" vocab [
"regexp.prettyprint" require
] when

View File

@ -1,10 +1,11 @@
! Copyright (C) 2009 Daniel Ehrenberg ! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: sequences splitting kernel math.parser io.files io.encodings.ascii biassocs ; USING: sequences splitting kernel math.parser io.files io.encodings.utf8
biassocs ascii ;
IN: simple-flat-file IN: simple-flat-file
: drop-comments ( seq -- newseq ) : drop-comments ( seq -- newseq )
[ "#" split1 drop ] map harvest ; [ "#@" split first ] map harvest ;
: split-column ( line -- columns ) : split-column ( line -- columns )
" \t" split harvest 2 short head 2 f pad-tail ; " \t" split harvest 2 short head 2 f pad-tail ;
@ -22,5 +23,10 @@ IN: simple-flat-file
drop-comments [ parse-line ] map ; drop-comments [ parse-line ] map ;
: flat-file>biassoc ( filename -- biassoc ) : flat-file>biassoc ( filename -- biassoc )
ascii file-lines process-codetable-lines >biassoc ; utf8 file-lines process-codetable-lines >biassoc ;
: split-; ( line -- array )
";" split [ [ blank? ] trim ] map ;
: data ( filename -- data )
utf8 file-lines drop-comments [ split-; ] map ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel generic sequences io words arrays summary effects USING: kernel generic sequences io words arrays summary effects
assocs accessors namespaces compiler.errors stack-checker.values continuations assocs accessors namespaces compiler.errors
stack-checker.recursive-state ; stack-checker.values stack-checker.recursive-state ;
IN: stack-checker.errors IN: stack-checker.errors
: pretty-word ( word -- word' ) : pretty-word ( word -- word' )
@ -15,7 +15,7 @@ M: inference-error compiler-error-type type>> ;
: (inference-error) ( ... class type -- * ) : (inference-error) ( ... class type -- * )
[ boa ] dip [ boa ] dip
recursive-state get word>> recursive-state get word>>
\ inference-error boa throw ; inline \ inference-error boa rethrow ; inline
: inference-error ( ... class -- * ) : inference-error ( ... class -- * )
+error+ (inference-error) ; inline +error+ (inference-error) ; inline

View File

@ -26,6 +26,8 @@ os macosx? [
[ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test
] when ] when
[ t ] [ "benchmark.regex-dna" shake-and-bake 900000 small-enough? ] unit-test
{ {
"tools.deploy.test.1" "tools.deploy.test.1"
"tools.deploy.test.2" "tools.deploy.test.2"

View File

@ -54,11 +54,8 @@ IN: tools.deploy.shaker
] when ; ] when ;
: strip-call ( -- ) : strip-call ( -- )
"call" vocab [ "Stripping stack effect checking from call( and execute(" show
"Stripping stack effect checking from call( and execute(" show "vocab:tools/deploy/shaker/strip-call.factor" run-file ;
"vocab:tools/deploy/shaker/strip-call.factor"
run-file
] when ;
: strip-cocoa ( -- ) : strip-cocoa ( -- )
"cocoa" vocab [ "cocoa" vocab [

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: tools.deploy.shaker.call IN: tools.deploy.shaker.call
IN: call IN: combinators
USE: call.private USE: combinators.private
: call-effect ( word effect -- ) call-effect-unsafe ; inline : call-effect ( word effect -- ) call-effect-unsafe ; inline

View File

@ -2,8 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators.short-circuit unicode.categories kernel math USING: combinators.short-circuit unicode.categories kernel math
combinators splitting sequences math.parser io.files io assocs combinators splitting sequences math.parser io.files io assocs
arrays namespaces make math.ranges unicode.normalize.private values arrays namespaces make math.ranges unicode.normalize
io.encodings.ascii unicode.syntax unicode.data compiler.units fry unicode.normalize.private values io.encodings.ascii
unicode.syntax unicode.data compiler.units fry
alien.syntax sets accessors interval-maps memoize locals words ; alien.syntax sets accessors interval-maps memoize locals words ;
IN: unicode.breaks IN: unicode.breaks
@ -126,7 +127,7 @@ to: grapheme-table
VALUE: word-break-table VALUE: word-break-table
"vocab:unicode/data/WordBreakProperty.txt" load-script "vocab:unicode/data/WordBreakProperty.txt" load-key-value
to: word-break-table to: word-break-table
C-ENUM: wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter C-ENUM: wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter

View File

@ -1,6 +1,7 @@
! Copyright (C) 2008, 2009 Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: unicode.case unicode.case.private tools.test namespaces strings unicode.normalize ; USING: unicode.case tools.test namespaces strings unicode.normalize
unicode.case.private ;
IN: unicode.case.tests IN: unicode.case.tests
\ >upper must-infer \ >upper must-infer

View File

@ -7,12 +7,6 @@ strings splitting kernel accessors unicode.breaks fry locals ;
QUALIFIED: ascii QUALIFIED: ascii
IN: unicode.case IN: unicode.case
<PRIVATE
: ch>lower ( ch -- lower ) simple-lower at-default ; inline
: ch>upper ( ch -- upper ) simple-upper at-default ; inline
: ch>title ( ch -- title ) simple-title at-default ; inline
PRIVATE>
SYMBOL: locale ! Just casing locale, or overall? SYMBOL: locale ! Just casing locale, or overall?
<PRIVATE <PRIVATE
@ -86,7 +80,7 @@ SYMBOL: locale ! Just casing locale, or overall?
:: map-case ( string string-quot char-quot -- case ) :: map-case ( string string-quot char-quot -- case )
string length <sbuf> :> out string length <sbuf> :> out
string [ string [
dup special-casing at dup special-case
[ string-quot call out push-all ] [ string-quot call out push-all ]
[ char-quot call out push ] ?if [ char-quot call out push ] ?if
] each out "" like ; inline ] each out "" like ; inline

View File

@ -1,4 +1,7 @@
USING: tools.test kernel unicode.categories words sequences unicode.syntax ; ! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test kernel unicode.categories words sequences unicode.data ;
IN: unicode.categories.tests
[ { f f t t f t t f f t } ] [ CHAR: A { [ { f f t t f t t f f t } ] [ CHAR: A {
blank? letter? LETTER? Letter? digit? blank? letter? LETTER? Letter? digit?

View File

@ -5,7 +5,7 @@ io.encodings.ascii kernel values splitting accessors math.parser
ascii io assocs strings math namespaces make sorting combinators ascii io assocs strings math namespaces make sorting combinators
math.order arrays unicode.normalize unicode.data locals math.order arrays unicode.normalize unicode.data locals
unicode.syntax macros sequences.deep words unicode.breaks unicode.syntax macros sequences.deep words unicode.breaks
quotations combinators.short-circuit ; quotations combinators.short-circuit simple-flat-file ;
IN: unicode.collation IN: unicode.collation
<PRIVATE <PRIVATE
@ -20,13 +20,11 @@ TUPLE: weight primary secondary tertiary ignorable? ;
[ >>primary ] [ >>secondary ] [ >>tertiary ] tri* [ >>primary ] [ >>secondary ] [ >>tertiary ] tri*
] map ; ] map ;
: parse-line ( line -- code-poing weight ) : parse-keys ( string -- chars )
";" split1 [ [ blank? ] trim ] bi@ " " split [ hex> ] "" map-as ;
[ " " split [ hex> ] "" map-as ] [ parse-weight ] bi* ;
: parse-ducet ( file -- ducet ) : parse-ducet ( file -- ducet )
ascii file-lines filter-comments data [ [ parse-keys ] [ parse-weight ] bi* ] H{ } assoc-map-as ;
[ parse-line ] H{ } map>assoc ;
"vocab:unicode/collation/allkeys.txt" parse-ducet to: ducet "vocab:unicode/collation/allkeys.txt" parse-ducet to: ducet

View File

@ -1,3 +1,5 @@
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup strings ; USING: help.syntax help.markup strings ;
IN: unicode.data IN: unicode.data
@ -5,18 +7,14 @@ ABOUT: "unicode.data"
ARTICLE: "unicode.data" "Unicode data tables" 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." "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 canonical-entry }
{ $subsection combine-chars } { $subsection combine-chars }
{ $subsection combining-class } { $subsection combining-class }
{ $subsection non-starter? } { $subsection non-starter? }
{ $subsection name>char } { $subsection name>char }
{ $subsection char>name } { $subsection char>name }
{ $subsection property? } ; { $subsection property? }
{ $subsection load-key-value } ;
HELP: load-script
{ $values { "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 HELP: canonical-entry
{ $values { "char" "a code point" } { "seq" string } } { $values { "char" "a code point" } { "seq" string } }
@ -49,3 +47,7 @@ HELP: name>char
HELP: property? HELP: property?
{ $values { "char" "a code point" } { "property" string } { "?" "a boolean" } } { $values { "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." } ; { $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ;
HELP: load-key-value
{ $values { "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." } ;

View File

@ -1,13 +1,15 @@
! Copyright (C) 2008 Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators.short-circuit assocs math kernel sequences USING: combinators.short-circuit assocs math kernel sequences
io.files hashtables quotations splitting grouping arrays io io.files hashtables quotations splitting grouping arrays io
math.parser hash2 math.order byte-arrays words namespaces words math.parser hash2 math.order byte-arrays words namespaces words
compiler.units parser io.encodings.ascii values interval-maps compiler.units parser io.encodings.ascii values interval-maps
ascii sets combinators locals math.ranges sorting make ascii sets combinators locals math.ranges sorting make
strings.parser io.encodings.utf8 memoize ; strings.parser io.encodings.utf8 memoize simple-flat-file ;
IN: unicode.data IN: unicode.data
<PRIVATE
VALUE: simple-lower VALUE: simple-lower
VALUE: simple-upper VALUE: simple-upper
VALUE: simple-title VALUE: simple-title
@ -16,35 +18,69 @@ VALUE: combine-map
VALUE: class-map VALUE: class-map
VALUE: compatibility-map VALUE: compatibility-map
VALUE: category-map VALUE: category-map
VALUE: name-map
VALUE: special-casing VALUE: special-casing
VALUE: properties VALUE: properties
: canonical-entry ( char -- seq ) canonical-map at ; PRIVATE>
: combine-chars ( a b -- char/f ) combine-map hash2 ;
: compatibility-entry ( char -- seq ) compatibility-map at ; VALUE: name-map
: combining-class ( char -- n ) class-map at ;
: non-starter? ( char -- ? ) combining-class { 0 f } member? not ; : canonical-entry ( char -- seq ) canonical-map at ; inline
: name>char ( name -- char ) name-map at ; : combine-chars ( a b -- char/f ) combine-map hash2 ; inline
: char>name ( char -- name ) name-map value-at ; : compatibility-entry ( char -- seq ) compatibility-map at ; inline
: property? ( char property -- ? ) properties at interval-key? ; : combining-class ( char -- n ) class-map at ; inline
: non-starter? ( char -- ? ) combining-class { 0 f } member? not ; inline
: name>char ( name -- char ) name-map at ; inline
: char>name ( char -- name ) name-map value-at ; inline
: property? ( char property -- ? ) properties at interval-key? ; inline
: ch>lower ( ch -- lower ) simple-lower at-default ; inline
: ch>upper ( ch -- upper ) simple-upper at-default ; inline
: ch>title ( ch -- title ) simple-title at-default ; inline
: special-case ( ch -- casing-tuple ) special-casing at ; inline
! For non-existent characters, use Cn
CONSTANT: categories
{ "Cn"
"Lu" "Ll" "Lt" "Lm" "Lo"
"Mn" "Mc" "Me"
"Nd" "Nl" "No"
"Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po"
"Sm" "Sc" "Sk" "So"
"Zs" "Zl" "Zp"
"Cc" "Cf" "Cs" "Co" }
<PRIVATE
MEMO: categories-map ( -- hashtable )
categories <enum> [ swap ] H{ } assoc-map-as ;
CONSTANT: num-chars HEX: 2FA1E
PRIVATE>
: category# ( char -- category )
! There are a few characters that should be Cn
! that this gives Cf or Mn
! Cf = 26; Mn = 5; Cn = 29
! Use a compressed array instead?
dup category-map ?nth [ ] [
dup HEX: E0001 HEX: E007F between?
[ drop 26 ] [
HEX: E0100 HEX: E01EF between? 5 29 ?
] if
] ?if ;
: category ( char -- category )
category# categories nth ;
<PRIVATE
! Loading data from UnicodeData.txt ! Loading data from UnicodeData.txt
: split-; ( line -- array )
";" split [ [ blank? ] trim ] map ;
: data ( filename -- data )
ascii file-lines [ split-; ] map ;
: load-data ( -- data ) : load-data ( -- data )
"vocab:unicode/data/UnicodeData.txt" data ; "vocab:unicode/data/UnicodeData.txt" data ;
: filter-comments ( lines -- lines )
[ "#@" split first ] map harvest ;
: (process-data) ( index data -- newdata ) : (process-data) ( index data -- newdata )
filter-comments
[ [ nth ] keep first swap ] with { } map>assoc [ [ nth ] keep first swap ] with { } map>assoc
[ [ hex> ] dip ] assoc-map ; [ [ hex> ] dip ] assoc-map ;
@ -97,22 +133,6 @@ VALUE: properties
[ nip zero? not ] assoc-filter [ nip zero? not ] assoc-filter
>hashtable ; >hashtable ;
! For non-existent characters, use Cn
CONSTANT: categories
{ "Cn"
"Lu" "Ll" "Lt" "Lm" "Lo"
"Mn" "Mc" "Me"
"Nd" "Nl" "No"
"Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po"
"Sm" "Sc" "Sk" "So"
"Zs" "Zl" "Zp"
"Cc" "Cf" "Cs" "Co" }
MEMO: categories-map ( -- hashtable )
categories <enum> [ swap ] H{ } assoc-map-as ;
CONSTANT: num-chars HEX: 2FA1E
! the maximum unicode char in the first 3 planes ! the maximum unicode char in the first 3 planes
: ?set-nth ( val index seq -- ) : ?set-nth ( val index seq -- )
@ -140,24 +160,26 @@ CONSTANT: num-chars HEX: 2FA1E
: multihex ( hexstring -- string ) : multihex ( hexstring -- string )
" " split [ hex> ] map sift ; " " split [ hex> ] map sift ;
PRIVATE>
TUPLE: code-point lower title upper ; TUPLE: code-point lower title upper ;
C: <code-point> code-point C: <code-point> code-point
<PRIVATE
: set-code-point ( seq -- ) : set-code-point ( seq -- )
4 head [ multihex ] map first4 4 head [ multihex ] map first4
<code-point> swap first set ; <code-point> swap first set ;
! Extra properties ! Extra properties
: properties-lines ( -- lines )
"vocab:unicode/data/PropList.txt"
ascii file-lines ;
: parse-properties ( -- {{[a,b],prop}} ) : parse-properties ( -- {{[a,b],prop}} )
properties-lines filter-comments [ "vocab:unicode/data/PropList.txt" data [
split-; first2 [
[ ".." split1 [ dup ] unless* [ hex> ] bi@ 2array ] dip ".." split1 [ dup ] unless*
] { } map>assoc ; [ hex> ] bi@ 2array
] dip
] assoc-map ;
: properties>intervals ( properties -- assoc[str,interval] ) : properties>intervals ( properties -- assoc[str,interval] )
dup values prune [ f ] H{ } map>assoc dup values prune [ f ] H{ } map>assoc
@ -195,14 +217,11 @@ load-special-casing to: special-casing
load-properties to: properties load-properties to: properties
! Utility to load resource files that look like Scripts.txt [ name>char [ "Invalid character" throw ] unless* ]
name>char-hook set-global
SYMBOL: interned SYMBOL: interned
: parse-script ( filename -- assoc )
! assoc is code point/range => name
ascii file-lines filter-comments [ split-; ] map ;
: range, ( value key -- ) : range, ( value key -- )
swap interned get swap interned get
[ = ] with find nip 2array , ; [ = ] with find nip 2array , ;
@ -216,12 +235,11 @@ SYMBOL: interned
] assoc-each ] assoc-each
] { } make <interval-map> ; ] { } make <interval-map> ;
: process-script ( ranges -- table ) : process-key-value ( ranges -- table )
dup values prune interned dup values prune interned
[ expand-ranges ] with-variable ; [ expand-ranges ] with-variable ;
: load-script ( filename -- table ) PRIVATE>
parse-script process-script ;
[ name>char [ "Invalid character" throw ] unless* ] : load-key-value ( filename -- table )
name>char-hook set-global data process-key-value ;

View File

@ -1,5 +1,5 @@
USING: unicode.normalize kernel tools.test sequences USING: unicode.normalize kernel tools.test sequences
unicode.data io.encodings.utf8 io.files splitting math.parser simple-flat-file io.encodings.utf8 io.files splitting math.parser
locals math quotations assocs combinators unicode.normalize.private ; locals math quotations assocs combinators unicode.normalize.private ;
IN: unicode.normalize.tests IN: unicode.normalize.tests
@ -23,9 +23,8 @@ IN: unicode.normalize.tests
[ "\u00d55c" ] [ "\u001112\u001161\u0011ab" nfc ] unit-test [ "\u00d55c" ] [ "\u001112\u001161\u0011ab" nfc ] unit-test
: parse-test ( -- tests ) : parse-test ( -- tests )
"vocab:unicode/normalize/NormalizationTest.txt" "vocab:unicode/normalize/NormalizationTest.txt" data
utf8 file-lines filter-comments [ 5 head [ " " split [ hex> ] "" map-as ] map ] map ;
[ ";" split 5 head [ " " split [ hex> ] "" map-as ] map ] map ;
:: assert= ( test spec quot -- ) :: assert= ( test spec quot -- )
spec [ spec [

View File

@ -1,6 +1,14 @@
USING: help.syntax help.markup ; ! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: help.syntax help.markup strings ;
IN: unicode.script IN: unicode.script
ABOUT: "unicode.script"
ARTICLE: "unicode.script" "Unicode script properties"
"The unicode standard gives every character a script. Note that this is different from a language, and that it is non-trivial to detect language from a string. To get the script of a character, use"
{ $subsection script-of } ;
HELP: script-of HELP: script-of
{ $values { "char" "a code point" } { "script" "a symbol" } } { $values { "char" "a code point" } { "script" string } }
{ $description "Gets a symbol representing the code point of a given character. The word name of the symbol is the same as the one " } ; { $description "Finds the script of the given Unicode code point, represented as a string." } ;

View File

@ -7,10 +7,14 @@ words words.symbol compiler.units arrays interval-maps
unicode.data ; unicode.data ;
IN: unicode.script IN: unicode.script
<PRIVATE
VALUE: script-table VALUE: script-table
"vocab:unicode/script/Scripts.txt" load-script "vocab:unicode/script/Scripts.txt" load-key-value
to: script-table to: script-table
PRIVATE>
: script-of ( char -- script ) : script-of ( char -- script )
script-table interval-at ; script-table interval-at ;

View File

@ -5,22 +5,7 @@ bit-arrays namespaces make sequences.private arrays quotations
assocs classes.predicate math.order strings.parser ; assocs classes.predicate math.order strings.parser ;
IN: unicode.syntax IN: unicode.syntax
! Character classes (categories) <PRIVATE
: category# ( char -- category )
! There are a few characters that should be Cn
! that this gives Cf or Mn
! Cf = 26; Mn = 5; Cn = 29
! Use a compressed array instead?
dup category-map ?nth [ ] [
dup HEX: E0001 HEX: E007F between?
[ drop 26 ] [
HEX: E0100 HEX: E01EF between? 5 29 ?
] if
] ?if ;
: category ( char -- category )
category# categories nth ;
: >category-array ( categories -- bitarray ) : >category-array ( categories -- bitarray )
categories [ swap member? ] with map >bit-array ; categories [ swap member? ] with map >bit-array ;
@ -40,6 +25,8 @@ IN: unicode.syntax
: define-category ( word categories -- ) : define-category ( word categories -- )
[category] integer swap define-predicate-class ; [category] integer swap define-predicate-class ;
PRIVATE>
: CATEGORY: : CATEGORY:
CREATE ";" parse-tokens define-category ; parsing CREATE ";" parse-tokens define-category ; parsing

View File

@ -82,9 +82,9 @@ HELP: parse-host
{ $notes "This word is used by " { $link >url } ". It can also be used directly to parse " { $snippet "host:port" } " strings which are not full URLs." } { $notes "This word is used by " { $link >url } ". It can also be used directly to parse " { $snippet "host:port" } " strings which are not full URLs." }
{ $examples { $examples
{ $example { $example
"USING: prettyprint urls kernel ;" "USING: arrays kernel prettyprint urls ;"
"\"sbcl.org:80\" parse-host .s 2drop" "\"sbcl.org:80\" parse-host 2array ."
"\"sbcl.org\"\n80" "{ \"sbcl.org\" 80 }"
} }
} ; } ;

View File

@ -3,7 +3,7 @@
USING: kernel namespaces xml.name io.encodings.utf8 xml.elements USING: kernel namespaces xml.name io.encodings.utf8 xml.elements
io.encodings.utf16 xml.tokenize xml.state math ascii sequences io.encodings.utf16 xml.tokenize xml.state math ascii sequences
io.encodings.string io.encodings combinators accessors io.encodings.string io.encodings combinators accessors
xml.data io.encodings.iana ; xml.data io.encodings.iana xml.errors ;
IN: xml.autoencoding IN: xml.autoencoding
: decode-stream ( encoding -- ) : decode-stream ( encoding -- )
@ -35,7 +35,10 @@ IN: xml.autoencoding
: prolog-encoding ( prolog -- ) : prolog-encoding ( prolog -- )
encoding>> dup "UTF-16" = encoding>> dup "UTF-16" =
[ drop ] [ name>encoding [ decode-stream ] when* ] if ; [ drop ] [
dup name>encoding
[ decode-stream ] [ bad-encoding ] ?if
] if ;
: instruct-encoding ( instruct/prolog -- ) : instruct-encoding ( instruct/prolog -- )
dup prolog? dup prolog?

View File

@ -1,5 +1,5 @@
USING: continuations xml xml.errors tools.test kernel arrays USING: continuations xml xml.errors tools.test kernel arrays
xml.data quotations fry ; xml.data quotations fry byte-arrays ;
IN: xml.errors.tests IN: xml.errors.tests
: xml-error-test ( expected-error xml-string -- ) : xml-error-test ( expected-error xml-string -- )
@ -40,3 +40,4 @@ T{ bad-doctype f 1 22 T{ opener { name T{ name f "" "foo" "" } } { attrs T{ attr
T{ disallowed-char f 1 4 1 } "<x>\u000001</x>" xml-error-test T{ disallowed-char f 1 4 1 } "<x>\u000001</x>" xml-error-test
T{ missing-close f 1 8 } "<!-- foo" xml-error-test T{ missing-close f 1 8 } "<!-- foo" xml-error-test
T{ misplaced-directive f 1 9 "ENTITY" } "<!ENTITY foo 'bar'><x/>" xml-error-test T{ misplaced-directive f 1 9 "ENTITY" } "<!ENTITY foo 'bar'><x/>" xml-error-test
[ "<?xml version='1.0' encoding='foobar'?>" >byte-array bytes>xml ] [ T{ bad-encoding f 1 39 "foobar" } = ] must-fail-with

View File

@ -338,5 +338,14 @@ TUPLE: bad-doctype < xml-error-at contents ;
M: bad-doctype summary M: bad-doctype summary
call-next-method "\nDTD contains invalid object" append ; call-next-method "\nDTD contains invalid object" append ;
TUPLE: bad-encoding < xml-error-at encoding ;
: bad-encoding ( encoding -- * )
\ bad-encoding xml-error-at
swap >>encoding
throw ;
M: bad-encoding summary
call-next-method
"\nEncoding in XML document does not exist" append ;
UNION: xml-error UNION: xml-error
multitags notags pre/post-content xml-error-at ; multitags notags pre/post-content xml-error-at ;

View File

@ -27,20 +27,18 @@ combinators vocabs.parser grouping ;
IN: vocabs.loader.test.2 IN: vocabs.loader.test.2
: hello 3 ; : hello ( -- ) ;
MAIN: hello MAIN: hello
IN: vocabs.loader.tests IN: vocabs.loader.tests
[ { 3 3 3 } ] [ [ ] [
"vocabs.loader.test.2" run "vocabs.loader.test.2" run
"vocabs.loader.test.2" vocab run "vocabs.loader.test.2" vocab run
"vocabs.loader.test.2" <vocab-link> run "vocabs.loader.test.2" <vocab-link> run
3array
] unit-test ] unit-test
[ [
"resource:core/vocabs/loader/test/a/a.factor" forget-source "resource:core/vocabs/loader/test/a/a.factor" forget-source
"vocabs.loader.test.a" forget-vocab "vocabs.loader.test.a" forget-vocab

View File

@ -49,7 +49,7 @@ PRIVATE>
in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ; in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ;
: make-advised ( word -- ) : make-advised ( word -- )
[ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ] [ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
[ { before after around } [ <linked-hash> swap set-word-prop ] with each ] [ { before after around } [ <linked-hash> swap set-word-prop ] with each ]
[ t advised set-word-prop ] tri ; [ t advised set-word-prop ] tri ;

View File

@ -0,0 +1,15 @@
USING: tools.deploy.config ;
H{
{ deploy-word-defs? f }
{ deploy-word-props? f }
{ deploy-math? f }
{ deploy-compiler? t }
{ deploy-ui? f }
{ deploy-c-types? f }
{ "stop-after-last-window?" t }
{ deploy-reflection 1 }
{ deploy-name "benchmark.regex-dna" }
{ deploy-io 2 }
{ deploy-threads? f }
{ deploy-unicode? f }
}

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors prettyprint io io.encodings.ascii USING: accessors io io.encodings.ascii io.files kernel sequences
io.files kernel sequences assocs namespaces regexp ; assocs math.parser namespaces regexp ;
IN: benchmark.regex-dna IN: benchmark.regex-dna
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=ruby&id=1 ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=ruby&id=1
@ -22,7 +22,7 @@ IN: benchmark.regex-dna
R/ agggtaa[cgt]|[acg]ttaccct/i R/ agggtaa[cgt]|[acg]ttaccct/i
} [ } [
[ raw>> write bl ] [ raw>> write bl ]
[ count-matches . ] [ count-matches number>string print ]
bi bi
] with each ; ] with each ;
@ -50,9 +50,9 @@ SYMBOL: clen
dup count-patterns dup count-patterns
do-replacements do-replacements
nl nl
ilen get . ilen get number>string print
clen get . clen get number>string print
length . ; length number>string print ;
: regex-dna-main ( -- ) : regex-dna-main ( -- )
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ; "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ;

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.ranges sequences ; USING: kernel math math.ranges sequences project-euler.common ;
IN: project-euler.001 IN: project-euler.001
! http://projecteuler.net/index.php?section=problems&id=1 ! http://projecteuler.net/index.php?section=problems&id=1
@ -51,4 +51,4 @@ PRIVATE>
! [ euler001b ] 100 ave-time ! [ euler001b ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials ! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler001 SOLUTION: euler001

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007, 2008 Aaron Schaefer, Alexander Solovyov, Vishal Talwar. ! Copyright (c) 2007, 2008 Aaron Schaefer, Alexander Solovyov, Vishal Talwar.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences ; USING: kernel math sequences project-euler.common ;
IN: project-euler.002 IN: project-euler.002
! http://projecteuler.net/index.php?section=problems&id=2 ! http://projecteuler.net/index.php?section=problems&id=2
@ -77,4 +77,4 @@ PRIVATE>
! [ euler002b ] 100 ave-time ! [ euler002b ] 100 ave-time
! 0 ms ave run time - 0.0 SD (100 trials) ! 0 ms ave run time - 0.0 SD (100 trials)
MAIN: euler002b SOLUTION: euler002b

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math.primes.factors sequences ; USING: math.primes.factors sequences project-euler.common ;
IN: project-euler.003 IN: project-euler.003
! http://projecteuler.net/index.php?section=problems&id=3 ! http://projecteuler.net/index.php?section=problems&id=3
@ -22,4 +22,4 @@ IN: project-euler.003
! [ euler003 ] 100 ave-time ! [ euler003 ] 100 ave-time
! 1 ms ave run time - 0.49 SD (100 trials) ! 1 ms ave run time - 0.49 SD (100 trials)
MAIN: euler003 SOLUTION: euler003

View File

@ -34,4 +34,4 @@ PRIVATE>
! [ euler004 ] 100 ave-time ! [ euler004 ] 100 ave-time
! 1164 ms ave run time - 39.35 SD (100 trials) ! 1164 ms ave run time - 39.35 SD (100 trials)
MAIN: euler004 SOLUTION: euler004

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math math.functions sequences ; USING: math math.functions sequences project-euler.common ;
IN: project-euler.005 IN: project-euler.005
! http://projecteuler.net/index.php?section=problems&id=5 ! http://projecteuler.net/index.php?section=problems&id=5
@ -23,4 +23,4 @@ IN: project-euler.005
! [ euler005 ] 100 ave-time ! [ euler005 ] 100 ave-time
! 0 ms ave run time - 0.14 SD (100 trials) ! 0 ms ave run time - 0.14 SD (100 trials)
MAIN: euler005 SOLUTION: euler005

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007, 2008 Aaron Schaefer. ! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.ranges sequences ; USING: kernel math math.ranges sequences project-euler.common ;
IN: project-euler.006 IN: project-euler.006
! http://projecteuler.net/index.php?section=problems&id=6 ! http://projecteuler.net/index.php?section=problems&id=6
@ -40,4 +40,4 @@ PRIVATE>
! [ euler006 ] 100 ave-time ! [ euler006 ] 100 ave-time
! 0 ms ave run time - 0.24 SD (100 trials) ! 0 ms ave run time - 0.24 SD (100 trials)
MAIN: euler006 SOLUTION: euler006

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: lists math math.primes.lists ; USING: lists math math.primes.lists project-euler.common ;
IN: project-euler.007 IN: project-euler.007
! http://projecteuler.net/index.php?section=problems&id=7 ! http://projecteuler.net/index.php?section=problems&id=7
@ -26,4 +26,4 @@ IN: project-euler.007
! [ euler007 ] 100 ave-time ! [ euler007 ] 100 ave-time
! 5 ms ave run time - 1.13 SD (100 trials) ! 5 ms ave run time - 1.13 SD (100 trials)
MAIN: euler007 SOLUTION: euler007

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007, 2008 Aaron Schaefer. ! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: grouping math.order math.parser sequences ; USING: grouping math.order math.parser sequences project-euler.common ;
IN: project-euler.008 IN: project-euler.008
! http://projecteuler.net/index.php?section=problems&id=8 ! http://projecteuler.net/index.php?section=problems&id=8
@ -69,4 +69,4 @@ PRIVATE>
! [ euler008 ] 100 ave-time ! [ euler008 ] 100 ave-time
! 2 ms ave run time - 0.79 SD (100 trials) ! 2 ms ave run time - 0.79 SD (100 trials)
MAIN: euler008 SOLUTION: euler008

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007, 2008 Aaron Schaefer. ! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel make math sequences sorting ; USING: kernel make math sequences sorting project-euler.common ;
IN: project-euler.009 IN: project-euler.009
! http://projecteuler.net/index.php?section=problems&id=9 ! http://projecteuler.net/index.php?section=problems&id=9
@ -50,4 +50,4 @@ PRIVATE>
! [ euler009 ] 100 ave-time ! [ euler009 ] 100 ave-time
! 1 ms ave run time - 0.73 SD (100 trials) ! 1 ms ave run time - 0.73 SD (100 trials)
MAIN: euler009 SOLUTION: euler009

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu. ! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math.primes sequences ; USING: math.primes sequences project-euler.common ;
IN: project-euler.010 IN: project-euler.010
! http://projecteuler.net/index.php?section=problems&id=10 ! http://projecteuler.net/index.php?section=problems&id=10
@ -22,4 +22,4 @@ IN: project-euler.010
! [ euler010 ] 100 ave-time ! [ euler010 ] 100 ave-time
! 15 ms ave run time - 0.41 SD (100 trials) ! 15 ms ave run time - 0.41 SD (100 trials)
MAIN: euler010 SOLUTION: euler010

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007, 2008 Aaron Schaefer. ! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: grouping kernel make math.order sequences ; USING: grouping kernel make math.order sequences project-euler.common ;
IN: project-euler.011 IN: project-euler.011
! http://projecteuler.net/index.php?section=problems&id=11 ! http://projecteuler.net/index.php?section=problems&id=11
@ -101,4 +101,4 @@ PRIVATE>
! [ euler011 ] 100 ave-time ! [ euler011 ] 100 ave-time
! 3 ms ave run time - 0.77 SD (100 trials) ! 3 ms ave run time - 0.77 SD (100 trials)
MAIN: euler011 SOLUTION: euler011

View File

@ -39,4 +39,4 @@ IN: project-euler.012
! [ euler012 ] 10 ave-time ! [ euler012 ] 10 ave-time
! 6573 ms ave run time - 346.27 SD (10 trials) ! 6573 ms ave run time - 346.27 SD (10 trials)
MAIN: euler012 SOLUTION: euler012

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math.parser sequences ; USING: math.parser sequences project-euler.common ;
IN: project-euler.013 IN: project-euler.013
! http://projecteuler.net/index.php?section=problems&id=13 ! http://projecteuler.net/index.php?section=problems&id=13
@ -230,4 +230,4 @@ PRIVATE>
! [ euler013 ] 100 ave-time ! [ euler013 ] 100 ave-time
! 0 ms ave run time - 0.31 SD (100 trials) ! 0 ms ave run time - 0.31 SD (100 trials)
MAIN: euler013 SOLUTION: euler013

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators.short-circuit kernel make math math.ranges sequences ; USING: combinators.short-circuit kernel make math math.ranges
sequences project-euler.common ;
IN: project-euler.014 IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14 ! http://projecteuler.net/index.php?section=problems&id=14
@ -72,4 +73,4 @@ PRIVATE>
! TODO: try using memoization ! TODO: try using memoization
MAIN: euler014a SOLUTION: euler014a

View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.combinatorics ; USING: kernel math math.combinatorics project-euler.common ;
IN: project-euler.015 IN: project-euler.015
! http://projecteuler.net/index.php?section=problems&id=15 ! http://projecteuler.net/index.php?section=problems&id=15
@ -30,4 +30,4 @@ PRIVATE>
! [ euler015 ] 100 ave-time ! [ euler015 ] 100 ave-time
! 0 ms ave run time - 0.2 SD (100 trials) ! 0 ms ave run time - 0.2 SD (100 trials)
MAIN: euler015 SOLUTION: euler015

View File

@ -22,4 +22,4 @@ IN: project-euler.016
! [ euler016 ] 100 ave-time ! [ euler016 ] 100 ave-time
! 0 ms ave run time - 0.67 SD (100 trials) ! 0 ms ave run time - 0.67 SD (100 trials)
MAIN: euler016 SOLUTION: euler016

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007, 2008 Aaron Schaefer. ! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: ascii kernel math.ranges math.text.english sequences ; USING: ascii kernel math.ranges math.text.english sequences
project-euler.common ;
IN: project-euler.017 IN: project-euler.017
! http://projecteuler.net/index.php?section=problems&id=17 ! http://projecteuler.net/index.php?section=problems&id=17
@ -28,4 +29,4 @@ IN: project-euler.017
! [ euler017 ] 100 ave-time ! [ euler017 ] 100 ave-time
! 15 ms ave run time - 1.71 SD (100 trials) ! 15 ms ave run time - 1.71 SD (100 trials)
MAIN: euler017 SOLUTION: euler017

View File

@ -86,4 +86,4 @@ PRIVATE>
! [ euler018a ] 100 ave-time ! [ euler018a ] 100 ave-time
! 0 ms ave run time - 0.39 SD (100 trials) ! 0 ms ave run time - 0.39 SD (100 trials)
MAIN: euler018a SOLUTION: euler018a

View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: calendar combinators kernel math math.ranges namespaces sequences USING: calendar combinators kernel math math.ranges namespaces sequences
math.order ; math.order project-euler.common ;
IN: project-euler.019 IN: project-euler.019
! http://projecteuler.net/index.php?section=problems&id=19 ! http://projecteuler.net/index.php?section=problems&id=19
@ -63,4 +63,4 @@ PRIVATE>
! [ euler019a ] 100 ave-time ! [ euler019a ] 100 ave-time
! 17 ms ave run time - 2.13 SD (100 trials) ! 17 ms ave run time - 2.13 SD (100 trials)
MAIN: euler019 SOLUTION: euler019

View File

@ -22,4 +22,4 @@ IN: project-euler.020
! [ euler020 ] 100 ave-time ! [ euler020 ] 100 ave-time
! 0 ms ave run time - 0.55 (100 trials) ! 0 ms ave run time - 0.55 (100 trials)
MAIN: euler020 SOLUTION: euler020

View File

@ -35,4 +35,4 @@ IN: project-euler.021
! [ euler021 ] 100 ave-time ! [ euler021 ] 100 ave-time
! 335 ms ave run time - 18.63 SD (100 trials) ! 335 ms ave run time - 18.63 SD (100 trials)
MAIN: euler021 SOLUTION: euler021

View File

@ -42,4 +42,4 @@ PRIVATE>
! [ euler022 ] 100 ave-time ! [ euler022 ] 100 ave-time
! 74 ms ave run time - 5.13 SD (100 trials) ! 74 ms ave run time - 5.13 SD (100 trials)
MAIN: euler022 SOLUTION: euler022

View File

@ -58,4 +58,4 @@ PRIVATE>
! [ euler023 ] time ! [ euler023 ] time
! 52780 ms run / 3839 ms GC ! 52780 ms run / 3839 ms GC
MAIN: euler023 SOLUTION: euler023

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.combinatorics math.parser ; USING: kernel math.combinatorics math.parser project-euler.common ;
IN: project-euler.024 IN: project-euler.024
! http://projecteuler.net/index.php?section=problems&id=24 ! http://projecteuler.net/index.php?section=problems&id=24
@ -28,4 +28,4 @@ IN: project-euler.024
! [ euler024 ] 100 ave-time ! [ euler024 ] 100 ave-time
! 0 ms ave run time - 0.27 SD (100 trials) ! 0 ms ave run time - 0.27 SD (100 trials)
MAIN: euler024 SOLUTION: euler024

View File

@ -78,4 +78,4 @@ PRIVATE>
! [ euler025a ] 100 ave-time ! [ euler025a ] 100 ave-time
! 0 ms ave run time - 0.17 SD (100 trials) ! 0 ms ave run time - 0.17 SD (100 trials)
MAIN: euler025a SOLUTION: euler025a

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.primes math.ranges sequences ; USING: kernel math math.functions math.primes math.ranges sequences project-euler.common ;
IN: project-euler.026 IN: project-euler.026
! http://projecteuler.net/index.php?section=problems&id=26 ! http://projecteuler.net/index.php?section=problems&id=26
@ -68,4 +68,4 @@ PRIVATE>
! [ euler026 ] 100 ave-time ! [ euler026 ] 100 ave-time
! 290 ms ave run time - 19.2 SD (100 trials) ! 290 ms ave run time - 19.2 SD (100 trials)
MAIN: euler026 SOLUTION: euler026

View File

@ -1,6 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.primes project-euler.common sequences ; USING: kernel math math.primes project-euler.common sequences
project-euler.common ;
IN: project-euler.027 IN: project-euler.027
! http://projecteuler.net/index.php?section=problems&id=27 ! http://projecteuler.net/index.php?section=problems&id=27
@ -72,4 +73,4 @@ PRIVATE>
! TODO: generalize max-consecutive/max-product (from #26) into a new word ! TODO: generalize max-consecutive/max-product (from #26) into a new word
MAIN: euler027 SOLUTION: euler027

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.ranges sequences ; USING: kernel math math.ranges sequences project-euler.common ;
IN: project-euler.028 IN: project-euler.028
! http://projecteuler.net/index.php?section=problems&id=28 ! http://projecteuler.net/index.php?section=problems&id=28
@ -43,4 +43,4 @@ PRIVATE>
! [ euler028 ] 100 ave-time ! [ euler028 ] 100 ave-time
! 0 ms ave run time - 0.39 SD (100 trials) ! 0 ms ave run time - 0.39 SD (100 trials)
MAIN: euler028 SOLUTION: euler028

View File

@ -34,4 +34,4 @@ IN: project-euler.029
! [ euler029 ] 100 ave-time ! [ euler029 ] 100 ave-time
! 704 ms ave run time - 28.07 SD (100 trials) ! 704 ms ave run time - 28.07 SD (100 trials)
MAIN: euler029 SOLUTION: euler029

View File

@ -43,4 +43,4 @@ PRIVATE>
! [ euler030 ] 100 ave-time ! [ euler030 ] 100 ave-time
! 1700 ms ave run time - 64.84 SD (100 trials) ! 1700 ms ave run time - 64.84 SD (100 trials)
MAIN: euler030 SOLUTION: euler030

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math ; USING: kernel math project-euler.common ;
IN: project-euler.031 IN: project-euler.031
! http://projecteuler.net/index.php?section=problems&id=31 ! http://projecteuler.net/index.php?section=problems&id=31
@ -60,4 +60,4 @@ PRIVATE>
! TODO: generalize to eliminate duplication; use a sequence to specify denominations? ! TODO: generalize to eliminate duplication; use a sequence to specify denominations?
MAIN: euler031 SOLUTION: euler031

View File

@ -75,4 +75,4 @@ PRIVATE>
! [ euler032a ] 10 ave-time ! [ euler032a ] 10 ave-time
! 2624 ms ave run time - 131.91 SD (10 trials) ! 2624 ms ave run time - 131.91 SD (10 trials)
MAIN: euler032a SOLUTION: euler032a

View File

@ -52,4 +52,4 @@ PRIVATE>
! [ euler033 ] 100 ave-time ! [ euler033 ] 100 ave-time
! 7 ms ave run time - 1.31 SD (100 trials) ! 7 ms ave run time - 1.31 SD (100 trials)
MAIN: euler033 SOLUTION: euler033

View File

@ -44,4 +44,4 @@ PRIVATE>
! [ euler034 ] 10 ave-time ! [ euler034 ] 10 ave-time
! 5506 ms ave run time - 144.0 SD (10 trials) ! 5506 ms ave run time - 144.0 SD (10 trials)
MAIN: euler034 SOLUTION: euler034

View File

@ -58,4 +58,4 @@ PRIVATE>
! TODO: try using bit arrays or other methods outlined here: ! TODO: try using bit arrays or other methods outlined here:
! http://home.comcast.net/~babdulbaki/Circular_Primes.html ! http://home.comcast.net/~babdulbaki/Circular_Primes.html
MAIN: euler035 SOLUTION: euler035

View File

@ -36,4 +36,4 @@ PRIVATE>
! [ euler036 ] 100 ave-time ! [ euler036 ] 100 ave-time
! 1703 ms ave run time - 96.6 SD (100 trials) ! 1703 ms ave run time - 96.6 SD (100 trials)
MAIN: euler036 SOLUTION: euler036

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.parser math.primes sequences ; USING: kernel math math.parser math.primes sequences project-euler.common ;
IN: project-euler.037 IN: project-euler.037
! http://projecteuler.net/index.php?section=problems&id=37 ! http://projecteuler.net/index.php?section=problems&id=37
@ -49,4 +49,4 @@ PRIVATE>
! [ euler037 ] 100 ave-time ! [ euler037 ] 100 ave-time
! 130 ms ave run time - 6.27 SD (100 trials) ! 130 ms ave run time - 6.27 SD (100 trials)
MAIN: euler037 SOLUTION: euler037

View File

@ -53,4 +53,4 @@ PRIVATE>
! [ euler038 ] 100 ave-time ! [ euler038 ] 100 ave-time
! 11 ms ave run time - 1.5 SD (100 trials) ! 11 ms ave run time - 1.5 SD (100 trials)
MAIN: euler038 SOLUTION: euler038

View File

@ -62,4 +62,4 @@ PRIVATE>
! [ euler039 ] 100 ave-time ! [ euler039 ] 100 ave-time
! 1 ms ave run time - 0.37 SD (100 trials) ! 1 ms ave run time - 0.37 SD (100 trials)
MAIN: euler039 SOLUTION: euler039

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.parser sequences strings ; USING: kernel math math.parser sequences strings project-euler.common ;
IN: project-euler.040 IN: project-euler.040
! http://projecteuler.net/index.php?section=problems&id=40 ! http://projecteuler.net/index.php?section=problems&id=40
@ -48,4 +48,4 @@ PRIVATE>
! [ euler040 ] 100 ave-time ! [ euler040 ] 100 ave-time
! 444 ms ave run time - 23.64 SD (100 trials) ! 444 ms ave run time - 23.64 SD (100 trials)
MAIN: euler040 SOLUTION: euler040

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.combinatorics math.parser math.primes sequences ; USING: kernel math.combinatorics math.parser math.primes sequences project-euler.common ;
IN: project-euler.041 IN: project-euler.041
! http://projecteuler.net/index.php?section=problems&id=41 ! http://projecteuler.net/index.php?section=problems&id=41
@ -37,4 +37,4 @@ IN: project-euler.041
! [ euler041 ] 100 ave-time ! [ euler041 ] 100 ave-time
! 64 ms ave run time - 4.22 SD (100 trials) ! 64 ms ave run time - 4.22 SD (100 trials)
MAIN: euler041 SOLUTION: euler041

View File

@ -71,4 +71,4 @@ PRIVATE>
! [ euler042a ] 100 ave-time ! [ euler042a ] 100 ave-time
! 21 ms ave run time - 2.2 SD (100 trials) ! 21 ms ave run time - 2.2 SD (100 trials)
MAIN: euler042a SOLUTION: euler042a

View File

@ -97,4 +97,4 @@ PRIVATE>
! [ euler043a ] 100 ave-time ! [ euler043a ] 100 ave-time
! 10 ms ave run time - 1.37 SD (100 trials) ! 10 ms ave run time - 1.37 SD (100 trials)
MAIN: euler043a SOLUTION: euler043a

View File

@ -45,4 +45,4 @@ PRIVATE>
! TODO: this solution is ugly and not very efficient...find a better algorithm ! TODO: this solution is ugly and not very efficient...find a better algorithm
MAIN: euler044 SOLUTION: euler044

View File

@ -46,4 +46,4 @@ PRIVATE>
! [ euler045 ] 100 ave-time ! [ euler045 ] 100 ave-time
! 12 ms ave run time - 1.71 SD (100 trials) ! 12 ms ave run time - 1.71 SD (100 trials)
MAIN: euler045 SOLUTION: euler045

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.primes math.ranges sequences ; USING: kernel math math.functions math.primes math.ranges sequences project-euler.common ;
IN: project-euler.046 IN: project-euler.046
! http://projecteuler.net/index.php?section=problems&id=46 ! http://projecteuler.net/index.php?section=problems&id=46
@ -49,4 +49,4 @@ PRIVATE>
! [ euler046 ] 100 ave-time ! [ euler046 ] 100 ave-time
! 37 ms ave run time - 3.39 SD (100 trials) ! 37 ms ave run time - 3.39 SD (100 trials)
MAIN: euler046 SOLUTION: euler046

View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.primes math.primes.factors USING: arrays kernel math math.primes math.primes.factors
math.ranges namespaces sequences ; math.ranges namespaces sequences project-euler.common ;
IN: project-euler.047 IN: project-euler.047
! http://projecteuler.net/index.php?section=problems&id=47 ! http://projecteuler.net/index.php?section=problems&id=47
@ -93,4 +93,4 @@ PRIVATE>
! TODO: I don't like that you have to specify the upper bound, maybe try making ! TODO: I don't like that you have to specify the upper bound, maybe try making
! this lazy so it could also short-circuit when it finds the answer? ! this lazy so it could also short-circuit when it finds the answer?
MAIN: euler047a SOLUTION: euler047a

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions sequences ; USING: kernel math math.functions sequences project-euler.common ;
IN: project-euler.048 IN: project-euler.048
! http://projecteuler.net/index.php?section=problems&id=48 ! http://projecteuler.net/index.php?section=problems&id=48
@ -22,4 +22,4 @@ IN: project-euler.048
! [ euler048 ] 100 ave-time ! [ euler048 ] 100 ave-time
! 276 ms run / 1 ms GC ave time - 100 trials ! 276 ms run / 1 ms GC ave time - 100 trials
MAIN: euler048 SOLUTION: euler048

View File

@ -87,4 +87,4 @@ PRIVATE>
! [ euler050 ] 100 ave-time ! [ euler050 ] 100 ave-time
! 291 ms run / 20.6 ms GC ave time - 100 trials ! 291 ms run / 20.6 ms GC ave time - 100 trials
MAIN: euler050 SOLUTION: euler050

View File

@ -49,4 +49,4 @@ PRIVATE>
! [ euler052 ] 100 ave-time ! [ euler052 ] 100 ave-time
! 92 ms ave run time - 6.29 SD (100 trials) ! 92 ms ave run time - 6.29 SD (100 trials)
MAIN: euler052 SOLUTION: euler052

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.combinatorics math.ranges sequences ; USING: kernel math math.combinatorics math.ranges sequences project-euler.common ;
IN: project-euler.053 IN: project-euler.053
! http://projecteuler.net/index.php?section=problems&id=53 ! http://projecteuler.net/index.php?section=problems&id=53
@ -32,4 +32,4 @@ IN: project-euler.053
! [ euler053 ] 100 ave-time ! [ euler053 ] 100 ave-time
! 52 ms ave run time - 4.44 SD (100 trials) ! 52 ms ave run time - 4.44 SD (100 trials)
MAIN: euler053 SOLUTION: euler053

View File

@ -66,4 +66,4 @@ PRIVATE>
! [ euler055 ] 100 ave-time ! [ euler055 ] 100 ave-time
! 478 ms ave run time - 30.63 SD (100 trials) ! 478 ms ave run time - 30.63 SD (100 trials)
MAIN: euler055 SOLUTION: euler055

View File

@ -29,4 +29,4 @@ IN: project-euler.056
! [ euler056 ] 100 ave-time ! [ euler056 ] 100 ave-time
! 22 ms ave run time - 2.13 SD (100 trials) ! 22 ms ave run time - 2.13 SD (100 trials)
MAIN: euler056 SOLUTION: euler056

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Samuel Tardieu ! Copyright (c) 2008 Samuel Tardieu
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.parser sequences ; USING: kernel math math.functions math.parser sequences project-euler.common ;
IN: project-euler.057 IN: project-euler.057
! http://projecteuler.net/index.php?section=problems&id=57 ! http://projecteuler.net/index.php?section=problems&id=57
@ -40,4 +40,4 @@ IN: project-euler.057
! [ euler057 ] time ! [ euler057 ] time
! 3.375118 seconds ! 3.375118 seconds
MAIN: euler057 SOLUTION: euler057

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays ascii assocs hashtables io.encodings.ascii io.files kernel math USING: arrays ascii assocs hashtables io.encodings.ascii io.files kernel math
math.parser namespaces make sequences sequences.private sorting math.parser namespaces make sequences sequences.private sorting
splitting grouping strings sets accessors ; splitting grouping strings sets accessors project-euler.common ;
IN: project-euler.059 IN: project-euler.059
! http://projecteuler.net/index.php?section=problems&id=59 ! http://projecteuler.net/index.php?section=problems&id=59
@ -89,4 +89,4 @@ PRIVATE>
! [ euler059 ] 100 ave-time ! [ euler059 ] 100 ave-time
! 8 ms ave run time - 1.4 SD (100 trials) ! 8 ms ave run time - 1.4 SD (100 trials)
MAIN: euler059 SOLUTION: euler059

View File

@ -59,4 +59,4 @@ PRIVATE>
! [ euler067a ] 100 ave-time ! [ euler067a ] 100 ave-time
! 21 ms ave run time - 2.65 SD (100 trials) ! 21 ms ave run time - 2.65 SD (100 trials)
MAIN: euler067a SOLUTION: euler067a

View File

@ -46,4 +46,4 @@ PRIVATE>
! [ euler071 ] 100 ave-time ! [ euler071 ] 100 ave-time
! 155 ms ave run time - 6.95 SD (100 trials) ! 155 ms ave run time - 6.95 SD (100 trials)
MAIN: euler071 SOLUTION: euler071

View File

@ -49,4 +49,4 @@ PRIVATE>
! [ euler073 ] 10 ave-time ! [ euler073 ] 10 ave-time
! 20506 ms ave run time - 937.07 SD (10 trials) ! 20506 ms ave run time - 937.07 SD (10 trials)
MAIN: euler073 SOLUTION: euler073

View File

@ -75,4 +75,4 @@ PRIVATE>
! [ euler075 ] 10 ave-time ! [ euler075 ] 10 ave-time
! 3341 ms ave run timen - 157.77 SD (10 trials) ! 3341 ms ave run timen - 157.77 SD (10 trials)
MAIN: euler075 SOLUTION: euler075

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Eric Mertens. ! Copyright (c) 2008 Eric Mertens.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel locals math math.order math.ranges sequences ; USING: arrays assocs kernel locals math math.order math.ranges sequences project-euler.common ;
IN: project-euler.076 IN: project-euler.076
! http://projecteuler.net/index.php?section=problems&id=76 ! http://projecteuler.net/index.php?section=problems&id=76
@ -56,4 +56,4 @@ PRIVATE>
! [ euler076 ] 100 ave-time ! [ euler076 ] 100 ave-time
! 560 ms ave run time - 17.74 SD (100 trials) ! 560 ms ave run time - 17.74 SD (100 trials)
MAIN: euler076 SOLUTION: euler076

Some files were not shown because too many files have changed in this diff Show More