Minor parser combinators tweaks (hope doublec doesn't mind)
parent
43931a4a43
commit
6668b6a975
|
@ -4,31 +4,31 @@ USING: kernel tools.test parser-combinators lazy-lists fjsc ;
|
||||||
IN: temporary
|
IN: temporary
|
||||||
|
|
||||||
{ T{ ast-expression f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
{ T{ ast-expression f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
||||||
"55 2abc1 100" 'expression' parse car parse-result-parsed
|
"55 2abc1 100" 'expression' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-quotation f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
{ T{ ast-quotation f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
||||||
"[ 55 2abc1 100 ]" 'quotation' parse car parse-result-parsed
|
"[ 55 2abc1 100 ]" 'quotation' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-array f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
{ T{ ast-array f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
||||||
"{ 55 2abc1 100 }" 'array' parse car parse-result-parsed
|
"{ 55 2abc1 100 }" 'array' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-stack-effect f { } { "d" "e" "f" } } } [
|
{ T{ ast-stack-effect f { } { "d" "e" "f" } } } [
|
||||||
"( -- d e f )" 'stack-effect' parse car parse-result-parsed
|
"( -- d e f )" 'stack-effect' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-stack-effect f { "a" "b" "c" } { "d" "e" "f" } } } [
|
{ T{ ast-stack-effect f { "a" "b" "c" } { "d" "e" "f" } } } [
|
||||||
"( a b c -- d e f )" 'stack-effect' parse car parse-result-parsed
|
"( a b c -- d e f )" 'stack-effect' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-stack-effect f { "a" "b" "c" } { } } } [
|
{ T{ ast-stack-effect f { "a" "b" "c" } { } } } [
|
||||||
"( a b c -- )" 'stack-effect' parse car parse-result-parsed
|
"( a b c -- )" 'stack-effect' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-stack-effect f { } { } } } [
|
{ T{ ast-stack-effect f { } { } } } [
|
||||||
"( -- )" 'stack-effect' parse car parse-result-parsed
|
"( -- )" 'stack-effect' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ } [
|
{ } [
|
||||||
|
@ -37,18 +37,18 @@ IN: temporary
|
||||||
|
|
||||||
|
|
||||||
{ T{ ast-expression f { T{ ast-string f "abcd" } } } } [
|
{ T{ ast-expression f { T{ ast-string f "abcd" } } } } [
|
||||||
"\"abcd\"" 'statement' parse car parse-result-parsed
|
"\"abcd\"" 'statement' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-expression f { T{ ast-use f "foo" } } } } [
|
{ T{ ast-expression f { T{ ast-use f "foo" } } } } [
|
||||||
"USE: foo" 'statement' parse car parse-result-parsed
|
"USE: foo" 'statement' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-expression f { T{ ast-in f "foo" } } } } [
|
{ T{ ast-expression f { T{ ast-in f "foo" } } } } [
|
||||||
"IN: foo" 'statement' parse car parse-result-parsed
|
"IN: foo" 'statement' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ T{ ast-expression f { T{ ast-using f { "foo" "bar" } } } } } [
|
{ T{ ast-expression f { T{ ast-using f { "foo" "bar" } } } } } [
|
||||||
"USING: foo bar ;" 'statement' parse car parse-result-parsed
|
"USING: foo bar ;" 'statement' parse-1
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -328,7 +328,7 @@ M: wrapper (parse-factor-quotation) ( object -- ast )
|
||||||
GENERIC: fjsc-parse ( object -- ast )
|
GENERIC: fjsc-parse ( object -- ast )
|
||||||
|
|
||||||
M: string fjsc-parse ( object -- ast )
|
M: string fjsc-parse ( object -- ast )
|
||||||
'expression' parse car parse-result-parsed ;
|
'expression' parse-1 ;
|
||||||
|
|
||||||
M: quotation fjsc-parse ( object -- ast )
|
M: quotation fjsc-parse ( object -- ast )
|
||||||
[
|
[
|
||||||
|
@ -345,11 +345,11 @@ M: quotation fjsc-parse ( object -- ast )
|
||||||
] string-out ;
|
] string-out ;
|
||||||
|
|
||||||
: fjsc-compile* ( string -- string )
|
: fjsc-compile* ( string -- string )
|
||||||
'statement' parse car parse-result-parsed fjsc-compile ;
|
'statement' parse-1 fjsc-compile ;
|
||||||
|
|
||||||
: fc* ( string -- string )
|
: fc* ( string -- string )
|
||||||
[
|
[
|
||||||
'statement' parse car parse-result-parsed ast-expression-values do-expressions
|
'statement' parse-1 ast-expression-values do-expressions
|
||||||
] { } make [ write ] each ;
|
] { } make [ write ] each ;
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -11,6 +11,15 @@ HELP: list-of
|
||||||
"'items' is a parser that can parse the individual elements. 'separator' "
|
"'items' is a parser that can parse the individual elements. 'separator' "
|
||||||
"is a parser for the symbol that separatest them. The result tree of "
|
"is a parser for the symbol that separatest them. The result tree of "
|
||||||
"the resulting parser is an array of the parsed elements." }
|
"the resulting parser is an array of the parsed elements." }
|
||||||
{ $example "USE: parser-combinators" "\"1,2,3,4\" 'integer' \",\" token list-of parse car parse-result-parsed ." "{ 1 2 3 4 }" }
|
{ $example "USE: parser-combinators" "\"1,2,3,4\" 'integer' \",\" token list-of parse-1 ." "{ 1 2 3 4 }" }
|
||||||
{ $see-also list-of } ;
|
{ $see-also list-of } ;
|
||||||
|
|
||||||
|
HELP: any-char-parser
|
||||||
|
{ $values
|
||||||
|
{ "parser" "a parser object" } }
|
||||||
|
{ $description
|
||||||
|
"Return a parser that consumes a single value "
|
||||||
|
"from the input string. The value consumed is the "
|
||||||
|
"result of the parse." }
|
||||||
|
{ $examples
|
||||||
|
{ $example "USING: lazy-lists parser-combinators ;" "\"foo\" any-char-parser parse-1 ." "102" } } ;
|
||||||
|
|
|
@ -13,6 +13,9 @@ M: promise (parse) ( input parser -- list )
|
||||||
: parse ( input parser -- promise )
|
: parse ( input parser -- promise )
|
||||||
(parse) ;
|
(parse) ;
|
||||||
|
|
||||||
|
: parse-1 ( input parser -- result )
|
||||||
|
parse car parse-result-parsed ;
|
||||||
|
|
||||||
TUPLE: parse-result parsed unparsed ;
|
TUPLE: parse-result parsed unparsed ;
|
||||||
|
|
||||||
C: <parse-result> parse-result
|
C: <parse-result> parse-result
|
||||||
|
@ -46,6 +49,9 @@ M: satisfy-parser (parse) ( input parser -- list )
|
||||||
] if
|
] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
LAZY: any-char-parser ( -- parser )
|
||||||
|
[ drop t ] satisfy ;
|
||||||
|
|
||||||
TUPLE: epsilon-parser ;
|
TUPLE: epsilon-parser ;
|
||||||
|
|
||||||
C: epsilon epsilon-parser ( -- parser )
|
C: epsilon epsilon-parser ( -- parser )
|
||||||
|
@ -165,7 +171,7 @@ M: some-parser (parse) ( input parser -- result )
|
||||||
#! the parse is complete (the remaining input is empty),
|
#! the parse is complete (the remaining input is empty),
|
||||||
#! picks the first solution and only returns the parse
|
#! picks the first solution and only returns the parse
|
||||||
#! tree since the remaining input is empty.
|
#! tree since the remaining input is empty.
|
||||||
some-parser-p1 just parse car parse-result-parsed ;
|
some-parser-p1 just parse-1 ;
|
||||||
|
|
||||||
|
|
||||||
: <& ( parser1 parser2 -- parser )
|
: <& ( parser1 parser2 -- parser )
|
||||||
|
@ -251,4 +257,7 @@ LAZY: list-of ( items separator -- parser )
|
||||||
#! items themselves, return a parser that parses
|
#! items themselves, return a parser that parses
|
||||||
#! lists of those items. The parse tree is an
|
#! lists of those items. The parse tree is an
|
||||||
#! array of the parsed items.
|
#! array of the parsed items.
|
||||||
over &> <*> <&:> { } succeed <|> ;
|
dup <?> -rot over &> <*> <&:> &> { } succeed <|> ;
|
||||||
|
|
||||||
|
LAZY: surrounded-by ( parser start end -- parser' )
|
||||||
|
[ token ] 2apply swapd pack ;
|
|
@ -13,21 +13,21 @@ IN: parser-combinators
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
: search ( string parser -- seq )
|
: search ( string parser -- seq )
|
||||||
'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
|
any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
|
||||||
drop { }
|
drop { }
|
||||||
] [
|
] [
|
||||||
car parse-result-parsed [ ] subset
|
car parse-result-parsed [ ] subset
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: search* ( string parsers -- seq )
|
: search* ( string parsers -- seq )
|
||||||
unclip [ <|> ] reduce 'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
|
unclip [ <|> ] reduce any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
|
||||||
drop { }
|
drop { }
|
||||||
] [
|
] [
|
||||||
car parse-result-parsed [ ] subset
|
car parse-result-parsed [ ] subset
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: (replace) ( string parser -- seq )
|
: (replace) ( string parser -- seq )
|
||||||
'any-char' <|> <*> parse car parse-result-parsed ;
|
any-char-parser <|> <*> parse-1 ;
|
||||||
|
|
||||||
: replace ( string parser -- result )
|
: replace ( string parser -- result )
|
||||||
[ (replace) [ tree-write ] each ] string-out ;
|
[ (replace) [ tree-write ] each ] string-out ;
|
||||||
|
|
|
@ -3,17 +3,6 @@
|
||||||
USING: help.syntax help.markup parser-combinators
|
USING: help.syntax help.markup parser-combinators
|
||||||
parser-combinators.simple ;
|
parser-combinators.simple ;
|
||||||
|
|
||||||
HELP: 'any-char'
|
|
||||||
{ $values
|
|
||||||
{ "parser" "a parser object" } }
|
|
||||||
{ $description
|
|
||||||
"Return a parser that consumes a single value "
|
|
||||||
"from the input string. The value consumed is the "
|
|
||||||
"result of the parse." }
|
|
||||||
{ $examples
|
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"foo\" 'any-char' parse car parse-result-parsed ." "102" } }
|
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
|
||||||
HELP: 'digit'
|
HELP: 'digit'
|
||||||
{ $values
|
{ $values
|
||||||
{ "parser" "a parser object" } }
|
{ "parser" "a parser object" } }
|
||||||
|
@ -22,8 +11,7 @@ HELP: 'digit'
|
||||||
"the input string. The numeric value of the digit "
|
"the input string. The numeric value of the digit "
|
||||||
" consumed is the result of the parse." }
|
" consumed is the result of the parse." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse car parse-result-parsed ." "1" } }
|
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse-1 ." "1" } } ;
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
|
||||||
HELP: 'integer'
|
HELP: 'integer'
|
||||||
{ $values
|
{ $values
|
||||||
|
@ -33,9 +21,7 @@ HELP: 'integer'
|
||||||
"the input string. The numeric value of the integer "
|
"the input string. The numeric value of the integer "
|
||||||
" consumed is the result of the parse." }
|
" consumed is the result of the parse." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse car parse-result-parsed ." "123" } }
|
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse-1 ." "123" } } ;
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
|
||||||
HELP: 'string'
|
HELP: 'string'
|
||||||
{ $values
|
{ $values
|
||||||
{ "parser" "a parser object" } }
|
{ "parser" "a parser object" } }
|
||||||
|
@ -44,9 +30,7 @@ HELP: 'string'
|
||||||
"quotations from the input string. The string value "
|
"quotations from the input string. The string value "
|
||||||
" consumed is the result of the parse." }
|
" consumed is the result of the parse." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse car parse-result-parsed ." "\"foo\"" } }
|
{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse-1 ." "\"foo\"" } } ;
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
|
||||||
HELP: 'bold'
|
HELP: 'bold'
|
||||||
{ $values
|
{ $values
|
||||||
{ "parser" "a parser object" } }
|
{ "parser" "a parser object" } }
|
||||||
|
@ -55,10 +39,8 @@ HELP: 'bold'
|
||||||
"the '*' character from the input string. This is "
|
"the '*' character from the input string. This is "
|
||||||
"commonly used in markup languages to indicate bold "
|
"commonly used in markup languages to indicate bold "
|
||||||
"faced text." }
|
"faced text." }
|
||||||
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse car parse-result-parsed ." "\"foo\"" }
|
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse-1 ." "\"foo\"" }
|
||||||
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse car parse-result-parsed ." "\"<strong>foo</strong>\"" }
|
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse-1 ." "\"<strong>foo</strong>\"" } ;
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
|
||||||
HELP: 'italic'
|
HELP: 'italic'
|
||||||
{ $values
|
{ $values
|
||||||
{ "parser" "a parser object" } }
|
{ "parser" "a parser object" } }
|
||||||
|
@ -68,10 +50,8 @@ HELP: 'italic'
|
||||||
"commonly used in markup languages to indicate italic "
|
"commonly used in markup languages to indicate italic "
|
||||||
"faced text." }
|
"faced text." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse car parse-result-parsed ." "\"foo\"" }
|
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse-1 ." "\"foo\"" }
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse car parse-result-parsed ." "\"<emphasis>foo</emphasis>\"" } }
|
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse-1 ." "\"<emphasis>foo</emphasis>\"" } } ;
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
|
||||||
HELP: comma-list
|
HELP: comma-list
|
||||||
{ $values
|
{ $values
|
||||||
{ "element" "a parser object" } { "parser" "a parser object" } }
|
{ "element" "a parser object" } { "parser" "a parser object" } }
|
||||||
|
@ -80,5 +60,6 @@ HELP: comma-list
|
||||||
"'element' should be a parser that can parse the elements. The "
|
"'element' should be a parser that can parse the elements. The "
|
||||||
"result of the parser is a sequence of the parsed elements." }
|
"result of the parser is a sequence of the parsed elements." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: lazy-lists parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse car parse-result-parsed ." "{ 1 2 3 4 }" } }
|
{ $example "USING: lazy-lits parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse-1 ." "{ 1 2 3 4 }" } } ;
|
||||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
|
||||||
|
{ $see-also 'digit' 'integer' 'string' 'bold' 'italic' comma-list } related-words
|
||||||
|
|
|
@ -4,9 +4,6 @@ USING: kernel strings math sequences lazy-lists words
|
||||||
math.parser promises ;
|
math.parser promises ;
|
||||||
IN: parser-combinators
|
IN: parser-combinators
|
||||||
|
|
||||||
LAZY: 'any-char' ( -- parser )
|
|
||||||
[ drop t ] satisfy ;
|
|
||||||
|
|
||||||
: 'digit' ( -- parser )
|
: 'digit' ( -- parser )
|
||||||
[ digit? ] satisfy [ digit> ] <@ ;
|
[ digit? ] satisfy [ digit> ] <@ ;
|
||||||
|
|
||||||
|
|
|
@ -11,7 +11,7 @@ IN: webapps.fjsc
|
||||||
#! Compile the factor code as a string, outputting the http
|
#! Compile the factor code as a string, outputting the http
|
||||||
#! response containing the javascript.
|
#! response containing the javascript.
|
||||||
serving-text
|
serving-text
|
||||||
'expression' parse car parse-result-parsed fjsc-compile
|
'expression' parse-1 fjsc-compile
|
||||||
write flush ;
|
write flush ;
|
||||||
|
|
||||||
! The 'compile' action results in an URL that looks like
|
! The 'compile' action results in an URL that looks like
|
||||||
|
|
Loading…
Reference in New Issue