comparison lab1/kgen.ml @ 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 (* lab1/kgen.ml *)
2 (* Copyright (c) 2017 J. M. Spivey *)
3
4 open Tree
5 open Keiko
6
7 let optflag = ref false
8
9 (* |gen_expr| -- generate code for an expression *)
10 let rec gen_expr =
11 function
12 Constant x ->
13 CONST x
14 | Variable x ->
15 SEQ [LINE x.x_line; LDGW x.x_lab]
16 | Monop (w, e1) ->
17 SEQ [gen_expr e1; MONOP w]
18 | Binop (w, e1, e2) ->
19 SEQ [gen_expr e1; gen_expr e2; BINOP w]
20
21 (* |gen_cond| -- generate code for short-circuit condition *)
22 let rec gen_cond e tlab flab =
23 (* Jump to |tlab| if |e| is true and |flab| if it is false *)
24 match e with
25 Constant x ->
26 if x <> 0 then JUMP tlab else JUMP flab
27 | Binop ((Eq|Neq|Lt|Gt|Leq|Geq) as w, e1, e2) ->
28 SEQ [gen_expr e1; gen_expr e2; JUMPC (w, tlab); JUMP flab]
29 | Monop (Not, e1) ->
30 gen_cond e1 flab tlab
31 | Binop (And, e1, e2) ->
32 let lab1 = label () in
33 SEQ [gen_cond e1 lab1 flab; LABEL lab1; gen_cond e2 tlab flab]
34 | Binop (Or, e1, e2) ->
35 let lab1 = label () in
36 SEQ [gen_cond e1 tlab lab1; LABEL lab1; gen_cond e2 tlab flab]
37 | _ ->
38 SEQ [gen_expr e; CONST 0; JUMPC (Neq, tlab); JUMP flab]
39
40 (* |gen_stmt| -- generate code for a statement *)
41 let rec gen_stmt s =
42 match s with
43 Skip -> NOP
44 | Seq stmts -> SEQ (List.map gen_stmt stmts)
45 | Assign (v, e) ->
46 SEQ [LINE v.x_line; gen_expr e; STGW v.x_lab]
47 | Print e ->
48 SEQ [gen_expr e; CONST 0; GLOBAL "lib.print"; PCALL 1]
49 | Newline ->
50 SEQ [CONST 0; GLOBAL "lib.newline"; PCALL 0]
51 | IfStmt (test, thenpt, elsept) ->
52 let lab1 = label () and lab2 = label () and lab3 = label () in
53 SEQ [gen_cond test lab1 lab2;
54 LABEL lab1; gen_stmt thenpt; JUMP lab3;
55 LABEL lab2; gen_stmt elsept; LABEL lab3]
56 | WhileStmt (test, body) ->
57 let lab1 = label () and lab2 = label () and lab3 = label () in
58 SEQ [JUMP lab2; LABEL lab1; gen_stmt body;
59 LABEL lab2; gen_cond test lab1 lab3; LABEL lab3]
60
61 (* |translate| -- generate code for the whole program *)
62 let translate (Program ss) =
63 let code = gen_stmt ss in
64 Keiko.output (if !optflag then Peepopt.optimise code else code)