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

Fix fjsc failing tests

db4
Chris Double 2008-07-11 11:23:03 +12:00
parent 9fc2175403
commit 14cc510844
2 changed files with 45 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,31 +4,31 @@ USING: kernel tools.test peg fjsc ;
IN: fjsc.tests IN: fjsc.tests
{ T{ ast-expression f V{ 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 parse-result-ast "55 2abc1 100" 'expression' parse
] unit-test ] unit-test
{ T{ ast-quotation f V{ 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 parse-result-ast "[ 55 2abc1 100 ]" 'quotation' parse
] unit-test ] unit-test
{ T{ ast-array f V{ 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 parse-result-ast "{ 55 2abc1 100 }" 'array' parse
] unit-test ] unit-test
{ T{ ast-stack-effect f V{ } V{ "d" "e" "f" } } } [ { T{ ast-stack-effect f V{ } V{ "d" "e" "f" } } } [
"( -- d e f )" 'stack-effect' parse parse-result-ast "( -- d e f )" 'stack-effect' parse
] unit-test ] unit-test
{ T{ ast-stack-effect f V{ "a" "b" "c" } V{ "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 parse-result-ast "( a b c -- d e f )" 'stack-effect' parse
] unit-test ] unit-test
{ T{ ast-stack-effect f V{ "a" "b" "c" } V{ } } } [ { T{ ast-stack-effect f V{ "a" "b" "c" } V{ } } } [
"( a b c -- )" 'stack-effect' parse parse-result-ast "( a b c -- )" 'stack-effect' parse
] unit-test ] unit-test
{ T{ ast-stack-effect f V{ } V{ } } } [ { T{ ast-stack-effect f V{ } V{ } } } [
"( -- )" 'stack-effect' parse parse-result-ast "( -- )" 'stack-effect' parse
] unit-test ] unit-test
{ f } [ { f } [
@ -37,18 +37,18 @@ IN: fjsc.tests
{ T{ ast-expression f V{ T{ ast-string f "abcd" } } } } [ { T{ ast-expression f V{ T{ ast-string f "abcd" } } } } [
"\"abcd\"" 'statement' parse parse-result-ast "\"abcd\"" 'statement' parse
] unit-test ] unit-test
{ T{ ast-expression f V{ T{ ast-use f "foo" } } } } [ { T{ ast-expression f V{ T{ ast-use f "foo" } } } } [
"USE: foo" 'statement' parse parse-result-ast "USE: foo" 'statement' parse
] unit-test ] unit-test
{ T{ ast-expression f V{ T{ ast-in f "foo" } } } } [ { T{ ast-expression f V{ T{ ast-in f "foo" } } } } [
"IN: foo" 'statement' parse parse-result-ast "IN: foo" 'statement' parse
] unit-test ] unit-test
{ T{ ast-expression f V{ T{ ast-using f V{ "foo" "bar" } } } } } [ { T{ ast-expression f V{ T{ ast-using f V{ "foo" "bar" } } } } } [
"USING: foo bar ;" 'statement' parse parse-result-ast "USING: foo bar ;" 'statement' parse
] unit-test ] unit-test

68
extra/fjsc/fjsc.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel peg strings promises sequences math USING: accessors kernel peg strings promises sequences math
math.parser namespaces words quotations arrays hashtables io math.parser namespaces words quotations arrays hashtables io
io.streams.string assocs memoize ascii peg.parsers ; io.streams.string assocs ascii peg.parsers ;
IN: fjsc IN: fjsc
TUPLE: ast-number value ; TUPLE: ast-number value ;
@ -41,7 +41,7 @@ C: <ast-hashtable> ast-hashtable
digit? not digit? not
and and ; and and ;
MEMO: 'identifier-ends' ( -- parser ) : 'identifier-ends' ( -- parser )
[ [
[ blank? not ] keep [ blank? not ] keep
[ CHAR: " = not ] keep [ CHAR: " = not ] keep
@ -52,22 +52,22 @@ MEMO: 'identifier-ends' ( -- parser )
and and and and and and and and and and
] satisfy repeat0 ; ] satisfy repeat0 ;
MEMO: 'identifier-middle' ( -- parser ) : 'identifier-middle' ( -- parser )
[ identifier-middle? ] satisfy repeat1 ; [ identifier-middle? ] satisfy repeat1 ;
MEMO: 'identifier' ( -- parser ) : 'identifier' ( -- parser )
[ [
'identifier-ends' , 'identifier-ends' ,
'identifier-middle' , 'identifier-middle' ,
'identifier-ends' , 'identifier-ends' ,
] { } make seq [ ] seq* [
concat >string f <ast-identifier> concat >string f <ast-identifier>
] action ; ] action ;
DEFER: 'expression' DEFER: 'expression'
MEMO: 'effect-name' ( -- parser ) : 'effect-name' ( -- parser )
[ [
[ blank? not ] keep [ blank? not ] keep
[ CHAR: ) = not ] keep [ CHAR: ) = not ] keep
@ -75,98 +75,98 @@ MEMO: 'effect-name' ( -- parser )
and and and and
] satisfy repeat1 [ >string ] action ; ] satisfy repeat1 [ >string ] action ;
MEMO: 'stack-effect' ( -- parser ) : 'stack-effect' ( -- parser )
[ [
"(" token hide , "(" token hide ,
'effect-name' sp repeat0 , 'effect-name' sp repeat0 ,
"--" token sp hide , "--" token sp hide ,
'effect-name' sp repeat0 , 'effect-name' sp repeat0 ,
")" token sp hide , ")" token sp hide ,
] { } make seq [ ] seq* [
first2 <ast-stack-effect> first2 <ast-stack-effect>
] action ; ] action ;
MEMO: 'define' ( -- parser ) : 'define' ( -- parser )
[ [
":" token sp hide , ":" token sp hide ,
'identifier' sp [ ast-identifier-value ] action , 'identifier' sp [ ast-identifier-value ] action ,
'stack-effect' sp optional , 'stack-effect' sp optional ,
'expression' , 'expression' ,
";" token sp hide , ";" token sp hide ,
] { } make seq [ first3 <ast-define> ] action ; ] seq* [ first3 <ast-define> ] action ;
MEMO: 'quotation' ( -- parser ) : 'quotation' ( -- parser )
[ [
"[" token sp hide , "[" token sp hide ,
'expression' [ ast-expression-values ] action , 'expression' [ ast-expression-values ] action ,
"]" token sp hide , "]" token sp hide ,
] { } make seq [ first <ast-quotation> ] action ; ] seq* [ first <ast-quotation> ] action ;
MEMO: 'array' ( -- parser ) : 'array' ( -- parser )
[ [
"{" token sp hide , "{" token sp hide ,
'expression' [ ast-expression-values ] action , 'expression' [ ast-expression-values ] action ,
"}" token sp hide , "}" token sp hide ,
] { } make seq [ first <ast-array> ] action ; ] seq* [ first <ast-array> ] action ;
MEMO: 'word' ( -- parser ) : 'word' ( -- parser )
[ [
"\\" token sp hide , "\\" token sp hide ,
'identifier' sp , 'identifier' sp ,
] { } make seq [ first ast-identifier-value f <ast-word> ] action ; ] seq* [ first ast-identifier-value f <ast-word> ] action ;
MEMO: 'atom' ( -- parser ) : 'atom' ( -- parser )
[ [
'identifier' , 'identifier' ,
'integer' [ <ast-number> ] action , 'integer' [ <ast-number> ] action ,
'string' [ <ast-string> ] action , 'string' [ <ast-string> ] action ,
] { } make choice ; ] choice* ;
MEMO: 'comment' ( -- parser ) : 'comment' ( -- parser )
[ [
[ [
"#!" token sp , "#!" token sp ,
"!" token sp , "!" token sp ,
] { } make choice hide , ] choice* hide ,
[ [
dup CHAR: \n = swap CHAR: \r = or not dup CHAR: \n = swap CHAR: \r = or not
] satisfy repeat0 , ] satisfy repeat0 ,
] { } make seq [ drop <ast-comment> ] action ; ] seq* [ drop <ast-comment> ] action ;
MEMO: 'USE:' ( -- parser ) : 'USE:' ( -- parser )
[ [
"USE:" token sp hide , "USE:" token sp hide ,
'identifier' sp , 'identifier' sp ,
] { } make seq [ first ast-identifier-value <ast-use> ] action ; ] seq* [ first ast-identifier-value <ast-use> ] action ;
MEMO: 'IN:' ( -- parser ) : 'IN:' ( -- parser )
[ [
"IN:" token sp hide , "IN:" token sp hide ,
'identifier' sp , 'identifier' sp ,
] { } make seq [ first ast-identifier-value <ast-in> ] action ; ] seq* [ first ast-identifier-value <ast-in> ] action ;
MEMO: 'USING:' ( -- parser ) : 'USING:' ( -- parser )
[ [
"USING:" token sp hide , "USING:" token sp hide ,
'identifier' sp [ ast-identifier-value ] action repeat1 , 'identifier' sp [ ast-identifier-value ] action repeat1 ,
";" token sp hide , ";" token sp hide ,
] { } make seq [ first <ast-using> ] action ; ] seq* [ first <ast-using> ] action ;
MEMO: 'hashtable' ( -- parser ) : 'hashtable' ( -- parser )
[ [
"H{" token sp hide , "H{" token sp hide ,
'expression' [ ast-expression-values ] action , 'expression' [ ast-expression-values ] action ,
"}" token sp hide , "}" token sp hide ,
] { } make seq [ first <ast-hashtable> ] action ; ] seq* [ first <ast-hashtable> ] action ;
MEMO: 'parsing-word' ( -- parser ) : 'parsing-word' ( -- parser )
[ [
'USE:' , 'USE:' ,
'USING:' , 'USING:' ,
'IN:' , 'IN:' ,
] { } make choice ; ] choice* ;
MEMO: 'expression' ( -- parser ) : 'expression' ( -- parser )
[ [
[ [
'comment' , 'comment' ,
@ -177,10 +177,10 @@ MEMO: 'expression' ( -- parser )
'hashtable' sp , 'hashtable' sp ,
'word' sp , 'word' sp ,
'atom' sp , 'atom' sp ,
] { } make choice repeat0 [ <ast-expression> ] action ] choice* repeat0 [ <ast-expression> ] action
] delay ; ] delay ;
MEMO: 'statement' ( -- parser ) : 'statement' ( -- parser )
'expression' ; 'expression' ;
GENERIC: (compile) ( ast -- ) GENERIC: (compile) ( ast -- )