annotate lab3/tree.ml @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 (* lab3/tree.ml *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 (* Copyright (c) 2017 J. M. Spivey *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 open Dict
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 (* |name| -- type for applied occurrences with annotations *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 type name =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 { x_name: ident; (* Name of the reference *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 x_line: int; (* Line number *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 mutable x_def: def option } (* Definition in scope *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 type expr =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 Constant of int
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 | Variable of name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 | Monop of Keiko.op * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 | Binop of Keiko.op * expr * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 | Call of name * expr list
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 type stmt =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 Skip
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 | Seq of stmt list
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 | Assign of name * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 | Return of expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 | IfStmt of expr * stmt * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 | WhileStmt of expr * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 | Print of expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 | Newline
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30 type block = Block of ident list * proc list * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32 and proc = Proc of name * ident list * block
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 type program = Program of block
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 let seq =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39 [] -> Skip
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 | [s] -> s
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 | ss -> Seq ss
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 let makeName x ln =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 { x_name = x; x_line = ln; x_def = None }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46 let get_def x =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 match x.x_def with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 Some d -> d
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 | None -> failwith (sprintf "missing def on $" [fStr x.x_name])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 (* Pretty printer *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 let fTail f xs =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 let g prf = List.iter (fun x -> prf "; $" [f x]) xs in fExt g
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 let fList f =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 [] -> fStr "[]"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 | x::xs -> fMeta "[$$]" [f x; fTail(f) xs]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 let fName x = fStr x.x_name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 let rec fExpr =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 Constant n ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 fMeta "Number_$" [fNum n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 | Variable x ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 fMeta "Variable_$" [fName x]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 | Monop (w, e1) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 fMeta "Monop_($, $)" [fStr (Keiko.op_name w); fExpr e1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 | Binop (w, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 fMeta "Binop_($, $, $)" [fStr (Keiko.op_name w); fExpr e1; fExpr e2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 | Call (x, es) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 fMeta "Call_($, $)" [fName x; fList(fExpr) es]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 let rec fStmt =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 Skip ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 fStr "Skip"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 | Seq ss ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 fMeta "Seq_$" [fList(fStmt) ss]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 | Assign (x, e) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 fMeta "Assign_($, $)" [fName x; fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 | Return e ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 fMeta "Return_($)" [fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 | Print e ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 fMeta "Print_($)" [fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 | Newline ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 fStr "Newline"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 | IfStmt (e, s1, s2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 fMeta "IfStmt_($, $, $)" [fExpr e; fStmt s1; fStmt s2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 | WhileStmt (e, s) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 fMeta "WhileStmt_($, $)" [fExpr e; fStmt s]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 let rec fBlock (Block (vs, ps, body)) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 fMeta "Block_($, $, $)" [fList(fStr) vs; fList(fProc) ps; fStmt body]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 and fProc (Proc (x, fps, body)) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 fMeta "Proc_($, $, $)" [fName x; fList(fStr) fps; fBlock body]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 let print_tree fp (Program b) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 fgrindf fp "" "Program_($)" [fBlock b]