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