comparison ppc/parser.mly @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bfdcc3820b32
1 /* ppc/parser.mly */
2 /* Copyright (c) 2017 J. M. Spivey */
3
4 %{
5 open Keiko
6 open Dict
7 open Tree
8 %}
9
10 %token <Dict.ident> IDENT
11 %token <Keiko.op> MULOP ADDOP RELOP
12 %token <int> NUMBER
13 %token <char> CHAR
14 %token <Keiko.symbol * int> STRING
15
16 /* punctuation */
17 %token SEMI DOT COLON LPAR RPAR COMMA SUB BUS
18 %token EQUAL MINUS ASSIGN VBAR ARROW
19 %token BADTOK IMPOSSIBLE
20
21 /* keywords */
22 %token ARRAY BEGIN CONST DO ELSE END IF OF
23 %token PROC RECORD RETURN THEN TO TYPE
24 %token VAR WHILE NOT POINTER NIL
25 %token REPEAT UNTIL FOR ELSIF CASE
26
27 /* operator priorities */
28 %left RELOP EQUAL
29 %left ADDOP MINUS
30 %left MULOP
31 %nonassoc NOT UMINUS
32
33 %type <Tree.program> program
34 %start program
35
36 %{
37 let const n t = makeExpr (Constant (n, t))
38 %}
39
40 %%
41
42 program :
43 block DOT { Prog ($1, ref []) } ;
44
45 block :
46 decl_list BEGIN stmts END { makeBlock ($1, $3) } ;
47
48 decl_list :
49 /* empty */ { [] }
50 | decl decl_list { $1 @ $2 } ;
51
52 decl :
53 CONST const_decls { $2 }
54 | VAR var_decls { $2 }
55 | proc_decl { [$1] }
56 | TYPE type_decls { [TypeDecl $2] } ;
57
58 const_decls :
59 const_decl { [$1] }
60 | const_decl const_decls { $1 :: $2 } ;
61
62 const_decl :
63 IDENT EQUAL expr SEMI { ConstDecl ($1, $3) } ;
64
65 type_decls :
66 type_decl { [$1] }
67 | type_decl type_decls { $1 :: $2 } ;
68
69 type_decl :
70 IDENT EQUAL typexpr SEMI { ($1, $3) } ;
71
72 var_decls :
73 var_decl { [$1] }
74 | var_decl var_decls { $1 :: $2 } ;
75
76 var_decl :
77 ident_list COLON typexpr SEMI { VarDecl (VarDef, $1, $3) } ;
78
79 proc_decl :
80 proc_heading SEMI block SEMI { ProcDecl ($1, $3) } ;
81
82 proc_heading :
83 PROC name params return_type { Heading ($2, $3, $4) } ;
84
85 params :
86 LPAR RPAR { [] }
87 | LPAR formal_decls RPAR { $2 } ;
88
89 formal_decls :
90 formal_decl { [$1] }
91 | formal_decl SEMI formal_decls { $1 :: $3 } ;
92
93 formal_decl :
94 ident_list COLON typexpr { VarDecl (CParamDef, $1, $3) }
95 | VAR ident_list COLON typexpr { VarDecl (VParamDef, $2, $4) }
96 | proc_heading { PParamDecl $1 } ;
97
98 return_type :
99 /* empty */ { None }
100 | COLON typexpr { Some $2 } ;
101
102 stmts :
103 stmt_list { match $1 with [x] -> x
104 | xs -> makeStmt (Seq $1, 0) } ;
105
106 stmt_list :
107 stmt { [$1] }
108 | stmt SEMI stmt_list { $1 :: $3 } ;
109
110 stmt :
111 line stmt1 { makeStmt ($2, $1) }
112 | /* A trick to force the right line number */
113 IMPOSSIBLE { failwith "impossible" } ;
114
115 line :
116 /* empty */ { !Lexer.lineno } ;
117
118 stmt1 :
119 /* empty */ { Skip }
120 | variable ASSIGN expr { Assign ($1, $3) }
121 | name actuals { ProcCall ($1, $2) }
122 | RETURN expr_opt { Return $2 }
123 | IF expr THEN stmts elses END { IfStmt ($2, $4, $5) }
124 | WHILE expr DO stmts END { WhileStmt ($2, $4) }
125 | REPEAT stmts UNTIL expr { RepeatStmt ($2, $4) }
126 | FOR name ASSIGN expr TO expr DO stmts END
127 { let v = makeExpr (Variable $2) in
128 ForStmt (v, $4, $6, $8) }
129 | CASE expr OF arms else_part END { CaseStmt ($2, $4, $5) } ;
130
131 elses :
132 /* empty */ { makeStmt (Skip, 0) }
133 | ELSE stmts { $2 }
134 | ELSIF line expr THEN stmts elses { makeStmt (IfStmt ($3, $5, $6), $2) } ;
135
136 arms :
137 arm { [$1] }
138 | arm VBAR arms { $1 :: $3 } ;
139
140 arm :
141 expr COLON stmts { ($1, $3) };
142
143 else_part :
144 /* empty */ { makeStmt (Skip, 0) }
145 | ELSE stmts { $2 } ;
146
147 ident_list :
148 IDENT { [$1] }
149 | IDENT COMMA ident_list { $1 :: $3 } ;
150
151 expr_opt :
152 /* empty */ { None }
153 | expr { Some $1 } ;
154
155 expr :
156 variable { $1 }
157 | NUMBER { const $1 integer }
158 | STRING { let (lab, len) = $1 in
159 makeExpr (String (lab, len)) }
160 | CHAR { const (int_of_char $1) character }
161 | NIL { makeExpr Nil }
162 | name actuals { makeExpr (FuncCall ($1, $2)) }
163 | NOT expr { makeExpr (Monop (Not, $2)) }
164 | MINUS expr %prec UMINUS { makeExpr (Monop (Uminus, $2)) }
165 | expr MULOP expr { makeExpr (Binop ($2, $1, $3)) }
166 | expr ADDOP expr { makeExpr (Binop ($2, $1, $3)) }
167 | expr MINUS expr { makeExpr (Binop (Minus, $1, $3)) }
168 | expr RELOP expr { makeExpr (Binop ($2, $1, $3)) }
169 | expr EQUAL expr { makeExpr (Binop (Eq, $1, $3)) }
170 | LPAR expr RPAR { $2 } ;
171
172 actuals :
173 LPAR RPAR { [] }
174 | LPAR expr_list RPAR { $2 } ;
175
176 expr_list :
177 expr { [$1] }
178 | expr COMMA expr_list { $1 :: $3 } ;
179
180 variable :
181 name { makeExpr (Variable $1) }
182 | variable SUB expr BUS { makeExpr (Sub ($1, $3)) }
183 | variable DOT name { makeExpr (Select ($1, $3)) }
184 | variable ARROW { makeExpr (Deref $1) } ;
185
186 typexpr :
187 name { TypeName $1 }
188 | ARRAY expr OF typexpr { Array ($2, $4) }
189 | RECORD fields END { Record $2 }
190 | POINTER TO typexpr { Pointer $3 } ;
191
192 fields :
193 field_decl opt_semi { [$1] }
194 | field_decl SEMI fields { $1 :: $3 } ;
195
196 field_decl :
197 ident_list COLON typexpr { VarDecl (FieldDef, $1, $3) } ;
198
199 opt_semi :
200 SEMI { () }
201 | /* empty */ { () } ;
202
203 name :
204 IDENT { makeName ($1, !Lexer.lineno) } ;