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