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