Use new style accessors in fjsc

db4
Chris Double 2008-07-11 11:28:47 +12:00
parent 14cc510844
commit 8208661ed8
1 changed files with 52 additions and 67 deletions

View File

@ -1,8 +1,8 @@
! 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: accessors kernel peg strings promises sequences math USING: accessors kernel peg strings sequences math
math.parser namespaces words quotations arrays hashtables io math.parser namespaces words quotations arrays hashtables io
io.streams.string assocs ascii peg.parsers ; io.streams.string assocs ascii peg.parsers accessors ;
IN: fjsc IN: fjsc
TUPLE: ast-number value ; TUPLE: ast-number value ;
@ -20,21 +20,6 @@ TUPLE: ast-using names ;
TUPLE: ast-in name ; TUPLE: ast-in name ;
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
: identifier-middle? ( ch -- bool ) : identifier-middle? ( ch -- bool )
[ blank? not ] keep [ blank? not ] keep
[ "}];\"" member? not ] keep [ "}];\"" member? not ] keep
@ -61,7 +46,7 @@ C: <ast-hashtable> ast-hashtable
'identifier-middle' , 'identifier-middle' ,
'identifier-ends' , 'identifier-ends' ,
] seq* [ ] seq* [
concat >string f <ast-identifier> concat >string f ast-identifier boa
] action ; ] action ;
@ -83,43 +68,43 @@ DEFER: 'expression'
'effect-name' sp repeat0 , 'effect-name' sp repeat0 ,
")" token sp hide , ")" token sp hide ,
] seq* [ ] seq* [
first2 <ast-stack-effect> first2 ast-stack-effect boa
] action ; ] action ;
: 'define' ( -- parser ) : 'define' ( -- parser )
[ [
":" token sp hide , ":" token sp hide ,
'identifier' sp [ ast-identifier-value ] action , 'identifier' sp [ value>> ] action ,
'stack-effect' sp optional , 'stack-effect' sp optional ,
'expression' , 'expression' ,
";" token sp hide , ";" token sp hide ,
] seq* [ first3 <ast-define> ] action ; ] seq* [ first3 ast-define boa ] action ;
: 'quotation' ( -- parser ) : 'quotation' ( -- parser )
[ [
"[" token sp hide , "[" token sp hide ,
'expression' [ ast-expression-values ] action , 'expression' [ values>> ] action ,
"]" token sp hide , "]" token sp hide ,
] seq* [ first <ast-quotation> ] action ; ] seq* [ first ast-quotation boa ] action ;
: 'array' ( -- parser ) : 'array' ( -- parser )
[ [
"{" token sp hide , "{" token sp hide ,
'expression' [ ast-expression-values ] action , 'expression' [ values>> ] action ,
"}" token sp hide , "}" token sp hide ,
] seq* [ first <ast-array> ] action ; ] seq* [ first ast-array boa ] action ;
: 'word' ( -- parser ) : 'word' ( -- parser )
[ [
"\\" token sp hide , "\\" token sp hide ,
'identifier' sp , 'identifier' sp ,
] seq* [ first ast-identifier-value f <ast-word> ] action ; ] seq* [ first value>> f ast-word boa ] action ;
: 'atom' ( -- parser ) : 'atom' ( -- parser )
[ [
'identifier' , 'identifier' ,
'integer' [ <ast-number> ] action , 'integer' [ ast-number boa ] action ,
'string' [ <ast-string> ] action , 'string' [ ast-string boa ] action ,
] choice* ; ] choice* ;
: 'comment' ( -- parser ) : 'comment' ( -- parser )
@ -131,33 +116,33 @@ DEFER: 'expression'
[ [
dup CHAR: \n = swap CHAR: \r = or not dup CHAR: \n = swap CHAR: \r = or not
] satisfy repeat0 , ] satisfy repeat0 ,
] seq* [ drop <ast-comment> ] action ; ] seq* [ drop ast-comment boa ] action ;
: 'USE:' ( -- parser ) : 'USE:' ( -- parser )
[ [
"USE:" token sp hide , "USE:" token sp hide ,
'identifier' sp , 'identifier' sp ,
] seq* [ first ast-identifier-value <ast-use> ] action ; ] seq* [ first value>> ast-use boa ] action ;
: 'IN:' ( -- parser ) : 'IN:' ( -- parser )
[ [
"IN:" token sp hide , "IN:" token sp hide ,
'identifier' sp , 'identifier' sp ,
] seq* [ first ast-identifier-value <ast-in> ] action ; ] seq* [ first value>> ast-in boa ] action ;
: 'USING:' ( -- parser ) : 'USING:' ( -- parser )
[ [
"USING:" token sp hide , "USING:" token sp hide ,
'identifier' sp [ ast-identifier-value ] action repeat1 , 'identifier' sp [ value>> ] action repeat1 ,
";" token sp hide , ";" token sp hide ,
] seq* [ first <ast-using> ] action ; ] seq* [ first ast-using boa ] action ;
: 'hashtable' ( -- parser ) : 'hashtable' ( -- parser )
[ [
"H{" token sp hide , "H{" token sp hide ,
'expression' [ ast-expression-values ] action , 'expression' [ values>> ] action ,
"}" token sp hide , "}" token sp hide ,
] seq* [ first <ast-hashtable> ] action ; ] seq* [ first ast-hashtable boa ] action ;
: 'parsing-word' ( -- parser ) : 'parsing-word' ( -- parser )
[ [
@ -177,7 +162,7 @@ DEFER: 'expression'
'hashtable' sp , 'hashtable' sp ,
'word' sp , 'word' sp ,
'atom' sp , 'atom' sp ,
] choice* repeat0 [ <ast-expression> ] action ] choice* repeat0 [ ast-expression boa ] action
] delay ; ] delay ;
: 'statement' ( -- parser ) : 'statement' ( -- parser )
@ -187,7 +172,7 @@ GENERIC: (compile) ( ast -- )
GENERIC: (literal) ( ast -- ) GENERIC: (literal) ( ast -- )
M: ast-number (literal) M: ast-number (literal)
ast-number-value number>string , ; value>> number>string , ;
M: ast-number (compile) M: ast-number (compile)
"factor.push_data(" , "factor.push_data(" ,
@ -196,7 +181,7 @@ M: ast-number (compile)
M: ast-string (literal) M: ast-string (literal)
"\"" , "\"" ,
ast-string-value , value>> ,
"\"" , ; "\"" , ;
M: ast-string (compile) M: ast-string (compile)
@ -205,14 +190,14 @@ M: ast-string (compile)
"," , ; "," , ;
M: ast-identifier (literal) M: ast-identifier (literal)
dup ast-identifier-vocab [ dup vocab>> [
"factor.get_word(\"" , "factor.get_word(\"" ,
dup ast-identifier-vocab , dup vocab>> ,
"\",\"" , "\",\"" ,
ast-identifier-value , value>> ,
"\")" , "\")" ,
] [ ] [
"factor.find_word(\"" , ast-identifier-value , "\")" , "factor.find_word(\"" , value>> , "\")" ,
] if ; ] if ;
M: ast-identifier (compile) M: ast-identifier (compile)
@ -220,9 +205,9 @@ M: ast-identifier (compile)
M: ast-define (compile) M: ast-define (compile)
"factor.define_word(\"" , "factor.define_word(\"" ,
dup ast-define-name , dup name>> ,
"\",\"source\"," , "\",\"source\"," ,
ast-define-expression (compile) expression>> (compile)
"," , ; "," , ;
: do-expressions ( seq -- ) : do-expressions ( seq -- )
@ -242,17 +227,17 @@ M: ast-define (compile)
M: ast-quotation (literal) M: ast-quotation (literal)
"factor.make_quotation(\"source\"," , "factor.make_quotation(\"source\"," ,
ast-quotation-values do-expressions values>> do-expressions
")" , ; ")" , ;
M: ast-quotation (compile) M: ast-quotation (compile)
"factor.push_data(factor.make_quotation(\"source\"," , "factor.push_data(factor.make_quotation(\"source\"," ,
ast-quotation-values do-expressions values>> do-expressions
")," , ; ")," , ;
M: ast-array (literal) M: ast-array (literal)
"[" , "[" ,
ast-array-elements [ "," , ] [ (literal) ] interleave elements>> [ "," , ] [ (literal) ] interleave
"]" , ; "]" , ;
M: ast-array (compile) M: ast-array (compile)
@ -260,7 +245,7 @@ M: ast-array (compile)
M: ast-hashtable (literal) M: ast-hashtable (literal)
"new Hashtable().fromAlist([" , "new Hashtable().fromAlist([" ,
ast-hashtable-elements [ "," , ] [ (literal) ] interleave elements>> [ "," , ] [ (literal) ] interleave
"])" , ; "])" , ;
M: ast-hashtable (compile) M: ast-hashtable (compile)
@ -268,22 +253,22 @@ M: ast-hashtable (compile)
M: ast-expression (literal) M: ast-expression (literal)
ast-expression-values [ values>> [
(literal) (literal)
] each ; ] each ;
M: ast-expression (compile) M: ast-expression (compile)
ast-expression-values do-expressions ; values>> do-expressions ;
M: ast-word (literal) M: ast-word (literal)
dup ast-word-vocab [ dup vocab>> [
"factor.get_word(\"" , "factor.get_word(\"" ,
dup ast-word-vocab , dup vocab>> ,
"\",\"" , "\",\"" ,
ast-word-value , value>> ,
"\")" , "\")" ,
] [ ] [
"factor.find_word(\"" , ast-word-value , "\")" , "factor.find_word(\"" , value>> , "\")" ,
] if ; ] if ;
M: ast-word (compile) M: ast-word (compile)
@ -299,17 +284,17 @@ M: ast-stack-effect (compile)
M: ast-use (compile) M: ast-use (compile)
"factor.use(\"" , "factor.use(\"" ,
ast-use-name , name>> ,
"\"," , ; "\"," , ;
M: ast-in (compile) M: ast-in (compile)
"factor.set_in(\"" , "factor.set_in(\"" ,
ast-in-name , name>> ,
"\"," , ; "\"," , ;
M: ast-using (compile) M: ast-using (compile)
"factor.using([" , "factor.using([" ,
ast-using-names [ names>> [
"," , "," ,
] [ ] [
"\"" , , "\"" , "\"" , , "\"" ,
@ -319,34 +304,34 @@ M: ast-using (compile)
GENERIC: (parse-factor-quotation) ( object -- ast ) GENERIC: (parse-factor-quotation) ( object -- ast )
M: number (parse-factor-quotation) ( object -- ast ) M: number (parse-factor-quotation) ( object -- ast )
<ast-number> ; ast-number boa ;
M: symbol (parse-factor-quotation) ( object -- ast ) M: symbol (parse-factor-quotation) ( object -- ast )
dup >string swap vocabulary>> <ast-identifier> ; dup >string swap vocabulary>> ast-identifier boa ;
M: word (parse-factor-quotation) ( object -- ast ) M: word (parse-factor-quotation) ( object -- ast )
dup name>> swap vocabulary>> <ast-identifier> ; dup name>> swap vocabulary>> ast-identifier boa ;
M: string (parse-factor-quotation) ( object -- ast ) M: string (parse-factor-quotation) ( object -- ast )
<ast-string> ; ast-string boa ;
M: quotation (parse-factor-quotation) ( object -- ast ) M: quotation (parse-factor-quotation) ( object -- ast )
[ [
[ (parse-factor-quotation) , ] each [ (parse-factor-quotation) , ] each
] { } make <ast-quotation> ; ] { } make ast-quotation boa ;
M: array (parse-factor-quotation) ( object -- ast ) M: array (parse-factor-quotation) ( object -- ast )
[ [
[ (parse-factor-quotation) , ] each [ (parse-factor-quotation) , ] each
] { } make <ast-array> ; ] { } make ast-array boa ;
M: hashtable (parse-factor-quotation) ( object -- ast ) M: hashtable (parse-factor-quotation) ( object -- ast )
>alist [ >alist [
[ (parse-factor-quotation) , ] each [ (parse-factor-quotation) , ] each
] { } make <ast-hashtable> ; ] { } make ast-hashtable boa ;
M: wrapper (parse-factor-quotation) ( object -- ast ) M: wrapper (parse-factor-quotation) ( object -- ast )
wrapped>> dup name>> swap vocabulary>> <ast-word> ; wrapped>> dup name>> swap vocabulary>> ast-word boa ;
GENERIC: fjsc-parse ( object -- ast ) GENERIC: fjsc-parse ( object -- ast )
@ -356,7 +341,7 @@ M: string fjsc-parse ( object -- ast )
M: quotation fjsc-parse ( object -- ast ) M: quotation fjsc-parse ( object -- ast )
[ [
[ (parse-factor-quotation) , ] each [ (parse-factor-quotation) , ] each
] { } make <ast-expression> ; ] { } make ast-expression boa ;
: fjsc-compile ( ast -- string ) : fjsc-compile ( ast -- string )
[ [
@ -372,7 +357,7 @@ M: quotation fjsc-parse ( object -- ast )
: fc* ( string -- string ) : fc* ( string -- string )
[ [
'statement' parse parse-result-ast ast-expression-values do-expressions 'statement' parse parse-result-ast values>> do-expressions
] { } make [ write ] each ; ] { } make [ write ] each ;