annotate lab2/tree.ml @ 1:b5139af1a420 tip basis

Fixed permissions on compile scripts
author Mike Spivey <mike@cs.ox.ac.uk>
date Fri, 13 Oct 2017 17:27:58 +0100
parents bfdcc3820b32
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 (* lab2/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
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 (* Abstract syntax *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 type program = Program of decl list * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 and decl = Decl of name list * ptype
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 and 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 expr * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 | Print of expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 | Newline
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 | IfStmt of expr * stmt * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 | WhileStmt of expr * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 and expr =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30 { e_guts: expr_guts;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 mutable e_type: ptype }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 and expr_guts =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 Constant of int * ptype
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 | Variable of name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 | Sub of expr * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 | Monop of Keiko.op * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 | Binop of Keiko.op * expr * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 let seq =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 [] -> Skip
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 | [s] -> s
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 | ss -> Seq ss
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 let makeName x ln =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 { x_name = x; x_line = ln; x_def = None }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 let get_def x =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 match x.x_def with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 Some d -> d
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53 | None -> failwith (sprintf "missing def on $" [fStr x.x_name])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 let makeExpr e =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 { e_guts = e; e_type = Void }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 (* Pretty printer *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 let fTail f xs =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 let g prf = List.iter (fun x -> prf "; $" [f x]) xs in fExt g
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 let fList f =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 [] -> fStr "[]"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 | x::xs -> fMeta "[$$]" [f x; fTail(f) xs]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 let fName x = fMeta "\"$\"" [fStr x.x_name]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 let rec fType =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 Integer -> fStr "Integer"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 | Boolean -> fStr "Boolean"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 | Void -> fStr "Void"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78 | Array (n, t) -> fMeta "Array_($, $)" [fNum n; fType t]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 let fDecl (Decl (xs, t)) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 fMeta "Decl_($, $)" [fList(fName) xs; fType t]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 let rec fExpr e =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 match e.e_guts with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 Constant (n, t) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 fMeta "Const_$" [fNum n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 | Variable x ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 fMeta "Variable_$" [fName x]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 | Sub (e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 fMeta "Sub_($, $)" [fExpr e1; fExpr e2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 | Monop (w, e1) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 fMeta "Monop_($, $)" [fStr (Keiko.op_name w); fExpr e1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 | Binop (w, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 fMeta "Binop_($, $, $)"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 [fStr (Keiko.op_name w); fExpr e1; fExpr e2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97 let rec fStmt =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 Skip ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100 fStr "Skip"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 | Seq ss ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 fMeta "Seq_$" [fList(fStmt) ss]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 | Assign (e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 fMeta "Assign_($, $)" [fExpr e1; fExpr e2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 | Print e ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 fMeta "Print_($)" [fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107 | Newline ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 fStr "Newline"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109 | IfStmt (e, s1, s2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 fMeta "IfStmt_($, $, $)" [fExpr e; fStmt s1; fStmt s2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111 | WhileStmt (e, s) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112 fMeta "WhileStmt_($, $)" [fExpr e; fStmt s]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 let fProg (Program (ds, s)) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 fMeta "Program_($, $)" [fList(fDecl) ds; fStmt s]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117 let print_tree fp t = fgrindf fp "" "$" [fProg t]