Mercurial > urweb

comparison src/mono_util.sml @ 182:d11754ffe252

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Compiled pattern matching to C
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 12:43:20 -0400
parents 3bbed533fbd2
children 8e9f97508f0d
comparison
equal deleted inserted replaced
181:31dfab1d4050 182:d11754ffe252
179 | EField (e, x) => 179 | EField (e, x) =>
180 S.map2 (mfe ctx e, 180 S.map2 (mfe ctx e,
181 fn e' => 181 fn e' =>
182 (EField (e', x), loc)) 182 (EField (e', x), loc))
183 183
184 | ECase (e, pes, t) => 184 | ECase (e, pes, {disc, result}) =>
185 S.bind2 (mfe ctx e, 185 S.bind2 (mfe ctx e,
186 fn e' => 186 fn e' =>
187 S.bind2 (ListUtil.mapfold (fn (p, e) => 187 S.bind2 (ListUtil.mapfold (fn (p, e) =>
188 let 188 let
189 val dummyt = (TFfi ("", ""), ErrorMsg.dummySpan)
190
191 fun pb ((p, _), ctx) = 189 fun pb ((p, _), ctx) =
192 case p of 190 case p of
193 PWild => ctx 191 PWild => ctx
194 | PVar x => bind (ctx, RelE (x, dummyt)) 192 | PVar (x, t) => bind (ctx, RelE (x, t))
195 | PPrim _ => ctx 193 | PPrim _ => ctx
196 | PCon (_, NONE) => ctx 194 | PCon (_, NONE) => ctx
197 | PCon (_, SOME p) => pb (p, ctx) 195 | PCon (_, SOME p) => pb (p, ctx)
198 | PRecord xps => foldl (fn ((_, p), ctx) => 196 | PRecord xps => foldl (fn ((_, p, _), ctx) =>
199 pb (p, ctx)) ctx xps 197 pb (p, ctx)) ctx xps
200 in 198 in
201 S.map2 (mfe (pb (p, ctx)) e, 199 S.map2 (mfe (pb (p, ctx)) e,
202 fn e' => (p, e')) 200 fn e' => (p, e'))
203 end) pes, 201 end) pes,
204 fn pes' => 202 fn pes' =>
205 S.map2 (mft t, 203 S.bind2 (mft disc,
206 fn t' => 204 fn disc' =>
207 (ECase (e', pes', t'), loc)))) 205 S.map2 (mft result,
206 fn result' =>
207 (ECase (e', pes', {disc = disc', result = result'}), loc)))))
208 208
209 | EStrcat (e1, e2) => 209 | EStrcat (e1, e2) =>
210 S.bind2 (mfe ctx e1, 210 S.bind2 (mfe ctx e1,
211 fn e1' => 211 fn e1' =>
212 S.map2 (mfe ctx e2, 212 S.map2 (mfe ctx e2,