Mercurial > urweb

comparison src/mono_env.sml @ 178:eb3f9913bf31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First part of getting cases through monoize
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 09:26:49 -0400
parents 25b169416ea8
children 3bbed533fbd2
comparison
equal deleted inserted replaced
177:5d030ee143e2 178:eb3f9913bf31
35 exception UnboundRel of int 35 exception UnboundRel of int
36 exception UnboundNamed of int 36 exception UnboundNamed of int
37 37
38 type env = { 38 type env = {
39 datatypes : (string * (string * int * typ option) list) IM.map, 39 datatypes : (string * (string * int * typ option) list) IM.map,
40 constructors : (string * typ option * int) IM.map,
40 41
41 relE : (string * typ) list, 42 relE : (string * typ) list,
42 namedE : (string * typ * exp option * string) IM.map 43 namedE : (string * typ * exp option * string) IM.map
43 } 44 }
44 45
45 val empty = { 46 val empty = {
46 datatypes = IM.empty, 47 datatypes = IM.empty,
48 constructors = IM.empty,
47 49
48 relE = [], 50 relE = [],
49 namedE = IM.empty 51 namedE = IM.empty
50 } 52 }
51 53
52 fun pushDatatype (env : env) x n xncs = 54 fun pushDatatype (env : env) x n xncs =
53 {datatypes = IM.insert (#datatypes env, n, (x, xncs)), 55 {datatypes = IM.insert (#datatypes env, n, (x, xncs)),
56 constructors = foldl (fn ((x, n, to), constructors) =>
57 IM.insert (constructors, n, (x, to, n)))
58 (#constructors env) xncs,
54 59
55 relE = #relE env, 60 relE = #relE env,
56 namedE = #namedE env} 61 namedE = #namedE env}
57 62
58 fun lookupDatatype (env : env) n = 63 fun lookupDatatype (env : env) n =
59 case IM.find (#datatypes env, n) of 64 case IM.find (#datatypes env, n) of
60 NONE => raise UnboundNamed n 65 NONE => raise UnboundNamed n
61 | SOME x => x 66 | SOME x => x
62 67
68 fun lookupConstructor (env : env) n =
69 case IM.find (#constructors env, n) of
70 NONE => raise UnboundNamed n
71 | SOME x => x
72
63 fun pushERel (env : env) x t = 73 fun pushERel (env : env) x t =
64 {datatypes = #datatypes env, 74 {datatypes = #datatypes env,
75 constructors = #constructors env,
65 76
66 relE = (x, t) :: #relE env, 77 relE = (x, t) :: #relE env,
67 namedE = #namedE env} 78 namedE = #namedE env}
68 79
69 fun lookupERel (env : env) n = 80 fun lookupERel (env : env) n =
70 (List.nth (#relE env, n)) 81 (List.nth (#relE env, n))
71 handle Subscript => raise UnboundRel n 82 handle Subscript => raise UnboundRel n
72 83
73 fun pushENamed (env : env) x n t eo s = 84 fun pushENamed (env : env) x n t eo s =
74 {datatypes = #datatypes env, 85 {datatypes = #datatypes env,
86 constructors = #constructors env,
75 87
76 relE = #relE env, 88 relE = #relE env,
77 namedE = IM.insert (#namedE env, n, (x, t, eo, s))} 89 namedE = IM.insert (#namedE env, n, (x, t, eo, s))}
78 90
79 fun lookupENamed (env : env) n = 91 fun lookupENamed (env : env) n =