Mercurial > urweb

comparison src/specialize.sml @ 194:df5fd8f6913a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
A multi-parameter datatype all the way through
author Adam Chlipala <adamc@hcoop.net>
date Sat, 09 Aug 2008 08:47:36 -0400
parents 8a70e2919e86
children e21d0dddda09
comparison
equal deleted inserted replaced
193:8a70e2919e86 194:df5fd8f6913a
75 fun considerSpecialization (st : state, n, args, dt : datatyp) = 75 fun considerSpecialization (st : state, n, args, dt : datatyp) =
76 case CM.find (#specializations dt, args) of 76 case CM.find (#specializations dt, args) of
77 SOME dt' => (#name dt', #constructors dt', st) 77 SOME dt' => (#name dt', #constructors dt', st)
78 | NONE => 78 | NONE =>
79 let 79 let
80 (*val () = Print.prefaces "Args" [("args", Print.p_list (CorePrint.p_con CoreEnv.empty) args)]*)
81
80 val n' = #count st 82 val n' = #count st
81 83
84 val nxs = length args - 1
82 fun sub t = ListUtil.foldli (fn (i, arg, t) => 85 fun sub t = ListUtil.foldli (fn (i, arg, t) =>
83 subConInCon (i, arg) t) t args 86 subConInCon (nxs - i, arg) t) t args
84 87
85 val (cons, (count, cmap)) = 88 val (cons, (count, cmap)) =
86 ListUtil.foldlMap (fn ((x, n, to), (count, cmap)) => 89 ListUtil.foldlMap (fn ((x, n, to), (count, cmap)) =>
87 let 90 let
88 val to = Option.map sub to 91 val to = Option.map sub to
238 val specDecl = U.Decl.foldMap {kind = kind, con = con, exp = exp, decl = decl} 241 val specDecl = U.Decl.foldMap {kind = kind, con = con, exp = exp, decl = decl}
239 242
240 fun specialize file = 243 fun specialize file =
241 let 244 let
242 fun doDecl (all as (d, _), st : state) = 245 fun doDecl (all as (d, _), st : state) =
243 case d of 246 let
244 DDatatype (x, n, xs, xnts) => 247 (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*)
245 ([all], {count = #count st, 248 in
246 datatypes = IM.insert (#datatypes st, n, 249 case d of
247 {name = x, 250 DDatatype (x, n, xs, xnts) =>
248 params = length xs, 251 ([all], {count = #count st,
249 constructors = xnts, 252 datatypes = IM.insert (#datatypes st, n,
250 specializations = CM.empty}), 253 {name = x,
251 constructors = foldl (fn ((_, n', _), constructors) => 254 params = length xs,
252 IM.insert (constructors, n', n)) 255 constructors = xnts,
253 (#constructors st) xnts, 256 specializations = CM.empty}),
254 decls = []}) 257 constructors = foldl (fn ((_, n', _), constructors) =>
255 | _ => 258 IM.insert (constructors, n', n))
256 let 259 (#constructors st) xnts,
257 val (d, st) = specDecl st all 260 decls = []})
258 in 261 | _ =>
259 (rev (d :: #decls st), 262 let
260 {count = #count st, 263 val (d, st) = specDecl st all
261 datatypes = #datatypes st, 264 in
262 constructors = #constructors st, 265 (rev (d :: #decls st),
263 decls = []}) 266 {count = #count st,
264 end 267 datatypes = #datatypes st,
268 constructors = #constructors st,
269 decls = []})
270 end
271 end
265 272
266 val (ds, _) = ListUtil.foldlMapConcat doDecl 273 val (ds, _) = ListUtil.foldlMapConcat doDecl
267 {count = U.File.maxName file + 1, 274 {count = U.File.maxName file + 1,
268 datatypes = IM.empty, 275 datatypes = IM.empty,
269 constructors = IM.empty, 276 constructors = IM.empty,