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