From 14cc510844e8dea99580eb1e532d06cb73943c40 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 11 Jul 2008 11:23:03 +1200 Subject: [PATCH] Fix fjsc failing tests --- extra/fjsc/fjsc-tests.factor | 22 ++++++------ extra/fjsc/fjsc.factor | 68 ++++++++++++++++++------------------ 2 files changed, 45 insertions(+), 45 deletions(-) diff --git a/extra/fjsc/fjsc-tests.factor b/extra/fjsc/fjsc-tests.factor index ce968128be..766e2ec60c 100755 --- a/extra/fjsc/fjsc-tests.factor +++ b/extra/fjsc/fjsc-tests.factor @@ -4,31 +4,31 @@ USING: kernel tools.test peg fjsc ; IN: fjsc.tests { 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 { 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 { 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 { 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 { 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 { 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 { T{ ast-stack-effect f V{ } V{ } } } [ - "( -- )" 'stack-effect' parse parse-result-ast + "( -- )" 'stack-effect' parse ] unit-test { f } [ @@ -37,18 +37,18 @@ IN: fjsc.tests { T{ ast-expression f V{ T{ ast-string f "abcd" } } } } [ - "\"abcd\"" 'statement' parse parse-result-ast + "\"abcd\"" 'statement' parse ] unit-test { T{ ast-expression f V{ T{ ast-use f "foo" } } } } [ - "USE: foo" 'statement' parse parse-result-ast + "USE: foo" 'statement' parse ] unit-test { T{ ast-expression f V{ T{ ast-in f "foo" } } } } [ - "IN: foo" 'statement' parse parse-result-ast + "IN: foo" 'statement' parse ] unit-test { 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 diff --git a/extra/fjsc/fjsc.factor b/extra/fjsc/fjsc.factor index ec3d92f78b..ecefd862d3 100755 --- a/extra/fjsc/fjsc.factor +++ b/extra/fjsc/fjsc.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel peg strings promises sequences math 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 TUPLE: ast-number value ; @@ -41,7 +41,7 @@ C: ast-hashtable digit? not and and ; -MEMO: 'identifier-ends' ( -- parser ) +: 'identifier-ends' ( -- parser ) [ [ blank? not ] keep [ CHAR: " = not ] keep @@ -52,22 +52,22 @@ MEMO: 'identifier-ends' ( -- parser ) and and and and and ] satisfy repeat0 ; -MEMO: 'identifier-middle' ( -- parser ) +: 'identifier-middle' ( -- parser ) [ identifier-middle? ] satisfy repeat1 ; -MEMO: 'identifier' ( -- parser ) +: 'identifier' ( -- parser ) [ 'identifier-ends' , 'identifier-middle' , 'identifier-ends' , - ] { } make seq [ + ] seq* [ concat >string f ] action ; DEFER: 'expression' -MEMO: 'effect-name' ( -- parser ) +: 'effect-name' ( -- parser ) [ [ blank? not ] keep [ CHAR: ) = not ] keep @@ -75,98 +75,98 @@ MEMO: 'effect-name' ( -- parser ) and and ] satisfy repeat1 [ >string ] action ; -MEMO: 'stack-effect' ( -- parser ) +: 'stack-effect' ( -- parser ) [ "(" token hide , 'effect-name' sp repeat0 , "--" token sp hide , 'effect-name' sp repeat0 , ")" token sp hide , - ] { } make seq [ + ] seq* [ first2 ] action ; -MEMO: 'define' ( -- parser ) +: 'define' ( -- parser ) [ ":" token sp hide , 'identifier' sp [ ast-identifier-value ] action , 'stack-effect' sp optional , 'expression' , ";" token sp hide , - ] { } make seq [ first3 ] action ; + ] seq* [ first3 ] action ; -MEMO: 'quotation' ( -- parser ) +: 'quotation' ( -- parser ) [ "[" token sp hide , 'expression' [ ast-expression-values ] action , "]" token sp hide , - ] { } make seq [ first ] action ; + ] seq* [ first ] action ; -MEMO: 'array' ( -- parser ) +: 'array' ( -- parser ) [ "{" token sp hide , 'expression' [ ast-expression-values ] action , "}" token sp hide , - ] { } make seq [ first ] action ; + ] seq* [ first ] action ; -MEMO: 'word' ( -- parser ) +: 'word' ( -- parser ) [ "\\" token sp hide , 'identifier' sp , - ] { } make seq [ first ast-identifier-value f ] action ; + ] seq* [ first ast-identifier-value f ] action ; -MEMO: 'atom' ( -- parser ) +: 'atom' ( -- parser ) [ 'identifier' , 'integer' [ ] action , 'string' [ ] action , - ] { } make choice ; + ] choice* ; -MEMO: 'comment' ( -- parser ) +: 'comment' ( -- parser ) [ [ "#!" token sp , "!" token sp , - ] { } make choice hide , + ] choice* hide , [ dup CHAR: \n = swap CHAR: \r = or not ] satisfy repeat0 , - ] { } make seq [ drop ] action ; + ] seq* [ drop ] action ; -MEMO: 'USE:' ( -- parser ) +: 'USE:' ( -- parser ) [ "USE:" token sp hide , 'identifier' sp , - ] { } make seq [ first ast-identifier-value ] action ; + ] seq* [ first ast-identifier-value ] action ; -MEMO: 'IN:' ( -- parser ) +: 'IN:' ( -- parser ) [ "IN:" token sp hide , 'identifier' sp , - ] { } make seq [ first ast-identifier-value ] action ; + ] seq* [ first ast-identifier-value ] action ; -MEMO: 'USING:' ( -- parser ) +: 'USING:' ( -- parser ) [ "USING:" token sp hide , 'identifier' sp [ ast-identifier-value ] action repeat1 , ";" token sp hide , - ] { } make seq [ first ] action ; + ] seq* [ first ] action ; -MEMO: 'hashtable' ( -- parser ) +: 'hashtable' ( -- parser ) [ "H{" token sp hide , 'expression' [ ast-expression-values ] action , "}" token sp hide , - ] { } make seq [ first ] action ; + ] seq* [ first ] action ; -MEMO: 'parsing-word' ( -- parser ) +: 'parsing-word' ( -- parser ) [ 'USE:' , 'USING:' , 'IN:' , - ] { } make choice ; + ] choice* ; -MEMO: 'expression' ( -- parser ) +: 'expression' ( -- parser ) [ [ 'comment' , @@ -177,10 +177,10 @@ MEMO: 'expression' ( -- parser ) 'hashtable' sp , 'word' sp , 'atom' sp , - ] { } make choice repeat0 [ ] action + ] choice* repeat0 [ ] action ] delay ; -MEMO: 'statement' ( -- parser ) +: 'statement' ( -- parser ) 'expression' ; GENERIC: (compile) ( ast -- )