Mercurial > urweb

comparison src/cjr_env.sml @ 101:717b6f8d8505

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First executable generated
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 11:13:49 -0400
parents d3cc191cb25f
children 813e5a52063d
comparison
equal deleted inserted replaced
100:f0f59e918cac 101:717b6f8d8505
33 33
34 34
35 exception UnboundRel of int 35 exception UnboundRel of int
36 exception UnboundNamed of int 36 exception UnboundNamed of int
37 exception UnboundF of int 37 exception UnboundF of int
38 exception UnboundStruct of int
38 39
39 type env = { 40 type env = {
40 namedT : (string * typ option) IM.map, 41 namedT : (string * typ option) IM.map,
41 42
42 numRelE : int, 43 numRelE : int,
43 relE : (string * typ) list, 44 relE : (string * typ) list,
44 namedE : (string * typ) IM.map, 45 namedE : (string * typ) IM.map,
45 46
46 F : (string * typ * typ) IM.map 47 F : (string * typ * typ) IM.map,
48 structs : (string * typ) list IM.map
47 } 49 }
48 50
49 val empty = { 51 val empty = {
50 namedT = IM.empty, 52 namedT = IM.empty,
51 53
52 numRelE = 0, 54 numRelE = 0,
53 relE = [], 55 relE = [],
54 namedE = IM.empty, 56 namedE = IM.empty,
55 57
56 F = IM.empty 58 F = IM.empty,
59 structs = IM.empty
57 } 60 }
58 61
59 fun pushTNamed (env : env) x n co = 62 fun pushTNamed (env : env) x n co =
60 {namedT = IM.insert (#namedT env, n, (x, co)), 63 {namedT = IM.insert (#namedT env, n, (x, co)),
61 64
62 numRelE = #numRelE env, 65 numRelE = #numRelE env,
63 relE = #relE env, 66 relE = #relE env,
64 namedE = #namedE env, 67 namedE = #namedE env,
65 68
66 F = #F env} 69 F = #F env,
70 structs = #structs env}
67 71
68 fun lookupTNamed (env : env) n = 72 fun lookupTNamed (env : env) n =
69 case IM.find (#namedT env, n) of 73 case IM.find (#namedT env, n) of
70 NONE => raise UnboundNamed n 74 NONE => raise UnboundNamed n
71 | SOME x => x 75 | SOME x => x
75 79
76 numRelE = #numRelE env + 1, 80 numRelE = #numRelE env + 1,
77 relE = (x, t) :: #relE env, 81 relE = (x, t) :: #relE env,
78 namedE = #namedE env, 82 namedE = #namedE env,
79 83
80 F = #F env} 84 F = #F env,
85 structs = #structs env}
81 86
82 fun lookupERel (env : env) n = 87 fun lookupERel (env : env) n =
83 (List.nth (#relE env, n)) 88 (List.nth (#relE env, n))
84 handle Subscript => raise UnboundRel n 89 handle Subscript => raise UnboundRel n
85 90
92 97
93 numRelE = #numRelE env, 98 numRelE = #numRelE env,
94 relE = #relE env, 99 relE = #relE env,
95 namedE = IM.insert (#namedE env, n, (x, t)), 100 namedE = IM.insert (#namedE env, n, (x, t)),
96 101
97 F = #F env} 102 F = #F env,
103 structs = #structs env}
98 104
99 fun lookupENamed (env : env) n = 105 fun lookupENamed (env : env) n =
100 case IM.find (#namedE env, n) of 106 case IM.find (#namedE env, n) of
101 NONE => raise UnboundNamed n 107 NONE => raise UnboundNamed n
102 | SOME x => x 108 | SOME x => x
106 112
107 numRelE = #numRelE env, 113 numRelE = #numRelE env,
108 relE = #relE env, 114 relE = #relE env,
109 namedE = #namedE env, 115 namedE = #namedE env,
110 116
111 F = IM.insert (#F env, n, (x, dom, ran))} 117 F = IM.insert (#F env, n, (x, dom, ran)),
118 structs = #structs env}
112 119
113 fun lookupF (env : env) n = 120 fun lookupF (env : env) n =
114 case IM.find (#F env, n) of 121 case IM.find (#F env, n) of
115 NONE => raise UnboundF n 122 NONE => raise UnboundF n
116 | SOME x => x 123 | SOME x => x
117 124
125 fun pushStruct (env : env) n xts =
126 {namedT = #namedT env,
127
128 numRelE = #numRelE env,
129 relE = #relE env,
130 namedE = #namedE env,
131
132 F = #F env,
133 structs = IM.insert (#structs env, n, xts)}
134
135 fun lookupStruct (env : env) n =
136 case IM.find (#structs env, n) of
137 NONE => raise UnboundStruct n
138 | SOME x => x
139
118 fun declBinds env (d, _) = 140 fun declBinds env (d, _) =
119 case d of 141 case d of
120 DVal (x, n, t, _) => pushENamed env x n t 142 DVal (x, n, t, _) => pushENamed env x n t
121 | DFun (n, x, dom, ran, _) => pushF env n x dom ran 143 | DFun (n, x, dom, ran, _) => pushF env n x dom ran
122 | DStruct _ => env 144 | DStruct (n, xts) => pushStruct env n xts
123 145
124 end 146 end