1 ! Copyright (C) 2006 Chris Double. All Rights Reserved.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel peg strings sequences math
4 math.parser namespaces words quotations arrays hashtables io
5 io.streams.string assocs ascii peg.parsers accessors ;
8 TUPLE: ast-number value ;
9 TUPLE: ast-identifier value vocab ;
10 TUPLE: ast-string value ;
11 TUPLE: ast-quotation values ;
12 TUPLE: ast-array elements ;
13 TUPLE: ast-define name stack-effect expression ;
14 TUPLE: ast-expression values ;
15 TUPLE: ast-word value vocab ;
17 TUPLE: ast-stack-effect in out ;
19 TUPLE: ast-using names ;
21 TUPLE: ast-hashtable elements ;
23 : identifier-middle? ( ch -- bool )
25 [ "}];\"" member? not ] keep
29 : 'identifier-ends' ( -- parser )
32 [ CHAR: " = not ] keep
33 [ CHAR: ; = not ] keep
36 identifier-middle? not
40 : 'identifier-middle' ( -- parser )
41 [ identifier-middle? ] satisfy repeat1 ;
43 : 'identifier' ( -- parser )
49 concat >string f ast-identifier boa
55 : 'effect-name' ( -- parser )
58 [ CHAR: ) = not ] keep
61 ] satisfy repeat1 [ >string ] action ;
63 : 'stack-effect' ( -- parser )
66 'effect-name' sp repeat0 ,
68 'effect-name' sp repeat0 ,
71 first2 ast-stack-effect boa
74 : 'define' ( -- parser )
77 'identifier' sp [ value>> ] action ,
78 'stack-effect' sp optional ,
81 ] seq* [ first3 ast-define boa ] action ;
83 : 'quotation' ( -- parser )
86 'expression' [ values>> ] action ,
88 ] seq* [ first ast-quotation boa ] action ;
90 : 'array' ( -- parser )
93 'expression' [ values>> ] action ,
95 ] seq* [ first ast-array boa ] action ;
97 : 'word' ( -- parser )
101 ] seq* [ first value>> f ast-word boa ] action ;
103 : 'atom' ( -- parser )
106 'integer' [ ast-number boa ] action ,
107 'string' [ ast-string boa ] action ,
110 : 'comment' ( -- parser )
117 dup CHAR: \n = swap CHAR: \r = or not
119 ] seq* [ drop ast-comment boa ] action ;
121 : 'USE:' ( -- parser )
123 "USE:" token sp hide ,
125 ] seq* [ first value>> ast-use boa ] action ;
127 : 'IN:' ( -- parser )
129 "IN:" token sp hide ,
131 ] seq* [ first value>> ast-in boa ] action ;
133 : 'USING:' ( -- parser )
135 "USING:" token sp hide ,
136 'identifier' sp [ value>> ] action repeat1 ,
138 ] seq* [ first ast-using boa ] action ;
140 : 'hashtable' ( -- parser )
143 'expression' [ values>> ] action ,
145 ] seq* [ first ast-hashtable boa ] action ;
147 : 'parsing-word' ( -- parser )
154 : 'expression' ( -- parser )
165 ] choice* repeat0 [ ast-expression boa ] action
168 : 'statement' ( -- parser )
171 GENERIC: (compile) ( ast -- )
172 GENERIC: (literal) ( ast -- )
174 M: ast-number (literal)
175 value>> number>string , ;
177 M: ast-number (compile)
178 "factor.push_data(" ,
182 M: ast-string (literal)
187 M: ast-string (compile)
188 "factor.push_data(" ,
192 M: ast-identifier (literal)
194 "factor.get_word(\"" ,
200 "factor.find_word(\"" , value>> , "\")" ,
203 M: ast-identifier (compile)
204 (literal) ".execute(" , ;
206 M: ast-define (compile)
207 "factor.define_word(\"" ,
210 expression>> (compile)
213 : do-expressions ( seq -- )
216 dup ast-comment? not [
225 drop "factor.cont.next" ,
228 M: ast-quotation (literal)
229 "factor.make_quotation(\"source\"," ,
230 values>> do-expressions
233 M: ast-quotation (compile)
234 "factor.push_data(factor.make_quotation(\"source\"," ,
235 values>> do-expressions
238 M: ast-array (literal)
240 elements>> [ "," , ] [ (literal) ] interleave
243 M: ast-array (compile)
244 "factor.push_data(" , (literal) "," , ;
246 M: ast-hashtable (literal)
247 "new Hashtable().fromAlist([" ,
248 elements>> [ "," , ] [ (literal) ] interleave
251 M: ast-hashtable (compile)
252 "factor.push_data(" , (literal) "," , ;
255 M: ast-expression (literal)
260 M: ast-expression (compile)
261 values>> do-expressions ;
263 M: ast-word (literal)
265 "factor.get_word(\"" ,
271 "factor.find_word(\"" , value>> , "\")" ,
274 M: ast-word (compile)
275 "factor.push_data(" ,
279 M: ast-comment (compile)
282 M: ast-stack-effect (compile)
295 M: ast-using (compile)
304 GENERIC: (parse-factor-quotation) ( object -- ast )
306 M: number (parse-factor-quotation) ( object -- ast )
309 M: symbol (parse-factor-quotation) ( object -- ast )
310 dup >string swap vocabulary>> ast-identifier boa ;
312 M: word (parse-factor-quotation) ( object -- ast )
313 dup name>> swap vocabulary>> ast-identifier boa ;
315 M: string (parse-factor-quotation) ( object -- ast )
318 M: quotation (parse-factor-quotation) ( object -- ast )
320 [ (parse-factor-quotation) , ] each
321 ] { } make ast-quotation boa ;
323 M: array (parse-factor-quotation) ( object -- ast )
325 [ (parse-factor-quotation) , ] each
326 ] { } make ast-array boa ;
328 M: hashtable (parse-factor-quotation) ( object -- ast )
330 [ (parse-factor-quotation) , ] each
331 ] { } make ast-hashtable boa ;
333 M: wrapper (parse-factor-quotation) ( object -- ast )
334 wrapped>> dup name>> swap vocabulary>> ast-word boa ;
336 GENERIC: fjsc-parse ( object -- ast )
338 M: string fjsc-parse ( object -- ast )
339 'expression' parse parse-result-ast ;
341 M: quotation fjsc-parse ( object -- ast )
343 [ (parse-factor-quotation) , ] each
344 ] { } make ast-expression boa ;
346 : fjsc-compile ( ast -- string )
352 ] { } make [ write ] each
353 ] with-string-writer ;
355 : fjsc-compile* ( string -- string )
356 'statement' parse parse-result-ast fjsc-compile ;
358 : fc* ( string -- string )
360 'statement' parse parse-result-ast values>> do-expressions
361 ] { } make [ write ] each ;
364 : fjsc-literal ( ast -- string )
366 [ (literal) ] { } make [ write ] each
367 ] with-string-writer ;