Mercurial > urweb

comparison src/mono_util.sml @ 188:8e9f97508f0d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Datatype representation optimization
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 19:49:21 -0400
parents d11754ffe252
children 8a70e2919e86
comparison
equal deleted inserted replaced
187:fb6ed259f5bd 188:8e9f97508f0d
27 27
28 structure MonoUtil :> MONO_UTIL = struct 28 structure MonoUtil :> MONO_UTIL = struct
29 29
30 open Mono 30 open Mono
31 31
32 fun classifyDatatype xncs =
33 if List.all (fn (_, _, NONE) => true | _ => false) xncs then
34 Enum
35 else
36 Default
37
32 structure S = Search 38 structure S = Search
33 39
34 structure Typ = struct 40 structure Typ = struct
35 41
36 fun join (o1, o2) = 42 fun join (o1, o2) =
55 val xts1 = sortFields xts1 61 val xts1 = sortFields xts1
56 val xts2 = sortFields xts2 62 val xts2 = sortFields xts2
57 in 63 in
58 joinL compareFields (xts1, xts2) 64 joinL compareFields (xts1, xts2)
59 end 65 end
60 | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2) 66 | (TDatatype (_, n1, _), TDatatype (_, n2, _)) => Int.compare (n1, n2)
61 | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2)) 67 | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2))
62 68
63 | (TFun _, _) => LESS 69 | (TFun _, _) => LESS
64 | (_, TFun _) => GREATER 70 | (_, TFun _) => GREATER
65 71
139 and mfe' ctx (eAll as (e, loc)) = 145 and mfe' ctx (eAll as (e, loc)) =
140 case e of 146 case e of
141 EPrim _ => S.return2 eAll 147 EPrim _ => S.return2 eAll
142 | ERel _ => S.return2 eAll 148 | ERel _ => S.return2 eAll
143 | ENamed _ => S.return2 eAll 149 | ENamed _ => S.return2 eAll
144 | ECon (_, NONE) => S.return2 eAll 150 | ECon (_, _, NONE) => S.return2 eAll
145 | ECon (n, SOME e) => 151 | ECon (dk, n, SOME e) =>
146 S.map2 (mfe ctx e, 152 S.map2 (mfe ctx e,
147 fn e' => 153 fn e' =>
148 (ECon (n, SOME e'), loc)) 154 (ECon (dk, n, SOME e'), loc))
149 | EFfi _ => S.return2 eAll 155 | EFfi _ => S.return2 eAll
150 | EFfiApp (m, x, es) => 156 | EFfiApp (m, x, es) =>
151 S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es, 157 S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es,
152 fn es' => 158 fn es' =>
153 (EFfiApp (m, x, es'), loc)) 159 (EFfiApp (m, x, es'), loc))
189 fun pb ((p, _), ctx) = 195 fun pb ((p, _), ctx) =
190 case p of 196 case p of
191 PWild => ctx 197 PWild => ctx
192 | PVar (x, t) => bind (ctx, RelE (x, t)) 198 | PVar (x, t) => bind (ctx, RelE (x, t))
193 | PPrim _ => ctx 199 | PPrim _ => ctx
194 | PCon (_, NONE) => ctx 200 | PCon (_, _, NONE) => ctx
195 | PCon (_, SOME p) => pb (p, ctx) 201 | PCon (_, _, SOME p) => pb (p, ctx)
196 | PRecord xps => foldl (fn ((_, p, _), ctx) => 202 | PRecord xps => foldl (fn ((_, p, _), ctx) =>
197 pb (p, ctx)) ctx xps 203 pb (p, ctx)) ctx xps
198 in 204 in
199 S.map2 (mfe (pb (p, ctx)) e, 205 S.map2 (mfe (pb (p, ctx)) e,
200 fn e' => (p, e')) 206 fn e' => (p, e'))
353 val ctx' = 359 val ctx' =
354 case #1 d' of 360 case #1 d' of
355 DDatatype (x, n, xncs) => 361 DDatatype (x, n, xncs) =>
356 let 362 let
357 val ctx = bind (ctx, Datatype (x, n, xncs)) 363 val ctx = bind (ctx, Datatype (x, n, xncs))
358 val t = (TDatatype (n, xncs), #2 d') 364 val t = (TDatatype (classifyDatatype xncs, n, xncs), #2 d')
359 in 365 in
360 foldl (fn ((x, n, to), ctx) => 366 foldl (fn ((x, n, to), ctx) =>
361 let 367 let
362 val t = case to of 368 val t = case to of
363 NONE => t 369 NONE => t