annotate lab3/dict.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 (* lab3/dict.ml *)
mike@0 2 (* Copyright (c) 2017 J. M. Spivey *)
mike@0 3
mike@0 4 (*
mike@0 5 Environments are implemented using a library module that
mike@0 6 represents mappings by balanced binary trees.
mike@0 7 *)
mike@0 8
mike@0 9 type ident = string
mike@0 10
mike@0 11 type codelab = int
mike@0 12
mike@0 13 (* |lab| -- last used code label *)
mike@0 14 let lab = ref 0
mike@0 15
mike@0 16 (* |label| -- allocate a code label *)
mike@0 17 let label () = incr lab; !lab
mike@0 18
mike@0 19 (* |def| -- definitions in environment *)
mike@0 20 type def =
mike@0 21 { d_tag : ident; (* Name *)
mike@0 22 d_kind : def_kind; (* Definition *)
mike@0 23 d_level : int; (* Nesting level *)
mike@0 24 d_lab : string; (* Label if global *)
mike@0 25 d_off : int } (* Offset if local *)
mike@0 26
mike@0 27 and def_kind =
mike@0 28 VarDef (* Variable *)
mike@0 29 | ProcDef of int (* Procedure (nparams) *)
mike@0 30
mike@0 31 let find_def x ds =
mike@0 32 let rec search =
mike@0 33 function
mike@0 34 [] -> raise Not_found
mike@0 35 | d::ds ->
mike@0 36 if x = d.d_tag then d else search ds in
mike@0 37 search ds
mike@0 38
mike@0 39 module IdMap = Map.Make(struct type t = ident let compare = compare end)
mike@0 40
mike@0 41 type environment = Env of def list * def IdMap.t
mike@0 42
mike@0 43 let can f x = try f x; true with Not_found -> false
mike@0 44
mike@0 45 (* |define| -- add a definition *)
mike@0 46 let define d (Env (b, m)) =
mike@0 47 if can (find_def d.d_tag) b then raise Exit;
mike@0 48 Env (d::b, IdMap.add d.d_tag d m)
mike@0 49
mike@0 50 (* |lookup| -- find definition of an identifier *)
mike@0 51 let lookup x (Env (b, m)) = IdMap.find x m
mike@0 52
mike@0 53 (* |empty| -- empty environment *)
mike@0 54 let empty = Env ([], IdMap.empty)
mike@0 55
mike@0 56 (* |new_block| -- add new block *)
mike@0 57 let new_block (Env (b, m)) = Env ([], m)