comparison src/mono_util.sml @ 178:eb3f9913bf31

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
139 and mfe' ctx (eAll as (e, loc)) = 139 and mfe' ctx (eAll as (e, loc)) =
140 case e of 140 case e of
141 EPrim _ => S.return2 eAll 141 EPrim _ => S.return2 eAll
142 | ERel _ => S.return2 eAll 142 | ERel _ => S.return2 eAll
143 | ENamed _ => S.return2 eAll 143 | ENamed _ => S.return2 eAll
144 | ECon (_, NONE) => S.return2 eAll
145 | ECon (n, SOME e) =>
146 S.map2 (mfe ctx e,
147 fn e' =>
148 (ECon (n, SOME e'), loc))
144 | EFfi _ => S.return2 eAll 149 | EFfi _ => S.return2 eAll
145 | EFfiApp (m, x, es) => 150 | EFfiApp (m, x, es) =>
146 S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es, 151 S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es,
147 fn es' => 152 fn es' =>
148 (EFfiApp (m, x, es'), loc)) 153 (EFfiApp (m, x, es'), loc))
173 (ERecord xes', loc)) 178 (ERecord xes', loc))
174 | EField (e, x) => 179 | EField (e, x) =>
175 S.map2 (mfe ctx e, 180 S.map2 (mfe ctx e,
176 fn e' => 181 fn e' =>
177 (EField (e', x), loc)) 182 (EField (e', x), loc))
183
184 | ECase (e, pes, t) =>
185 S.bind2 (mfe ctx e,
186 fn e' =>
187 S.bind2 (ListUtil.mapfold (fn (p, e) =>
188 S.map2 (mfe ctx e,
189 fn e' => (p, e'))) pes,
190 fn pes' =>
191 S.map2 (mft t,
192 fn t' =>
193 (ECase (e', pes', t'), loc))))
178 194
179 | EStrcat (e1, e2) => 195 | EStrcat (e1, e2) =>
180 S.bind2 (mfe ctx e1, 196 S.bind2 (mfe ctx e1,
181 fn e1' => 197 fn e1' =>
182 S.map2 (mfe ctx e2, 198 S.map2 (mfe ctx e2,