smalltalk-tng

view etng-r2/etng-parser.g @ 321:c4a0718c2d3c

find changesets by author, revision, files, or words in the commit message
Sketch of dependencies
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
date Sat Oct 08 15:36:03 2011 -0400 (7 months ago)
parents 4d06e035b80e
children
line source
1 -- -*- text -*-
2
3 toplevel = toplevel-item:v ~_ -> v;
4
5 toplevel-item =
6 {#paren #namespace :prefix ?(symbol? prefix) equal :urn ?(string? urn) ~_
7 -> `(define-namespace ,prefix ,urn)}
8 | {#paren #namespace :urn ?(string? urn) ~_
9 -> `(declare-default-namespace ,urn)}
10 | {#paren #define :q ?(qname-or-symbol? q) equal expr:exp ~_
11 -> `(define-value ,q ,exp)}
12 | {#paren #define :q ?(qname-or-symbol? q) normal-method:def ~_
13 -> `(define-function ,q ,def)}
14 | parse
15 ;
16
17 parse =
18 ~(comma | semi | arrow | equal | pipe)
19 :n
20 ( grouping(n)
21 | ?(qname-or-symbol? n) -> `(ref ,n)
22 | ?(or (string? n) (number? n)) -> `(lit ,n) )
23 | comma -> (error 'extra 'comma)
24 | semi -> (error 'extra 'semi)
25 | arrow -> (error 'extra 'arrow)
26 | equal -> (error 'extra 'equal)
27 | pipe -> (error 'extra 'pipe)
28 | -> (error)
29 ;
30
31 grouping =
32 {#paren expr:e ~_ -> e}
33 | #rec {#brace methods:ms -> `(object self ,@ms)}
34 | #rec :selfid {#brace methods:ms -> `(object ,selfid ,@ms)}
35 | {#brace methods:ms -> `(function ,@ms)}
36 ;
37
38 expr =
39 :head ?(special-segment-head? head) special-segment(head)
40 | tuple:elts -> (if (= (length elts) 1) (car elts) `(tuple ,@elts))
41 ;
42
43 special-segment =
44 :head ?(equal? head QUOTE-QNAME) :n -> `(lit ,n)
45 | :head ?(equal? head UNQUOTE-QNAME) -> (error 'naked-unquote)
46 | #do expr:e1 semis expr:e2
47 -> `(send (function (method ((discard)) ,e2)) ,e1)
48 | #let pattern:p equal expr:e semis expr:body
49 -> `(send (function (method (,p) ,body)) ,e)
50 | #'%assemble' {#paren assemble-bindings:bindings ~_} {#brace assemble-clauses:clauses ~_}
51 -> `(assemble ,bindings ,clauses)
52 ;
53
54 assemble-bindings =
55 assemble-binding:b (comma assemble-binding)*:bs -> (cons b bs)
56 | ~_ -> '()
57 ;
58
59 assemble-binding = :n ?(qname-or-symbol? n) equal send:e -> (list n e);
60
61 assemble-clauses =
62 ({#paren quote :n ?(qname-or-symbol? n)} | -> (error 'expected 'quoted-language-name))
63 arrow :item &(semi | ~_)
64 semis assemble-clauses:more -> (cons (list n item) more)
65 | ~_ -> '()
66 ;
67
68 tuple =
69 send:s (comma send)*:ss -> (cons s ss)
70 | ~_ -> '()
71 ;
72
73 send =
74 parse:receiver parse*:arguments pipeline:continuation
75 -> (continuation (if (null? arguments) receiver `(send ,receiver ,@arguments)))
76 | &pipe pipeline:continuation
77 -> (let ((g (gensym 'pipe)))
78 `(function (method ((bind ,g)) ,(continuation `(ref ,g)))))
79 ;
80
81 pipeline =
82 pipe parse:receiver parse*:arguments pipeline:continuation
83 -> (lambda (first-argument-ast)
84 (continuation `(send ,receiver ,first-argument-ast ,@arguments)))
85 | -> (lambda (first-argument-ast)
86 first-argument-ast)
87 ;
88
89 methods =
90 normal-method:m semis methods:ms -> (cons m ms)
91 | constant-method:m semis methods:ms -> (cons m ms)
92 | &_ expr:e semis ~_ -> (list `(method ((discard)) ,e))
93 | semis ~_ -> '()
94 ;
95
96 normal-method =
97 (~&(arrow | equal) pattern)+:patterns arrow expr:body
98 -> `(method ,patterns ,body)
99 ;
100
101 constant-method =
102 (~&(arrow | equal) pattern)+:patterns equal expr:body
103 -> `(constant-method ,patterns ,body)
104 ;
105
106 pattern = pattern-tuple-nonempty:elts -> (if (= (length elts) 1) (car elts) `(tuple ,@elts));
107
108 pattern-tuple-nonempty =
109 pattern-element:e (comma pattern-element)*:es
110 -> (cons e es)
111 ;
112
113 pattern-tuple = pattern | -> `(tuple);
114
115 pattern-element =
116 ~(#do | #let)
117 :n
118 ( pattern-grouping(n)
119 | ?(eq? n DISCARD) -> `(discard)
120 | ?(qname-or-symbol? n) -> `(bind ,n)
121 | ?(or (string? n) (number? n)) -> `(lit ,n)
122 )
123 ;
124
125 pattern-grouping =
126 {#paren quote :n -> `(lit ,n)}
127 | {#paren pattern-tuple:p ~_ -> p}
128 | {#brace -> (error 'object-matching-not-supported)}
129 | {#brack -> (error 'list-matching-not-supported)}
130 ;
131
132 semis = (:x ?(eq? x SEMI))*;
133 semi = :x ?(eq? x SEMI) -> x;
134
135 quote = :x ?(equal? x QUOTE-QNAME) -> x;
136 comma = :x ?(eq? x COMMA) -> x;
137 arrow = :x ?(eq? x ARROW) -> x;
138 equal = :x ?(eq? x '=) -> x;
139 pipe = :x ?(eq? x PIPE) -> x;