7
8:- use_module(library(clpfd)). 9:- use_module(library(assoc)). 10:- use_module(library(pio)). 11
12:- set_prolog_flag(double_quotes, codes). 13
15
16run(AST) :-
17 env_new(Env),
18 interpret(AST, Env, _).
19
20
21interpret(print(P), Env, Env) :-
22 eval(P, Env, Value),
23 format("~w\n", [Value]).
24interpret(sequence(A,B), Env0, Env) :-
25 interpret(A, Env0, Env1),
26 ( A = return(_) ->
27 Env = Env1
28 ; interpret(B, Env1, Env)
29 ).
30interpret(call(Name, Arg), Env0, Env0) :-
31 eval(Arg, Env0, ArgVal),
32 env_func_body(Env0, Name, ArgName, Body),
33 env_clear_variables(Env0, Env1),
34 env_put_var(ArgName, ArgVal, Env1, Env2),
35 interpret(Body, Env2, _).
36interpret(function(Name,Arg,Body), Env0, Env) :-
37 env_put_func(Name, Arg, Body, Env0, Env).
38interpret(if(Cond,Then,Else), Env0, Env) :-
39 eval(Cond, Env0, Value),
40 ( Value #\= 0 ->
41 interpret(Then, Env0, Env)
42 ; interpret(Else, Env0, Env)
43 ).
44interpret(assign(Var, Expr), Env0, Env) :-
45 eval(Expr, Env0, Value),
46 env_put_var(Var, Value, Env0, Env).
47interpret(while(Cond, Body), Env0, Env) :-
48 eval(Cond, Env0, Value),
49 ( Value #\= 0 ->
50 interpret(Body, Env0, Env1),
51 interpret(while(Cond, Body), Env1, Env)
52 ; Env = Env0
53 ).
54interpret(return(Expr), Env0, Value) :-
55 eval(Expr, Env0, Value).
56interpret(nop, Env, Env).
57
58
59eval(bin(Op,A,B), Env, Value) :-
60 eval(A, Env, VA),
61 eval(B, Env, VB),
62 eval_(Op, VA, VB, Value).
63eval(v(V), Env, Value) :-
64 env_get_var(Env, V, Value).
65eval(n(N), _, N).
66eval(call(Name, Arg), Env0, Value) :-
67 eval(Arg, Env0, ArgVal),
68 env_func_body(Env0, Name, ArgName, Body),
69 env_clear_variables(Env0, Env1),
70 env_put_var(ArgName, ArgVal, Env1, Env2),
71 interpret(Body, Env2, Value).
72
73
74eval_(+, A, B, V) :- V #= A + B.
75eval_(-, A, B, V) :- V #= A - B.
76eval_(*, A, B, V) :- V #= A * B.
77eval_(/, A, B, V) :- V #= A // B.
78eval_(=, A, B, V) :- goal_truth(A #= B, V).
79eval_(>, A, B, V) :- goal_truth(A #> B, V).
80eval_(<, A, B, V) :- goal_truth(A #< B, V).
81
82goal_truth(Goal, V) :- ( Goal -> V = 1 ; V = 0).
83
85
87
88env_new(E-E) :- empty_assoc(E).
89
90env_put_func(Name, Arg, Body, Vars0-Funcs0, Vars0-Funcs) :-
91 put_assoc(Name, Funcs0, Arg-Body, Funcs).
92
93env_func_body(_-Funcs, Name, ArgName, Body) :-
94 get_assoc(Name, Funcs, ArgName-Body).
95
96env_put_var(Name, Value, Vars0-Funcs0, Vars-Funcs0) :-
97 put_assoc(Name, Vars0, Value, Vars).
98
99env_get_var(Vars-_, Name, Value) :- get_assoc(Name, Vars, Value).
100
101env_clear_variables(_-Funcs0, E-Funcs0) :- empty_assoc(E).
102
103
105
107
108ast_vminstrs(AST, VMs) :-
109 initial_state(S0),
110 phrase(compilation(AST), [S0], [S]),
111 state_vminstrs(S, VMs).
112
113initial_state(s([],[],[],0)).
114
115state_vminstrs(s(Is0,Fs,_,_), Is) :-
116 reverse([halt|Is0], Is1),
117 maplist(resolve_calls(Fs), Is1, Is).
118
119resolve_calls(Fs, I0, I) :-
120 ( I0 = call(Name) ->
121 memberchk(Name-Adr, Fs),
122 I = call(Adr)
123 ; I = I0
124 ).
125
126state(S), [S] --> [S].
127
128state(S0, S), [S] --> [S0].
129
130
131current_pc(PC) --> state(s(_,_,_,PC)).
132
133vminstr(I) -->
134 state(s(Is,Fs,Vs,PC0), s([I|Is],Fs,Vs,PC)),
135 { I =.. Ls,
136 length(Ls, L), % length of instruction including arguments
137 PC #= PC0 + L }.
138
139start_function(Name, Arg) -->
140 state(s(Is,Fs,_,PC), s(Is,[Name-PC|Fs],[Arg-0],PC)).
141
142num_variables(Num) -->
143 state(s(_,_,Vs,_)),
144 { length(Vs, Num0),
145 Num #= Num0 - 1 }. % don't count parameter
146
147variable_offset(Name, Offset) -->
148 state(s(Is,Fs,Vs0,PC), s(Is,Fs,Vs,PC)),
149 { ( memberchk(Name-Offset, Vs0) ->
150 Vs = Vs0
151 ; Vs0 = [_-Curr|_],
152 Offset #= Curr + 1,
153 Vs = [Name-Offset|Vs0]
154 ) }.
155
156compilation(nop) --> [].
157compilation(print(P)) -->
158 compilation(P),
159 vminstr(print).
160compilation(sequence(A,B)) -->
161 compilation(A),
162 compilation(B).
163compilation(call(Name,Arg)) -->
164 compilation(Arg),
165 vminstr(call(Name)).
166compilation(function(Name,Arg,Body)) -->
167 vminstr(jmp(Skip)),
168 start_function(Name, Arg),
169 vminstr(alloc(NumVars)),
170 compilation(Body),
171 num_variables(NumVars),
172 current_pc(Skip).
173compilation(if(Cond,Then,Else)) -->
174 { Cond = bin(Op,A,B) },
175 compilation(A),
176 compilation(B),
177 condition(Op, Adr1),
178 compilation(Then),
179 vminstr(jmp(Adr2)),
180 current_pc(Adr1),
181 compilation(Else),
182 current_pc(Adr2).
183compilation(assign(Var,Expr)) -->
184 variable_offset(Var, Offset),
185 compilation(Expr),
186 vminstr(pop(Offset)).
187compilation(while(Cond,Body)) -->
188 current_pc(Head),
189 { Cond = bin(Op,A,B) },
190 compilation(A),
191 compilation(B),
192 condition(Op, Break),
193 compilation(Body),
194 vminstr(jmp(Head)),
195 current_pc(Break).
196compilation(return(Expr)) -->
197 compilation(Expr),
198 vminstr(ret).
199compilation(bin(Op,A,B)) -->
200 compilation(A),
201 compilation(B),
202 { op_vminstr(Op, VI) },
203 vminstr(VI).
204compilation(n(N)) -->
205 vminstr(pushc(N)).
206compilation(v(V)) -->
207 variable_offset(V, Offset),
208 vminstr(pushv(Offset)).
209
210
211op_vminstr(+, add).
212op_vminstr(-, sub).
213op_vminstr(*, mul).
214op_vminstr(/, div).
215
216condition(=, Adr) --> vminstr(jne(Adr)).
217condition(<, Adr) --> vminstr(jge(Adr)).
218condition(>, Adr) --> vminstr(jle(Adr)).
219
220
222
224
225vminstrs_ints([]) --> [].
226vminstrs_ints([I|Is]) -->
227 vminstr_ints(I),
228 vminstrs_ints(Is).
229
230vminstr_ints(halt) --> [0].
231vminstr_ints(alloc(A)) --> [1,A].
232vminstr_ints(pushc(C)) --> [2,C].
233vminstr_ints(pushv(V)) --> [3,V].
234vminstr_ints(pop(V)) --> [4,V].
235vminstr_ints(add) --> [5].
236vminstr_ints(sub) --> [6].
237vminstr_ints(mul) --> [7].
238vminstr_ints(div) --> [8].
239vminstr_ints(jmp(Adr)) --> [9,Adr].
240vminstr_ints(jne(Adr)) --> [10,Adr].
241vminstr_ints(jge(Adr)) --> [11,Adr].
242vminstr_ints(jle(Adr)) --> [12,Adr].
243vminstr_ints(call(Adr)) --> [13,Adr].
244vminstr_ints(print) --> [14].
245vminstr_ints(ret) --> [15].
246
248
250
251tokens(Ts) -->
252 whitespace,
253 tokens(Ts).
254tokens([T|Ts]) -->
255 tok(T),
256 !, 257 tokens(Ts).
258tokens([]) --> "".
259
260
261tok('{') --> "{".
262tok('}') --> "}".
263tok(';') --> ";".
264tok(',') --> ",".
265tok('(') --> "(".
266tok(')') --> ")".
267
268tok(rop(=)) --> "==".
269tok(rop(<)) --> "<".
270tok(rop(>)) --> ">".
271
272tok(aop(+)) --> "+".
273tok(aop(-)) --> "-".
274
275tok(mop(*)) --> "*".
276tok(mop(/)) --> "/".
277tok(=) --> "=".
278
279tok(ID_or_KW) -->
280 ident(Cs),
281 { name(I, Cs), ( keyword(I) -> ID_or_KW = I ; ID_or_KW = id(I) ) }.
282tok(num(N)) --> number(Cs), { name(N, Cs) }.
283
284ident([C|Cs]) --> letter(C), identr(Cs).
285
286identr([C|Cs]) --> letter(C), identr(Cs).
287identr([C|Cs]) --> digit(C), identr(Cs).
288identr([]) --> [].
289
290number([C|Cs]) --> digit(C), number(Cs).
291number([C]) --> digit(C).
292
293letter(C) --> [C], { between(0'A, 0'Z, C) ; between(0'a, 0'z, C)}.
294digit(C) --> [C], { between(0'0, 0'9, C) }.
295whitespace --> [C], {C =< 0' }. 296
297
298keyword(K) :- memberchk(K, [if,else,while,return,print]).
299
301
303
304tokens_ast(Tokens, AST) :-
305 phrase(program(AST), Tokens).
306
307program(nop) --> [].
308program(P) --> func_or_print(FP), program_r(FP, P).
309
310program_r(P, P) --> [].
311program_r(P0, sequence(P0, P1)) --> func_or_print(FP), program_r(FP, P1).
312
313func_or_print(F) --> func(F).
314func_or_print(print(P)) --> stm(print(P)).
315
316func(function(Name,Arg,Body)) -->
317 [id(Name)], ['('], [id(Arg)], [')'], block_(Body).
318
319stms(S) --> stm(S1), stmr(S1, S).
320stms(nop) --> [].
321
322stmr(S1, sequence(S1, S)) --> stm(S2), stmr(S2, S).
323stmr(S, S) --> [].
324
325stm(call(Name, Arg)) --> [id(Name)], ['('], exp(Arg), [')'], [';'].
326stm(assign(Id, E)) --> [id(Id)], ['='], exp(E), [';'].
327stm(if(Cond,S1,S2)) --> [if], cond(Cond), stm(S1), [else], stm(S2).
328stm(while(Cond, S)) --> [while], cond(Cond), stm(S).
329stm(return(E)) --> [return], exp(E), [';'].
330stm(print(E)) --> [print], exp(E), [';'].
331stm(S) --> block_(S).
332stm(nop) --> [';'].
333
334block_(S) --> ['{'], stms(S), ['}'].
335
336cond(bin(Op,A,B)) --> ['('], exp(A), [rop(Op)], exp(B), [')'].
337
338exp(E) --> term(E1), expr(E1, E).
339expr(E1, E) --> [aop(Op)], term(E2), expr(bin(Op, E1, E2), E).
340expr(E, E) --> [].
341
342term(E) --> factor(E1), termr(E1, E).
343termr(E1, E) --> [mop(Op)], factor(E2), termr(bin(Op, E1, E2), E).
344termr(E, E) --> [].
345
346factor(n(N)) --> [num(N)].
347factor(v(Id)) --> [id(Id)].
348factor(call(Name, Arg)) --> [id(Name)], ['('], exp(Arg), [')'].
349factor(E) --> ['('], exp(E), [')'].
350
352
354
355is_program(nop).
356is_program(sequence(A,B)) :-
357 ( (A = print(E), is_exp(E)) ; is_function(A) ),
358 is_program(B).
359
360is_function(function(Name,Arg,Body)) :-
361 atom(Name),
362 atom(Arg),
363 is_stm(Body).
364
365is_stm(print(E)) :-
366 is_exp(E).
367is_stm(sequence(S1,S2)) :-
368 is_stm(S1),
369 is_stm(S2).
370is_stm(call(Name, Arg)) :-
371 atom(Name),
372 is_exp(Arg).
373is_stm(if(Cond,Then,Else)) :-
374 is_exp(Cond),
375 is_stm(Then),
376 is_stm(Else).
377is_stm(while(Cond,Body)) :-
378 is_exp(Cond),
379 is_stm(Body).
380is_stm(return(E)) :-
381 is_exp(E).
382is_stm(nop).
383is_stm(assign(Id, E)) :-
384 atom(Id),
385 is_exp(E).
386
387
388is_exp(n(N)) :-
389 number(N).
390is_exp(v(V)) :-
391 atom(V).
392is_exp(call(Id, E)) :-
393 atom(Id),
394 is_exp(E).
395is_exp(bin(Op,E1,E2)) :-
396 member(Op, [=,#,>,<,+,-,*,/]),
397 is_exp(E1),
398 is_exp(E2).
399
401
402string_ast(String, AST) :-
403 phrase(tokens(Tokens), String),
404 tokens_ast(Tokens, AST).
405
406run_file(File) :-
407 ( phrase_from_file(tokens(Tokens), File) ->
408 format("\n\ntokens:\n\n~w\n", [Tokens]),
409 ( tokens_ast(Tokens, AST) ->
410 411 format("\nAST:\n\n~w\n", [AST]),
412 ast_vminstrs(AST, VMs),
413 format("\n\nVM code:\n\n"),
414 foldl(display_vminstr, VMs, 0, _),
415 phrase(vminstrs_ints(VMs), Ints),
416 format("\nintcode:\n\n~w\n\n", [Ints]),
417 format("program output:\n\n"),
418 run(AST),
419 halt
420 ; format("syntax error\n")
421 )
422 ; format("lexical error")
423 ).
424
425
426display_vminstr(Cmd, N0, N1) :-
427 format("~t~w~5|: ", [N0]),
428 Cmd =.. Ls,
429 length(Ls, L),
430 ( L = 1 ->
431 format("~w\n", Ls)
432 ; format("~w ~w\n", Ls)
433 ),
434 N1