annotate lab1/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 (* lab1/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 type ident = string
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 (* |name| -- type for applied occurrences, with annotations *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 type name =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 { x_name: ident; (* Name of the reference *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 x_lab: string; (* Global label *)
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
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 let make_name x ln = { x_name = x; x_lab = "_" ^ x; x_line = ln }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 (* Abstract syntax *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 type program = Program of stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 and stmt =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 Skip
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 | Seq of stmt list
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 | Assign of name * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 | Print of expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 | Newline
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 | IfStmt of expr * stmt * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 | WhileStmt of expr * stmt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 and expr =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 Constant of int
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 | Variable of name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30 | Monop of Keiko.op * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 | Binop of Keiko.op * expr * expr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 let seq =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 [] -> Skip
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 | [s] -> s
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 | ss -> Seq ss
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 (* Pretty printer -- uses LISP-like syntax *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 let fTail f xs =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 let g prf = List.iter (fun x -> prf "; $" [f x]) xs in fExt g
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 let fList f =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 [] -> fStr "[]"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 | x::xs -> fMeta "[$$]" [f x; fTail(f) xs]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 let fName x = fStr x.x_name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 let rec fExpr =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 Constant n ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 fMeta "Constant_$" [fNum n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58 | Variable x ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 fMeta "Variable_\"$\"" [fName x]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 | Monop (w, e1) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 fMeta "Monop_($, $)" [fStr (Keiko.op_name w); fExpr e1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 | Binop (w, e1, e2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 fMeta "Binop_($, $, $)" [fStr (Keiko.op_name w); fExpr e1; fExpr e2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 let rec fStmt =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 Skip ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 fStr "Skip"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 | Seq ss ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 fMeta "Seq_$" [fList(fStmt) ss]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 | Assign (x, e) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 fMeta "Assign_(\"$\", $)" [fName x; fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 | Print e ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 fMeta "Print_($)" [fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 | Newline ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 fStr "Newline"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 | IfStmt (e, s1, s2) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78 fMeta "IfStmt_($, $, $)" [fExpr e; fStmt s1; fStmt s2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 | WhileStmt (e, s) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 fMeta "WhileStmt_($, $)" [fExpr e; fStmt s]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 (*
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 | RepeatStmt (s, e) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 fMeta "RepeatStmt_($, $)" [fStmt s; fExpr e]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 | LoopStmt s ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 fMeta "LoopStmt_($)" [fStmt s]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 | ExitStmt ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 fStr "Exit"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 | CaseStmt (e, cases, elsept) ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 let fArm (labs, body) =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 fMeta "($, $)" [fList(fNum) labs; fStmt body] in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 fMeta "CaseStmt_($, $, $)"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 [fExpr e; fList(fArm) cases; fStmt elsept]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 | _ ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 (* Catch-all for statements added later *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 fStr "???"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 let print_tree fp (Program s) = fgrindf fp "" "$" [fStmt s]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99