Merge git://factorcode.org/git/factor
Daniel Ehrenberg
commit
37a9d0d6db
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
IN: temporary
|
||||
USING: tools.test globs ;
|
||||
|
||||
[ f ] [ "abd" "fdf" glob-matches? ] unit-test
|
||||
[ f ] [ "fdsafas" "?" glob-matches? ] unit-test
|
||||
[ t ] [ "fdsafas" "*as" glob-matches? ] unit-test
|
||||
[ t ] [ "fdsafas" "*a*" glob-matches? ] unit-test
|
||||
[ t ] [ "fdsafas" "*a?" glob-matches? ] unit-test
|
||||
[ t ] [ "fdsafas" "*?" glob-matches? ] unit-test
|
||||
[ f ] [ "fdsafas" "*s?" glob-matches? ] unit-test
|
||||
[ t ] [ "a" "[abc]" glob-matches? ] unit-test
|
||||
[ f ] [ "a" "[^abc]" glob-matches? ] unit-test
|
||||
[ t ] [ "d" "[^abc]" glob-matches? ] unit-test
|
||||
[ f ] [ "foo.java" "*.{xml,txt}" glob-matches? ] unit-test
|
||||
[ t ] [ "foo.txt" "*.{xml,txt}" glob-matches? ] unit-test
|
||||
[ t ] [ "foo.xml" "*.{xml,txt}" glob-matches? ] unit-test
|
||||
[ f ] [ "foo." "*.{,xml,txt}" glob-matches? ] unit-test
|
||||
[ t ] [ "foo.{" "*.{" glob-matches? ] unit-test
|
||||
|
|
@ -0,0 +1,42 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: parser-combinators regexp lazy-lists sequences kernel
|
||||
promises ;
|
||||
IN: globs
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: 'char'
|
||||
[ ",*?" member? not ] satisfy ;
|
||||
|
||||
: 'string'
|
||||
'char' <+> [ token ] <@ ;
|
||||
|
||||
: 'escaped-char'
|
||||
"\\" token any-char-parser &> [ 1token ] <@ ;
|
||||
|
||||
: 'escaped-string'
|
||||
'string' 'escaped-char' <|> ;
|
||||
|
||||
DEFER: 'term'
|
||||
|
||||
: 'glob' ( -- parser )
|
||||
'term' <*> [ <and-parser> ] <@ ;
|
||||
|
||||
: 'union' ( -- parser )
|
||||
'glob' "," token nonempty-list-of "{" "}" surrounded-by
|
||||
[ <or-parser> ] <@ ;
|
||||
|
||||
LAZY: 'term'
|
||||
'union'
|
||||
'character-class' <|>
|
||||
"?" token [ drop any-char-parser ] <@ <|>
|
||||
"*" token [ drop any-char-parser <*> ] <@ <|>
|
||||
'escaped-string' <|> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <glob> 'glob' just parse-1 just ;
|
||||
|
||||
: glob-matches? ( input glob -- ? )
|
||||
<glob> parse nil? not ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Unix shell-style glob pattern matching
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
{ $subheading "Performance" }
|
||||
{ $list
|
||||
{ "Continuations are now supported by the static stack effect system. This means that the " { $link infer } " word and the optimizing compiler now both support code which uses continuations." }
|
||||
{ "Many words which previously ran in the interpreter, such as error handling and I/O, are now compiled to optimized machine code." }
|
||||
{ "A non-optimizing, just-in-time compiler replaces the interpreter with no loss in functionality or introspective ability." }
|
||||
{ "The non-optimizing compiler compiles quotations the first time they are called, generating a series of stack pushes and subroutine calls." }
|
||||
{ "The optimizing compiler now performs some more representation inference. Alien pointers are unboxed where possible. This improves performance of the " { $vocab-link "ogg.player" } " Ogg Theora video player considerably." }
|
||||
{ "The queue of sleeping tasks is now a sorted priority queue. This improves performance considerably when there is a large number of sleeping threads (Doug Coleman)" }
|
||||
{ "Improved hash code algorithm for sequences" }
|
||||
{ "New, efficient implementations of " { $link bit? } " and " { $link log2 } " runs in constant time for large bignums" }
|
||||
{ "New " { $link big-random } " word for generating large random numbers quickly" }
|
||||
{ "Improved profiler no longer has to be explicitly enabled and disabled with a recompile step; instead, the " { $link profile } " word can be used at any time, and it dynamically patches all words in the code heap to increment call counts. There is no overhead when the profiler is not in use." }
|
||||
}
|
||||
{ $subheading "IO" }
|
||||
{ $list
|
||||
{ "The " { $link "stream-protocol" } " has changed" }
|
||||
{ "New " { $link os-envs } " word to get the current set of environment variables" }
|
||||
{ "Redesigned " { $vocab-link "io.launcher" } " supports passing environment variables to the child process" }
|
||||
{ { $link <process-stream> } " implemented on Windows (Doug Coleman)" }
|
||||
{ "More robust Windows CE native I/O" }
|
||||
{ "Updated " { $vocab-link "io.mmap" } " for new module system, now supports Windows CE (Doug Coleman)" }
|
||||
{ { $vocab-link "io.sniffer" } " - packet sniffer library (Doug Coleman, Elie Chaftari)" }
|
||||
{ { $vocab-link "io.server" } " - improved logging support, logs to a file by default" }
|
||||
{ { $vocab-link "io.files" } " - several new file system manipulation words added" }
|
||||
{ { $vocab-link "tar" } " - tar file extraction in pure Factor (Doug Coleman)" }
|
||||
{ { $vocab-link "unix.linux" } ", " { $vocab-link "raptor" } " - ``Raptor Linux'', a set of alien bindings to low-level Linux features, such as network interface configuration, file system mounting/unmounting, etc, together with experimental boot scripts intended to entirely replace " { $snippet "/sbin/init" } ", " { $vocab-link "/etc/inittab" } " and " { $snippet "/etc/init.d/" } "." }
|
||||
}
|
||||
{ $subheading "Tools" }
|
||||
{ $list
|
||||
{ "Graphical deploy tool added - see " { $link "ui.tools.deploy" } }
|
||||
{ "The deploy tool now supports Windows" }
|
||||
{ { $vocab-link "network-clipboard" } " - clipboard synchronization with a simple TCP/IP protocol" }
|
||||
}
|
||||
{ $subheading "UI" }
|
||||
{ $list
|
||||
{ { $vocab-link "cairo" } " - updated for new module system, new features (Sampo Vuori)" }
|
||||
{ { $vocab-link "springies" } " - physics simulation UI demo (Eduardo Cavazos)" }
|
||||
{ { $vocab-link "ui.gadgets.buttons" } " - added check box and radio button gadgets" }
|
||||
{ "Double- and triple-click-drag now supported in the editor gadget to select words or lines at a time" }
|
||||
{ "Windows can be closed on request now using " { $link close-window } }
|
||||
{ "New icons (Elie Chaftari)" }
|
||||
}
|
||||
{ $subheading "Other" }
|
||||
{ $list
|
||||
{ "The " { $snippet "queues" } " vocabulary has been removed because its functionality is a subset of " { $vocab-link "dlists" } }
|
||||
{ "The " { $vocab-link "http.server.responder.cgi" } " vocabulary implements CGI support for the Factor HTTP server." }
|
||||
{ "The optimizing compiler no longer depends on the number tower and it is possible to bootstrap a minimal image by just passing " { $snippet "-include=compiler" } " to stage 2 bootstrap." }
|
||||
{ { $vocab-link "benchmarks.knucleotide" } " - new benchmark (Eric Mertens)" }
|
||||
{ { $vocab-link "channels" } " - concurrent message passing over message channels" }
|
||||
{ { $vocab-link "destructors" } " - deterministic scope-based resource deallocation (Doug Coleman)" }
|
||||
{ { $vocab-link "dlists" } " - various updates (Doug Coleman)" }
|
||||
{ { $vocab-link "editors.notepadpp" } " - Notepad++ integration (Doug Coleman)" }
|
||||
{ { $vocab-link "heaps" } " - updated for new module system and cleaned up (Doug Coleman)" }
|
||||
{ { $vocab-link "peg" } " - Parser Expression Grammars, a new appoach to parser construction, similar to parser combinators (Chris Double)" }
|
||||
{ { $vocab-link "regexp" } " - revived from " { $snippet "unmaintained/" } " and completely redesigned (Doug Coleman)" }
|
||||
{ { $vocab-link "tuple.lib" } " - some utility words for working with tuples (Doug Coleman)" }
|
||||
}
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
USING: help help.markup help.syntax help.topics
|
||||
namespaces words sequences classes assocs vocabs kernel
|
||||
arrays prettyprint.backend kernel.private io tools.browser
|
||||
generic ;
|
||||
generic math tools.profiler system ui ;
|
||||
IN: help.handbook
|
||||
|
||||
ARTICLE: "conventions" "Conventions"
|
||||
|
|
@ -222,6 +222,63 @@ ARTICLE: "handbook" "Factor documentation"
|
|||
USING: io.files io.sockets float-arrays inference ;
|
||||
|
||||
ARTICLE: "changes" "Changes in the latest release"
|
||||
{ $heading "Factor 0.91" }
|
||||
{ $subheading "Performance" }
|
||||
{ $list
|
||||
{ "Continuations are now supported by the static stack effect system. This means that the " { $link infer } " word and the optimizing compiler now both support code which uses continuations." }
|
||||
{ "Many words which previously ran in the interpreter, such as error handling and I/O, are now compiled to optimized machine code." }
|
||||
{ "A non-optimizing, just-in-time compiler replaces the interpreter with no loss in functionality or introspective ability." }
|
||||
{ "The non-optimizing compiler compiles quotations the first time they are called, generating a series of stack pushes and subroutine calls. It offers a 33%-50% performance increase over the interpreter." }
|
||||
{ "The optimizing compiler now performs some more representation inference. Alien pointers are unboxed where possible. This improves performance of the " { $vocab-link "ogg.player" } " Ogg Theora video player." }
|
||||
{ "The queue of sleeping tasks is now a sorted priority queue. This reduces overhead for workloads involving large numbers of sleeping threads (Doug Coleman)" }
|
||||
{ "Improved hash code algorithm for sequences" }
|
||||
{ "New, efficient implementations of " { $link bit? } " and " { $link log2 } " runs in constant time for large bignums" }
|
||||
{ "New " { $link big-random } " word for generating large random numbers quickly" }
|
||||
{ "Improved profiler no longer has to be explicitly enabled and disabled with a full recompile; instead, the " { $link profile } " word can be used at any time, and it dynamically patches words to increment call counts. There is no overhead when the profiler is not in use." }
|
||||
}
|
||||
{ $subheading "IO" }
|
||||
{ $list
|
||||
{ "More robust Windows CE native I/O" }
|
||||
{ "New " { $link os-envs } " word to get the current set of environment variables" }
|
||||
{ "Redesigned " { $vocab-link "io.launcher" } " supports passing environment variables to the child process" }
|
||||
{ { $link <process-stream> } " implemented on Windows (Doug Coleman)" }
|
||||
{ "Updated " { $vocab-link "io.mmap" } " for new module system, now supports Windows CE (Doug Coleman)" }
|
||||
{ { $vocab-link "io.sniffer" } " - packet sniffer library (Doug Coleman, Elie Chaftari)" }
|
||||
{ { $vocab-link "io.server" } " - improved logging support, logs to a file by default" }
|
||||
{ { $vocab-link "io.files" } " - several new file system manipulation words added" }
|
||||
{ { $vocab-link "tar" } " - tar file extraction in pure Factor (Doug Coleman)" }
|
||||
{ { $vocab-link "unix.linux" } ", " { $vocab-link "raptor" } " - ``Raptor Linux'', a set of alien bindings to low-level Linux features, such as network interface configuration, file system mounting/unmounting, etc, together with experimental boot scripts intended to entirely replace " { $snippet "/sbin/init" } ", " { $vocab-link "/etc/inittab" } " and " { $snippet "/etc/init.d/" } " (Eduardo Cavazos)." }
|
||||
}
|
||||
{ $subheading "Tools" }
|
||||
{ $list
|
||||
{ "Graphical deploy tool added - see " { $link "ui.tools.deploy" } }
|
||||
{ "The deploy tool now supports Windows" }
|
||||
{ { $vocab-link "network-clipboard" } " - clipboard synchronization with a simple TCP/IP protocol" }
|
||||
}
|
||||
{ $subheading "UI" }
|
||||
{ $list
|
||||
{ { $vocab-link "cairo" } " - updated for new module system, new features (Sampo Vuori)" }
|
||||
{ { $vocab-link "springies" } " - physics simulation UI demo (Eduardo Cavazos)" }
|
||||
{ { $vocab-link "ui.gadgets.buttons" } " - added check box and radio button gadgets" }
|
||||
{ "Double- and triple-click-drag now supported in the editor gadget to select words or lines at a time" }
|
||||
{ "Windows can be closed on request now using " { $link close-window } }
|
||||
{ "New icons (Elie Chaftari)" }
|
||||
}
|
||||
{ $subheading "Other" }
|
||||
{ $list
|
||||
{ "The " { $snippet "queues" } " vocabulary has been removed because its functionality is a subset of " { $vocab-link "dlists" } }
|
||||
{ "The " { $vocab-link "webapps.cgi" } " vocabulary implements CGI support for the Factor HTTP server." }
|
||||
{ "The optimizing compiler no longer depends on the number tower and it is possible to bootstrap a minimal image by just passing " { $snippet "-include=compiler" } " to stage 2 bootstrap." }
|
||||
{ { $vocab-link "benchmark.knucleotide" } " - new benchmark (Eric Mertens)" }
|
||||
{ { $vocab-link "channels" } " - concurrent message passing over message channels" }
|
||||
{ { $vocab-link "destructors" } " - deterministic scope-based resource deallocation (Doug Coleman)" }
|
||||
{ { $vocab-link "dlists" } " - various updates (Doug Coleman)" }
|
||||
{ { $vocab-link "editors.notepadpp" } " - Notepad++ integration (Doug Coleman)" }
|
||||
{ { $vocab-link "heaps" } " - updated for new module system and cleaned up (Doug Coleman)" }
|
||||
{ { $vocab-link "peg" } " - Parser Expression Grammars, a new appoach to parser construction, similar to parser combinators (Chris Double)" }
|
||||
{ { $vocab-link "regexp" } " - revived from " { $snippet "unmaintained/" } " and completely redesigned (Doug Coleman)" }
|
||||
{ { $vocab-link "tuple.lib" } " - some utility words for working with tuples (Doug Coleman)" }
|
||||
}
|
||||
{ $heading "Factor 0.90" }
|
||||
{ $subheading "Core" }
|
||||
{ $list
|
||||
|
|
@ -249,7 +306,7 @@ ARTICLE: "changes" "Changes in the latest release"
|
|||
"Most existing libraries were improved when ported to the new module system; the most notable changes include:"
|
||||
{ $list
|
||||
{ { $vocab-link "asn1" } ": ASN1 parser and writer. (Elie Chaftari)" }
|
||||
{ { $vocab-link "benchmarks" } ": new set of benchmarks." }
|
||||
{ { $vocab-link "benchmark" } ": new set of benchmarks." }
|
||||
{ { $vocab-link "cfdg" } ": Context-free design grammar implementation; see " { $url "http://www.chriscoyne.com/cfdg/" } ". (Eduardo Cavazos)" }
|
||||
{ { $vocab-link "cryptlib" } ": Cryptlib library binding. (Elie Chaftari)" }
|
||||
{ { $vocab-link "cryptlib.streams" } ": Streams which perform SSL encryption and decryption. (Matthew Willis)" }
|
||||
|
|
|
|||
|
|
@ -13,10 +13,10 @@ M: promise parse ( input parser -- list )
|
|||
TUPLE: parse-result parsed unparsed ;
|
||||
|
||||
: parse-1 ( input parser -- result )
|
||||
parse dup nil? [
|
||||
"Parse error" throw
|
||||
dupd parse dup nil? [
|
||||
"Cannot parse " rot append throw
|
||||
] [
|
||||
car parse-result-parsed
|
||||
nip car parse-result-parsed
|
||||
] if ;
|
||||
|
||||
C: <parse-result> parse-result
|
||||
|
|
@ -32,6 +32,8 @@ M: token-parser parse ( input parser -- list )
|
|||
2drop nil
|
||||
] if ;
|
||||
|
||||
: 1token ( n -- parser ) 1string token ;
|
||||
|
||||
TUPLE: satisfy-parser quot ;
|
||||
|
||||
C: satisfy satisfy-parser ( quot -- parser )
|
||||
|
|
@ -91,6 +93,9 @@ TUPLE: and-parser parsers ;
|
|||
2array
|
||||
] if and-parser construct-boa ;
|
||||
|
||||
: <and-parser> ( parsers -- parser )
|
||||
dup length 1 = [ first ] [ and-parser construct-boa ] if ;
|
||||
|
||||
: and-parser-parse ( list p1 -- list )
|
||||
swap [
|
||||
dup parse-result-unparsed rot parse
|
||||
|
|
@ -109,15 +114,20 @@ M: and-parser parse ( input parser -- list )
|
|||
and-parser-parsers unclip swapd parse
|
||||
[ [ and-parser-parse ] reduce ] 2curry promise ;
|
||||
|
||||
TUPLE: or-parser p1 p2 ;
|
||||
TUPLE: or-parser parsers ;
|
||||
|
||||
C: <|> or-parser ( parser1 parser2 -- parser )
|
||||
: <or-parser> ( parsers -- parser )
|
||||
dup length 1 = [ first ] [ or-parser construct-boa ] if ;
|
||||
|
||||
: <|> ( parser1 parser2 -- parser )
|
||||
2array <or-parser> ;
|
||||
|
||||
M: or-parser parse ( input parser1 -- list )
|
||||
#! Return the combined list resulting from the parses
|
||||
#! of parser1 and parser2 being applied to the same
|
||||
#! input. This implements the choice parsing operator.
|
||||
[ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
|
||||
or-parser-parsers 0 swap seq>list
|
||||
[ parse ] lmap-with lconcat ;
|
||||
|
||||
: left-trim-slice ( string -- string )
|
||||
#! Return a new string without any leading whitespace
|
||||
|
|
|
|||
|
|
@ -12,6 +12,24 @@ IN: temporary
|
|||
"\"55\"" 'terminal' parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
! { } [
|
||||
! "digit = \"0\" | \"1\" | \"2\"" 'rule' parse parse-result-ast
|
||||
! ] unit-test
|
||||
{
|
||||
T{ ebnf-rule f
|
||||
"digit"
|
||||
T{ ebnf-choice f
|
||||
V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
|
||||
}
|
||||
}
|
||||
} [
|
||||
"digit = \"1\" | \"2\"" 'rule' parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{
|
||||
T{ ebnf-rule f
|
||||
"digit"
|
||||
T{ ebnf-sequence f
|
||||
V{ T{ ebnf-terminal f "1" } T{ ebnf-terminal f "2" } }
|
||||
}
|
||||
}
|
||||
} [
|
||||
"digit = \"1\" \"2\"" 'rule' parse parse-result-ast
|
||||
] unit-test
|
||||
|
|
@ -1,15 +1,23 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel arrays strings math.parser sequences namespaces peg ;
|
||||
USING: kernel parser words arrays strings math.parser sequences namespaces peg ;
|
||||
IN: peg.ebnf
|
||||
|
||||
TUPLE: ebnf-non-terminal symbol ;
|
||||
TUPLE: ebnf-terminal symbol ;
|
||||
TUPLE: ebnf-choice options ;
|
||||
TUPLE: ebnf-sequence elements ;
|
||||
TUPLE: ebnf-repeat0 group ;
|
||||
TUPLE: ebnf-rule symbol elements ;
|
||||
TUPLE: ebnf rules ;
|
||||
|
||||
C: <ebnf-non-terminal> ebnf-non-terminal
|
||||
C: <ebnf-terminal> ebnf-terminal
|
||||
C: <ebnf-choice> ebnf-choice
|
||||
C: <ebnf-sequence> ebnf-sequence
|
||||
C: <ebnf-repeat0> ebnf-repeat0
|
||||
C: <ebnf-rule> ebnf-rule
|
||||
C: <ebnf> ebnf
|
||||
|
||||
GENERIC: ebnf-compile ( ast -- quot )
|
||||
|
||||
|
|
@ -18,6 +26,11 @@ M: ebnf-terminal ebnf-compile ( ast -- quot )
|
|||
ebnf-terminal-symbol , \ token ,
|
||||
] [ ] make ;
|
||||
|
||||
M: ebnf-non-terminal ebnf-compile ( ast -- quot )
|
||||
[
|
||||
ebnf-non-terminal-symbol , \ in , \ get , \ lookup , \ execute ,
|
||||
] [ ] make ;
|
||||
|
||||
M: ebnf-choice ebnf-compile ( ast -- quot )
|
||||
[
|
||||
[
|
||||
|
|
@ -25,7 +38,35 @@ M: ebnf-choice ebnf-compile ( ast -- quot )
|
|||
ebnf-compile ,
|
||||
] each
|
||||
] { } make ,
|
||||
[ call ] , \ map ,
|
||||
[ call ] , \ map , \ choice ,
|
||||
] [ ] make ;
|
||||
|
||||
M: ebnf-sequence ebnf-compile ( ast -- quot )
|
||||
[
|
||||
[
|
||||
ebnf-sequence-elements [
|
||||
ebnf-compile ,
|
||||
] each
|
||||
] { } make ,
|
||||
[ call ] , \ map , \ seq ,
|
||||
] [ ] make ;
|
||||
|
||||
M: ebnf-repeat0 ebnf-compile ( ast -- quot )
|
||||
[
|
||||
ebnf-repeat0-group ebnf-compile % \ repeat0 ,
|
||||
] [ ] make ;
|
||||
|
||||
M: ebnf-rule ebnf-compile ( ast -- quot )
|
||||
[
|
||||
dup ebnf-rule-symbol , \ in , \ get , \ create ,
|
||||
ebnf-rule-elements ebnf-compile , \ define-compound ,
|
||||
] [ ] make ;
|
||||
|
||||
M: ebnf ebnf-compile ( ast -- quot )
|
||||
[
|
||||
ebnf-rules [
|
||||
ebnf-compile %
|
||||
] each
|
||||
] [ ] make ;
|
||||
|
||||
DEFER: 'rhs'
|
||||
|
|
@ -40,7 +81,9 @@ DEFER: 'rhs'
|
|||
'non-terminal' 'terminal' 2array choice ;
|
||||
|
||||
: 'sequence' ( -- parser )
|
||||
'element' sp repeat1 ;
|
||||
'element' sp
|
||||
"|" token sp ensure-not 2array seq [ first ] action
|
||||
repeat1 [ <ebnf-sequence> ] action ;
|
||||
|
||||
: 'choice' ( -- parser )
|
||||
'element' sp "|" token sp list-of [ <ebnf-choice> ] action ;
|
||||
|
|
@ -49,17 +92,29 @@ DEFER: 'rhs'
|
|||
"{" token sp hide
|
||||
[ 'rhs' sp ] delay
|
||||
"}" token sp hide
|
||||
3array seq ;
|
||||
3array seq [ first <ebnf-repeat0> ] action ;
|
||||
|
||||
: 'rhs' ( -- parser )
|
||||
'repeat0'
|
||||
'choice'
|
||||
'sequence'
|
||||
'choice'
|
||||
'element'
|
||||
4array choice ;
|
||||
|
||||
: 'rule' ( -- parser )
|
||||
'non-terminal'
|
||||
"=" token sp
|
||||
'non-terminal' [ ebnf-non-terminal-symbol ] action
|
||||
"=" token sp hide
|
||||
'rhs'
|
||||
3array seq ;
|
||||
3array seq [ first2 <ebnf-rule> ] action ;
|
||||
|
||||
: 'ebnf' ( -- parser )
|
||||
'rule' sp "." token sp hide list-of [ <ebnf> ] action ;
|
||||
|
||||
: ebnf>quot ( string -- quot )
|
||||
'ebnf' parse [
|
||||
parse-result-ast ebnf-compile
|
||||
] [
|
||||
f
|
||||
] if* ;
|
||||
|
||||
: <EBNF "EBNF>" parse-tokens "" join ebnf>quot call ; parsing
|
||||
|
|
@ -29,6 +29,7 @@ IN: regexp-tests
|
|||
[ f ] [ "" "." matches? ] unit-test
|
||||
[ t ] [ "a" "." matches? ] unit-test
|
||||
[ t ] [ "." "." matches? ] unit-test
|
||||
[ f ] [ "\n" "." matches? ] unit-test
|
||||
|
||||
[ f ] [ "" ".+" matches? ] unit-test
|
||||
[ t ] [ "a" ".+" matches? ] unit-test
|
||||
|
|
@ -75,3 +76,68 @@ IN: regexp-tests
|
|||
[ t ] [ "aaa" "a{1,3}" matches? ] unit-test
|
||||
[ f ] [ "aaaa" "a{1,3}" matches? ] unit-test
|
||||
|
||||
[ f ] [ "" "[a]" matches? ] unit-test
|
||||
[ t ] [ "a" "[a]" matches? ] unit-test
|
||||
[ t ] [ "a" "[abc]" matches? ] unit-test
|
||||
[ f ] [ "b" "[a]" matches? ] unit-test
|
||||
[ f ] [ "d" "[abc]" matches? ] unit-test
|
||||
[ t ] [ "ab" "[abc]{1,2}" matches? ] unit-test
|
||||
[ f ] [ "abc" "[abc]{1,2}" matches? ] unit-test
|
||||
|
||||
[ f ] [ "" "[^a]" matches? ] unit-test
|
||||
[ f ] [ "a" "[^a]" matches? ] unit-test
|
||||
[ f ] [ "a" "[^abc]" matches? ] unit-test
|
||||
[ t ] [ "b" "[^a]" matches? ] unit-test
|
||||
[ t ] [ "d" "[^abc]" matches? ] unit-test
|
||||
[ f ] [ "ab" "[^abc]{1,2}" matches? ] unit-test
|
||||
[ f ] [ "abc" "[^abc]{1,2}" matches? ] unit-test
|
||||
|
||||
[ t ] [ "]" "[]]" matches? ] unit-test
|
||||
[ f ] [ "]" "[^]]" matches? ] unit-test
|
||||
|
||||
[ "^" "[^]" matches? ] unit-test-fails
|
||||
[ t ] [ "^" "[]^]" matches? ] unit-test
|
||||
[ t ] [ "]" "[]^]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "[" "[[]" matches? ] unit-test
|
||||
[ f ] [ "^" "[^^]" matches? ] unit-test
|
||||
[ t ] [ "a" "[^^]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "-" "[-]" matches? ] unit-test
|
||||
[ f ] [ "a" "[-]" matches? ] unit-test
|
||||
[ f ] [ "-" "[^-]" matches? ] unit-test
|
||||
[ t ] [ "a" "[^-]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "-" "[-a]" matches? ] unit-test
|
||||
[ t ] [ "a" "[-a]" matches? ] unit-test
|
||||
[ t ] [ "-" "[a-]" matches? ] unit-test
|
||||
[ t ] [ "a" "[a-]" matches? ] unit-test
|
||||
[ f ] [ "b" "[a-]" matches? ] unit-test
|
||||
[ f ] [ "-" "[^-]" matches? ] unit-test
|
||||
[ t ] [ "a" "[^-]" matches? ] unit-test
|
||||
|
||||
[ f ] [ "-" "[a-c]" matches? ] unit-test
|
||||
[ t ] [ "-" "[^a-c]" matches? ] unit-test
|
||||
[ t ] [ "b" "[a-c]" matches? ] unit-test
|
||||
[ f ] [ "b" "[^a-c]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "-" "[a-c-]" matches? ] unit-test
|
||||
[ f ] [ "-" "[^a-c-]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "\\" "[\\\\]" matches? ] unit-test
|
||||
[ f ] [ "a" "[\\\\]" matches? ] unit-test
|
||||
[ f ] [ "\\" "[^\\\\]" matches? ] unit-test
|
||||
[ t ] [ "a" "[^\\\\]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "0" "[\\d]" matches? ] unit-test
|
||||
[ f ] [ "a" "[\\d]" matches? ] unit-test
|
||||
[ f ] [ "0" "[^\\d]" matches? ] unit-test
|
||||
[ t ] [ "a" "[^\\d]" matches? ] unit-test
|
||||
|
||||
[ t ] [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" matches? ] unit-test
|
||||
[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" matches? ] unit-test
|
||||
[ 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
|
||||
|
||||
|
|
|
|||
|
|
@ -1,21 +1,37 @@
|
|||
USING: combinators kernel lazy-lists math math.parser
|
||||
USING: arrays combinators kernel lazy-lists math math.parser
|
||||
namespaces parser parser-combinators parser-combinators.simple
|
||||
promises sequences strings ;
|
||||
promises quotations sequences sequences.lib strings ;
|
||||
USING: continuations io prettyprint ;
|
||||
IN: regexp
|
||||
|
||||
: 'any-char'
|
||||
"." token [ drop any-char-parser ] <@ ;
|
||||
|
||||
: escaped-char
|
||||
{
|
||||
{ CHAR: d [ [ digit? ] ] }
|
||||
{ CHAR: D [ [ digit? not ] ] }
|
||||
{ CHAR: s [ [ blank? ] ] }
|
||||
{ CHAR: S [ [ blank? not ] ] }
|
||||
{ CHAR: \\ [ [ CHAR: \\ = ] ] }
|
||||
[ "bad \\, use \\\\ to match a literal \\" throw ]
|
||||
} case ;
|
||||
|
||||
: 'escaped-char'
|
||||
"\\" token any-char-parser &> ;
|
||||
"\\" token any-char-parser &> [ escaped-char ] <@ ;
|
||||
|
||||
! Must escape to use as literals
|
||||
! : meta-chars "[\\^$.|?*+()" ;
|
||||
|
||||
: 'ordinary-char'
|
||||
[ "*+?|(){}" member? not ] satisfy ;
|
||||
[ "\\^*+?|(){}[" member? not ] satisfy ;
|
||||
|
||||
: 'char' 'escaped-char' 'ordinary-char' <|> ;
|
||||
|
||||
: 'string' 'char' <+> [ >string token ] <@ ;
|
||||
: 'string'
|
||||
'char' <+> [
|
||||
[ dup quotation? [ satisfy ] [ 1token ] if ] [ <&> ] map-reduce
|
||||
] <@ ;
|
||||
|
||||
: exactly-n ( parser n -- parser' )
|
||||
swap <repetition> and-parser construct-boa ;
|
||||
|
|
@ -45,51 +61,54 @@ C: <group-result> group-result
|
|||
'regexp' [ [ <group-result> ] <@ ] <@
|
||||
")" token <& &> ;
|
||||
|
||||
! Special cases: ]\\^-
|
||||
: 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 ;
|
||||
|
||||
: 'range'
|
||||
any-char-parser "-" token <& any-char-parser <&>
|
||||
[ first2 [ between? ] 2curry ] <@ ;
|
||||
|
||||
: 'character-class-contents'
|
||||
'escaped-char'
|
||||
'range' <|>
|
||||
[ "\\]" member? not ] satisfy <|> ;
|
||||
|
||||
: 'character-class'
|
||||
"[" 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 <& ;
|
||||
|
||||
: 'term'
|
||||
'any-char'
|
||||
'string' <|>
|
||||
'grouping' <|>
|
||||
'character-class' <|>
|
||||
<+> [
|
||||
dup length 1 =
|
||||
[ first ] [ and-parser construct-boa ] if
|
||||
] <@ ;
|
||||
|
||||
: 'interval'
|
||||
'term'
|
||||
"{" token
|
||||
'integer' <?> &>
|
||||
"," token <?> <:&:>
|
||||
'integer' <?> <:&:>
|
||||
"}" token <& <&> [
|
||||
first2 dup length {
|
||||
{ 1 [ first exactly-n ] }
|
||||
{ 2 [ first2 dup integer?
|
||||
[ nip at-most-n ]
|
||||
[ drop at-least-n ] if ] }
|
||||
{ 3 [ first3 nip from-m-to-n ] }
|
||||
} case
|
||||
] <@ ;
|
||||
|
||||
: 'character-range'
|
||||
any-char-parser "-" token <& any-char-parser &> ;
|
||||
|
||||
: 'character-class-inside'
|
||||
any-char-parser
|
||||
'character-range' <|> ;
|
||||
|
||||
: 'character-class-inclusive'
|
||||
"[" token
|
||||
'character-class-inside'
|
||||
"]" token ;
|
||||
|
||||
: 'character-class-exclusive'
|
||||
"[^" token
|
||||
'character-class-inside'
|
||||
"]" token ;
|
||||
|
||||
: 'character-class'
|
||||
'character-class-inclusive'
|
||||
'character-class-exclusive' <|> ;
|
||||
'term' "{" token <& 'integer' <&> "}" token <& [ first2 exactly-n ] <@
|
||||
'term' "{" token <& 'integer' <&> "," token <& "}" token <&
|
||||
[ first2 at-least-n ] <@ <|>
|
||||
'term' "{" token <& "," token <& 'integer' <&> "}" token <&
|
||||
[ first2 at-most-n ] <@ <|>
|
||||
'term' "{" token <& 'integer' <&> "," token <& 'integer' <:&> "}" token <&
|
||||
[ first3 from-m-to-n ] <@ <|> ;
|
||||
|
||||
: 'repetition'
|
||||
'term'
|
||||
|
|
@ -113,7 +132,6 @@ LAZY: 'regexp' ( -- parser )
|
|||
|
||||
: <regexp> 'regexp' just parse-1 ;
|
||||
|
||||
|
||||
GENERIC: >regexp ( obj -- parser )
|
||||
M: string >regexp 'regexp' just parse-1 ;
|
||||
M: object >regexp ;
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ debugger "gestures" f {
|
|||
|
||||
\ :help H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
|
||||
\ :edit H{ { +nullary+ t } } define-command
|
||||
\ :edit H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
|
||||
debugger "toolbar" f {
|
||||
{ T{ key-down f f "s" } com-traceback }
|
||||
|
|
|
|||
Loading…
Reference in New Issue