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