comparison lab3/dict.ml @ 0:bfdcc3820b32

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