Mercurial > hg > compilers
view lab2/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 |
line wrap: on
line source
(* 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]