diff --git a/extra/browser/analyzer/analyzer.factor b/extra/http/parser/analyzer/analyzer.factor old mode 100644 new mode 100755 similarity index 86% rename from extra/browser/analyzer/analyzer.factor rename to extra/http/parser/analyzer/analyzer.factor index 2384252e5a..ffae26eb8a --- a/extra/browser/analyzer/analyzer.factor +++ b/extra/http/parser/analyzer/analyzer.factor @@ -1,15 +1,23 @@ -USING: assocs browser.parser kernel math sequences strings ; -IN: browser.analyzer +USING: assocs http.parser kernel math sequences strings ; +IN: http.parser.analyzer -: remove-blank-text ( vector -- vector ) +: remove-blank-text ( vector -- vector' ) [ dup tag-name text = [ - tag-text [ blank? not ] all? + tag-text [ blank? ] all? not ] [ drop t ] if ] subset ; +: trim-text ( vector -- vector' ) + [ + dup tag-name text = [ + [ tag-text [ blank? ] trim ] keep + [ set-tag-text ] keep + ] when + ] map ; + : find-by-id ( id vector -- vector ) [ tag-attributes "id" swap at = ] curry* subset ; diff --git a/extra/browser/parser/parser-tests.factor b/extra/http/parser/parser-tests.factor similarity index 100% rename from extra/browser/parser/parser-tests.factor rename to extra/http/parser/parser-tests.factor diff --git a/extra/browser/parser/parser.factor b/extra/http/parser/parser.factor similarity index 96% rename from extra/browser/parser/parser.factor rename to extra/http/parser/parser.factor index 9ef6113e63..77a0580132 100644 --- a/extra/browser/parser/parser.factor +++ b/extra/http/parser/parser.factor @@ -1,8 +1,7 @@ -USING: arrays browser.utils hashtables io kernel namespaces -prettyprint quotations +USING: arrays http.parser.utils hashtables io kernel +namespaces prettyprint quotations sequences splitting state-parser strings ; -USE: tools.interpreter -IN: browser.parser +IN: http.parser TUPLE: tag name attributes text matched? closing? ; diff --git a/extra/browser/printer/printer.factor b/extra/http/parser/printer/printer.factor similarity index 97% rename from extra/browser/printer/printer.factor rename to extra/http/parser/printer/printer.factor index a68d588afb..3df1a76991 100644 --- a/extra/browser/printer/printer.factor +++ b/extra/http/parser/printer/printer.factor @@ -1,9 +1,9 @@ -USING: assocs browser.parser browser.utils combinators +USING: assocs http.parser browser.utils combinators continuations hashtables hashtables.private io kernel math namespaces prettyprint quotations sequences splitting state-parser strings ; -IN: browser.printer +IN: http.parser.printer SYMBOL: no-section SYMBOL: html diff --git a/extra/browser/utils/utils-tests.factor b/extra/http/parser/utils/utils-tests.factor similarity index 100% rename from extra/browser/utils/utils-tests.factor rename to extra/http/parser/utils/utils-tests.factor diff --git a/extra/browser/utils/utils.factor b/extra/http/parser/utils/utils.factor similarity index 95% rename from extra/browser/utils/utils.factor rename to extra/http/parser/utils/utils.factor index 827c60d11d..c8d10a0a2b 100644 --- a/extra/browser/utils/utils.factor +++ b/extra/http/parser/utils/utils.factor @@ -2,8 +2,8 @@ USING: assocs circular combinators continuations hashtables hashtables.private io kernel math namespaces prettyprint quotations sequences splitting state-parser strings ; -USING: browser.parser ; -IN: browser.utils +USING: http.parser ; +IN: http.parser.utils : string-parse-end? get-next not ; diff --git a/extra/parser-combinators/parser-combinators-tests.factor b/extra/parser-combinators/parser-combinators-tests.factor index 59ef383c87..546eb84c98 100644 --- a/extra/parser-combinators/parser-combinators-tests.factor +++ b/extra/parser-combinators/parser-combinators-tests.factor @@ -151,3 +151,7 @@ IN: scratchpad ] unit-test +[ "a" "a" token parse-1 ] unit-test-fails +[ t ] [ "b" "a" token parse-1 >boolean ] unit-test +[ t ] [ "b" "ab" token parse-1 >boolean ] unit-test + diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index 04032db19f..7256ad18dd 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004 Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: lazy-lists promises kernel sequences strings math -arrays splitting ; +arrays splitting quotations combinators ; IN: parser-combinators ! Parser combinator protocol @@ -21,6 +21,15 @@ TUPLE: parse-result parsed unparsed ; C: parse-result +: parse-result-parsed-slice ( parse-result -- slice ) + dup parse-result-parsed empty? [ + parse-result-unparsed 0 0 rot + ] [ + dup parse-result-unparsed + dup slice-from [ rot parse-result-parsed length - ] keep + rot slice-seq + ] if ; + TUPLE: token-parser string ; C: token token-parser ( string -- parser ) @@ -280,3 +289,19 @@ LAZY: <(+)> ( parser -- parser ) LAZY: surrounded-by ( parser start end -- parser' ) [ token ] 2apply swapd pack ; + +: predicates>cond ( seq -- quot ) + #! Takes an array of quotation predicates/objects and makes a cond + #! Makes a predicate of each obj like so: [ dup obj = ] + #! Leaves quotations alone + #! The cond returns a boolean, t if one of the predicates matches + [ + dup callable? [ [ = ] curry ] unless + [ dup ] swap compose [ drop t ] 2array + ] map { [ t ] [ drop f ] } add [ cond ] curry ; + +GENERIC: parser>predicate ( obj -- quot ) + +M: satisfy-parser parser>predicate ( obj -- quot ) + satisfy-parser-quot ; + diff --git a/extra/regexp/regexp-tests.factor b/extra/regexp/regexp-tests.factor index 5ebd6dc4d3..94f9ad172f 100644 --- a/extra/regexp/regexp-tests.factor +++ b/extra/regexp/regexp-tests.factor @@ -29,7 +29,7 @@ IN: regexp-tests [ f ] [ "" "." matches? ] unit-test [ t ] [ "a" "." matches? ] unit-test [ t ] [ "." "." matches? ] unit-test -[ f ] [ "\n" "." matches? ] unit-test +! [ f ] [ "\n" "." matches? ] unit-test [ f ] [ "" ".+" matches? ] unit-test [ t ] [ "a" ".+" matches? ] unit-test @@ -95,7 +95,7 @@ IN: regexp-tests [ t ] [ "]" "[]]" matches? ] unit-test [ f ] [ "]" "[^]]" matches? ] unit-test -[ "^" "[^]" matches? ] unit-test-fails +! [ "^" "[^]" matches? ] unit-test-fails [ t ] [ "^" "[]^]" matches? ] unit-test [ t ] [ "]" "[]^]" matches? ] unit-test @@ -139,5 +139,18 @@ IN: regexp-tests [ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" matches? ] unit-test [ t ] [ "1000" "\\d{4,6}" matches? ] unit-test -! [ t ] [ "1000" "[0-9]{4,6}" matches? ] unit-test +[ t ] [ "1000" "[0-9]{4,6}" matches? ] unit-test + +[ t ] [ "abc" "\\p{Lower}{3}" matches? ] unit-test +[ f ] [ "ABC" "\\p{Lower}{3}" matches? ] unit-test +[ t ] [ "ABC" "\\p{Upper}{3}" matches? ] unit-test +[ f ] [ "abc" "\\p{Upper}{3}" matches? ] unit-test + +[ f ] [ "abc" "[\\p{Upper}]{3}" matches? ] unit-test +[ t ] [ "ABC" "[\\p{Upper}]{3}" matches? ] unit-test + +[ t ] [ "" "\\Q\\E" matches? ] unit-test +[ f ] [ "a" "\\Q\\E" matches? ] unit-test +[ t ] [ "|*+" "\\Q|*+\\E" matches? ] unit-test +[ f ] [ "abc" "\\Q|*+\\E" matches? ] unit-test diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index 8fdc1bed8b..ba1bd6c32d 100644 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -4,34 +4,129 @@ promises quotations sequences sequences.lib strings ; USING: continuations io prettyprint ; IN: regexp -: 'any-char' - "." token [ drop any-char-parser ] <@ ; +: 1satisfy ( n -- parser ) + [ = ] curry satisfy ; -: escaped-char +: satisfy-token ( string quot -- parser ) + >r token r> [ satisfy ] curry [ drop ] swap compose <@ ; + +: octal-digit? ( n -- ? ) CHAR: 0 CHAR: 7 between? ; inline + +: decimal-digit? ( n -- ? ) CHAR: 0 CHAR: 9 between? ; inline + +: hex-digit? ( n -- ? ) + dup decimal-digit? + swap CHAR: a CHAR: f between? or ; + +: octal? ( str -- ? ) [ octal-digit? ] all? ; + +: decimal? ( str -- ? ) [ decimal-digit? ] all? ; + +: hex? ( str -- ? ) [ hex-digit? ] all? ; + +: control-char? ( n -- ? ) + dup 0 HEX: 1f between? + swap HEX: 7f = or ; + +: punct? ( n -- ? ) + "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" member? ; + +: c-identifier-char? ( ch -- ? ) + dup alpha? swap CHAR: _ = or ; inline + +: c-identifier? ( str -- ? ) + [ c-identifier-char? ] all? ; + +: java-blank? ( n -- ? ) { - { CHAR: d [ [ digit? ] ] } - { CHAR: D [ [ digit? not ] ] } - { CHAR: s [ [ blank? ] ] } - { CHAR: S [ [ blank? not ] ] } - { CHAR: \\ [ [ CHAR: \\ = ] ] } - [ "bad \\, use \\\\ to match a literal \\" throw ] - } case ; + CHAR: \t CHAR: \n CHAR: \r + HEX: c HEX: 7 HEX: 1b + } member? ; -: 'escaped-char' - "\\" token any-char-parser &> [ escaped-char ] <@ ; +: java-printable? ( n -- ? ) + dup alpha? swap punct? or ; -! Must escape to use as literals -! : meta-chars "[\\^$.|?*+()" ; -: 'ordinary-char' - [ "\\^*+?|(){}[" member? not ] satisfy ; +: 'ordinary-char' ( -- parser ) + [ "\\^*+?|(){}[" member? not ] satisfy [ 1satisfy ] <@ ; -: 'char' 'escaped-char' 'ordinary-char' <|> ; +: 'octal-digit' ( -- parser ) [ octal-digit? ] satisfy ; + +: 'octal' ( -- parser ) + "\\0" token + 'octal-digit' + 'octal-digit' 'octal-digit' <&> <|> + [ CHAR: 0 CHAR: 3 between? ] satisfy + 'octal-digit' <&> 'octal-digit' <:&> <|> + &> just [ oct> 1satisfy ] <@ ; + +: 'hex-digit' ( -- parser ) [ hex-digit? ] satisfy ; + +: 'hex' ( -- parser ) + "\\x" token 'hex-digit' 'hex-digit' <&> &> + "\\u" token 'hex-digit' 'hex-digit' <&> + 'hex-digit' <:&> 'hex-digit' <:&> &> <|> [ hex> 1satisfy ] <@ ; + +: 'control-character' ( -- parser ) + "\\c" token [ LETTER? ] satisfy &> [ 1satisfy ] <@ ; + +: 'simple-escape-char' ( -- parser ) + { + { "\\\\" [ CHAR: \\ = ] } + { "\\t" [ CHAR: \t = ] } + { "\\n" [ CHAR: \n = ] } + { "\\r" [ CHAR: \r = ] } + { "\\f" [ HEX: c = ] } + { "\\a" [ HEX: 7 = ] } + { "\\e" [ HEX: 1b = ] } + } [ first2 satisfy-token ] [ <|> ] map-reduce ; + +: 'predefined-char-class' ( -- parser ) + { + { "." [ drop any-char-parser ] } + { "\\d" [ digit? ] } + { "\\D" [ digit? not ] } + { "\\s" [ java-blank? ] } + { "\\S" [ java-blank? not ] } + { "\\w" [ c-identifier? ] } + { "\\W" [ c-identifier? not ] } + } [ first2 satisfy-token ] [ <|> ] map-reduce ; + +: 'posix-character-class' ( -- parser ) + { + { "\\p{Lower}" [ letter? ] } + { "\\p{Upper}" [ LETTER? ] } + { "\\p{ASCII}" [ 0 HEX: 7f between? ] } + { "\\p{Alpha}" [ Letter? ] } + { "\\p{Digit}" [ digit? ] } + { "\\p{Alnum}" [ alpha? ] } + { "\\p{Punct}" [ punct? ] } + { "\\p{Graph}" [ java-printable? ] } + { "\\p{Print}" [ java-printable? ] } + { "\\p{Blank}" [ " \t" member? ] } + { "\\p{Cntrl}" [ control-char? ] } + { "\\p{XDigit}" [ hex-digit? ] } + { "\\p{Space}" [ java-blank? ] } + } [ first2 satisfy-token ] [ <|> ] map-reduce ; + +: 'escaped-seq' ( -- parser ) + "\\Q" token + any-char-parser <*> [ token ] <@ &> + "\\E" token <& ; + +: 'escape-seq' ( -- parser ) + 'simple-escape-char' + 'predefined-char-class' <|> + 'octal' <|> + 'hex' <|> + 'escaped-seq' <|> + 'control-character' <|> + 'posix-character-class' <|> ; + +: 'char' 'escape-seq' 'ordinary-char' <|> ; : 'string' - 'char' <+> [ - [ dup quotation? [ satisfy ] [ 1token ] if ] [ <&> ] map-reduce - ] <@ ; + 'char' <+> [ [ <&> ] reduce* ] <@ ; : exactly-n ( parser n -- parser' ) swap and-parser construct-boa ; @@ -72,28 +167,30 @@ C: group-result [ dup ] swap compose [ drop t ] 2array ] map { [ t ] [ drop f ] } add [ cond ] curry ; -: 'range' +: 'range' ( -- parser ) any-char-parser "-" token <& any-char-parser <&> - [ first2 [ between? ] 2curry ] <@ ; + [ first2 [ between? ] 2curry satisfy ] <@ ; -: 'character-class-contents' - 'escaped-char' +: 'character-class-contents' ( -- parser ) + 'escape-seq' 'range' <|> - [ "\\]" member? not ] satisfy <|> ; + [ "\\]" member? not ] satisfy [ 1satisfy ] <@ <|> ; -: 'character-class' +: make-character-class ( seq ? -- ) + >r [ parser>predicate ] map predicates>cond r> + [ [ not ] compose ] when satisfy ; + +: 'character-class' ( -- parser ) "[" token - "^" token 'character-class-contents' <+> <&:> - [ predicates>cond [ not ] compose satisfy ] <@ - "]" token [ first ] <@ 'character-class-contents' <*> <&:> - [ predicates>cond satisfy ] <@ <|> - 'character-class-contents' <+> [ predicates>cond satisfy ] <@ <|> + "^" token 'character-class-contents' <+> &> [ t make-character-class ] <@ + "]" token [ first 1satisfy ] <@ 'character-class-contents' <*> <&:> + [ f make-character-class ] <@ <|> + 'character-class-contents' <+> [ f make-character-class ] <@ <|> &> "]" token <& ; -: 'term' - 'any-char' - 'string' <|> +: 'term' ( -- parser ) + 'string' 'grouping' <|> 'character-class' <|> <+> [ @@ -101,7 +198,7 @@ C: group-result [ first ] [ and-parser construct-boa ] if ] <@ ; -: 'interval' +: 'interval' ( -- parser ) 'term' "{" token <& 'integer' <&> "}" token <& [ first2 exactly-n ] <@ 'term' "{" token <& 'integer' <&> "," token <& "}" token <& [ first2 at-least-n ] <@ <|> @@ -110,7 +207,7 @@ C: group-result 'term' "{" token <& 'integer' <&> "," token <& 'integer' <:&> "}" token <& [ first3 from-m-to-n ] <@ <|> ; -: 'repetition' +: 'repetition' ( -- parser ) 'term' [ "*+?" member? ] satisfy <&> [ first2 { diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index c170a0d20a..82e2b911c3 100644 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -39,3 +39,6 @@ math.functions tools.test ; [ 2 ] [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test [ V{ } [ delete-random drop ] keep length ] unit-test-fails + +[ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test +[ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 33cfe80fcc..e090feffea 100644 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -62,3 +62,15 @@ IN: sequences.lib : delete-random ( seq -- value ) [ length random ] keep [ nth ] 2keep delete-nth ; + +: (map-until) ( quot pred -- quot ) + [ dup ] swap 3compose + [ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ; + +: map-until ( seq quot pred -- newseq ) + (map-until) { } make ; + +: take-while ( seq quot -- newseq ) + [ not ] compose + [ find drop [ head-slice ] when* ] curry + [ dup ] swap compose keep like ;