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

Port fjsc to use pegs instead of parser combinators

db4
Chris Double 2007-12-20 12:48:45 +13:00
parent d45ed669f8
commit b5186937a4
5 changed files with 166 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
extra/fjsc/fjsc-tests.factor
View File

@ -1,54 +1,54 @@
! Copyright (C) 2006 Chris Double. All Rights Reserved. ! Copyright (C) 2006 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel tools.test parser-combinators lazy-lists fjsc ; USING: kernel tools.test peg 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 V{ T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
"55 2abc1 100" 'expression' parse-1 "55 2abc1 100" 'expression' parse parse-result-ast
] 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 V{ T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
"[ 55 2abc1 100 ]" 'quotation' parse-1 "[ 55 2abc1 100 ]" 'quotation' parse parse-result-ast
] 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 V{ T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
"{ 55 2abc1 100 }" 'array' parse-1 "{ 55 2abc1 100 }" 'array' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-stack-effect f { } { "d" "e" "f" } } } [ { T{ ast-stack-effect f V{ } V{ "d" "e" "f" } } } [
"( -- d e f )" 'stack-effect' parse-1 "( -- d e f )" 'stack-effect' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-stack-effect f { "a" "b" "c" } { "d" "e" "f" } } } [ { T{ ast-stack-effect f V{ "a" "b" "c" } V{ "d" "e" "f" } } } [
"( a b c -- d e f )" 'stack-effect' parse-1 "( a b c -- d e f )" 'stack-effect' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-stack-effect f { "a" "b" "c" } { } } } [ { T{ ast-stack-effect f V{ "a" "b" "c" } V{ } } } [
"( a b c -- )" 'stack-effect' parse-1 "( a b c -- )" 'stack-effect' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-stack-effect f { } { } } } [ { T{ ast-stack-effect f V{ } V{ } } } [
"( -- )" 'stack-effect' parse-1 "( -- )" 'stack-effect' parse parse-result-ast
] unit-test ] unit-test
{ } [ { f } [
": foo ( a b -- c d ) abcdefghijklmn 123 ;" 'expression' parse car drop ": foo ( a b -- c d ) abcdefghijklmn 123 ;" 'expression' parse not
] unit-test ] unit-test
{ T{ ast-expression f { T{ ast-string f "abcd" } } } } [ { T{ ast-expression f V{ T{ ast-string f "abcd" } } } } [
"\"abcd\"" 'statement' parse-1 "\"abcd\"" 'statement' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-expression f { T{ ast-use f "foo" } } } } [ { T{ ast-expression f V{ T{ ast-use f "foo" } } } } [
"USE: foo" 'statement' parse-1 "USE: foo" 'statement' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-expression f { T{ ast-in f "foo" } } } } [ { T{ ast-expression f V{ T{ ast-in f "foo" } } } } [
"IN: foo" 'statement' parse-1 "IN: foo" 'statement' parse parse-result-ast
] unit-test ] unit-test
{ T{ ast-expression f { T{ ast-using f { "foo" "bar" } } } } } [ { T{ ast-expression f V{ T{ ast-using f V{ "foo" "bar" } } } } } [
"USING: foo bar ;" 'statement' parse-1 "USING: foo bar ;" 'statement' parse parse-result-ast
] unit-test ] unit-test

232
extra/fjsc/fjsc.factor
View File

@ -1,50 +1,38 @@
! Copyright (C) 2006 Chris Double. All Rights Reserved. ! Copyright (C) 2006 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel lazy-lists parser-combinators parser-combinators.simple USING: kernel peg strings promises sequences math math.parser
strings promises sequences math math.parser namespaces words namespaces words quotations arrays hashtables io
quotations arrays hashtables io io.streams.string assocs ; io.streams.string assocs memoize ;
IN: fjsc IN: fjsc
TUPLE: ast-number value ; TUPLE: ast-number value ;
C: <ast-number> ast-number
TUPLE: ast-identifier value vocab ; TUPLE: ast-identifier value vocab ;
C: <ast-identifier> ast-identifier
TUPLE: ast-string value ; TUPLE: ast-string value ;
C: <ast-string> ast-string
TUPLE: ast-quotation values ; TUPLE: ast-quotation values ;
C: <ast-quotation> ast-quotation
TUPLE: ast-array elements ; TUPLE: ast-array elements ;
C: <ast-array> ast-array
TUPLE: ast-define name stack-effect expression ; TUPLE: ast-define name stack-effect expression ;
C: <ast-define> ast-define
TUPLE: ast-expression values ; TUPLE: ast-expression values ;
C: <ast-expression> ast-expression
TUPLE: ast-word value vocab ; TUPLE: ast-word value vocab ;
C: <ast-word> ast-word
TUPLE: ast-comment ; TUPLE: ast-comment ;
C: <ast-comment> ast-comment
TUPLE: ast-stack-effect in out ; TUPLE: ast-stack-effect in out ;
C: <ast-stack-effect> ast-stack-effect
TUPLE: ast-use name ; TUPLE: ast-use name ;
C: <ast-use> ast-use
TUPLE: ast-using names ; TUPLE: ast-using names ;
C: <ast-using> ast-using
TUPLE: ast-in name ; TUPLE: ast-in name ;
C: <ast-in> ast-in
TUPLE: ast-hashtable elements ; TUPLE: ast-hashtable elements ;
C: <ast-number> ast-number
C: <ast-identifier> ast-identifier
C: <ast-string> ast-string
C: <ast-quotation> ast-quotation
C: <ast-array> ast-array
C: <ast-define> ast-define
C: <ast-expression> ast-expression
C: <ast-word> ast-word
C: <ast-comment> ast-comment
C: <ast-stack-effect> ast-stack-effect
C: <ast-use> ast-use
C: <ast-using> ast-using
C: <ast-in> ast-in
C: <ast-hashtable> ast-hashtable C: <ast-hashtable> ast-hashtable
: identifier-middle? ( ch -- bool ) : identifier-middle? ( ch -- bool )
@ -56,7 +44,7 @@ C: <ast-hashtable> ast-hashtable
digit? not digit? not
and and and and and ; and and and and and ;
LAZY: 'identifier-ends' ( -- parser ) MEMO: 'identifier-ends' ( -- parser )
[ [
[ blank? not ] keep [ blank? not ] keep
[ CHAR: " = not ] keep [ CHAR: " = not ] keep
@ -65,99 +53,137 @@ LAZY: 'identifier-ends' ( -- parser )
[ letter? not ] keep [ letter? not ] keep
identifier-middle? not identifier-middle? not
and and and and and and and and and and
] satisfy <!*> ; ] satisfy repeat0 ;
LAZY: 'identifier-middle' ( -- parser ) MEMO: 'identifier-middle' ( -- parser )
[ identifier-middle? ] satisfy <!+> ; [ identifier-middle? ] satisfy repeat1 ;
LAZY: 'identifier' ( -- parser ) MEMO: 'identifier' ( -- parser )
'identifier-ends' [
'identifier-middle' <&> 'identifier-ends' ,
'identifier-ends' <:&> 'identifier-middle' ,
[ concat >string f <ast-identifier> ] <@ ; 'identifier-ends' ,
] { } make seq [
concat >string f <ast-identifier>
] action ;
DEFER: 'expression' DEFER: 'expression'
LAZY: 'effect-name' ( -- parser ) MEMO: 'effect-name' ( -- parser )
[ [
[ blank? not ] keep [ blank? not ] keep
[ CHAR: ) = not ] keep
CHAR: - = not CHAR: - = not
and and and
] satisfy <!+> [ >string ] <@ ; ] satisfy repeat1 [ >string ] action ;
LAZY: 'stack-effect' ( -- parser ) MEMO: 'stack-effect' ( -- parser )
"(" token sp [
'effect-name' sp <*> &> "(" token hide ,
"--" token sp <& 'effect-name' sp repeat0 ,
'effect-name' sp <*> <&> "--" token sp hide ,
")" token sp <& [ first2 <ast-stack-effect> ] <@ ; 'effect-name' sp repeat0 ,
")" token sp hide ,
] { } make seq [
first2 <ast-stack-effect>
] action ;
LAZY: 'define' ( -- parser ) MEMO: 'define' ( -- parser )
":" token sp [
'identifier' sp [ ast-identifier-value ] <@ &> ":" token sp hide ,
'stack-effect' sp <!?> <&> 'identifier' sp [ ast-identifier-value ] action ,
'expression' <:&> 'stack-effect' sp optional ,
";" token sp <& [ first3 <ast-define> ] <@ ; 'expression' ,
";" token sp hide ,
] { } make seq [ first3 <ast-define> ] action ;
LAZY: 'quotation' ( -- parser ) MEMO: 'quotation' ( -- parser )
"[" token sp [
'expression' [ ast-expression-values ] <@ &> "[" token sp hide ,
"]" token sp <& [ <ast-quotation> ] <@ ; 'expression' [ ast-expression-values ] action ,
"]" token sp hide ,
] { } make seq [ first <ast-quotation> ] action ;
LAZY: 'array' ( -- parser ) MEMO: 'array' ( -- parser )
"{" token sp [
'expression' [ ast-expression-values ] <@ &> "{" token sp hide ,
"}" token sp <& [ <ast-array> ] <@ ; 'expression' [ ast-expression-values ] action ,
"}" token sp hide ,
] { } make seq [ first <ast-array> ] action ;
LAZY: 'word' ( -- parser ) MEMO: 'word' ( -- parser )
"\\" token sp [
'identifier' sp &> [ ast-identifier-value f <ast-word> ] <@ ; "\\" token sp hide ,
'identifier' sp ,
] { } make seq [ first ast-identifier-value f <ast-word> ] action ;
LAZY: 'atom' ( -- parser ) MEMO: 'atom' ( -- parser )
'identifier' 'integer' [ <ast-number> ] <@ <|> 'string' [ <ast-string> ] <@ <|> ; [
'identifier' ,
'integer' [ <ast-number> ] action ,
'string' [ <ast-string> ] action ,
] { } make choice ;
LAZY: 'comment' ( -- parser ) MEMO: 'comment' ( -- parser )
"#!" token sp [
"!" token sp <|> [ [
dup CHAR: \n = swap CHAR: \r = or not "#!" token sp ,
] satisfy <*> <&> [ drop <ast-comment> ] <@ ; "!" token sp ,
] { } make choice hide ,
[
dup CHAR: \n = swap CHAR: \r = or not
] satisfy repeat0 ,
] { } make seq [ drop <ast-comment> ] action ;
LAZY: 'USE:' ( -- parser ) MEMO: 'USE:' ( -- parser )
"USE:" token sp [
'identifier' sp &> [ ast-identifier-value <ast-use> ] <@ ; "USE:" token sp hide ,
'identifier' sp ,
] { } make seq [ first ast-identifier-value <ast-use> ] action ;
LAZY: 'IN:' ( -- parser ) MEMO: 'IN:' ( -- parser )
"IN:" token sp [
'identifier' sp &> [ ast-identifier-value <ast-in> ] <@ ; "IN:" token sp hide ,
'identifier' sp ,
] { } make seq [ first ast-identifier-value <ast-in> ] action ;
LAZY: 'USING:' ( -- parser ) MEMO: 'USING:' ( -- parser )
"USING:" token sp [
'identifier' sp [ ast-identifier-value ] <@ <+> &> "USING:" token sp hide ,
";" token sp <& [ <ast-using> ] <@ ; 'identifier' sp [ ast-identifier-value ] action repeat1 ,
";" token sp hide ,
] { } make seq [ first <ast-using> ] action ;
LAZY: 'hashtable' ( -- parser ) MEMO: 'hashtable' ( -- parser )
"H{" token sp [
'expression' [ ast-expression-values ] <@ &> "H{" token sp hide ,
"}" token sp <& [ <ast-hashtable> ] <@ ; 'expression' [ ast-expression-values ] action ,
"}" token sp hide ,
] { } make seq [ first <ast-hashtable> ] action ;
LAZY: 'parsing-word' ( -- parser ) MEMO: 'parsing-word' ( -- parser )
'USE:' [
'USING:' <|> 'USE:' ,
'IN:' <|> ; 'USING:' ,
'IN:' ,
] { } make choice ;
LAZY: 'expression' ( -- parser ) MEMO: 'expression' ( -- parser )
'comment' [
'parsing-word' sp <|> [
'quotation' sp <|> 'comment' ,
'define' sp <|> 'parsing-word' sp ,
'array' sp <|> 'quotation' sp ,
'hashtable' sp <|> 'define' sp ,
'word' sp <|> 'array' sp ,
'atom' sp <|> 'hashtable' sp ,
<*> [ <ast-expression> ] <@ ; 'word' sp ,
'atom' sp ,
] { } make choice repeat0 [ <ast-expression> ] action
] delay ;
LAZY: 'statement' ( -- parser ) MEMO: 'statement' ( -- parser )
'expression' ; 'expression' ;
GENERIC: (compile) ( ast -- ) GENERIC: (compile) ( ast -- )
@ -328,7 +354,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-1 ; 'expression' parse parse-result-ast ;
M: quotation fjsc-parse ( object -- ast ) M: quotation fjsc-parse ( object -- ast )
[ [
@ -345,11 +371,11 @@ M: quotation fjsc-parse ( object -- ast )
] string-out ; ] string-out ;
: fjsc-compile* ( string -- string ) : fjsc-compile* ( string -- string )
'statement' parse-1 fjsc-compile ; 'statement' parse parse-result-ast fjsc-compile ;
: fc* ( string -- string ) : fc* ( string -- string )
[ [
'statement' parse-1 ast-expression-values do-expressions 'statement' parse parse-result-ast ast-expression-values do-expressions
] { } make [ write ] each ; ] { } make [ write ] each ;

7
extra/fjsc/resources/bootstrap.factor
View File

@ -3,10 +3,6 @@ USE: kernel-internals
: bind ( ns quot -- ) : bind ( ns quot -- )
swap >n call n> drop ; swap >n call n> drop ;
: alert ( string -- )
#! Display the string in an alert box
window { } "" "alert" { "string" } alien-invoke ;
"browser-dom" set-in "browser-dom" set-in
: elements ( string -- result ) : elements ( string -- result )
@ -38,3 +34,6 @@ USE: kernel-internals
drop "Click done!" alert drop "Click done!" alert
] callcc0 ; ] callcc0 ;
: alert ( string -- )
#! Display the string in an alert box
window { } "" "alert" { "string" } alien-invoke ;

6
extra/fjsc/resources/bootstrap.js
View File

@ -513,6 +513,12 @@ factor.add_word("alien", "set-alien-property", "primitive", function(next) {
factor.call_next(next); factor.call_next(next);
}); });
factor.add_word("alien", "uneval", "primitive", function(next) {
var stack = factor.cont.data_stack;
stack.push(uneval(stack.pop()));
factor.call_next(next);
});
factor.add_word("words", "vocabs", "primitive", function(next) { factor.add_word("words", "vocabs", "primitive", function(next) {
var stack = factor.cont.data_stack; var stack = factor.cont.data_stack;
var result = []; var result = [];

6
extra/webapps/fjsc/fjsc.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double. All Rights Reserved. ! Copyright (C) 2006 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: kernel furnace fjsc parser-combinators namespaces USING: kernel furnace fjsc peg namespaces
lazy-lists io io.files furnace.validator sequences lazy-lists io io.files furnace.validator sequences
http.client http.server http.server.responders http.client http.server http.server.responders
webapps.file html ; webapps.file html ;
@ -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-1 fjsc-compile 'expression' parse parse-result-ast 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
@ -25,7 +25,7 @@ IN: webapps.fjsc
: compile-url ( url -- ) : compile-url ( url -- )
#! Compile the factor code at the given url, return the javascript. #! Compile the factor code at the given url, return the javascript.
dup "http:" head? [ "Unable to access remote sites." throw ] when dup "http:" head? [ "Unable to access remote sites." throw ] when
"http://" host rot 3append http-get 2nip compile "();" write flush ; "http://" "Host" header-param rot 3append http-get 2nip compile "();" write flush ;
\ compile-url { \ compile-url {
{ "url" v-required } { "url" v-required }