From 594f21e5bdc6b3687d8c54298934e2396c2d709e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 3 Feb 2009 19:44:28 -0600 Subject: [PATCH 01/14] Fixing HTTP and IANA tests --- basis/http/http.factor | 14 +++++--------- basis/io/encodings/iana/iana-tests.factor | 8 ++++---- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/basis/http/http.factor b/basis/http/http.factor index cda3460c71..2b5414b299 100755 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -3,17 +3,11 @@ USING: accessors kernel combinators math namespaces make assocs sequences splitting sorting sets strings vectors hashtables quotations arrays byte-arrays math.parser calendar -calendar.format present urls - +calendar.format present urls fry io io.encodings io.encodings.iana io.encodings.binary io.encodings.8-bit io.crlf - unicode.case unicode.categories - http.parsers ; - -EXCLUDE: fry => , ; - IN: http : (read-header) ( -- alist ) @@ -217,5 +211,7 @@ TUPLE: post-data data params content-type content-encoding ; " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ; : parse-content-type ( content-type -- type encoding ) - ";" split1 parse-content-type-attributes "charset" swap at - name>encoding over "text/" head? latin1 binary ? or ; + ";" split1 + parse-content-type-attributes "charset" swap at + [ name>encoding ] + [ dup "text/" head? latin1 binary ? ] if* ; diff --git a/basis/io/encodings/iana/iana-tests.factor b/basis/io/encodings/iana/iana-tests.factor index 5ffcc161d4..3175e624ce 100644 --- a/basis/io/encodings/iana/iana-tests.factor +++ b/basis/io/encodings/iana/iana-tests.factor @@ -1,5 +1,5 @@ USING: io.encodings.iana io.encodings.iana.private -io.encodings.utf8 tools.test assocs ; +io.encodings.utf8 tools.test assocs namespaces ; IN: io.encodings.iana.tests [ utf8 ] [ "UTF-8" name>encoding ] unit-test @@ -15,9 +15,9 @@ ebcdic-fisea "EBCDIC-FI-SE-A" register-encoding ! Clean up after myself [ ] [ - "EBCDIC-FI-SE-A" n>e-table delete-at - "csEBCDICFISEA" n>e-table delete-at - ebcdic-fisea e>n-table delete-at + "EBCDIC-FI-SE-A" n>e-table get delete-at + "csEBCDICFISEA" n>e-table get delete-at + ebcdic-fisea e>n-table get delete-at ] unit-test [ "EBCDIC-FI-SE-A" name>encoding ] must-fail [ "csEBCDICFISEA" name>encoding ] must-fail From d5f2a2133b17c45c414476cc896b259d06151736 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 3 Feb 2009 21:27:59 -0600 Subject: [PATCH 02/14] add random to using list --- core/continuations/continuations-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 2cc44bee1b..7eb8f36c73 100644 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -246,7 +246,7 @@ HELP: retry { $description "Tries the quotation up to " { $snippet "n" } " times until it returns true. Retries the quotation if an exception is thrown or if the quotation returns " { $link f } ". The quotation is expected to have side effects that may fail, such as generating a random name for a new file until successful." } { $examples "Try to get a 0 as a random number:" - { $unchecked-example "USING: continuations math prettyprint ;" + { $unchecked-example "USING: continuations math prettyprint random ;" "[ 5 random 0 = ] 5 retry t" "t" } From 86a46477a68af36862ff0432770228710ae4f7a4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 3 Feb 2009 21:29:24 -0600 Subject: [PATCH 03/14] Unchecked-examples are hard, let's go shopping. --- core/continuations/continuations-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 7eb8f36c73..2bf59f7780 100644 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -247,7 +247,7 @@ HELP: retry { $examples "Try to get a 0 as a random number:" { $unchecked-example "USING: continuations math prettyprint random ;" - "[ 5 random 0 = ] 5 retry t" + "[ 5 random 0 = ] 5 retry" "t" } } ; From 067681334f89056081709da6a77a6e483819b959 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 3 Feb 2009 22:12:04 -0600 Subject: [PATCH 04/14] Bug fix and docs in wrap --- basis/wrap/authors.txt | 1 + basis/wrap/wrap-docs.factor | 41 ++++++++++++++++++++++++++++++++++++ basis/wrap/wrap-tests.factor | 38 +++++++++++++++++++++++++++++++-- basis/wrap/wrap.factor | 25 ++++++++++++++++------ 4 files changed, 97 insertions(+), 8 deletions(-) create mode 100644 basis/wrap/wrap-docs.factor diff --git a/basis/wrap/authors.txt b/basis/wrap/authors.txt index f990dd0ed2..33616a2d6a 100644 --- a/basis/wrap/authors.txt +++ b/basis/wrap/authors.txt @@ -1 +1,2 @@ Daniel Ehrenberg +Slava Pestov diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor new file mode 100644 index 0000000000..c94e12907f --- /dev/null +++ b/basis/wrap/wrap-docs.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup strings math kernel ; +IN: wrap + +ABOUT: "wrap" + +ARTICLE: "wrap" "Word wrapping" +"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. There is support for simple string wrapping, with the following words:" +{ $subsection wrap-lines } +{ $subsection wrap-string } +{ $subsection wrap-indented-string } +"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called words." +{ $subsection wrap } +{ $subsection word } +{ $subsection } ; + +HELP: wrap-lines +{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } } +{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ; + +HELP: wrap-string +{ $values { "string" string } { "width" integer } { "newstring" string } } +{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ; + +HELP: wrap-indented-string +{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } } +{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ; + +HELP: wrap +{ $values { "words" { "a sequence of " { $instance word } "s" } } { "width" integer } { "lines" "a sequence of sequences of words" } } +{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given width. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ; + +HELP: word +{ $class-description "A word, for the purposes of " { $vocab-link "wrap" } ", is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link } "." } +{ $see-also wrap } ; + +HELP: +{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } } +{ $description "Creates a " { $link word } " object with the given parameters." } +{ $see-also wrap } ; diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor index b2d18761e2..ba5168a1c2 100644 --- a/basis/wrap/wrap-tests.factor +++ b/basis/wrap/wrap-tests.factor @@ -1,5 +1,7 @@ -IN: wrap.tests +! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov +! See http://factorcode.org/license.txt for BSD license. USING: tools.test wrap multiline sequences ; +IN: wrap.tests [ { @@ -23,6 +25,32 @@ USING: tools.test wrap multiline sequences ; } 35 wrap [ { } like ] map ] unit-test +[ + { + { + T{ word f 1 10 f } + T{ word f 2 10 f } + T{ word f 3 9 t } + T{ word f 3 9 t } + T{ word f 3 9 t } + } + { + T{ word f 4 10 f } + T{ word f 5 10 f } + } + } +] [ + { + T{ word f 1 10 f } + T{ word f 2 10 f } + T{ word f 3 9 t } + T{ word f 3 9 t } + T{ word f 3 9 t } + T{ word f 4 10 f } + T{ word f 5 10 f } + } 35 wrap [ { } like ] map +] unit-test + [ <" This is a long piece @@ -45,4 +73,10 @@ word wrap."> ] [ <" This is a long piece of text that we wish to word wrap."> 12 " " wrap-indented-string -] unit-test \ No newline at end of file +] unit-test + +[ "this text\nhas lots of\nspaces" ] +[ "this text has lots of spaces" 12 wrap-string ] unit-test + +[ "hello\nhow\nare\nyou\ntoday?" ] +[ "hello how are you today?" 3 wrap-string ] unit-test diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor index 8e4e2753a8..e93509b58e 100644 --- a/basis/wrap/wrap.factor +++ b/basis/wrap/wrap.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov +! See http://factorcode.org/license.txt for BSD license. USING: sequences kernel namespaces make splitting math math.order fry assocs accessors ; IN: wrap @@ -15,12 +17,25 @@ SYMBOL: width : break-here? ( column word -- ? ) break?>> not [ width get > ] [ drop f ] if ; +: walk ( n words -- n ) + ! If on a break, take the rest of the breaks + ! If not on a break, go back until you hit a break + 2dup bounds-check? [ + 2dup nth break?>> + [ [ break?>> not ] find-from drop ] + [ [ break?>> ] find-last-from drop 1+ ] if + ] [ drop ] if ; + : find-optimal-break ( words -- n ) - [ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ; + [ 0 ] keep + [ [ width>> + dup ] keep break-here? ] find drop nip + [ 1 max swap walk ] [ drop f ] if* ; : (wrap) ( words -- ) - dup find-optimal-break - [ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ; + [ + dup find-optimal-break + [ cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* + ] unless-empty ; : intersperse ( seq elt -- seq' ) [ '[ _ , ] [ , ] interleave ] { } make ; @@ -34,9 +49,7 @@ SYMBOL: width : join-words ( wrapped-lines -- lines ) [ - [ break?>> ] - [ trim-head-slice ] - [ trim-tail-slice ] bi + [ break?>> ] trim-slice [ key>> ] map concat ] map ; From 80389d23ff7ed39d6cb508282516cc5904435448 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 3 Feb 2009 23:00:34 -0600 Subject: [PATCH 05/14] remove nrev from reports.noise --- extra/reports/noise/noise.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 1ce7f9c726..3e47adac0b 100755 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -53,7 +53,6 @@ IN: reports.noise { nipd 3 } { nkeep 5 } { npick 6 } - { nrev 5 } { nrot 5 } { nslip 5 } { ntuck 6 } From cd77ecfab3c0a1407d93cc98c381ea05b529b058 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 4 Feb 2009 02:41:30 -0600 Subject: [PATCH 06/14] 'case' didn't work if the default was a non-quotation callable, like a curry; this could come up with macro expansion. Bug reported by Dan --- basis/stack-checker/transforms/transforms.factor | 2 +- core/combinators/combinators-tests.factor | 12 +++++++++++- core/combinators/combinators.factor | 4 ++-- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 7afac0440f..808ea6a141 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -70,7 +70,7 @@ IN: stack-checker.transforms [ [ no-case ] ] [ - dup peek quotation? [ + dup peek callable? [ dup peek swap but-last ] [ [ no-case ] swap diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index 5a56d2b636..1a73e22e31 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -1,6 +1,6 @@ USING: alien strings kernel math tools.test io prettyprint namespaces combinators words classes sequences accessors -math.functions ; +math.functions arrays ; IN: combinators.tests ! Compiled @@ -314,3 +314,13 @@ IN: combinators.tests \ test-case-7 must-infer [ "plus" ] [ \ + test-case-7 ] unit-test + +! Some corner cases (no pun intended) +DEFER: corner-case-1 + +<< \ corner-case-1 2 [ + ] curry 1array [ case ] curry (( a -- b )) define-declared >> + +[ t ] [ \ corner-case-1 optimized>> ] unit-test +[ 4 ] [ 2 corner-case-1 ] unit-test + +[ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test \ No newline at end of file diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index c4c18c1c62..e356a6d246 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -59,13 +59,13 @@ ERROR: no-case ; ] [ dup wrapper? [ wrapped>> ] when ] if = - ] [ quotation? ] if + ] [ callable? ] if ] find nip ; : case ( obj assoc -- ) case-find { { [ dup array? ] [ nip second call ] } - { [ dup quotation? ] [ call ] } + { [ dup callable? ] [ call ] } { [ dup not ] [ no-case ] } } cond ; From cb174f0db10bbf53831e499eaeab5da52c2e3919 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 4 Feb 2009 04:17:24 -0600 Subject: [PATCH 07/14] Regression: HTTP server would fail to serve files with binary encoding after Dan's io.encodings.iana changes from earlier today --- basis/http/server/server-tests.factor | 17 ++++++++++++++++- basis/http/server/server.factor | 6 ++---- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/basis/http/server/server-tests.factor b/basis/http/server/server-tests.factor index fdba9a63ef..171973fcd8 100644 --- a/basis/http/server/server-tests.factor +++ b/basis/http/server/server-tests.factor @@ -1,6 +1,21 @@ -USING: http http.server math sequences continuations tools.test ; +USING: http http.server math sequences continuations tools.test +io.encodings.utf8 io.encodings.binary accessors ; IN: http.server.tests [ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test \ make-http-error must-infer + +[ "text/plain; charset=UTF-8" ] [ + + "text/plain" >>content-type + utf8 >>content-charset + unparse-content-type +] unit-test + +[ "text/xml" ] [ + + "text/xml" >>content-type + binary >>content-charset + unparse-content-type +] unit-test \ No newline at end of file diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 97c14a6457..b6ee70057b 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -97,10 +97,8 @@ GENERIC: write-full-response ( request response -- ) tri ; : unparse-content-type ( request -- content-type ) - [ content-type>> "application/octet-stream" or ] - [ content-charset>> encoding>name ] - bi - [ "; charset=" glue ] when* ; + [ content-type>> "application/octet-stream" or ] [ content-charset>> ] bi + dup binary eq? [ drop ] [ encoding>name "; charset=" glue ] if ; : ensure-domain ( cookie -- cookie ) [ From 4ee7fb1c30a18c120d37bffeb16bf5be7974dc00 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 4 Feb 2009 04:58:19 -0600 Subject: [PATCH 08/14] Minor performance improvement for io.encodings.chinese: don't call 'linear' all the time --- basis/io/encodings/chinese/chinese.factor | 34 +++++++++++------------ 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/basis/io/encodings/chinese/chinese.factor b/basis/io/encodings/chinese/chinese.factor index 01ddb810ba..9d50583ce5 100644 --- a/basis/io/encodings/chinese/chinese.factor +++ b/basis/io/encodings/chinese/chinese.factor @@ -17,6 +17,14 @@ gb18030 "GB18030" register-encoding ! Resource file from: ! http://source.icu-project.org/repos/icu/data/trunk/charset/data/xml/gb-18030-2000.xml +! Algorithms from: +! http://www-128.ibm.com/developerworks/library/u-china.html + +: linear ( bytes -- num ) + ! This hard-codes bMin and bMax + reverse first4 + 10 * + 126 * + 10 * + ; foldable + TUPLE: range ufirst ulast bfirst blast ; : b>byte-array ( string -- byte-array ) @@ -27,8 +35,8 @@ TUPLE: range ufirst ulast bfirst blast ; { [ "uFirst" attr hex> ] [ "uLast" attr hex> ] - [ "bFirst" attr b>byte-array ] - [ "bLast" attr b>byte-array ] + [ "bFirst" attr b>byte-array linear ] + [ "bLast" attr b>byte-array linear ] } cleave range boa ] dip push ; @@ -51,21 +59,13 @@ TUPLE: range ufirst ulast bfirst blast ; ] each-element mapping ranges ] ; -! Algorithms from: -! http://www-128.ibm.com/developerworks/library/u-china.html - -: linear ( bytes -- num ) - ! This hard-codes bMin and bMax - reverse first4 - 10 * + 126 * + 10 * + ; - : unlinear ( num -- bytes ) B{ HEX: 81 HEX: 30 HEX: 81 HEX: 30 } linear - - 10 /mod swap [ HEX: 30 + ] dip - 126 /mod swap [ HEX: 81 + ] dip - 10 /mod swap [ HEX: 30 + ] dip + 10 /mod HEX: 30 + swap + 126 /mod HEX: 81 + swap + 10 /mod HEX: 30 + swap HEX: 81 + - B{ } 4sequence reverse ; + B{ } 4sequence dup reverse-here ; : >interval-map-by ( start-quot end-quot value-quot seq -- interval-map ) '[ _ [ @ 2array ] _ tri ] { } map>assoc ; inline @@ -74,7 +74,7 @@ TUPLE: range ufirst ulast bfirst blast ; [ ufirst>> ] [ ulast>> ] [ ] >interval-map-by ; : ranges-gb>u ( ranges -- interval-map ) - [ bfirst>> linear ] [ blast>> linear ] [ ] >interval-map-by ; + [ bfirst>> ] [ blast>> ] [ ] >interval-map-by ; VALUE: gb>u VALUE: u>gb @@ -87,7 +87,7 @@ ascii xml>gb-data : lookup-range ( char -- byte-array ) dup u>gb interval-at [ - [ ufirst>> - ] [ bfirst>> linear ] bi + unlinear + [ ufirst>> - ] [ bfirst>> ] bi + unlinear ] [ encode-error ] if* ; M: gb18030 encode-char ( char stream encoding -- ) @@ -109,7 +109,7 @@ M: gb18030 encode-char ( char stream encoding -- ) : decode-quad ( byte-array -- char ) dup mapping value-at [ ] [ linear dup gb>u interval-at [ - [ bfirst>> linear - ] [ ufirst>> ] bi + + [ bfirst>> - ] [ ufirst>> ] bi + ] [ drop replacement-char ] if* ] ?if ; From f8d80faed37b4ea5ec6425b988b79cc69c0baeb4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 4 Feb 2009 05:13:12 -0600 Subject: [PATCH 09/14] Add 1sequence word. Add unit tests for existing 1vector and 1byte-array words, and make them use 1sequence --- core/byte-arrays/byte-arrays-tests.factor | 2 ++ core/byte-arrays/byte-arrays.factor | 4 ++-- core/sequences/sequences-docs.factor | 4 ++++ core/sequences/sequences.factor | 8 +++++++- core/vectors/vectors-tests.factor | 2 ++ core/vectors/vectors.factor | 2 +- 6 files changed, 18 insertions(+), 4 deletions(-) diff --git a/core/byte-arrays/byte-arrays-tests.factor b/core/byte-arrays/byte-arrays-tests.factor index edaea108a1..1c3e4d3bdf 100644 --- a/core/byte-arrays/byte-arrays-tests.factor +++ b/core/byte-arrays/byte-arrays-tests.factor @@ -9,3 +9,5 @@ USING: tools.test byte-arrays sequences kernel ; [ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test [ -10 B{ } resize-byte-array ] must-fail + +[ B{ 123 } ] [ 123 1byte-array ] unit-test \ No newline at end of file diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor index f0d188ce4a..72989ac447 100644 --- a/core/byte-arrays/byte-arrays.factor +++ b/core/byte-arrays/byte-arrays.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel kernel.private alien.accessors sequences sequences.private math ; @@ -19,7 +19,7 @@ M: byte-array resize INSTANCE: byte-array sequence -: 1byte-array ( x -- byte-array ) 1 [ set-first ] keep ; inline +: 1byte-array ( x -- byte-array ) B{ } 1sequence ; inline : 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index f213be4fe7..6ca782a202 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -207,6 +207,10 @@ HELP: first4-unsafe { $values { "seq" sequence } { "first" "the first element" } { "second" "the second element" } { "third" "the third element" } { "fourth" "the fourth element" } } { $contract "Unsafe variant of " { $link first4 } " that does not perform bounds checks." } ; +HELP: 1sequence +{ $values { "obj" object } { "exemplar" sequence } { "seq" sequence } } +{ $description "Creates a one-element sequence of the same type as " { $snippet "exemplar" } "." } ; + HELP: 2sequence { $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } } { $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 2c30a62fe3..9e64cfa536 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -137,9 +137,12 @@ INSTANCE: iota immutable-sequence : from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline +: (1sequence) ( obj seq -- seq ) + [ 0 swap set-nth-unsafe ] keep ; inline + : (2sequence) ( obj1 obj2 seq -- seq ) [ 1 swap set-nth-unsafe ] keep - [ 0 swap set-nth-unsafe ] keep ; inline + (1sequence) ; inline : (3sequence) ( obj1 obj2 obj3 seq -- seq ) [ 2 swap set-nth-unsafe ] keep @@ -151,6 +154,9 @@ INSTANCE: iota immutable-sequence PRIVATE> +: 1sequence ( obj exemplar -- seq ) + 1 swap [ (1sequence) ] new-like ; inline + : 2sequence ( obj1 obj2 exemplar -- seq ) 2 swap [ (2sequence) ] new-like ; inline diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor index f2e29d79e8..12e2ea49f7 100644 --- a/core/vectors/vectors-tests.factor +++ b/core/vectors/vectors-tests.factor @@ -97,3 +97,5 @@ IN: vectors.tests [ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test [ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test + +[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test \ No newline at end of file diff --git a/core/vectors/vectors.factor b/core/vectors/vectors.factor index a6bfef71d0..1bdda7b69d 100644 --- a/core/vectors/vectors.factor +++ b/core/vectors/vectors.factor @@ -40,7 +40,7 @@ M: sequence new-resizable drop ; INSTANCE: vector growable -: 1vector ( x -- vector ) 1array >vector ; +: 1vector ( x -- vector ) V{ } 1sequence ; : ?push ( elt seq/f -- seq ) [ 1 ] unless* [ push ] keep ; From 489019acd07ac446ad445de8aae91128cf70050a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 4 Feb 2009 05:14:00 -0600 Subject: [PATCH 10/14] io.encodings.chinese and io.encodings.japanese: use [1234]byte-array words instead of B{ } new-sequence and [1234]array >byte-array --- basis/io/encodings/chinese/chinese.factor | 14 +++++++------- basis/io/encodings/japanese/japanese.factor | 8 ++++---- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/basis/io/encodings/chinese/chinese.factor b/basis/io/encodings/chinese/chinese.factor index 9d50583ce5..b0013b6e08 100644 --- a/basis/io/encodings/chinese/chinese.factor +++ b/basis/io/encodings/chinese/chinese.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: xml xml.data kernel io io.encodings interval-maps splitting fry -math.parser sequences combinators assocs locals accessors math -arrays values io.encodings.ascii ascii io.files biassocs math.order -combinators.short-circuit io.binary io.encodings.iana ; +math.parser sequences combinators assocs locals accessors math arrays +byte-arrays values io.encodings.ascii ascii io.files biassocs +math.order combinators.short-circuit io.binary io.encodings.iana ; IN: io.encodings.chinese SINGLETON: gb18030 @@ -65,7 +65,7 @@ TUPLE: range ufirst ulast bfirst blast ; 126 /mod HEX: 81 + swap 10 /mod HEX: 30 + swap HEX: 81 + - B{ } 4sequence dup reverse-here ; + 4byte-array dup reverse-here ; : >interval-map-by ( start-quot end-quot value-quot seq -- interval-map ) '[ _ [ @ 2array ] _ tri ] { } map>assoc ; inline @@ -115,13 +115,13 @@ M: gb18030 encode-char ( char stream encoding -- ) : four-byte ( stream byte1 byte2 -- char ) rot 2 swap stream-read dup last-bytes? - [ first2 B{ } 4sequence decode-quad ] + [ first2 4byte-array decode-quad ] [ 3drop replacement-char ] if ; : two-byte ( stream byte -- char ) over stream-read1 { { [ dup not ] [ 3drop replacement-char ] } - { [ dup second-byte? ] [ B{ } 2sequence mapping value-at nip ] } + { [ dup second-byte? ] [ 2byte-array mapping value-at nip ] } { [ dup quad-2/4? ] [ four-byte ] } [ 3drop replacement-char ] } cond ; @@ -129,7 +129,7 @@ M: gb18030 encode-char ( char stream encoding -- ) M: gb18030 decode-char ( stream encoding -- char ) drop dup stream-read1 { { [ dup not ] [ 2drop f ] } - { [ dup ascii? ] [ nip 1array B{ } like mapping value-at ] } + { [ dup ascii? ] [ nip 1byte-array mapping value-at ] } { [ dup quad-1/3? ] [ two-byte ] } [ 2drop replacement-char ] } cond ; diff --git a/basis/io/encodings/japanese/japanese.factor b/basis/io/encodings/japanese/japanese.factor index e3257ad63e..194ade377b 100644 --- a/basis/io/encodings/japanese/japanese.factor +++ b/basis/io/encodings/japanese/japanese.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: sequences kernel io io.files combinators.short-circuit -math.order values assocs io.encodings io.binary fry strings -math io.encodings.ascii arrays accessors splitting math.parser -biassocs io.encodings.iana ; +math.order values assocs io.encodings io.binary fry strings math +io.encodings.ascii arrays byte-arrays accessors splitting +math.parser biassocs io.encodings.iana ; IN: io.encodings.japanese SINGLETON: shift-jis @@ -55,7 +55,7 @@ make-jis to: shift-jis-table { [ 0 HEX: 7F between? ] [ HEX: A1 HEX: DF between? ] } 1|| ; : write-halfword ( stream halfword -- ) - h>b/b swap B{ } 2sequence swap stream-write ; + h>b/b swap 2byte-array swap stream-write ; M: jis encode-char swapd ch>jis From eec86d6043b09b6773ff887da61baef81669ef90 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Feb 2009 13:05:52 -0600 Subject: [PATCH 11/14] Fix io.launcher on Windows -- Microsoft does the same thing with devenv --- Makefile | 12 +++++++----- vm/Config.windows | 1 + vm/Config.windows.nt | 1 + vm/Config.windows.nt.x86.32 | 1 + vm/Config.windows.nt.x86.64 | 1 + vm/os-windows.c | 11 ----------- 6 files changed, 11 insertions(+), 16 deletions(-) diff --git a/Makefile b/Makefile index b41e756729..68c2c97426 100644 --- a/Makefile +++ b/Makefile @@ -130,18 +130,20 @@ solaris-x86-64: $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64 freetype6.dll: - wget http://factorcode.org/dlls/freetype6.dll + wget $(DLL_PATH)/freetype6.dll chmod 755 freetype6.dll zlib1.dll: - wget http://factorcode.org/dlls/zlib1.dll + wget $(DLL_PATH)/zlib1.dll chmod 755 zlib1.dll -winnt-x86-32: freetype6.dll zlib1.dll +windows-dlls: freetype6.dll zlib1.dll + +winnt-x86-32: windows-dlls $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 -winnt-x86-64: +winnt-x86-64: windows-dlls $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64 $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64 @@ -167,7 +169,7 @@ factor: $(DLL_OBJS) $(EXE_OBJS) factor-console: $(DLL_OBJS) $(EXE_OBJS) $(LINKER) $(ENGINE) $(DLL_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ - $(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) + $(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS) clean: rm -f vm/*.o diff --git a/vm/Config.windows b/vm/Config.windows index 41eca86b5c..45d2f0cb98 100644 --- a/vm/Config.windows +++ b/vm/Config.windows @@ -2,6 +2,7 @@ CFLAGS += -DWINDOWS -mno-cygwin LIBS = -lm PLAF_DLL_OBJS += vm/os-windows.o EXE_EXTENSION=.exe +CONSOLE_EXTENSION=.com DLL_EXTENSION=.dll LINKER = $(CC) -shared -mno-cygwin -o LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX) diff --git a/vm/Config.windows.nt b/vm/Config.windows.nt index de28ba64ba..ffaa899fe1 100644 --- a/vm/Config.windows.nt +++ b/vm/Config.windows.nt @@ -6,4 +6,5 @@ PLAF_EXE_OBJS += vm/resources.o PLAF_EXE_OBJS += vm/main-windows-nt.o CFLAGS += -mwindows CFLAGS_CONSOLE += -mconsole +CONSOLE_EXTENSION = .com include vm/Config.windows diff --git a/vm/Config.windows.nt.x86.32 b/vm/Config.windows.nt.x86.32 index 9a020a7bc1..d27629fe83 100644 --- a/vm/Config.windows.nt.x86.32 +++ b/vm/Config.windows.nt.x86.32 @@ -1,3 +1,4 @@ +DLL_PATH=http://factorcode.org/dlls WINDRES=windres include vm/Config.windows.nt include vm/Config.x86.32 diff --git a/vm/Config.windows.nt.x86.64 b/vm/Config.windows.nt.x86.64 index f0c0a068cb..ddb61480e5 100644 --- a/vm/Config.windows.nt.x86.64 +++ b/vm/Config.windows.nt.x86.64 @@ -1,3 +1,4 @@ +DLL_PATH=http://factorcode.org/dlls/64 CC=$(WIN64_PATH)-gcc.exe WINDRES=$(WIN64_PATH)-windres.exe include vm/Config.windows.nt diff --git a/vm/os-windows.c b/vm/os-windows.c index c4d29ea57f..2abc04cb3b 100755 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -109,17 +109,6 @@ const F_CHAR *default_image_path(void) snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path); temp_path[sizeof(temp_path) - 1] = 0; - if(!windows_stat(temp_path)) { - unsigned int len = wcslen(full_path); - F_CHAR magic[] = L"-console"; - unsigned int magic_len = wcslen(magic); - - if(!wcsncmp(full_path + len - magic_len, magic, MIN(len, magic_len))) - full_path[len - magic_len] = 0; - snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path); - temp_path[sizeof(temp_path) - 1] = 0; - } - return safe_strdup(temp_path); } From 3d84d17cc6fe1521b267cecf80316060ae4ffc52 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Feb 2009 13:28:19 -0600 Subject: [PATCH 12/14] use the console factor for tests --- basis/io/launcher/windows/nt/nt-tests.factor | 25 +++++++++++--------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor index 93b1e8c2ff..4dd0eebed3 100644 --- a/basis/io/launcher/windows/nt/nt-tests.factor +++ b/basis/io/launcher/windows/nt/nt-tests.factor @@ -1,7 +1,7 @@ USING: io.launcher tools.test calendar accessors environment namespaces kernel system arrays io io.files io.encodings.ascii sequences parser assocs hashtables math continuations eval -io.files.temp io.directories io.pathnames ; +io.files.temp io.directories io.pathnames splitting ; IN: io.launcher.windows.nt.tests [ ] [ @@ -23,9 +23,12 @@ IN: io.launcher.windows.nt.tests [ f ] [ "notepad" get process-running? ] unit-test +: console-vm ( -- path ) + vm ".exe" ?tail [ ".com" append ] when ; + [ ] [ - vm "-quiet" "-run=hello-world" 3array >>command + console-vm "-quiet" "-run=hello-world" 3array >>command "out.txt" temp-file >>stdout try-process ] unit-test @@ -36,7 +39,7 @@ IN: io.launcher.windows.nt.tests [ ] [ - vm "-run=listener" 2array >>command + console-vm "-run=listener" 2array >>command +closed+ >>stdin try-process ] unit-test @@ -47,7 +50,7 @@ IN: io.launcher.windows.nt.tests [ ] [ launcher-test-path [ - vm "-script" "stderr.factor" 3array >>command + console-vm "-script" "stderr.factor" 3array >>command "out.txt" temp-file >>stdout "err.txt" temp-file >>stderr try-process @@ -65,7 +68,7 @@ IN: io.launcher.windows.nt.tests [ ] [ launcher-test-path [ - vm "-script" "stderr.factor" 3array >>command + console-vm "-script" "stderr.factor" 3array >>command "out.txt" temp-file >>stdout +stdout+ >>stderr try-process @@ -79,7 +82,7 @@ IN: io.launcher.windows.nt.tests [ "output" ] [ launcher-test-path [ - vm "-script" "stderr.factor" 3array >>command + console-vm "-script" "stderr.factor" 3array >>command "err2.txt" temp-file >>stderr ascii lines first ] with-directory @@ -92,7 +95,7 @@ IN: io.launcher.windows.nt.tests [ t ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command ascii contents ] with-directory eval @@ -102,7 +105,7 @@ IN: io.launcher.windows.nt.tests [ t ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command +replace-environment+ >>environment-mode os-envs >>environment ascii contents @@ -114,7 +117,7 @@ IN: io.launcher.windows.nt.tests [ "B" ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command { { "A" "B" } } >>environment ascii contents ] with-directory eval @@ -125,7 +128,7 @@ IN: io.launcher.windows.nt.tests [ f ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command { { "USERPROFILE" "XXX" } } >>environment +prepend-environment+ >>environment-mode ascii contents @@ -151,7 +154,7 @@ IN: io.launcher.windows.nt.tests 2 [ launcher-test-path [ - vm "-script" "append.factor" 3array >>command + console-vm "-script" "append.factor" 3array >>command "append-test" temp-file >>stdout try-process ] with-directory From cdc5529070268743f56d6c87a07c35fa99c0e4d6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Feb 2009 13:31:57 -0600 Subject: [PATCH 13/14] ignore a windows file --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 05a53c02c6..435595f502 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ Factor/factor *.image *.dylib factor +factor.com *#*# .DS_Store .gdb_history From b6c3bc892d22af12681487303d89cdc4f06f0816 Mon Sep 17 00:00:00 2001 From: unknown Date: Wed, 4 Feb 2009 18:21:58 -0600 Subject: [PATCH 14/14] Fix the build support for windows again, have the makefile load Config.* files in the top level so that freetype.dll and zlib1.dll targets can make --- Makefile | 5 ++--- build-support/factor.sh | 14 +++++++++++++- vm/Config.windows.nt.x86.64 | 1 + 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 68c2c97426..e84a5f9c5a 100644 --- a/Makefile +++ b/Makefile @@ -17,9 +17,8 @@ else CFLAGS += -O3 $(SITE_CFLAGS) endif -ifdef CONFIG - include $(CONFIG) -endif +CONFIG = $(shell ./build-support/factor.sh config-target) +include $(CONFIG) ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION) diff --git a/build-support/factor.sh b/build-support/factor.sh index 44c047155d..e70ef40e5c 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -236,7 +236,7 @@ find_word_size() { set_factor_binary() { case $OS in - winnt) FACTOR_BINARY=factor-console.exe;; + winnt) FACTOR_BINARY=factor.com;; *) FACTOR_BINARY=factor;; esac } @@ -260,6 +260,7 @@ echo_build_info() { $ECHO FACTOR_BINARY=$FACTOR_BINARY $ECHO FACTOR_LIBRARY=$FACTOR_LIBRARY $ECHO FACTOR_IMAGE=$FACTOR_IMAGE + $ECHO CONFIG_TARGET=$CONFIG_TARGET $ECHO MAKE_TARGET=$MAKE_TARGET $ECHO BOOT_IMAGE=$BOOT_IMAGE $ECHO MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET @@ -289,20 +290,30 @@ set_build_info() { if [[ $OS == macosx && $ARCH == ppc ]] ; then MAKE_IMAGE_TARGET=macosx-ppc MAKE_TARGET=macosx-ppc + CONFIG_TARGET=macosx.ppc elif [[ $OS == linux && $ARCH == ppc ]] ; then MAKE_IMAGE_TARGET=linux-ppc MAKE_TARGET=linux-ppc + CONFIG_TARGET=linux.ppc elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then MAKE_IMAGE_TARGET=winnt-x86.64 MAKE_TARGET=winnt-x86-64 + CONFIG_TARGET=windows.nt.x86.64 + elif [[ $OS == winnt && $ARCH == x86 && $WORD == 32 ]] ; then + MAKE_IMAGE_TARGET=winnt-x86.32 + MAKE_TARGET=winnt-x86-32 + CONFIG_TARGET=windows.nt.x86.32 elif [[ $ARCH == x86 && $WORD == 64 ]] ; then MAKE_IMAGE_TARGET=unix-x86.64 MAKE_TARGET=$OS-x86-64 + CONFIG_TARGET=$OS.x86.64 else MAKE_IMAGE_TARGET=$ARCH.$WORD MAKE_TARGET=$OS-$ARCH-$WORD + CONFIG_TARGET=$OS.$ARCH.$WORD fi BOOT_IMAGE=boot.$MAKE_IMAGE_TARGET.image + CONFIG_TARGET=vm/Config.$CONFIG_TARGET } parse_build_info() { @@ -570,5 +581,6 @@ case "$1" in dlls) get_config_info; maybe_download_dlls;; net-bootstrap) get_config_info; update_boot_images; bootstrap ;; make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;; + config-target) ECHO=false; find_build_info; echo $CONFIG_TARGET ;; *) usage ;; esac diff --git a/vm/Config.windows.nt.x86.64 b/vm/Config.windows.nt.x86.64 index ddb61480e5..13ef665b19 100644 --- a/vm/Config.windows.nt.x86.64 +++ b/vm/Config.windows.nt.x86.64 @@ -1,3 +1,4 @@ +#error "lol" DLL_PATH=http://factorcode.org/dlls/64 CC=$(WIN64_PATH)-gcc.exe WINDRES=$(WIN64_PATH)-windres.exe