Mercurial > urweb

comparison src/mono_util.sml @ 1663:0577be31a435

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First part of changes to avoid depending on C function call argument order of evaluation (omitting normal Ur function calls, so far)
author Adam Chlipala <adam@chlipala.net>
date Sat, 07 Jan 2012 15:56:22 -0500
parents 7bb8c560f23d
children 38297294cf98
comparison
equal deleted inserted replaced
1662:edf86cef0dba 1663:0577be31a435
154 val mft = Typ.mapfold fc 154 val mft = Typ.mapfold fc
155 155
156 fun mfe ctx e acc = 156 fun mfe ctx e acc =
157 S.bindP (mfe' ctx e acc, fe ctx) 157 S.bindP (mfe' ctx e acc, fe ctx)
158 158
159 and mfet ctx (e, t) =
160 S.bind2 (mfe ctx e,
161 fn e' =>
162 S.map2 (mft t,
163 fn t' => (e', t')))
164
159 and mfe' ctx (eAll as (e, loc)) = 165 and mfe' ctx (eAll as (e, loc)) =
160 case e of 166 case e of
161 EPrim _ => S.return2 eAll 167 EPrim _ => S.return2 eAll
162 | ERel _ => S.return2 eAll 168 | ERel _ => S.return2 eAll
163 | ENamed _ => S.return2 eAll 169 | ENamed _ => S.return2 eAll
176 S.map2 (mfe ctx e, 182 S.map2 (mfe ctx e,
177 fn e' => 183 fn e' =>
178 (ESome (t', e'), loc))) 184 (ESome (t', e'), loc)))
179 | EFfi _ => S.return2 eAll 185 | EFfi _ => S.return2 eAll
180 | EFfiApp (m, x, es) => 186 | EFfiApp (m, x, es) =>
181 S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es, 187 S.map2 (ListUtil.mapfold (fn e => mfet ctx e) es,
182 fn es' => 188 fn es' =>
183 (EFfiApp (m, x, es'), loc)) 189 (EFfiApp (m, x, es'), loc))
184 | EApp (e1, e2) => 190 | EApp (e1, e2) =>
185 S.bind2 (mfe ctx e1, 191 S.bind2 (mfe ctx e1,
186 fn e1' => 192 fn e1' =>
477 | ENamed _ => () 483 | ENamed _ => ()
478 | ECon (_, _, eo) => Option.app appl eo 484 | ECon (_, _, eo) => Option.app appl eo
479 | ENone _ => () 485 | ENone _ => ()
480 | ESome (_, e) => appl e 486 | ESome (_, e) => appl e
481 | EFfi _ => () 487 | EFfi _ => ()
482 | EFfiApp (_, _, es) => app appl es 488 | EFfiApp (_, _, es) => app (appl o #1) es
483 | EApp (e1, e2) => (appl e1; appl e2) 489 | EApp (e1, e2) => (appl e1; appl e2)
484 | EAbs (_, _, _, e1) => appl e1 490 | EAbs (_, _, _, e1) => appl e1
485 | EUnop (_, e1) => appl e1 491 | EUnop (_, e1) => appl e1
486 | EBinop (_, _, e1, e2) => (appl e1; appl e2) 492 | EBinop (_, _, e1, e2) => (appl e1; appl e2)
487 | ERecord xets => app (appl o #2) xets 493 | ERecord xets => app (appl o #2) xets