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