From 3b4bc615f10b8fb6f64f4907ade905bf0928c81a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Sep 2008 12:50:16 -0500 Subject: [PATCH 01/17] chicken/egg --- build-support/factor.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build-support/factor.sh b/build-support/factor.sh index 8be61f322a..2d4547a121 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -464,7 +464,7 @@ make_boot_image() { } install_build_system_apt() { - sudo apt-get --yes install sudo libc6-dev libfreetype6-dev libx11-dev xorg-dev glutg3-dev wget git-core git-doc rlwrap gcc make + sudo apt-get --yes install libc6-dev libfreetype6-dev libx11-dev xorg-dev glutg3-dev wget git-core git-doc rlwrap gcc make check_ret sudo } From 01cafb935b438a57afda18a8d0e73836c95a6035 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Sep 2008 13:47:42 -0500 Subject: [PATCH 02/17] moved regexp to parser-combinators.regexp --- extra/{ => parser-combinators}/regexp/authors.txt | 0 extra/{ => parser-combinators}/regexp/regexp-tests.factor | 2 +- extra/{ => parser-combinators}/regexp/regexp.factor | 2 +- extra/{ => parser-combinators}/regexp/summary.txt | 0 extra/{ => parser-combinators}/regexp/tags.txt | 0 5 files changed, 2 insertions(+), 2 deletions(-) rename extra/{ => parser-combinators}/regexp/authors.txt (100%) rename extra/{ => parser-combinators}/regexp/regexp-tests.factor (99%) rename extra/{ => parser-combinators}/regexp/regexp.factor (99%) rename extra/{ => parser-combinators}/regexp/summary.txt (100%) rename extra/{ => parser-combinators}/regexp/tags.txt (100%) diff --git a/extra/regexp/authors.txt b/extra/parser-combinators/regexp/authors.txt similarity index 100% rename from extra/regexp/authors.txt rename to extra/parser-combinators/regexp/authors.txt diff --git a/extra/regexp/regexp-tests.factor b/extra/parser-combinators/regexp/regexp-tests.factor similarity index 99% rename from extra/regexp/regexp-tests.factor rename to extra/parser-combinators/regexp/regexp-tests.factor index e9433c6c64..64feb0903c 100755 --- a/extra/regexp/regexp-tests.factor +++ b/extra/parser-combinators/regexp/regexp-tests.factor @@ -1,5 +1,5 @@ USING: regexp tools.test kernel ; -IN: regexp-tests +IN: parser-combinators.regexp.tests [ f ] [ "b" "a*" f matches? ] unit-test [ t ] [ "" "a*" f matches? ] unit-test diff --git a/extra/regexp/regexp.factor b/extra/parser-combinators/regexp/regexp.factor similarity index 99% rename from extra/regexp/regexp.factor rename to extra/parser-combinators/regexp/regexp.factor index 5ef3eacc6c..40d4603fb6 100755 --- a/extra/regexp/regexp.factor +++ b/extra/parser-combinators/regexp/regexp.factor @@ -3,7 +3,7 @@ namespaces parser lexer parser-combinators parser-combinators.simple promises quotations sequences combinators.lib strings math.order assocs prettyprint.backend memoize unicode.case unicode.categories combinators.short-circuit accessors make io ; -IN: regexp +IN: parser-combinators.regexp Date: Thu, 18 Sep 2008 13:48:18 -0500 Subject: [PATCH 03/17] use parser-combinators.regexp instead of regexp --- basis/globs/globs.factor | 2 +- basis/validators/validators.factor | 5 +++-- basis/xmode/loader/loader.factor | 2 +- basis/xmode/loader/syntax/syntax.factor | 4 ++-- basis/xmode/rules/rules.factor | 3 ++- 5 files changed, 9 insertions(+), 7 deletions(-) diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index c7d5413a47..14ddb0ed9b 100755 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser-combinators regexp lists sequences kernel +USING: parser-combinators parser-combinators.regexp lists sequences kernel promises strings unicode.case ; IN: globs diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index f24171b2b4..dab109e368 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: kernel continuations sequences math namespaces make sets -math.parser math.ranges assocs regexp unicode.categories arrays -hashtables words classes quotations xmode.catalog ; +math.parser math.ranges assocs parser-combinators.regexp +unicode.categories arrays hashtables words classes quotations +xmode.catalog ; IN: validators : v-default ( str def -- str ) diff --git a/basis/xmode/loader/loader.factor b/basis/xmode/loader/loader.factor index 28c0de406a..8639c93e71 100755 --- a/basis/xmode/loader/loader.factor +++ b/basis/xmode/loader/loader.factor @@ -1,7 +1,7 @@ USING: xmode.loader.syntax xmode.tokens xmode.rules xmode.keyword-map xml.data xml.utilities xml assocs kernel combinators sequences math.parser namespaces parser -xmode.utilities regexp io.files accessors ; +xmode.utilities parser-combinators.regexp io.files accessors ; IN: xmode.loader ! Based on org.gjt.sp.jedit.XModeHandler diff --git a/basis/xmode/loader/syntax/syntax.factor b/basis/xmode/loader/syntax/syntax.factor index 69c4e4fac3..cbebe090c3 100644 --- a/basis/xmode/loader/syntax/syntax.factor +++ b/basis/xmode/loader/syntax/syntax.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors xmode.tokens xmode.rules xmode.keyword-map xml.data xml.utilities xml assocs kernel combinators sequences -math.parser namespaces make parser lexer xmode.utilities regexp -io.files ; +math.parser namespaces make parser lexer xmode.utilities +parser-combinators.regexp io.files ; IN: xmode.loader.syntax SYMBOL: ignore-case? diff --git a/basis/xmode/rules/rules.factor b/basis/xmode/rules/rules.factor index e3c0c65db0..e4f12bcc49 100755 --- a/basis/xmode/rules/rules.factor +++ b/basis/xmode/rules/rules.factor @@ -1,5 +1,6 @@ USING: accessors xmode.tokens xmode.keyword-map kernel -sequences vectors assocs strings memoize regexp unicode.case ; +sequences vectors assocs strings memoize unicode.case +parser-combinators.regexp ; IN: xmode.rules TUPLE: string-matcher string ignore-case? ; From e59b320df3140fd4c3786cd80d79d98c33d27267 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Sep 2008 14:42:16 -0500 Subject: [PATCH 04/17] move regexp2 to regexp, bug fixes, more tests --- unfinished/{regexp2 => regexp}/authors.txt | 0 .../backend/backend.factor | 2 +- .../classes/classes.factor | 6 +-- unfinished/{regexp2 => regexp}/dfa/dfa.factor | 13 +++--- unfinished/{regexp2 => regexp}/nfa/nfa.factor | 17 +++++-- .../parser/parser-tests.factor | 9 ++-- .../{regexp2 => regexp}/parser/parser.factor | 34 ++++++++++++-- .../regexp-docs.factor} | 4 +- .../regexp-tests.factor} | 37 ++++++++++------ .../regexp2.factor => regexp/regexp.factor} | 44 ++++++++++++------- unfinished/{regexp2 => regexp}/summary.txt | 0 unfinished/{regexp2 => regexp}/tags.txt | 0 .../transition-tables.factor | 4 +- .../traversal/traversal.factor | 15 +++---- .../{regexp2 => regexp}/utils/utils.factor | 9 ++-- 15 files changed, 123 insertions(+), 71 deletions(-) rename unfinished/{regexp2 => regexp}/authors.txt (100%) rename unfinished/{regexp2 => regexp}/backend/backend.factor (96%) rename unfinished/{regexp2 => regexp}/classes/classes.factor (90%) rename unfinished/{regexp2 => regexp}/dfa/dfa.factor (87%) rename unfinished/{regexp2 => regexp}/nfa/nfa.factor (92%) rename unfinished/{regexp2 => regexp}/parser/parser-tests.factor (82%) rename unfinished/{regexp2 => regexp}/parser/parser.factor (92%) rename unfinished/{regexp2/regexp2-docs.factor => regexp/regexp-docs.factor} (89%) rename unfinished/{regexp2/regexp2-tests.factor => regexp/regexp-tests.factor} (90%) rename unfinished/{regexp2/regexp2.factor => regexp/regexp.factor} (67%) rename unfinished/{regexp2 => regexp}/summary.txt (100%) rename unfinished/{regexp2 => regexp}/tags.txt (100%) rename unfinished/{regexp2 => regexp}/transition-tables/transition-tables.factor (95%) rename unfinished/{regexp2 => regexp}/traversal/traversal.factor (86%) rename unfinished/{regexp2 => regexp}/utils/utils.factor (91%) diff --git a/unfinished/regexp2/authors.txt b/unfinished/regexp/authors.txt similarity index 100% rename from unfinished/regexp2/authors.txt rename to unfinished/regexp/authors.txt diff --git a/unfinished/regexp2/backend/backend.factor b/unfinished/regexp/backend/backend.factor similarity index 96% rename from unfinished/regexp2/backend/backend.factor rename to unfinished/regexp/backend/backend.factor index fa5c1f7f97..1a261fb0af 100644 --- a/unfinished/regexp2/backend/backend.factor +++ b/unfinished/regexp/backend/backend.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors hashtables kernel math state-tables vars vectors ; -IN: regexp2.backend +IN: regexp.backend TUPLE: regexp raw diff --git a/unfinished/regexp2/classes/classes.factor b/unfinished/regexp/classes/classes.factor similarity index 90% rename from unfinished/regexp2/classes/classes.factor rename to unfinished/regexp/classes/classes.factor index 7737e02d40..a2d91b97fb 100644 --- a/unfinished/regexp2/classes/classes.factor +++ b/unfinished/regexp/classes/classes.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math math.order symbols regexp2.parser -words regexp2.utils unicode.categories combinators.short-circuit ; -IN: regexp2.classes +USING: accessors kernel math math.order symbols regexp.parser +words regexp.utils unicode.categories combinators.short-circuit ; +IN: regexp.classes GENERIC: class-member? ( obj class -- ? ) diff --git a/unfinished/regexp2/dfa/dfa.factor b/unfinished/regexp/dfa/dfa.factor similarity index 87% rename from unfinished/regexp2/dfa/dfa.factor rename to unfinished/regexp/dfa/dfa.factor index cd2f4186f4..6f244dc8af 100644 --- a/unfinished/regexp2/dfa/dfa.factor +++ b/unfinished/regexp/dfa/dfa.factor @@ -1,15 +1,14 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators fry kernel locals -math math.order regexp2.nfa regexp2.transition-tables sequences -sets sorting vectors regexp2.utils sequences.lib combinators.lib -sequences.deep ; +math math.order regexp.nfa regexp.transition-tables sequences +sets sorting vectors regexp.utils sequences.deep ; USING: io prettyprint threads ; -IN: regexp2.dfa +IN: regexp.dfa : find-delta ( states transition regexp -- new-states ) nfa-table>> transitions>> - rot [ swap at at ] with with map sift concat prune ; + rot [ swap at at ] with with gather sift ; : (find-epsilon-closure) ( states regexp -- new-states ) eps swap find-delta ; @@ -26,7 +25,9 @@ IN: regexp2.dfa : find-transitions ( seq1 regexp -- seq2 ) nfa-table>> transitions>> - [ at keys ] curry map concat eps swap remove ; + [ at keys ] curry map concat + eps swap remove ; + ! dup t member? [ t swap remove t suffix ] when ; : add-todo-state ( state regexp -- ) 2dup visited-states>> key? [ diff --git a/unfinished/regexp2/nfa/nfa.factor b/unfinished/regexp/nfa/nfa.factor similarity index 92% rename from unfinished/regexp2/nfa/nfa.factor rename to unfinished/regexp/nfa/nfa.factor index 792d9fe30f..f070c3528b 100644 --- a/unfinished/regexp2/nfa/nfa.factor +++ b/unfinished/regexp/nfa/nfa.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs grouping kernel regexp2.backend -locals math namespaces regexp2.parser sequences state-tables fry +USING: accessors arrays assocs grouping kernel regexp.backend +locals math namespaces regexp.parser sequences state-tables fry quotations math.order math.ranges vectors unicode.categories -regexp2.utils regexp2.transition-tables words sequences.lib sets ; -IN: regexp2.nfa +regexp.utils regexp.transition-tables words sets ; +IN: regexp.nfa SYMBOL: negation-mode : negated? ( -- ? ) negation-mode get 0 or odd? ; @@ -121,6 +121,15 @@ M: character-class-range nfa-node ( node -- ) M: capture-group nfa-node ( node -- ) term>> nfa-node ; +! xyzzy +M: non-capture-group nfa-node ( node -- ) + term>> nfa-node ; + +M: reluctant-kleene-star nfa-node ( node -- ) + term>> nfa-node ; + +! + M: negation nfa-node ( node -- ) negation-mode inc term>> nfa-node diff --git a/unfinished/regexp2/parser/parser-tests.factor b/unfinished/regexp/parser/parser-tests.factor similarity index 82% rename from unfinished/regexp2/parser/parser-tests.factor rename to unfinished/regexp/parser/parser-tests.factor index 6911e8e76d..0f25b2e3bf 100644 --- a/unfinished/regexp2/parser/parser-tests.factor +++ b/unfinished/regexp/parser/parser-tests.factor @@ -1,13 +1,10 @@ -USING: kernel tools.test regexp2.backend regexp2 ; -IN: regexp2.parser +USING: kernel tools.test regexp.backend regexp ; +IN: regexp.parser : test-regexp ( string -- ) default-regexp parse-regexp ; -: test-regexp2 ( string -- regexp ) - default-regexp dup parse-regexp ; - -[ "(" ] [ unmatched-parentheses? ] must-fail-with +! [ "(" ] [ unmatched-parentheses? ] must-fail-with [ ] [ "a|b" test-regexp ] unit-test [ ] [ "a.b" test-regexp ] unit-test diff --git a/unfinished/regexp2/parser/parser.factor b/unfinished/regexp/parser/parser.factor similarity index 92% rename from unfinished/regexp2/parser/parser.factor rename to unfinished/regexp/parser/parser.factor index fb1bd08bfe..eaee70210e 100644 --- a/unfinished/regexp2/parser/parser.factor +++ b/unfinished/regexp/parser/parser.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators io io.streams.string kernel math math.parser multi-methods namespaces qualified sets -quotations sequences sequences.lib splitting symbols vectors -dlists math.order combinators.lib unicode.categories strings -sequences.lib regexp2.backend regexp2.utils unicode.case ; -IN: regexp2.parser +quotations sequences splitting symbols vectors math.order +unicode.categories strings regexp.backend regexp.utils +unicode.case ; +IN: regexp.parser FROM: math.ranges => [a,b] ; @@ -280,11 +280,26 @@ ERROR: bad-escaped-literals seq ; first|concatenation ] if-empty ; +ERROR: unrecognized-escape char ; + : parse-escaped ( -- obj ) read1 { { CHAR: \ [ CHAR: \ ] } + { CHAR: - [ CHAR: - ] } + { CHAR: { [ CHAR: { ] } + { CHAR: } [ CHAR: } ] } + { CHAR: [ [ CHAR: [ ] } + { CHAR: ] [ CHAR: ] ] } + { CHAR: ( [ CHAR: ( ] } + { CHAR: ) [ CHAR: ) ] } + { CHAR: @ [ CHAR: @ ] } + { CHAR: * [ CHAR: * ] } + { CHAR: + [ CHAR: + ] } + { CHAR: ? [ CHAR: ? ] } { CHAR: . [ CHAR: . ] } +! xyzzy + { CHAR: : [ CHAR: : ] } { CHAR: t [ CHAR: \t ] } { CHAR: n [ CHAR: \n ] } { CHAR: r [ CHAR: \r ] } @@ -314,8 +329,19 @@ ERROR: bad-escaped-literals seq ; ! { CHAR: G [ end of previous match ] } ! { CHAR: Z [ handle-end-of-input ] } ! { CHAR: z [ handle-end-of-input ] } ! except for terminator +! xyzzy + { CHAR: 1 [ CHAR: 1 ] } + { CHAR: 2 [ CHAR: 2 ] } + { CHAR: 3 [ CHAR: 3 ] } + { CHAR: 4 [ CHAR: 4 ] } + { CHAR: 5 [ CHAR: 5 ] } + { CHAR: 6 [ CHAR: 6 ] } + { CHAR: 7 [ CHAR: 7 ] } + { CHAR: 8 [ CHAR: 8 ] } + { CHAR: 9 [ CHAR: 9 ] } { CHAR: Q [ parse-escaped-literals ] } + [ unrecognized-escape ] } case ; : handle-escape ( -- ) parse-escaped push-stack ; diff --git a/unfinished/regexp2/regexp2-docs.factor b/unfinished/regexp/regexp-docs.factor similarity index 89% rename from unfinished/regexp2/regexp2-docs.factor rename to unfinished/regexp/regexp-docs.factor index f903c14bc4..f6a1fe1876 100644 --- a/unfinished/regexp2/regexp2-docs.factor +++ b/unfinished/regexp/regexp-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel strings help.markup help.syntax regexp2.backend ; -IN: regexp2 +USING: kernel strings help.markup help.syntax regexp.backend ; +IN: regexp HELP: { $values { "string" string } { "regexp" regexp } } diff --git a/unfinished/regexp2/regexp2-tests.factor b/unfinished/regexp/regexp-tests.factor similarity index 90% rename from unfinished/regexp2/regexp2-tests.factor rename to unfinished/regexp/regexp-tests.factor index e77a7a4419..78098952d3 100644 --- a/unfinished/regexp2/regexp2-tests.factor +++ b/unfinished/regexp/regexp-tests.factor @@ -1,6 +1,6 @@ -USING: regexp2 tools.test kernel sequences regexp2.parser -regexp2.traversal ; -IN: regexp2-tests +USING: regexp tools.test kernel sequences regexp.parser +regexp.traversal eval ; +IN: regexp-tests [ f ] [ "b" "a*" matches? ] unit-test [ t ] [ "" "a*" matches? ] unit-test @@ -224,6 +224,9 @@ IN: regexp2-tests [ f ] [ "a" "[a-z.-]@[a-z]" matches? ] unit-test [ t ] [ ".o" "\\.[a-z]" matches? ] unit-test +[ t ] [ "abc*" "[^\\*]*\\*" matches? ] unit-test +[ t ] [ "bca" "[^a]*a" matches? ] unit-test + [ ] [ "(0[lL]?|[1-9]\\d{0,9}(\\d{0,9}[lL])?|0[xX]\\p{XDigit}{1,8}(\\p{XDigit}{0,8}[lL])?|0[0-7]{1,11}([0-7]{0,11}[lL])?|([0-9]+\\.[0-9]*|\\.[0-9]+)([eE][+-]?[0-9]+)?[fFdD]?|[0-9]+([eE][+-]?[0-9]+[fFdD]?|([eE][+-]?[0-9]+)?[fFdD]))" drop @@ -236,20 +239,20 @@ IN: regexp2-tests -[ "{Lower}" ] [ invalid-range? ] must-fail-with +! [ "{Lower}" ] [ invalid-range? ] must-fail-with -[ 1 ] [ "aaacb" "a+?" match-head ] unit-test -[ 1 ] [ "aaacb" "aa??" match-head ] unit-test -[ f ] [ "aaaab" "a++ab" matches? ] unit-test -[ t ] [ "aaacb" "a++cb" matches? ] unit-test -[ 3 ] [ "aacb" "aa?c" match-head ] unit-test -[ 3 ] [ "aacb" "aa??c" match-head ] unit-test +! [ 1 ] [ "aaacb" "a+?" match-head ] unit-test +! [ 1 ] [ "aaacb" "aa??" match-head ] unit-test +! [ f ] [ "aaaab" "a++ab" matches? ] unit-test +! [ t ] [ "aaacb" "a++cb" matches? ] unit-test +! [ 3 ] [ "aacb" "aa?c" match-head ] unit-test +! [ 3 ] [ "aacb" "aa??c" match-head ] unit-test -[ t ] [ "fxxbar" "(?!foo).{3}bar" matches? ] unit-test -[ f ] [ "foobar" "(?!foo).{3}bar" matches? ] unit-test +! [ t ] [ "fxxbar" "(?!foo).{3}bar" matches? ] unit-test +! [ f ] [ "foobar" "(?!foo).{3}bar" matches? ] unit-test -[ 3 ] [ "foobar" "foo(?=bar)" match-head ] unit-test -[ f ] [ "foobxr" "foo(?=bar)" match-head ] unit-test +! [ 3 ] [ "foobar" "foo(?=bar)" match-head ] unit-test +! [ f ] [ "foobxr" "foo(?=bar)" match-head ] unit-test ! [ f ] [ "foobxr" "foo\\z" match-head ] unit-test ! [ 3 ] [ "foo" "foo\\z" match-head ] unit-test @@ -268,6 +271,12 @@ IN: regexp2-tests ! [ t ] [ "fooxbar" "foo\\Bxbar" matches? ] unit-test ! [ f ] [ "foo" "foo\\Bbar" matches? ] unit-test +[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test + +[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test + +[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test + ! Bug in parsing word ! [ t ] [ "a" R' a' matches? ] unit-test diff --git a/unfinished/regexp2/regexp2.factor b/unfinished/regexp/regexp.factor similarity index 67% rename from unfinished/regexp2/regexp2.factor rename to unfinished/regexp/regexp.factor index feec8ea97e..47c6e52c39 100644 --- a/unfinished/regexp2/regexp2.factor +++ b/unfinished/regexp/regexp.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators kernel math math.ranges -sequences regexp2.backend regexp2.utils memoize sets -regexp2.parser regexp2.nfa regexp2.dfa regexp2.traversal -regexp2.transition-tables assocs prettyprint.backend -make ; -IN: regexp2 +sequences regexp.backend regexp.utils memoize sets +regexp.parser regexp.nfa regexp.dfa regexp.traversal +regexp.transition-tables assocs prettyprint.backend +make lexer namespaces parser ; +IN: regexp : default-regexp ( string -- regexp ) regexp new @@ -51,17 +51,26 @@ IN: regexp2 reversed-regexp initial-option construct-regexp ; -: R! CHAR: ! ; parsing -: R" CHAR: " ; parsing -: R# CHAR: # ; parsing -: R' CHAR: ' ; parsing -: R( CHAR: ) ; parsing -: R/ CHAR: / ; parsing -: R@ CHAR: @ ; parsing -: R[ CHAR: ] ; parsing -: R` CHAR: ` ; parsing -: R{ CHAR: } ; parsing -: R| CHAR: | ; parsing + +: parsing-regexp ( accum end -- accum ) + lexer get dup skip-blank + [ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column + lexer get dup still-parsing-line? + [ (parse-token) ] [ drop f ] if + "i" = [ ] [ ] if parsed ; + +: R! CHAR: ! parsing-regexp ; parsing +: R" CHAR: " parsing-regexp ; parsing +: R# CHAR: # parsing-regexp ; parsing +: R' CHAR: ' parsing-regexp ; parsing +: R( CHAR: ) parsing-regexp ; parsing +: R/ CHAR: / parsing-regexp ; parsing +: R@ CHAR: @ parsing-regexp ; parsing +: R[ CHAR: ] parsing-regexp ; parsing +: R` CHAR: ` parsing-regexp ; parsing +: R{ CHAR: } parsing-regexp ; parsing +: R| CHAR: | parsing-regexp ; parsing + : find-regexp-syntax ( string -- prefix suffix ) { @@ -81,6 +90,8 @@ IN: regexp2 : option? ( option regexp -- ? ) options>> key? ; +USE: multiline +/* M: regexp pprint* [ [ @@ -89,3 +100,4 @@ M: regexp pprint* case-insensitive swap option? [ "i" % ] when ] "" make ] keep present-text ; +*/ diff --git a/unfinished/regexp2/summary.txt b/unfinished/regexp/summary.txt similarity index 100% rename from unfinished/regexp2/summary.txt rename to unfinished/regexp/summary.txt diff --git a/unfinished/regexp2/tags.txt b/unfinished/regexp/tags.txt similarity index 100% rename from unfinished/regexp2/tags.txt rename to unfinished/regexp/tags.txt diff --git a/unfinished/regexp2/transition-tables/transition-tables.factor b/unfinished/regexp/transition-tables/transition-tables.factor similarity index 95% rename from unfinished/regexp2/transition-tables/transition-tables.factor rename to unfinished/regexp/transition-tables/transition-tables.factor index c67985af4a..82e2db8496 100644 --- a/unfinished/regexp2/transition-tables/transition-tables.factor +++ b/unfinished/regexp/transition-tables/transition-tables.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs fry hashtables kernel sequences -vectors regexp2.utils ; -IN: regexp2.transition-tables +vectors regexp.utils ; +IN: regexp.transition-tables TUPLE: transition from to obj ; TUPLE: literal-transition < transition ; diff --git a/unfinished/regexp2/traversal/traversal.factor b/unfinished/regexp/traversal/traversal.factor similarity index 86% rename from unfinished/regexp2/traversal/traversal.factor rename to unfinished/regexp/traversal/traversal.factor index ba9284c110..752323de91 100644 --- a/unfinished/regexp2/traversal/traversal.factor +++ b/unfinished/regexp/traversal/traversal.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs combinators combinators.lib kernel -math math.ranges quotations sequences regexp2.parser -regexp2.classes combinators.short-circuit assocs.lib -sequences.lib regexp2.utils ; -IN: regexp2.traversal +USING: accessors assocs combinators kernel math math.ranges +quotations sequences regexp.parser regexp.classes +combinators.short-circuit regexp.utils ; +IN: regexp.traversal TUPLE: dfa-traverser dfa-table @@ -54,7 +53,7 @@ TUPLE: dfa-traverser V{ } clone >>matches ; : match-literal ( transition from-state table -- to-state/f ) - transitions>> [ at ] [ 2drop f ] if-at ; + transitions>> at* [ at ] [ 2drop f ] if ; : match-class ( transition from-state table -- to-state/f ) transitions>> at* [ @@ -62,8 +61,8 @@ TUPLE: dfa-traverser ] [ drop ] if ; : match-default ( transition from-state table -- to-state/f ) - [ nip ] dip transitions>> - [ t swap [ drop f ] unless-at ] [ drop f ] if-at ; + [ nip ] dip transitions>> at* + [ t swap at* [ ] [ drop f ] if ] [ drop f ] if ; : match-transition ( obj from-state dfa -- to-state/f ) { [ match-literal ] [ match-class ] [ match-default ] } 3|| ; diff --git a/unfinished/regexp2/utils/utils.factor b/unfinished/regexp/utils/utils.factor similarity index 91% rename from unfinished/regexp2/utils/utils.factor rename to unfinished/regexp/utils/utils.factor index ab51436f8b..fb058ecf92 100644 --- a/unfinished/regexp2/utils/utils.factor +++ b/unfinished/regexp/utils/utils.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs combinators.lib io kernel -math math.order namespaces regexp2.backend sequences -sequences.lib unicode.categories math.ranges fry -combinators.short-circuit vectors ; -IN: regexp2.utils +USING: accessors arrays assocs io kernel math math.order +namespaces regexp.backend sequences unicode.categories +math.ranges fry combinators.short-circuit vectors ; +IN: regexp.utils : (while-changes) ( obj quot pred pred-ret -- obj ) ! quot: ( obj -- obj' ) From a53a198cc2a77cdd10d3573ee7359bc67ed91ece Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Sep 2008 15:16:06 -0500 Subject: [PATCH 05/17] fix load error --- basis/xmode/marker/marker.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index d0d68febec..d36aa1228f 100755 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -4,7 +4,8 @@ IN: xmode.marker USING: kernel namespaces make xmode.rules xmode.tokens xmode.marker.state xmode.marker.context xmode.utilities xmode.catalog sequences math assocs combinators -strings regexp splitting parser-combinators ascii unicode.case +strings parser-combinators.regexp regexp splitting +parser-combinators ascii unicode.case combinators.short-circuit accessors ; ! Based on org.gjt.sp.jedit.syntax.TokenMarker From 772a964a04e787f6be5341a1212cbed89ad37e16 Mon Sep 17 00:00:00 2001 From: "U-ENCHILADA\\sheeple" Date: Thu, 18 Sep 2008 16:45:15 -0600 Subject: [PATCH 06/17] \\?\c: is a root-directory on windows --- basis/io/windows/nt/files/files-tests.factor | 7 +++++++ basis/io/windows/nt/files/files.factor | 13 ++++++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/basis/io/windows/nt/files/files-tests.factor b/basis/io/windows/nt/files/files-tests.factor index 830861eba0..6620dd691e 100755 --- a/basis/io/windows/nt/files/files-tests.factor +++ b/basis/io/windows/nt/files/files-tests.factor @@ -4,8 +4,12 @@ IN: io.windows.nt.files.tests [ f ] [ "\\foo" absolute-path? ] unit-test [ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test +[ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test +[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test [ t ] [ "c:\\foo" absolute-path? ] unit-test [ t ] [ "c:" absolute-path? ] unit-test +[ t ] [ "c:\\" absolute-path? ] unit-test +[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test [ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test [ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test @@ -26,6 +30,9 @@ IN: io.windows.nt.files.tests [ f ] [ "c:\\foo" root-directory? ] unit-test [ f ] [ "." root-directory? ] unit-test [ f ] [ ".." root-directory? ] unit-test +[ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test +[ t ] [ "\\\\?\\c:" root-directory? ] unit-test +[ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test [ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor index b572d9ec65..157662ade8 100755 --- a/basis/io/windows/nt/files/files.factor +++ b/basis/io/windows/nt/files/files.factor @@ -20,11 +20,14 @@ M: winnt cd M: winnt root-directory? ( path -- ? ) { - { [ dup empty? ] [ f ] } - { [ dup [ path-separator? ] all? ] [ t ] } - { [ dup trim-right-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] } - [ f ] - } cond nip ; + { [ dup empty? ] [ drop f ] } + { [ dup [ path-separator? ] all? ] [ drop t ] } + { [ dup trim-right-separators { [ length 2 = ] + [ second CHAR: : = ] } 1&& ] [ drop t ] } + { [ dup unicode-prefix head? ] + [ trim-right-separators length unicode-prefix length 2 + = ] } + [ drop f ] + } cond ; ERROR: not-absolute-path ; From 58914da662d1776fea50bd7b7248032d9d082399 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Sep 2008 18:20:26 -0500 Subject: [PATCH 07/17] I/O fixes --- basis/io/launcher/launcher.factor | 40 ++++++++++++++++------- basis/tools/deploy/backend/backend.factor | 12 ++----- core/io/files/files.factor | 2 +- 3 files changed, 33 insertions(+), 21 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 1b22ca8501..cc48ace60b 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -145,10 +145,13 @@ M: process-failed error. "Launch descriptor:" print nl process>> . ; -: try-process ( desc -- ) - run-process dup wait-for-process dup zero? +: wait-for-success ( process -- ) + dup wait-for-process dup zero? [ 2drop ] [ process-failed ] if ; +: try-process ( desc -- ) + run-process wait-for-success ; + HOOK: kill-process* io-backend ( handle -- ) : kill-process ( process -- ) @@ -167,7 +170,7 @@ M: object run-pipeline-element 3bi wait-for-process ; -: ( process encoding -- process stream ) +: ( desc encoding -- stream process ) [ >r (pipe) { [ |dispose drop ] @@ -178,13 +181,18 @@ M: object run-pipeline-element ] [ out>> dispose ] [ in>> ] - } cleave r> + } cleave r> swap ] with-destructors ; : ( desc encoding -- stream ) - nip ; inline + drop ; inline -: ( process encoding -- process stream ) +: with-process-reader ( desc encoding quot -- ) + [ ] dip + swap [ with-input-stream ] dip + wait-for-success ; inline + +: ( desc encoding -- stream process ) [ >r (pipe) { [ |dispose drop ] @@ -195,13 +203,18 @@ M: object run-pipeline-element ] [ in>> dispose ] [ out>> ] - } cleave r> + } cleave r> swap ] with-destructors ; : ( desc encoding -- stream ) - nip ; inline + drop ; inline -: ( process encoding -- process stream ) +: with-process-writer ( desc encoding quot -- ) + [ ] dip + swap [ with-output-stream ] dip + wait-for-success ; inline + +: ( desc encoding -- stream process ) [ >r (pipe) (pipe) { [ [ |dispose drop ] bi@ ] @@ -213,11 +226,16 @@ M: object run-pipeline-element ] [ [ out>> dispose ] [ in>> dispose ] bi* ] [ [ in>> ] [ out>> ] bi* ] - } 2cleave r> + } 2cleave r> swap ] with-destructors ; : ( desc encoding -- stream ) - nip ; inline + drop ; inline + +: with-process-stream ( desc encoding quot -- ) + [ ] dip + swap [ with-stream ] dip + wait-for-success ; inline : notify-exit ( process status -- ) >>status diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index 324adcaad2..cb899f4b87 100755 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -18,12 +18,8 @@ IN: tools.deploy.backend : image-name ( vocab bundle-name -- str ) prepend-path ".image" append ; -: (copy-lines) ( stream -- ) - dup stream-readln dup - [ print flush (copy-lines) ] [ 2drop ] if ; - -: copy-lines ( stream -- ) - [ (copy-lines) ] with-disposal ; +: copy-lines ( -- ) + readln [ print flush copy-lines ] when* ; : run-with-output ( arguments -- ) @@ -31,9 +27,7 @@ IN: tools.deploy.backend +stdout+ >>stderr +closed+ >>stdin +low-priority+ >>priority - utf8 - copy-lines - wait-for-process zero? [ "Deployment failed" throw ] unless ; + utf8 [ copy-lines ] with-process-reader ; : make-boot-image ( -- ) #! If stage1 image doesn't exist, create one. diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 58a08ed30c..5634336243 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -194,7 +194,7 @@ SYMBOL: current-directory [ cwd current-directory set-global - image parent-directory cwd prepend-path "resource-path" set + image parent-directory cwd prepend-path "resource-path" set-global ] "io.files" add-init-hook : resource-path ( path -- newpath ) From 1b875b8bf702d0c154073eef4daf48556d93d929 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Sep 2008 18:23:46 -0500 Subject: [PATCH 08/17] Better error message if git not in path --- extra/mason/common/common.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index d5996f300c..dfda85e4d7 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -51,7 +51,7 @@ SYMBOL: stamp with-directory ; : git-id ( -- id ) - { "git" "show" } utf8 [ readln ] with-input-stream + { "git" "show" } utf8 [ readln ] with-process-reader " " split second ; : ?prepare-build-machine ( -- ) From 4ce3cc4141157f37781161532f570aca4a087284 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Sep 2008 22:08:12 -0500 Subject: [PATCH 09/17] Bug fixes --- basis/bootstrap/random/random.factor | 2 +- core/io/files/files.factor | 13 ++++++++----- core/system/system.factor | 8 ++++---- 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/basis/bootstrap/random/random.factor b/basis/bootstrap/random/random.factor index 3782d517cf..f6527cdda1 100755 --- a/basis/bootstrap/random/random.factor +++ b/basis/bootstrap/random/random.factor @@ -13,4 +13,4 @@ IN: bootstrap.random [ [ 32 random-bits ] with-system-random random-generator set-global -] "generator.random" add-init-hook +] "bootstrap.random" add-init-hook diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 5634336243..1634b7a3f1 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: io.backend io.files.private io hashtables kernel math -memory namespaces sequences strings assocs arrays definitions -system combinators splitting sbufs continuations destructors -io.encodings io.encodings.binary init accessors math.order ; +USING: io.backend io.files.private io hashtables kernel +kernel.private math memory namespaces sequences strings assocs +arrays definitions system combinators splitting sbufs +continuations destructors io.encodings io.encodings.binary init +accessors math.order ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -194,7 +195,9 @@ SYMBOL: current-directory [ cwd current-directory set-global - image parent-directory cwd prepend-path "resource-path" set-global + 13 getenv cwd prepend-path \ image set-global + 14 getenv cwd prepend-path \ vm set-global + image parent-directory "resource-path" set-global ] "io.files" add-init-hook : resource-path ( path -- newpath ) diff --git a/core/system/system.factor b/core/system/system.factor index 98dc605acc..3c207c4ab5 100755 --- a/core/system/system.factor +++ b/core/system/system.factor @@ -55,15 +55,15 @@ UNION: unix bsd solaris linux ; PRIVATE> +: image ( -- path ) \ image get-global ; + +: vm ( -- path ) \ vm get-global ; + [ 8 getenv string>cpu \ cpu set-global 9 getenv string>os \ os set-global ] "system" add-init-hook -: image ( -- path ) 13 getenv ; - -: vm ( -- path ) 14 getenv ; - : embedded? ( -- ? ) 15 getenv ; : os-envs ( -- assoc ) From 09ecec270af022da06e1267bdf524d02f670baa8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Sep 2008 22:24:46 -0500 Subject: [PATCH 10/17] Fix load error --- basis/xmode/marker/marker.factor | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index d36aa1228f..f777eaa18c 100755 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -3,10 +3,9 @@ IN: xmode.marker USING: kernel namespaces make xmode.rules xmode.tokens xmode.marker.state xmode.marker.context xmode.utilities -xmode.catalog sequences math assocs combinators -strings parser-combinators.regexp regexp splitting -parser-combinators ascii unicode.case -combinators.short-circuit accessors ; +xmode.catalog sequences math assocs combinators strings +parser-combinators.regexp splitting parser-combinators ascii +unicode.case combinators.short-circuit accessors ; ! Based on org.gjt.sp.jedit.syntax.TokenMarker From 1588d2ab4cbd884b43487bbbd2b3f3f8884f459e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Sep 2008 23:49:51 -0500 Subject: [PATCH 11/17] fix a using --- extra/parser-combinators/regexp/regexp-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/parser-combinators/regexp/regexp-tests.factor b/extra/parser-combinators/regexp/regexp-tests.factor index 64feb0903c..78abd8b38a 100755 --- a/extra/parser-combinators/regexp/regexp-tests.factor +++ b/extra/parser-combinators/regexp/regexp-tests.factor @@ -1,4 +1,4 @@ -USING: regexp tools.test kernel ; +USING: parser-combinators.regexp tools.test kernel ; IN: parser-combinators.regexp.tests [ f ] [ "b" "a*" f matches? ] unit-test From 3d790d8ac848639f554e88474a9c182489c9c002 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 19 Sep 2008 00:26:27 -0500 Subject: [PATCH 12/17] Memory ricing to make deploy tests pass on Mac OS X/PowerPC --- .../core-foundation/fsevents/fsevents.factor | 7 +- .../core-foundation/run-loop/run-loop.factor | 2 - .../run-loop/thread/thread.factor | 8 +++ basis/random/unix/unix.factor | 2 + .../transforms/transforms.factor | 2 +- basis/tools/deploy/shaker/shaker.factor | 34 +++++++--- basis/tools/deploy/shaker/strip-cocoa.factor | 64 ++++++++++++------- core/classes/tuple/tuple.factor | 5 +- 8 files changed, 84 insertions(+), 40 deletions(-) create mode 100644 basis/core-foundation/run-loop/thread/thread.factor diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index bb21391f0a..6bec4b23c0 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -3,13 +3,10 @@ USING: alien alien.c-types alien.strings alien.syntax kernel math sequences namespaces make assocs init accessors continuations combinators core-foundation -core-foundation.run-loop io.encodings.utf8 destructors ; +core-foundation.run-loop core-foundation.run-loop.thread +io.encodings.utf8 destructors ; IN: core-foundation.fsevents -! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! -! FSEventStream API, Leopard only ! -! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! - : kFSEventStreamCreateFlagUseCFTypes 2 ; inline : kFSEventStreamCreateFlagWatchRoot 4 ; inline diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 5ffcafbbaf..e30cc2eb60 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -35,5 +35,3 @@ FUNCTION: SInt32 CFRunLoopRunInMode ( : start-run-loop-thread ( -- ) [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ; - -[ start-run-loop-thread ] "core-foundation.run-loop" add-init-hook diff --git a/basis/core-foundation/run-loop/thread/thread.factor b/basis/core-foundation/run-loop/thread/thread.factor new file mode 100644 index 0000000000..326226ec0e --- /dev/null +++ b/basis/core-foundation/run-loop/thread/thread.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: init core-foundation.run-loop ; +IN: core-foundation.run-loop.thread + +! Load this vocabulary if you need a run loop running. + +[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook diff --git a/basis/random/unix/unix.factor b/basis/random/unix/unix.factor index 90f3d1efbb..599cd5e0ad 100644 --- a/basis/random/unix/unix.factor +++ b/basis/random/unix/unix.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman +! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io io.files kernel namespaces random io.encodings.binary init accessors system ; IN: random.unix diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 41c7e2c972..abc3ae1950 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -96,7 +96,7 @@ IN: stack-checker.transforms \ boa [ dup tuple-class? [ dup inlined-dependency depends-on - [ "boa-check" word-prop ] + [ "boa-check" word-prop [ ] or ] [ tuple-layout '[ _ ] ] bi append ] [ drop f ] if diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index f2726c00fa..8713be54bb 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -4,7 +4,7 @@ USING: accessors qualified io.streams.c init fry namespaces make assocs kernel parser lexer strings.parser tools.deploy.config vocabs sequences words words.private memory kernel.private continuations io prettyprint vocabs.loader debugger system -strings sets vectors quotations byte-arrays ; +strings sets vectors quotations byte-arrays sorting ; QUALIFIED: bootstrap.stage2 QUALIFIED: classes QUALIFIED: command-line @@ -29,6 +29,7 @@ IN: tools.deploy.shaker "cpu.x86" init-hooks get delete-at "command-line" init-hooks get delete-at "libc" init-hooks get delete-at + "system" init-hooks get delete-at deploy-threads? get [ "threads" init-hooks get delete-at ] unless @@ -36,7 +37,11 @@ IN: tools.deploy.shaker "io.thread" init-hooks get delete-at ] unless strip-io? [ + "io.files" init-hooks get delete-at "io.backend" init-hooks get delete-at + ] when + strip-dictionary? [ + "compiler.units" init-hooks get delete-at ] when ; : strip-debugger ( -- ) @@ -74,17 +79,22 @@ IN: tools.deploy.shaker : strip-word-props ( stripped-props words -- ) "Stripping word properties" show [ - [ - props>> swap - '[ drop _ member? not ] assoc-filter sift-assoc - dup assoc-empty? [ drop f ] [ >alist >vector ] if - ] keep (>>props) - ] with each ; + swap '[ + [ + [ drop _ member? not ] assoc-filter sift-assoc + >alist f like + ] change-props drop + ] each + ] [ + "Remaining word properties:" print + [ props>> keys ] gather . + ] bi ; : stripped-word-props ( -- seq ) [ strip-dictionary? [ { + "boa-check" "cannot-infer" "coercer" "combination" @@ -92,12 +102,15 @@ IN: tools.deploy.shaker "compiled-generic-uses" "compiled-uses" "constraints" + "custom-inlining" "declared-effect" "default" "default-method" "default-output-classes" "derived-from" "engines" + "forgotten" + "identities" "if-intrinsics" "infer" "inferred-effect" @@ -116,9 +129,11 @@ IN: tools.deploy.shaker "macro" "members" "memo-quot" + "mixin" "method-class" "method-generic" "methods" + "modular-arithmetic" "no-compile" "optimizer-hooks" "outputs" @@ -126,6 +141,7 @@ IN: tools.deploy.shaker "predicate" "predicate-definition" "predicating" + "primitive" "reader" "reading" "recursive" @@ -230,6 +246,7 @@ IN: tools.deploy.shaker compiled-generic-crossref compiler.units:recompile-hook compiler.units:update-tuples-hook + compiler.units:definition-observers definitions:crossref interactive-vocabs layouts:num-tags @@ -244,6 +261,7 @@ IN: tools.deploy.shaker vocabs:dictionary vocabs:load-vocab-hook word + parser-notes } % { } { "math.partial-dispatch" } strip-vocab-globals % @@ -273,7 +291,7 @@ IN: tools.deploy.shaker "ui-error-hook" "ui.gadgets.worlds" lookup , ] when - "" "inference.dataflow" lookup [ , ] when* + "" "stack-checker.state" lookup [ , ] when* "windows-messages" "windows.messages" lookup [ , ] when* diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor index de5aee68e2..2cf803e270 100755 --- a/basis/tools/deploy/shaker/strip-cocoa.factor +++ b/basis/tools/deploy/shaker/strip-cocoa.factor @@ -1,30 +1,50 @@ -USING: cocoa cocoa.messages cocoa.application cocoa.nibs -assocs namespaces kernel words compiler.units sequences -ui ui.cocoa ; +! Copyright (C) 2007, 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: cocoa cocoa.messages cocoa.application cocoa.nibs assocs +namespaces kernel kernel.private words compiler.units sequences +ui ui.cocoa init ; +IN: tools.deploy.shaker.cocoa + +: pool ( obj -- obj' ) \ pool get [ ] cache ; + +: pool-array ( obj -- obj' ) [ pool ] map pool ; + +: pool-keys ( assoc -- assoc' ) [ [ pool-array ] dip ] assoc-map ; + +: pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ; + +IN: cocoa.application + +: objc-error ( error -- ) die ; + +[ [ die ] 19 setenv ] "cocoa.application" add-init-hook "stop-after-last-window?" get -global [ - stop-after-last-window? set - [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global +H{ } clone \ pool [ + global [ + stop-after-last-window? set - ! Only keeps those methods that we actually call - sent-messages get super-sent-messages get assoc-union - objc-methods [ assoc-intersect ] change + [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global - sent-messages get - super-sent-messages get - [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@ - super-message-senders [ assoc-intersect ] change - message-senders [ assoc-intersect ] change + ! Only keeps those methods that we actually call + sent-messages get super-sent-messages get assoc-union + objc-methods [ assoc-intersect pool-values ] change - sent-messages off - super-sent-messages off + sent-messages get + super-sent-messages get + [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@ + super-message-senders [ assoc-intersect pool-keys ] change + message-senders [ assoc-intersect pool-keys ] change - alien>objc-types off - objc>alien-types off + sent-messages off + super-sent-messages off - ! We need this for strip-stack-traces to work fully - { message-senders super-message-senders } - [ get values compile ] each -] bind + alien>objc-types off + objc>alien-types off + + ! We need this for strip-stack-traces to work fully + { message-senders super-message-senders } + [ get values compile ] each + ] bind +] with-variable diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index f92c9c0fd5..577ad133e1 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -125,7 +125,8 @@ ERROR: bad-superclass class ; } cond ; : boa-check-quot ( class -- quot ) - all-slots [ class>> instance-check-quot ] map spread>quot ; + all-slots [ class>> instance-check-quot ] map spread>quot + f like ; : define-boa-check ( class -- ) dup boa-check-quot "boa-check" set-word-prop ; @@ -311,7 +312,7 @@ M: tuple-class new [ (clone) ] [ tuple-layout ] ?if ; M: tuple-class boa - [ "boa-check" word-prop call ] + [ "boa-check" word-prop [ call ] when* ] [ tuple-layout ] bi ; From d592106e93863f2cc4be967a6403002dc407475d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 19 Sep 2008 01:08:27 -0500 Subject: [PATCH 13/17] Fix inference --- basis/opengl/opengl.factor | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 2d1b644050..bae05f4244 100755 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -16,8 +16,6 @@ IN: opengl : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) [ first2 [ >fixnum ] bi@ ] bi@ ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : gl-color ( color -- ) first4 glColor4d ; inline : gl-clear-color ( color -- ) @@ -27,13 +25,11 @@ IN: opengl gl-clear-color GL_COLOR_BUFFER_BIT glClear ; : color>raw ( object -- r g b a ) - >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; + >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; -: set-color ( object -- ) color>raw glColor4d ; +: set-color ( object -- ) color>raw glColor4d ; : set-clear-color ( object -- ) color>raw glClearColor ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : gl-error ( -- ) glGetError dup zero? [ "GL error: " over gluErrorString append throw @@ -53,7 +49,9 @@ IN: opengl : (all-enabled) ( seq quot -- ) over [ glEnable ] each dip [ glDisable ] each ; inline : (all-enabled-client-state) ( seq quot -- ) - over [ glEnableClientState ] each dip [ glDisableClientState ] each ; inline + [ dup [ glEnableClientState ] each ] dip + dip + [ glDisableClientState ] each ; inline MACRO: all-enabled ( seq quot -- ) >r words>values r> [ (all-enabled) ] 2curry ; From c6db662b3b3d58e7036bd46dc4cca40e705f6ae3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 5 Aug 2008 04:38:01 -0500 Subject: [PATCH 14/17] Rice is a part of every healthy diet --- basis/tools/deploy/shaker/shaker.factor | 24 ++++++++++++++++++++---- vm/image.c | 18 ++++++++++++++++++ 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 8713be54bb..7a2aa1c299 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -42,6 +42,7 @@ IN: tools.deploy.shaker ] when strip-dictionary? [ "compiler.units" init-hooks get delete-at + "tools.vocabs" init-hooks get delete-at ] when ; : strip-debugger ( -- ) @@ -88,16 +89,28 @@ IN: tools.deploy.shaker ] [ "Remaining word properties:" print [ props>> keys ] gather . - ] bi ; + ] [ + H{ } clone '[ + [ [ _ [ ] cache ] map ] change-props drop + ] each + ] tri ; : stripped-word-props ( -- seq ) [ + strip-dictionary? deploy-compiler? get and [ + { + "combination" + "members" + "methods" + } % + ] when + strip-dictionary? [ { + "alias" "boa-check" "cannot-infer" "coercer" - "combination" "compiled-effect" "compiled-generic-uses" "compiled-uses" @@ -127,12 +140,10 @@ IN: tools.deploy.shaker "local-writer?" "local?" "macro" - "members" "memo-quot" "mixin" "method-class" "method-generic" - "methods" "modular-arithmetic" "no-compile" "optimizer-hooks" @@ -145,6 +156,8 @@ IN: tools.deploy.shaker "reader" "reading" "recursive" + "register" + "register-size" "shuffle" "slot-names" "slots" @@ -226,9 +239,12 @@ IN: tools.deploy.shaker "alarms" "tools" "io.launcher" + "random" } strip-vocab-globals % strip-dictionary? [ + "libraries" "alien" lookup , + { } { "cpu" } strip-vocab-globals % { diff --git a/vm/image.c b/vm/image.c index a0fa48d504..a668cb7913 100755 --- a/vm/image.c +++ b/vm/image.c @@ -169,8 +169,26 @@ DEFINE_PRIMITIVE(save_image) save_image(unbox_native_string()); } +void strip_compiled_quotations(void) +{ + begin_scan(); + CELL obj; + while((obj = next_object()) != F) + { + if(type_of(obj) == QUOTATION_TYPE) + { + F_QUOTATION *quot = untag_object(obj); + quot->compiledp = F; + } + } + gc_off = false; +} + DEFINE_PRIMITIVE(save_image_and_exit) { + /* This reduces deployed image size */ + strip_compiled_quotations(); + F_CHAR *path = unbox_native_string(); REGISTER_C_STRING(path); From 7155e422517885a7a271256fd989c158ca467de3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 19 Sep 2008 03:10:44 -0500 Subject: [PATCH 15/17] Better error messages --- basis/io/launcher/launcher.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index cc48ace60b..72535053eb 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -99,7 +99,7 @@ M: process hashcode* handle>> hashcode* ; GENERIC: >process ( obj -- process ) -ERROR: process-already-started ; +ERROR: process-already-started process ; M: process-already-started summary drop "Process has already been started once" ; @@ -116,7 +116,7 @@ HOOK: current-process-handle io-backend ( -- handle ) HOOK: run-process* io-backend ( process -- handle ) -ERROR: process-was-killed ; +ERROR: process-was-killed process ; : wait-for-process ( process -- status ) [ From 0a8980d37e649f990ea88daf098d05bdd4ffda08 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 19 Sep 2008 03:14:11 -0500 Subject: [PATCH 16/17] Better error messages in io.launcher --- basis/io/launcher/launcher.factor | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 72535053eb..7f1a3f4507 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -101,8 +101,10 @@ GENERIC: >process ( obj -- process ) ERROR: process-already-started process ; -M: process-already-started summary - drop "Process has already been started once" ; +M: process-already-started error. + "Process has already been started" print nl + "Launch descriptor:" print nl + process>> . ; M: process >process dup process-started? [ @@ -118,6 +120,13 @@ HOOK: run-process* io-backend ( process -- handle ) ERROR: process-was-killed process ; +M: process-was-killed error. + "Process was killed as a result of a call to" print + "kill-process, or a timeout" print + nl + "Launch descriptor:" print nl + process>> . ; + : wait-for-process ( process -- status ) [ dup handle>> From 005cdd4d3a6db484417fbeb3ff6f00e37c7949dd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 19 Sep 2008 11:22:40 -0500 Subject: [PATCH 17/17] tweaking hello-world deploy --- extra/hello-world/deploy.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/hello-world/deploy.factor b/extra/hello-world/deploy.factor index 403cb4737e..c683ef6e06 100755 --- a/extra/hello-world/deploy.factor +++ b/extra/hello-world/deploy.factor @@ -1,15 +1,15 @@ USING: tools.deploy.config ; H{ - { deploy-word-props? f } - { deploy-random? f } - { deploy-compiler? f } { deploy-c-types? f } - { deploy-ui? f } - { deploy-reflection 1 } - { deploy-threads? f } - { deploy-io 2 } - { deploy-word-defs? f } - { "stop-after-last-window?" t } { deploy-name "Hello world (console)" } + { deploy-threads? f } + { deploy-word-props? f } + { deploy-reflection 2 } + { deploy-random? f } + { deploy-io 2 } { deploy-math? f } + { deploy-ui? f } + { deploy-compiler? f } + { "stop-after-last-window?" t } + { deploy-word-defs? f } }