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 math.parser
4 namespaces make words quotations arrays hashtables io
5 io.streams.string assocs ascii peg.parsers words.symbol
6 combinators.short-circuit ;
9 TUPLE: ast-number value ;
10 TUPLE: ast-identifier value vocab ;
11 TUPLE: ast-string value ;
12 TUPLE: ast-quotation values ;
13 TUPLE: ast-array elements ;
14 TUPLE: ast-define name stack-effect expression ;
15 TUPLE: ast-expression values ;
16 TUPLE: ast-word value vocab ;
18 TUPLE: ast-stack-effect in out ;
20 TUPLE: ast-using names ;
22 TUPLE: ast-hashtable elements ;
24 : identifier-middle? ( ch -- bool )
27 [ "}];\"" member? not ]
31 : 'identifier-ends' ( -- parser )
39 [ identifier-middle? not ]
43 : 'identifier-middle' ( -- parser )
44 [ identifier-middle? ] satisfy repeat1 ;
46 : 'identifier' ( -- parser )
52 "" concat-as f ast-identifier boa
58 : 'effect-name' ( -- parser )
65 ] satisfy repeat1 [ >string ] action ;
67 : 'stack-effect' ( -- parser )
70 'effect-name' sp repeat0 ,
72 'effect-name' sp repeat0 ,
75 first2 ast-stack-effect boa
78 : 'define' ( -- parser )
81 'identifier' sp [ value>> ] action ,
82 'stack-effect' sp optional ,
85 ] seq* [ first3 ast-define boa ] action ;
87 : 'quotation' ( -- parser )
90 'expression' [ values>> ] action ,
92 ] seq* [ first ast-quotation boa ] action ;
94 : 'array' ( -- parser )
97 'expression' [ values>> ] action ,
99 ] seq* [ first ast-array boa ] action ;
101 : 'word' ( -- parser )
105 ] seq* [ first value>> f ast-word boa ] action ;
107 : 'atom' ( -- parser )
110 'integer' [ ast-number boa ] action ,
111 'string' [ ast-string boa ] action ,
114 : 'comment' ( -- parser )
121 dup CHAR: \n = swap CHAR: \r = or not
123 ] seq* [ drop ast-comment boa ] action ;
125 : 'USE:' ( -- parser )
127 "USE:" token sp hide ,
129 ] seq* [ first value>> ast-use boa ] action ;
131 : 'IN:' ( -- parser )
133 "IN:" token sp hide ,
135 ] seq* [ first value>> ast-in boa ] action ;
137 : 'USING:' ( -- parser )
139 "USING:" token sp hide ,
140 'identifier' sp [ value>> ] action repeat1 ,
142 ] seq* [ first ast-using boa ] action ;
144 : 'hashtable' ( -- parser )
147 'expression' [ values>> ] action ,
149 ] seq* [ first ast-hashtable boa ] action ;
151 : 'parsing-word' ( -- parser )
158 : 'expression' ( -- parser )
169 ] choice* repeat0 [ ast-expression boa ] action
172 : 'statement' ( -- parser )
175 GENERIC: (compile) ( ast -- )
176 GENERIC: (literal) ( ast -- )
178 M: ast-number (literal)
179 value>> number>string , ;
181 M: ast-number (compile)
182 "factor.push_data(" ,
186 M: ast-string (literal)
191 M: ast-string (compile)
192 "factor.push_data(" ,
196 M: ast-identifier (literal)
198 "factor.get_word(\"" ,
204 "factor.find_word(\"" , value>> , "\")" ,
207 M: ast-identifier (compile)
208 (literal) ".execute(" , ;
210 M: ast-define (compile)
211 "factor.define_word(\"" ,
214 expression>> (compile)
217 : do-expressions ( seq -- )
220 dup ast-comment? not [
229 drop "factor.cont.next" ,
232 M: ast-quotation (literal)
233 "factor.make_quotation(\"source\"," ,
234 values>> do-expressions
237 M: ast-quotation (compile)
238 "factor.push_data(factor.make_quotation(\"source\"," ,
239 values>> do-expressions
242 M: ast-array (literal)
244 elements>> [ "," , ] [ (literal) ] interleave
247 M: ast-array (compile)
248 "factor.push_data(" , (literal) "," , ;
250 M: ast-hashtable (literal)
251 "new Hashtable().fromAlist([" ,
252 elements>> [ "," , ] [ (literal) ] interleave
255 M: ast-hashtable (compile)
256 "factor.push_data(" , (literal) "," , ;
259 M: ast-expression (literal)
264 M: ast-expression (compile)
265 values>> do-expressions ;
267 M: ast-word (literal)
269 "factor.get_word(\"" ,
275 "factor.find_word(\"" , value>> , "\")" ,
278 M: ast-word (compile)
279 "factor.push_data(" ,
283 M: ast-comment (compile)
286 M: ast-stack-effect (compile)
299 M: ast-using (compile)
308 GENERIC: (parse-factor-quotation) ( object -- ast )
310 M: number (parse-factor-quotation) ( object -- ast )
313 M: symbol (parse-factor-quotation) ( object -- ast )
314 [ >string ] [ vocabulary>> ] bi ast-identifier boa ;
316 M: word (parse-factor-quotation) ( object -- ast )
317 [ name>> ] [ vocabulary>> ] bi ast-identifier boa ;
319 M: string (parse-factor-quotation) ( object -- ast )
322 M: quotation (parse-factor-quotation) ( object -- ast )
323 [ (parse-factor-quotation) ] { } map-as ast-quotation boa ;
325 M: array (parse-factor-quotation) ( object -- ast )
326 [ (parse-factor-quotation) ] { } map-as ast-array boa ;
328 M: hashtable (parse-factor-quotation) ( object -- ast )
329 >alist [ (parse-factor-quotation) ] { } map-as ast-hashtable boa ;
331 M: wrapper (parse-factor-quotation) ( object -- ast )
332 wrapped>> [ name>> ] [ vocabulary>> ] bi ast-word boa ;
334 GENERIC: fjsc-parse ( object -- ast )
336 M: string fjsc-parse ( object -- ast )
339 M: quotation fjsc-parse ( object -- ast )
340 [ (parse-factor-quotation) ] { } map-as ast-expression boa ;
342 : fjsc-compile ( ast -- string )
348 ] { } make [ write ] each
349 ] with-string-writer ;
351 : fjsc-compile* ( string -- string )
352 'statement' parse fjsc-compile ;
356 'statement' parse values>> do-expressions
357 ] { } make [ write ] each ;
359 : fjsc-literal ( ast -- string )
361 [ (literal) ] { } make [ write ] each
362 ] with-string-writer ;