steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Minor parser combinators tweaks (hope doublec doesn't mind)

release
Slava Pestov 2007-11-24 18:07:01 -05:00
parent 43931a4a43
commit 6668b6a975
8 changed files with 149 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/fjsc/fjsc-tests.factor Normal file → Executable file
View File

@ -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

6
extra/fjsc/fjsc.factor Normal file → Executable file
View File

@ -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
extra/parser-combinators/parser-combinators-docs.factor Normal file → Executable file
View File

@ -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
extra/parser-combinators/parser-combinators.factor Normal file → Executable file
View File

@ -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 ;

6
extra/parser-combinators/replace/replace.factor Normal file → Executable file
View File

@ -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 ;

39
extra/parser-combinators/simple/simple-docs.factor Normal file → Executable file
View File

@ -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

3
extra/parser-combinators/simple/simple.factor Normal file → Executable file
View File

@ -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> ] <@ ;

2
extra/webapps/fjsc/fjsc.factor Normal file → Executable file
View File

@ -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