1 %{
2 //////////////////////////////////////////////////////////////////////////////
3 // This file is part of Teyjus. //
4 // //
5 // Teyjus is free software: you can redistribute it and/or modify //
6 // it under the terms of the GNU General Public License as published by //
7 // the Free Software Foundation, either version 3 of the License, or //
8 // (at your option) any later version. //
9 // //
10 // Teyjus is distributed in the hope that it will be useful, //
11 // but WITHOUT ANY WARRANTY; without even the implied warranty of //
12 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
13 // GNU General Public License for more details. //
14 // //
15 // You should have received a copy of the GNU General Public License //
16 // along with Teyjus. If not, see <http://www.gnu.org/licenses/>. //
17 //////////////////////////////////////////////////////////////////////////////
18
19 #include <stdio.h>
20 #include <stdlib.h>
21 #include "../util/util.h"
22 #include "op.h"
23 #include "types.h"
24 #include "pervgen-c.h"
25 #include "pervgen-ocaml.h"
26 //#include "ops.h"
27
28 extern int yylex();
29
yywrap()30 int yywrap() {return 1;}
31
yyerror(const char * str)32 void yyerror(const char* str)
33 {
34 printf("Error: Unable to parse input: %s\n", str);
35 }
36
37 static int tySkelInd = 0;
38
39 %}
40
41 %union
42 {
43 char* name;
44 char* text;
45 OP_Fixity fixityType;
46 OP_Prec precType;
47 OP_Code codeType;
48 UTIL_Bool boolType;
49 struct
50 {
51 int ival;
52 char* sval;
53 } isval;
54 Type tyval;
55 TypeList tylistval;
56 }
57
58 %token LBRACKET RBRACKET LPAREN RPAREN COMMA POUND SEMICOLON TRUE
59 FALSE
60 TYARROW TYAPP
61 INFIX INFIXL INFIXR PREFIX PREFIXR POSTFIX POSTFIXL NOFIXITY
62 MIN1 MIN2 MAX
63 NOCODE
64 LSSYMB LSSTART LSEND PREDSYMB PREDSTART PREDEND REGCL
65 BACKTRACK
66 KIND CONST EMPTY TYSKEL TYPE EMPTYTYPE ERROR
67
68 %token <name> ID
69 %token <isval> NUM
70 %token <text> STRING
71
72
73 %start pervasives
74 %type <text> comments
75 %type <tyval> arrow_tyskel app_tyskel atomic_tyskel
76 %type <tylistval> tyskel_list
77 %type <isval> ty_index tesize neededness
78 %type <name> const_name const_ind_name
79 %type <fixityType> fixity
80 %type <precType> prec
81 %type <codeType> code_info
82 %type <boolType> redef typrev
83 %%
84
85 pervasives : kind const_tyskel
86 ;
87
88 kind : kind_header kind_decls
89 { cgenKindH(); cgenKindC(); ocamlGenKinds(); }
90 ;
91
92 kind_header : KIND NUM
93 { cgenKindInit($2.ival); cgenNumKinds($2.sval);
94 ocamlGenNumKinds($2.sval);
95 }
96 ;
97
98 kind_decls : kind_decl SEMICOLON kind_decls
99 | kind_decl
100 ;
101
102 kind_decl : NUM ID ID NUM
103 { cgenKindIndex($1.ival, $3, $1.sval, NULL);
104 cgenKindData($1.ival, $2, $4.sval, NULL);
105 ocamlGenKind($2, $3, $4.sval, $1.sval); }
106 | comments NUM ID ID NUM
107 { cgenKindIndex($2.ival, $4, $2.sval, $1);
108 cgenKindData($2.ival, $3, $5.sval, $1);
109 ocamlGenKind($3, $4, $5.sval, $2.sval); }
110 ;
111
112 comments : STRING { $$ = $1;};
113 ;
114
115 const_tyskel : const_tyskel_header const_tyskel_decls const_property
116 { cgenTySkelsH(); cgenTySkelsC(); cgenConstProperty();
117 cgenConstH(); cgenConstC();
118 ocamlGenConsts();
119 }
120 ;
121
122
123 const_tyskel_header : CONST NUM TYSKEL NUM
124 { cgenNumTySkels($4.sval); cgenTySkelInit($4.ival);
125 cgenNumConsts($2.sval); cgenConstInit($2.ival);
126 ocamlGenNumConsts($2.sval);
127 }
128 ;
129
130 const_tyskel_decls : const_tyskel_decl SEMICOLON const_tyskel_decls
131 | const_tyskel_decl
132 ;
133
134 const_tyskel_decl : tyskel_decl const_decls
135 ;
136
137 tyskel_decl : TYPE NUM arrow_tyskel
138 {tySkelInd = $2.ival;
139 ocamlGenTySkel($2.sval, $3);
140 cgenTySkelTab($2.ival, $3, NULL);
141 }
142 | comments TYPE NUM arrow_tyskel
143 {tySkelInd = $3.ival;
144 ocamlGenTySkel($3.sval, $4);
145 cgenTySkelTab($3.ival, $4, $1);
146 }
147 ;
148
149
150 arrow_tyskel : app_tyskel TYARROW arrow_tyskel
151 { $$ = mkArrowType($1, $3); }
152 | app_tyskel
153 { $$ = $1; }
154 ;
155
156 app_tyskel : LPAREN TYAPP ID NUM LBRACKET tyskel_list
157 RBRACKET RPAREN
158 {$$ = mkStrType(mkStrFuncType($3,$4.sval), $4.ival, $6);}
159 | atomic_tyskel
160 {$$ = $1; }
161 ;
162
163 atomic_tyskel : ID
164 { $$ = mkSortType($1); }
165 | ty_index
166 { $$ = mkSkVarType($1.sval); }
167 | LPAREN arrow_tyskel RPAREN
168 { $$ = $2; }
169 ;
170
171 tyskel_list : arrow_tyskel COMMA tyskel_list
172 { $$ = addItem($1, $3); }
173 | arrow_tyskel
174 { $$ = addItem($1, NULL); }
175
176 ty_index : POUND NUM {$$ = $2;}
177 ;
178
179 const_decls : const_decl const_decls
180 | const_decl
181 ;
182
183 const_decl : NUM const_name const_ind_name tesize tesize neededness
184 typrev redef prec fixity code_info
185 { cgenConstIndex($1.ival, $3, $1.sval, NULL);
186 cgenConstData($1.ival, $2, $4.sval, $9, $10, tySkelInd,
187 $5.sval, NULL);
188 ocamlGenConst($1.sval, $2, $3, $10, $9, $7, $8,
189 $4.ival, tySkelInd, $6.ival, $11,
190 $1.sval, $2);
191 }
192 | NUM const_name const_ind_name tesize tesize neededness
193 typrev redef prec fixity code_info const_name
194 { cgenConstIndex($1.ival, $3, $1.sval, NULL);
195 cgenConstData($1.ival, $12, $4.sval, $9, $10, tySkelInd,
196 $5.sval, NULL);
197 ocamlGenConst($1.sval, $2, $3, $10, $9, $7, $8,
198 $4.ival, tySkelInd, $6.ival, $11,
199 $1.sval, $12);
200 }
201 | comments NUM const_name const_ind_name tesize tesize
202 neededness typrev redef prec fixity code_info
203 { cgenConstIndex($2.ival, $4, $2.sval, $1);
204 cgenConstData($2.ival, $3, $5.sval, $10, $11,
205 tySkelInd, $7.sval, $1);
206 ocamlGenConst($2.sval, $3, $4, $11, $10, $8, $9,
207 $5.ival, tySkelInd, $7.ival, $12,
208 $2.sval, $3);
209 }
210 | comments NUM const_name const_ind_name tesize tesize
211 neededness typrev redef prec fixity code_info const_name
212 { cgenConstIndex($2.ival, $4, $2.sval, $1);
213 cgenConstData($2.ival, $13, $5.sval, $10, $11,
214 tySkelInd, $7.sval, $1);
215 ocamlGenConst($2.sval, $3, $4, $11, $10, $8, $9,
216 $5.ival, tySkelInd, $7.ival, $12,
217 $2.sval, $13);
218 }
219 ;
220
221 const_name : ID {$$ = $1;}
222 ;
223 const_ind_name : ID {$$ = $1;}
224 ;
225
226 tesize : NUM {$$ = $1;}
227 ;
228 neededness : NUM {$$ = $1;}
229 ;
230
231 typrev : TRUE {$$ = UTIL_TRUE;}
232 | FALSE {$$ = UTIL_FALSE;}
233 ;
234
235 redef : TRUE {$$ = UTIL_TRUE;}
236 | FALSE {$$ = UTIL_FALSE;}
237 ;
238
239 fixity : INFIX {$$ = OP_INFIX;}
240 | INFIXL {$$ = OP_INFIXL;}
241 | INFIXR {$$ = OP_INFIXR;}
242 | PREFIX {$$ = OP_PREFIX;}
243 | PREFIXR {$$ = OP_PREFIXR;}
244 | POSTFIX {$$ = OP_POSTFIX;}
245 | POSTFIXL {$$ = OP_POSTFIXL;}
246 | NOFIXITY {$$ = OP_NONE;}
247 ;
248
249 prec : MIN1 {$$ = OP_mkPrecMin1();}
250 | MIN2 {$$ = OP_mkPrecMin2();}
251 | NUM {$$ = OP_mkPrec($1.ival);}
252 | MAX {$$ = OP_mkPrecMax();}
253 ;
254
255 code_info : NOCODE {$$ = OP_mkCodeInfoNone();}
256 | NUM {$$ = OP_mkCodeInfo($1.ival);}
257 ;
258
259 const_property : logic_symbol pred_symbol regclobber backtrackable
260 ;
261
262 logic_symbol : ls_header ls_range ls_types
263 ;
264
265 ls_header : LSSYMB NUM { cgenLogicSymbolInit($2.ival); }
266 ;
267
268 ls_range : LSSTART const_ind_name LSEND const_ind_name
269 { cgenLSRange($2, $4);}
270 ;
271
272 ls_types : ls_type ls_types
273 | ls_type
274 ;
275
276 ls_type : NUM ID {cgenLogicSymbType($1.ival, $2, $1.sval);}
277 ;
278
279 pred_symbol : pred_header pred_range
280 ;
281
282 pred_header : PREDSYMB NUM
283 {if ($2.ival == 0) {
284 fprintf(stderr,
285 "The number of predicate symbols cannot be 0\n");
286 exit(1);
287 }
288 }
289 ;
290
291 pred_range : PREDSTART const_ind_name PREDEND const_ind_name
292 { cgenPREDRange($2, $4); }
293 ;
294
295 regclobber : REGCL const_list { ocamlGenRC(); }
296 ;
297
298 backtrackable : BACKTRACK const_list { ocamlGenBC(); }
299 ;
300
301 const_list : ID const_list { ocamlCollectConsts($1, 0); }
302 | ID { ocamlCollectConsts($1, 1); }
303 ;
304
305 %%
306
307 extern FILE* yyin;
308
main(argc,argv)309 int main(argc, argv)
310 int argc;
311 char * argv[];
312 {
313 int ret = 0;
314 char * root = NULL;
315 if(argc == 1)
316 {
317 //printf("No input file specified; using 'Pervasives.in'.\n");
318 yyin = UTIL_fopenR("Pervasives.in");
319 }
320 else
321 {
322 yyin = UTIL_fopenR(argv[1]);
323 }
324
325 if(argc > 2)
326 {
327 root = argv[2];
328 }
329 else
330 {
331 //printf("Teyjus source root directory not specified; using '../../'.\n");
332 root = "../../";
333 }
334
335 //printf("Generating pervasive files...\n");
336
337 ret = yyparse();
338 UTIL_fclose(yyin);
339
340 if(ret != 0)
341 {
342 printf("Generation failed.\n");
343 return -1;
344 }
345 spitCPervasivesH(root);
346 spitCPervasivesC(root);
347 spitOCPervasiveMLI(root);
348 spitOCPervasiveML(root);
349 //printf("Done.\n");
350 return 0;
351 }
352