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

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

@ -4,51 +4,51 @@ USING: kernel tools.test parser-combinators lazy-lists fjsc ;
IN: temporary
{ 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
{ 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
{ 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
{ 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
{ 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
{ 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
{ T{ ast-stack-effect f { } { } } } [
"( -- )" 'stack-effect' parse car parse-result-parsed
"( -- )" 'stack-effect' parse-1
] unit-test
{ } [
": foo ( a b -- c d ) abcdefghijklmn 123 ;" 'expression' parse car drop
] unit-test
{ T{ ast-expression f { T{ ast-string f "abcd" } } } } [
"\"abcd\"" 'statement' parse car parse-result-parsed
] unit-test
{ T{ ast-expression f { T{ ast-string f "abcd" } } } } [
"\"abcd\"" 'statement' parse-1
] unit-test
{ T{ ast-expression f { T{ ast-use f "foo" } } } } [
"USE: foo" 'statement' parse car parse-result-parsed
"USE: foo" 'statement' parse-1
] unit-test
{ T{ ast-expression f { T{ ast-in f "foo" } } } } [
"IN: foo" 'statement' parse car parse-result-parsed
"IN: foo" 'statement' parse-1
] unit-test
{ 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

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

@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel lazy-lists parser-combinators parser-combinators.simple
strings promises sequences math math.parser namespaces words
strings promises sequences math math.parser namespaces words
quotations arrays hashtables io io.streams.string assocs ;
IN: fjsc
@ -53,11 +53,11 @@ C: <ast-hashtable> ast-hashtable
[ CHAR: ] = not ] keep
[ CHAR: ;" = not ] keep
[ CHAR: " = not ] keep
digit? not
digit? not
and and and and and ;
LAZY: 'identifier-ends' ( -- parser )
[
LAZY: 'identifier-ends' ( -- parser )
[
[ blank? not ] keep
[ CHAR: " = not ] keep
[ CHAR: ;" = not ] keep
@ -67,23 +67,23 @@ LAZY: 'identifier-ends' ( -- parser )
and and and and and
] satisfy <!*> ;
LAZY: 'identifier-middle' ( -- parser )
LAZY: 'identifier-middle' ( -- parser )
[ identifier-middle? ] satisfy <!+> ;
LAZY: 'identifier' ( -- parser )
'identifier-ends'
'identifier-ends'
'identifier-middle' <&>
'identifier-ends' <:&>
'identifier-ends' <:&>
[ concat >string f <ast-identifier> ] <@ ;
DEFER: 'expression'
LAZY: 'effect-name' ( -- parser )
[
[
[ blank? not ] keep
CHAR: - = not
and
and
] satisfy <!+> [ >string ] <@ ;
LAZY: 'stack-effect' ( -- parser )
@ -94,24 +94,24 @@ LAZY: 'stack-effect' ( -- parser )
")" token sp <& [ first2 <ast-stack-effect> ] <@ ;
LAZY: 'define' ( -- parser )
":" token sp
":" token sp
'identifier' sp [ ast-identifier-value ] <@ &>
'stack-effect' sp <!?> <&>
'expression' <:&>
";" token sp <& [ first3 <ast-define> ] <@ ;
LAZY: 'quotation' ( -- parser )
"[" token sp
"[" token sp
'expression' [ ast-expression-values ] <@ &>
"]" token sp <& [ <ast-quotation> ] <@ ;
LAZY: 'array' ( -- parser )
"{" token sp
"{" token sp
'expression' [ ast-expression-values ] <@ &>
"}" token sp <& [ <ast-array> ] <@ ;
LAZY: 'word' ( -- parser )
"\\" token sp
"\\" token sp
'identifier' sp &> [ ast-identifier-value f <ast-word> ] <@ ;
LAZY: 'atom' ( -- parser )
@ -137,7 +137,7 @@ LAZY: 'USING:' ( -- parser )
";" token sp <& [ <ast-using> ] <@ ;
LAZY: 'hashtable' ( -- parser )
"H{" token sp
"H{" token sp
'expression' [ ast-expression-values ] <@ &>
"}" token sp <& [ <ast-hashtable> ] <@ ;
@ -147,14 +147,14 @@ LAZY: 'parsing-word' ( -- parser )
'IN:' <|> ;
LAZY: 'expression' ( -- parser )
'comment'
'parsing-word' sp <|>
'quotation' sp <|>
'comment'
'parsing-word' sp <|>
'quotation' sp <|>
'define' sp <|>
'array' sp <|>
'hashtable' sp <|>
'word' sp <|>
'atom' sp <|>
'atom' sp <|>
<*> [ <ast-expression> ] <@ ;
LAZY: 'statement' ( -- parser )
@ -163,41 +163,41 @@ LAZY: 'statement' ( -- parser )
GENERIC: (compile) ( ast -- )
GENERIC: (literal) ( ast -- )
M: ast-number (literal)
M: ast-number (literal)
ast-number-value number>string , ;
M: ast-number (compile)
"factor.push_data(" ,
(literal)
"," , ;
M: ast-string (literal)
"\"" ,
ast-string-value ,
"\"" , ;
M: ast-string (compile)
M: ast-number (compile)
"factor.push_data(" ,
(literal)
"," , ;
M: ast-identifier (literal)
M: ast-string (literal)
"\"" ,
ast-string-value ,
"\"" , ;
M: ast-string (compile)
"factor.push_data(" ,
(literal)
"," , ;
M: ast-identifier (literal)
dup ast-identifier-vocab [
"factor.get_word(\"" ,
"factor.get_word(\"" ,
dup ast-identifier-vocab ,
"\",\"" ,
ast-identifier-value ,
"\")" ,
ast-identifier-value ,
"\")" ,
] [
"factor.find_word(\"" , ast-identifier-value , "\")" ,
"factor.find_word(\"" , ast-identifier-value , "\")" ,
] if ;
M: ast-identifier (compile)
M: ast-identifier (compile)
(literal) ".execute(" , ;
M: ast-define (compile)
"factor.define_word(\"" ,
dup ast-define-name ,
M: ast-define (compile)
"factor.define_word(\"" ,
dup ast-define-name ,
"\",\"source\"," ,
ast-define-expression (compile)
"," , ;
@ -207,7 +207,7 @@ M: ast-define (compile)
unclip
dup ast-comment? not [
"function() {" ,
(compile)
(compile)
do-expressions
")}" ,
] [
@ -217,74 +217,74 @@ M: ast-define (compile)
drop "factor.cont.next" ,
] if ;
M: ast-quotation (literal)
M: ast-quotation (literal)
"factor.make_quotation(\"source\"," ,
ast-quotation-values do-expressions
")" , ;
M: ast-quotation (compile)
M: ast-quotation (compile)
"factor.push_data(factor.make_quotation(\"source\"," ,
ast-quotation-values do-expressions
")," , ;
M: ast-array (literal)
"[" ,
M: ast-array (literal)
"[" ,
ast-array-elements [ "," , ] [ (literal) ] interleave
"]" , ;
M: ast-array (compile)
M: ast-array (compile)
"factor.push_data(" , (literal) "," , ;
M: ast-hashtable (literal)
"new Hashtable().fromAlist([" ,
M: ast-hashtable (literal)
"new Hashtable().fromAlist([" ,
ast-hashtable-elements [ "," , ] [ (literal) ] interleave
"])" , ;
M: ast-hashtable (compile)
M: ast-hashtable (compile)
"factor.push_data(" , (literal) "," , ;
M: ast-expression (literal)
ast-expression-values [
(literal)
(literal)
] each ;
M: ast-expression (compile)
ast-expression-values do-expressions ;
M: ast-word (literal)
M: ast-word (literal)
dup ast-word-vocab [
"factor.get_word(\"" ,
"factor.get_word(\"" ,
dup ast-word-vocab ,
"\",\"" ,
ast-word-value ,
"\")" ,
ast-word-value ,
"\")" ,
] [
"factor.find_word(\"" , ast-word-value , "\")" ,
"factor.find_word(\"" , ast-word-value , "\")" ,
] if ;
M: ast-word (compile)
"factor.push_data(" ,
(literal)
"," , ;
M: ast-comment (compile)
drop ;
M: ast-stack-effect (compile)
drop ;
M: ast-use (compile)
M: ast-use (compile)
"factor.use(\"" ,
ast-use-name ,
ast-use-name ,
"\"," , ;
M: ast-in (compile)
M: ast-in (compile)
"factor.set_in(\"" ,
ast-in-name ,
ast-in-name ,
"\"," , ;
M: ast-using (compile)
M: ast-using (compile)
"factor.using([" ,
ast-using-names [
"," ,
@ -308,17 +308,17 @@ M: string (parse-factor-quotation) ( object -- ast )
<ast-string> ;
M: quotation (parse-factor-quotation) ( object -- ast )
[
[
[ (parse-factor-quotation) , ] each
] { } make <ast-quotation> ;
M: array (parse-factor-quotation) ( object -- ast )
[
[
[ (parse-factor-quotation) , ] each
] { } make <ast-array> ;
M: hashtable (parse-factor-quotation) ( object -- ast )
>alist [
>alist [
[ (parse-factor-quotation) , ] each
] { } make <ast-hashtable> ;
@ -328,33 +328,33 @@ M: wrapper (parse-factor-quotation) ( object -- ast )
GENERIC: 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 )
[
[ (parse-factor-quotation) , ] each
[ (parse-factor-quotation) , ] each
] { } make <ast-expression> ;
: fjsc-compile ( ast -- string )
[
[
[
"(" ,
(compile)
(compile)
")" ,
] { } make [ write ] each
] string-out ;
: fjsc-compile* ( string -- string )
'statement' parse car parse-result-parsed fjsc-compile ;
'statement' parse-1 fjsc-compile ;
: 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 ;
: fjsc-literal ( ast -- string )
[
[ (literal) ] { } make [ write ] each
] string-out ;

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

@ -3,14 +3,23 @@
USING: help.markup help.syntax parser-combinators ;
HELP: list-of
{ $values
{ $values
{ "items" "a parser object" } { "separator" "a parser object" } { "parser" "a parser object" } }
{ $description
{ $description
"Return a parser for parsing the repetition of things that are "
"separated by a certain symbol. For example, comma separated lists. "
"'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." }
{ $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 } ;
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" } } ;

43
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) ;
: parse-1 ( input parser -- result )
parse car parse-result-parsed ;
TUPLE: parse-result parsed unparsed ;
C: <parse-result> parse-result
@ -23,7 +26,7 @@ C: token token-parser ( string -- parser )
M: token-parser (parse) ( input parser -- list )
token-parser-string swap over ?head-slice [
<parse-result> 1list
<parse-result> 1list
] [
2drop nil
] if ;
@ -43,9 +46,12 @@ M: satisfy-parser (parse) ( input parser -- list )
swap <parse-result> 1list
] [
2drop nil
] if
] if
] if ;
LAZY: any-char-parser ( -- parser )
[ drop t ] satisfy ;
TUPLE: epsilon-parser ;
C: epsilon epsilon-parser ( -- parser )
@ -63,7 +69,7 @@ C: succeed succeed-parser ( result -- parser )
M: succeed-parser (parse) ( input parser -- list )
#! A parser that always returns 'result' as a
#! successful parse with no input consumed.
#! successful parse with no input consumed.
succeed-parser-result swap <parse-result> 1list ;
TUPLE: fail-parser ;
@ -81,7 +87,7 @@ TUPLE: and-parser parsers ;
over and-parser? [
>r and-parser-parsers r> add
] [
2array
2array
] if \ and-parser construct-boa ;
: and-parser-parse ( list p1 -- list )
@ -92,13 +98,13 @@ TUPLE: and-parser parsers ;
[ parse-result-parsed 2array ] keep
parse-result-unparsed <parse-result>
] lmap-with
] lmap-with lconcat ;
] lmap-with lconcat ;
M: and-parser (parse) ( input parser -- list )
#! Parse 'input' by sequentially combining the
#! two parsers. First parser1 is applied to the
#! input then parser2 is applied to the rest of
#! the input strings from the first parser.
#! the input strings from the first parser.
and-parser-parsers unclip swapd parse [ [ and-parser-parse ] reduce ] 2curry promise ;
TUPLE: or-parser p1 p2 ;
@ -115,7 +121,7 @@ M: or-parser (parse) ( input parser1 -- list )
#! Return a new string without any leading whitespace
#! from the original string.
dup empty? [
dup first blank? [ 1 tail-slice left-trim-slice ] when
dup first blank? [ 1 tail-slice left-trim-slice ] when
] unless ;
TUPLE: sp-parser p1 ;
@ -136,7 +142,7 @@ C: just just-parser ( p1 -- parser )
M: just-parser (parse) ( input parser -- result )
#! Calls the given parser on the input removes
#! from the results anything where the remaining
#! input to be parsed is not empty. So ensures a
#! input to be parsed is not empty. So ensures a
#! fully parsed input string.
just-parser-p1 parse [ parse-result-unparsed empty? ] lsubset ;
@ -150,8 +156,8 @@ M: apply-parser (parse) ( input parser -- result )
#! The result of that quotation then becomes the new parse result.
#! This allows modification of parse tree results (like
#! converting strings to integers, etc).
[ apply-parser-p1 ] keep apply-parser-quot
-rot parse [
[ apply-parser-p1 ] keep apply-parser-quot
-rot parse [
[ parse-result-parsed swap call ] keep
parse-result-unparsed <parse-result>
] lmap-with ;
@ -165,7 +171,7 @@ M: some-parser (parse) ( input parser -- result )
#! the parse is complete (the remaining input is empty),
#! picks the first solution and only returns the parse
#! 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 )
@ -230,13 +236,13 @@ LAZY: <!?> ( parser -- parser )
#! required.
<?> only-first ;
LAZY: <(*)> ( parser -- parser )
#! Like <*> but take shortest match first.
LAZY: <(*)> ( parser -- parser )
#! Like <*> but take shortest match first.
#! Implementation by Matthew Willis.
{ } succeed swap dup <(*)> <&:> <|> ;
LAZY: <(+)> ( parser -- parser )
#! Like <+> but take shortest match first.
#! Like <+> but take shortest match first.
#! Implementation by Matthew Willis.
dup <(*)> <&:> ;
@ -249,6 +255,9 @@ LAZY: pack ( close body open -- parser )
LAZY: list-of ( items separator -- parser )
#! Given a parser for the separator and for the
#! 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.
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 ;
: search ( string parser -- seq )
'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
drop { }
] [
car parse-result-parsed [ ] subset
] if ;
: search* ( string parsers -- seq )
unclip [ <|> ] reduce 'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
unclip [ <|> ] reduce any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
drop { }
] [
car parse-result-parsed [ ] subset
] if ;
: (replace) ( string parser -- seq )
'any-char' <|> <*> parse car parse-result-parsed ;
any-char-parser <|> <*> parse-1 ;
: replace ( string parser -- result )
[ (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
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'
{ $values
{ "parser" "a parser object" } }
@ -22,8 +11,7 @@ HELP: 'digit'
"the input string. The numeric value of the digit "
" consumed is the result of the parse." }
{ $examples
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse car parse-result-parsed ." "1" } }
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse-1 ." "1" } } ;
HELP: 'integer'
{ $values
@ -33,9 +21,7 @@ HELP: 'integer'
"the input string. The numeric value of the integer "
" consumed is the result of the parse." }
{ $examples
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse car parse-result-parsed ." "123" } }
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse-1 ." "123" } } ;
HELP: 'string'
{ $values
{ "parser" "a parser object" } }
@ -44,9 +30,7 @@ HELP: 'string'
"quotations from the input string. The string value "
" consumed is the result of the parse." }
{ $examples
{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse car parse-result-parsed ." "\"foo\"" } }
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse-1 ." "\"foo\"" } } ;
HELP: 'bold'
{ $values
{ "parser" "a parser object" } }
@ -55,10 +39,8 @@ HELP: 'bold'
"the '*' character from the input string. This is "
"commonly used in markup languages to indicate bold "
"faced text." }
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse car parse-result-parsed ." "\"foo\"" }
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse car parse-result-parsed ." "\"<strong>foo</strong>\"" }
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse-1 ." "\"foo\"" }
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse-1 ." "\"<strong>foo</strong>\"" } ;
HELP: 'italic'
{ $values
{ "parser" "a parser object" } }
@ -68,10 +50,8 @@ HELP: 'italic'
"commonly used in markup languages to indicate italic "
"faced text." }
{ $examples
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse car parse-result-parsed ." "\"foo\"" }
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse car parse-result-parsed ." "\"<emphasis>foo</emphasis>\"" } }
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse-1 ." "\"foo\"" }
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse-1 ." "\"<emphasis>foo</emphasis>\"" } } ;
HELP: comma-list
{ $values
{ "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 "
"result of the parser is a sequence of the parsed elements." }
{ $examples
{ $example "USING: lazy-lists parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse car parse-result-parsed ." "{ 1 2 3 4 }" } }
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
{ $example "USING: lazy-lits parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse-1 ." "{ 1 2 3 4 }" } } ;
{ $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 ;
IN: parser-combinators
LAZY: 'any-char' ( -- parser )
[ drop t ] satisfy ;
: 'digit' ( -- parser )
[ digit? ] satisfy [ digit> ] <@ ;

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

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel furnace fjsc parser-combinators namespaces
lazy-lists io io.files furnace.validator sequences
http.client http.server http.server.responders
lazy-lists io io.files furnace.validator sequences
http.client http.server http.server.responders
webapps.file ;
IN: webapps.fjsc
@ -11,15 +11,15 @@ IN: webapps.fjsc
#! Compile the factor code as a string, outputting the http
#! response containing the javascript.
serving-text
'expression' parse car parse-result-parsed fjsc-compile
'expression' parse-1 fjsc-compile
write flush ;
! The 'compile' action results in an URL that looks like
! 'responder/fjsc/compile'. It takes one query or post
! 'responder/fjsc/compile'. It takes one query or post
! parameter called 'code'. It calls the 'compile' word
! passing the parameter to it on the stack.
\ compile {
{ "code" v-required }
\ compile {
{ "code" v-required }
} define-action
: compile-url ( url -- )
@ -28,18 +28,18 @@ IN: webapps.fjsc
"http://" host rot 3append http-get 2nip compile "();" write flush ;
\ compile-url {
{ "url" v-required }
{ "url" v-required }
} define-action
: repl ( -- )
#! The main 'repl' page.
f "repl" "head" render-page* ;
! An action called 'repl'
! An action called 'repl'
\ repl { } define-action
: fjsc-web-app ( -- )
! Create the web app, providing access
! Create the web app, providing access
! under '/responder/fjsc' which calls the
! 'repl' action.
"fjsc" "repl" "extra/webapps/fjsc" web-app