1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
/* ------------------------------------------------------------------------ */
/* */
/* [pl0.c] PL0 Interpreter */
/* */
/* Copyright (c) 2000 by Doelle, Manns */
/* ------------------------------------------------------------------------ */
#include "stdosx.h" // General Definitions (for gcc)
#include "ptm_gen.h" // General Parsing Routines
#include "ptm_pp.h" // Pretty Printer
#include "gls.h" // General Language Services
#include "hmap.h" // Datatype: Finite Maps
#include "symbols.h" // Datatype: Symbols
#include "pl0_int.h" // grammar interface
#include "pl0_lim.h" // scanner table
#include "pl0_pim.h" // parser table
/* Auxiluary Functions ----------------------------------------------------- */
static void ppExp(pl0Exp exp)
/* somewhat misused pretty printer */
/* This is only for demonstration purposes, so we don't care to get the */
/* parser table and initialize things here over and over. We do not even */
/* reformat. See [stypp.c] for how to do it the right way. For diagnostic */
/* purposes, one will certainly prefere the PT_print routine. */
{ PLR_Tab plr = PLR_get_pl0(); // Get parser table
PTP_init(plr); // Init Pretty Printer
PTP_pp(exp,stdout); // slightly abused
PTP_quit(); // Done Pretty Printer
PLR_delTab(plr); // Free parser table
}
static MAP(symbol, pl0Dfn) collectFunctions(pl0Program src, bool emitErrors)
/* collect global definitions, emit duplicate errors if requiered */
{ GLS_Lst(pl0Dfn) dfns; GLS_Lst(pl0Dfn) dit;
MAP(symbol, pl0Dfn) glo = MAP_newPrimMap(); // global environment
bug0( pl0Program_pgm(src,&dfns,_), "program expected");
GLS_FORALL(dit,dfns)
{ GLS_Tok fid; pl0Dfn dfn = GLS_FIRST(pl0Dfn,dit);
bug0( pl0Dfn_fun(dfn, &fid,_,_), "expecting fun Dfn");
if (MAP_defined(glo,GLS_Tok_symbol(fid)))
{
if (emitErrors)
PT_error(fid,"Function '%s' is already defined",GLS_Tok_string(fid));
}
else
MAP_define(glo,GLS_Tok_symbol(fid),dfn);
}
return glo;
}
/* Static Semantics -------------------------------------------------------- */
static void StaticSemantic(pl0Program src)
/* Collect definitions and validate scoping rules */
{
PT_Itr it; pl0Dfn d; pl0Exp e;
MAP(symbol, pl0Dfn) glo; // global environment.
MAP(symbol, void) local; // local environment, a set really.
//
// Pass 1
// - function names are unique
// : collect them in 'glo' for later use
//
glo = collectFunctions(src,True);
//
// Pass 2
// - applied function occurences are defined ...
// - ... and have the right arity
// - formal parameter names are unique
// - applied identfiers refer to formal parameters
//
local = NULL; // only to make gcc happy
PT_FORALL(it,src)
{ PT_Term t = PT_termIT(it);
if (PT_stateIT(it) == PT_PRAE && pl0_Dfn(t,&d) )
// start of function definition
{ GLS_Lst(GLS_Tok) fpl; GLS_Lst(GLS_Tok) fpit;
bug0( pl0Dfn_fun(d, _,&fpl,_), "expecting fun Dfn");
local = MAP_newPrimMap(); // create local environment
GLS_FORALL(fpit,fpl)
{ GLS_Tok fp = GLS_FIRST(GLS_Tok,fpit);
if (MAP_defined(local,GLS_Tok_symbol(fp)))
PT_error(fp,"Parameter '%s' is already defined",GLS_Tok_string(fp));
else
MAP_define(local,GLS_Tok_symbol(fp),_);
}
}
if (PT_stateIT(it) == PT_POST && pl0_Dfn(t,&d) )
// end of function definition
{
MAP_freeMap(local); // drop local environment
}
if (PT_stateIT(it) == PT_PRAE && pl0_Exp(t,&e) )
// found expression
{ GLS_Tok fid; GLS_Tok vid; GLS_Lst(pl0Exp) apl;
if (pl0Exp_app(e, &fid, &apl)) // applied function
{
// check for defined occurence
if (MAP_defined(glo,GLS_Tok_symbol(fid)))
{ GLS_Lst(GLS_Tok) fpl;
bug0( pl0Dfn_fun( MAP_apply(pl0Dfn,glo,GLS_Tok_symbol(fid)), _,&fpl,_),
"fun expected");
// check for matching arity
if (GLS_Lst_length(fpl) != GLS_Lst_length(apl))
PT_error(e,"arity error");
}
else
PT_error(e,"undefined function '%s'",GLS_Tok_string(fid));
}
if (pl0Exp_var(e, &vid)) // applied variable
{
// check for defined occurence
if (!MAP_defined(local,GLS_Tok_symbol(vid)))
PT_error(vid,"Undefined variable '%s'",GLS_Tok_string(vid));
}
}
}
MAP_freeMap(glo);
}
/* Dynamic Semantic -------------------------------------------------------- */
static int calls; // profiling function calls
static int evals; // profiling evaluated expression
static int eval(pl0Exp ex, MAP(symbol,pl0Dfn) glo, MAP(symbol,int) loc)
/* a standard expression evaluator */
{ pl0Exp ex1, ex2, ex3; GLS_Tok tok; GLS_Lst(pl0Exp) exps;
evals++; // profile
if( pl0Exp_equ(ex, &ex1,&ex2) ) return eval(ex1,glo,loc) == eval(ex2,glo,loc); else
if( pl0Exp_les(ex, &ex1,&ex2) ) return eval(ex1,glo,loc) < eval(ex2,glo,loc); else
if( pl0Exp_div(ex, &ex1,&ex2) ) return eval(ex1,glo,loc) / eval(ex2,glo,loc); else
if( pl0Exp_mlt(ex, &ex1,&ex2) ) return eval(ex1,glo,loc) * eval(ex2,glo,loc); else
if( pl0Exp_sub(ex, &ex1,&ex2) ) return eval(ex1,glo,loc) - eval(ex2,glo,loc); else
if( pl0Exp_add(ex, &ex1,&ex2) ) return eval(ex1,glo,loc) + eval(ex2,glo,loc); else
if( pl0Exp_neg(ex, &ex1) ) return - eval(ex1,glo,loc); else
if( pl0Exp_int(ex, &tok) ) return atoi(GLS_Tok_string(tok)); else
if( pl0Exp_var(ex, &tok) ) return MAP_apply(int,loc,GLS_Tok_symbol(tok)); else
if( pl0Exp_if(ex, &ex1,&ex2,&ex3) ) return eval(eval(ex1,glo,loc)?ex2:ex3,glo,loc);
else
if( pl0Exp_app(ex, &tok,&exps) )
{ int res; GLS_Lst(GLS_Tok) fpit, fpl; pl0Exp body;
MAP(symbol,int) newloc = MAP_newPrimMap();
pl0Dfn dfn = MAP_apply(pl0Dfn,glo,GLS_Tok_symbol(tok));
bug0( pl0Dfn_fun( dfn, _, &fpl, &body), "function expected");
calls++; // profile
// evaluate actual parameter list creating new local environment
GLS_FORALL(fpit,fpl)
{ GLS_Tok fp = GLS_FIRST(GLS_Tok,fpit);
pl0Exp ap = GLS_FIRST(pl0Exp,exps);
MAP_define(newloc,GLS_Tok_symbol(fp),eval(ap,glo,loc));
exps = GLS_REST(pl0Exp,exps);
}
res = eval(body,glo,newloc); // recursively evaluate function body
MAP_freeMap(newloc); // free new local environment
return res;
}
else
{
PT_error(ex,"unrecognized expression type");
return 0; // fault, but we continue anyway.
}
}
static void DynamicSemantic(pl0Program src)
/* semantic of the program: evaluate and print each "run" expression */
{ GLS_Lst(pl0Run) runs; GLS_Lst(pl0Run) runit;
MAP(symbol,pl0Dfn) glo = collectFunctions(src,False); // global environment
MAP(symbol,int) loc = MAP_newPrimMap(); // empty local environment
bug0( pl0Program_pgm(src,_,&runs), "program expected");
GLS_FORALL(runit,runs)
{ pl0Exp exp; pl0Run run = GLS_FIRST(pl0Run,runit);
bug0( pl0Run_run(run, &exp), "expecting run Run");
calls = 0; evals = 0; // init execution profile
printf("running: "); ppExp(exp); // pretty print expression
printf(" = %d",eval(exp,glo,loc)); // calculate and print result
printf(" [%d calls, %d expressions evaluated]\n",calls,evals);
}
MAP_freeMap(loc);
MAP_freeMap(glo);
}
/* Main Program ------------------------------------------------------------ */
void PL0(string fileid)
/* initialize and get source */
{ Scn_T scn; Scn_Stream cstream; // scanner table & configuration
PLR_Tab plr; PT_Cfg PCfg; // parser table & configuration
PT_Term srcterm; // the source term
//
// init modules
//
MAP_init(); initSymbols(); pl0_initSymbols();
//
// Parse the source file
//
Scn_get_pl0(&scn); // Get scanner table
cstream = Stream_file(scn,"",fileid,""); // Open source file
plr = PLR_get_pl0(); // Get parser table
PCfg = PT_init(plr,cstream); // Create parser
srcterm = PT_PARSE(PCfg,"Program"); // Parse
PT_setErrorCnt(PT_synErrorCnt(PCfg)); // Save error count
PT_quit(PCfg); // Free parser
Stream_close(cstream); // Close source stream
Stream_free(cstream); // Free source stream
Scn_free(scn); // Free scanner table
PLR_delTab(plr); // Free parser table
//
// done parsing, proceed if no syntax errors
//
if (PT_errorCnt() == 0)
{ pl0Program src;
// get tree for start symbol
bug0( pl0_Start_Program((pl0)srcterm,&src), "Program expected");
// check & execute program
StaticSemantic(src);
if (PT_errorCnt() == 0) DynamicSemantic(src);
}
if (PT_errorCnt() > 0)
{
fprintf(stderr,"Total %d errors.\n",PT_errorCnt());
STD_ERREXIT;
}
//
// release allocated objects
//
PT_delT(srcterm);
pl0_quitSymbols();
freeSymbols();
MAP_quit();
}
int main(int argc, string argv[])
{
if( argc > 1 ) PL0(argv[1]);
else fprintf(stderr,"missing source\n");
BUG_CORE; // check for object left over
return 0;
}
|
