comparison lab2/tree.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 (* lab2/tree.ml *)
2 (* Copyright (c) 2017 J. M. Spivey *)
3
4 open Dict
5 open Print
6
7 (* |name| -- type for applied occurrences with annotations *)
8 type name =
9 { x_name: ident; (* Name of the reference *)
10 x_line: int; (* Line number *)
11 mutable x_def: def option } (* Definition in scope *)
12
13
14 (* Abstract syntax *)
15
16 type program = Program of decl list * stmt
17
18 and decl = Decl of name list * ptype
19
20 and stmt =
21 Skip
22 | Seq of stmt list
23 | Assign of expr * expr
24 | Print of expr
25 | Newline
26 | IfStmt of expr * stmt * stmt
27 | WhileStmt of expr * stmt
28
29 and expr =
30 { e_guts: expr_guts;
31 mutable e_type: ptype }
32
33 and expr_guts =
34 Constant of int * ptype
35 | Variable of name
36 | Sub of expr * expr
37 | Monop of Keiko.op * expr
38 | Binop of Keiko.op * expr * expr
39
40
41 let seq =
42 function
43 [] -> Skip
44 | [s] -> s
45 | ss -> Seq ss
46
47 let makeName x ln =
48 { x_name = x; x_line = ln; x_def = None }
49
50 let get_def x =
51 match x.x_def with
52 Some d -> d
53 | None -> failwith (sprintf "missing def on $" [fStr x.x_name])
54
55 let makeExpr e =
56 { e_guts = e; e_type = Void }
57
58
59 (* Pretty printer *)
60
61 open Print
62
63 let fTail f xs =
64 let g prf = List.iter (fun x -> prf "; $" [f x]) xs in fExt g
65
66 let fList f =
67 function
68 [] -> fStr "[]"
69 | x::xs -> fMeta "[$$]" [f x; fTail(f) xs]
70
71 let fName x = fMeta "\"$\"" [fStr x.x_name]
72
73 let rec fType =
74 function
75 Integer -> fStr "Integer"
76 | Boolean -> fStr "Boolean"
77 | Void -> fStr "Void"
78 | Array (n, t) -> fMeta "Array_($, $)" [fNum n; fType t]
79
80 let fDecl (Decl (xs, t)) =
81 fMeta "Decl_($, $)" [fList(fName) xs; fType t]
82
83 let rec fExpr e =
84 match e.e_guts with
85 Constant (n, t) ->
86 fMeta "Const_$" [fNum n]
87 | Variable x ->
88 fMeta "Variable_$" [fName x]
89 | Sub (e1, e2) ->
90 fMeta "Sub_($, $)" [fExpr e1; fExpr e2]
91 | Monop (w, e1) ->
92 fMeta "Monop_($, $)" [fStr (Keiko.op_name w); fExpr e1]
93 | Binop (w, e1, e2) ->
94 fMeta "Binop_($, $, $)"
95 [fStr (Keiko.op_name w); fExpr e1; fExpr e2]
96
97 let rec fStmt =
98 function
99 Skip ->
100 fStr "Skip"
101 | Seq ss ->
102 fMeta "Seq_$" [fList(fStmt) ss]
103 | Assign (e1, e2) ->
104 fMeta "Assign_($, $)" [fExpr e1; fExpr e2]
105 | Print e ->
106 fMeta "Print_($)" [fExpr e]
107 | Newline ->
108 fStr "Newline"
109 | IfStmt (e, s1, s2) ->
110 fMeta "IfStmt_($, $, $)" [fExpr e; fStmt s1; fStmt s2]
111 | WhileStmt (e, s) ->
112 fMeta "WhileStmt_($, $)" [fExpr e; fStmt s]
113
114 let fProg (Program (ds, s)) =
115 fMeta "Program_($, $)" [fList(fDecl) ds; fStmt s]
116
117 let print_tree fp t = fgrindf fp "" "$" [fProg t]