Mercurial > urweb
comparison src/cjr_env.sml @ 109:813e5a52063d
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 13 Jul 2008 10:17:06 -0400 |
parents | 717b6f8d8505 |
children | 91027db5a07c |
comparison
equal
deleted
inserted
replaced
108:f59553dc1b6a | 109:813e5a52063d |
---|---|
42 | 42 |
43 numRelE : int, | 43 numRelE : int, |
44 relE : (string * typ) list, | 44 relE : (string * typ) list, |
45 namedE : (string * typ) IM.map, | 45 namedE : (string * typ) IM.map, |
46 | 46 |
47 F : (string * typ * typ) IM.map, | |
48 structs : (string * typ) list IM.map | 47 structs : (string * typ) list IM.map |
49 } | 48 } |
50 | 49 |
51 val empty = { | 50 val empty = { |
52 namedT = IM.empty, | 51 namedT = IM.empty, |
53 | 52 |
54 numRelE = 0, | 53 numRelE = 0, |
55 relE = [], | 54 relE = [], |
56 namedE = IM.empty, | 55 namedE = IM.empty, |
57 | 56 |
58 F = IM.empty, | |
59 structs = IM.empty | 57 structs = IM.empty |
60 } | 58 } |
61 | 59 |
62 fun pushTNamed (env : env) x n co = | 60 fun pushTNamed (env : env) x n co = |
63 {namedT = IM.insert (#namedT env, n, (x, co)), | 61 {namedT = IM.insert (#namedT env, n, (x, co)), |
64 | 62 |
65 numRelE = #numRelE env, | 63 numRelE = #numRelE env, |
66 relE = #relE env, | 64 relE = #relE env, |
67 namedE = #namedE env, | 65 namedE = #namedE env, |
68 | 66 |
69 F = #F env, | |
70 structs = #structs env} | 67 structs = #structs env} |
71 | 68 |
72 fun lookupTNamed (env : env) n = | 69 fun lookupTNamed (env : env) n = |
73 case IM.find (#namedT env, n) of | 70 case IM.find (#namedT env, n) of |
74 NONE => raise UnboundNamed n | 71 NONE => raise UnboundNamed n |
79 | 76 |
80 numRelE = #numRelE env + 1, | 77 numRelE = #numRelE env + 1, |
81 relE = (x, t) :: #relE env, | 78 relE = (x, t) :: #relE env, |
82 namedE = #namedE env, | 79 namedE = #namedE env, |
83 | 80 |
84 F = #F env, | |
85 structs = #structs env} | 81 structs = #structs env} |
86 | 82 |
87 fun lookupERel (env : env) n = | 83 fun lookupERel (env : env) n = |
88 (List.nth (#relE env, n)) | 84 (List.nth (#relE env, n)) |
89 handle Subscript => raise UnboundRel n | 85 handle Subscript => raise UnboundRel n |
97 | 93 |
98 numRelE = #numRelE env, | 94 numRelE = #numRelE env, |
99 relE = #relE env, | 95 relE = #relE env, |
100 namedE = IM.insert (#namedE env, n, (x, t)), | 96 namedE = IM.insert (#namedE env, n, (x, t)), |
101 | 97 |
102 F = #F env, | |
103 structs = #structs env} | 98 structs = #structs env} |
104 | 99 |
105 fun lookupENamed (env : env) n = | 100 fun lookupENamed (env : env) n = |
106 case IM.find (#namedE env, n) of | 101 case IM.find (#namedE env, n) of |
107 NONE => raise UnboundNamed n | 102 NONE => raise UnboundNamed n |
108 | SOME x => x | |
109 | |
110 fun pushF (env : env) n x dom ran = | |
111 {namedT = #namedT env, | |
112 | |
113 numRelE = #numRelE env, | |
114 relE = #relE env, | |
115 namedE = #namedE env, | |
116 | |
117 F = IM.insert (#F env, n, (x, dom, ran)), | |
118 structs = #structs env} | |
119 | |
120 fun lookupF (env : env) n = | |
121 case IM.find (#F env, n) of | |
122 NONE => raise UnboundF n | |
123 | SOME x => x | 103 | SOME x => x |
124 | 104 |
125 fun pushStruct (env : env) n xts = | 105 fun pushStruct (env : env) n xts = |
126 {namedT = #namedT env, | 106 {namedT = #namedT env, |
127 | 107 |
128 numRelE = #numRelE env, | 108 numRelE = #numRelE env, |
129 relE = #relE env, | 109 relE = #relE env, |
130 namedE = #namedE env, | 110 namedE = #namedE env, |
131 | 111 |
132 F = #F env, | |
133 structs = IM.insert (#structs env, n, xts)} | 112 structs = IM.insert (#structs env, n, xts)} |
134 | 113 |
135 fun lookupStruct (env : env) n = | 114 fun lookupStruct (env : env) n = |
136 case IM.find (#structs env, n) of | 115 case IM.find (#structs env, n) of |
137 NONE => raise UnboundStruct n | 116 NONE => raise UnboundStruct n |
138 | SOME x => x | 117 | SOME x => x |
139 | 118 |
140 fun declBinds env (d, _) = | 119 fun declBinds env (d, loc) = |
141 case d of | 120 case d of |
142 DVal (x, n, t, _) => pushENamed env x n t | 121 DVal (x, n, t, _) => pushENamed env x n t |
143 | DFun (n, x, dom, ran, _) => pushF env n x dom ran | 122 | DFun (fx, n, _, dom, ran, _) => pushENamed env fx n (TFun (dom, ran), loc) |
144 | DStruct (n, xts) => pushStruct env n xts | 123 | DStruct (n, xts) => pushStruct env n xts |
145 | 124 |
146 end | 125 end |