diff 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
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lab2/tree.ml	Thu Oct 05 08:04:15 2017 +0100
@@ -0,0 +1,117 @@
+(* lab2/tree.ml *)
+(* Copyright (c) 2017 J. M. Spivey *)
+
+open Dict
+open Print
+
+(* |name| -- type for applied occurrences with annotations *)
+type name = 
+  { x_name: ident;              (* Name of the reference *)
+    x_line: int;                (* Line number *)
+    mutable x_def: def option } (* Definition in scope *)
+
+
+(* Abstract syntax *)
+
+type program = Program of decl list * stmt
+
+and decl = Decl of name list * ptype
+
+and stmt = 
+    Skip 
+  | Seq of stmt list
+  | Assign of expr * expr
+  | Print of expr
+  | Newline
+  | IfStmt of expr * stmt * stmt
+  | WhileStmt of expr * stmt
+
+and expr = 
+  { e_guts: expr_guts;
+    mutable e_type: ptype }
+
+and expr_guts =
+    Constant of int * ptype
+  | Variable of name
+  | Sub of expr * expr
+  | Monop of Keiko.op * expr 
+  | Binop of Keiko.op * expr * expr
+
+
+let seq =
+  function
+      [] -> Skip
+    | [s] -> s
+    | ss -> Seq ss
+
+let makeName x ln = 
+  { x_name = x; x_line = ln; x_def = None }
+
+let get_def x =
+  match x.x_def with
+      Some d -> d
+    | None -> failwith (sprintf "missing def on $" [fStr x.x_name])
+
+let makeExpr e =
+  { e_guts = e; e_type = Void }
+
+
+(* Pretty printer *)
+
+open Print
+
+let fTail f xs =
+  let g prf = List.iter (fun x -> prf "; $" [f x]) xs in fExt g
+
+let fList f =
+  function
+      [] -> fStr "[]"
+    | x::xs -> fMeta "[$$]" [f x; fTail(f) xs]
+
+let fName x = fMeta "\"$\"" [fStr x.x_name]
+
+let rec fType =
+  function
+      Integer -> fStr "Integer"
+    | Boolean -> fStr "Boolean"
+    | Void -> fStr "Void"
+    | Array (n, t) -> fMeta "Array_($, $)" [fNum n; fType t]
+
+let fDecl (Decl (xs, t)) =
+  fMeta "Decl_($, $)" [fList(fName) xs; fType t]
+
+let rec fExpr e =
+  match e.e_guts with
+      Constant (n, t) ->
+        fMeta "Const_$" [fNum n]
+    | Variable x -> 
+        fMeta "Variable_$" [fName x]
+    | Sub (e1, e2) ->
+        fMeta "Sub_($, $)" [fExpr e1; fExpr e2]
+    | Monop (w, e1) -> 
+        fMeta "Monop_($, $)" [fStr (Keiko.op_name w); fExpr e1]
+    | Binop (w, e1, e2) -> 
+        fMeta "Binop_($, $, $)" 
+          [fStr (Keiko.op_name w); fExpr e1; fExpr e2]
+
+let rec fStmt = 
+  function
+      Skip -> 
+        fStr "Skip"
+    | Seq ss -> 
+        fMeta "Seq_$" [fList(fStmt) ss]
+    | Assign (e1, e2) -> 
+        fMeta "Assign_($, $)" [fExpr e1; fExpr e2]
+    | Print e -> 
+        fMeta "Print_($)" [fExpr e]
+    | Newline -> 
+        fStr "Newline"
+    | IfStmt (e, s1, s2) ->
+        fMeta "IfStmt_($, $, $)" [fExpr e; fStmt s1; fStmt s2]
+    | WhileStmt (e, s) -> 
+        fMeta "WhileStmt_($, $)" [fExpr e; fStmt s]
+
+let fProg (Program (ds, s)) = 
+  fMeta "Program_($, $)" [fList(fDecl) ds; fStmt s]
+
+let print_tree fp t = fgrindf fp "" "$" [fProg t]