comparison src/mono_util.sml @ 196:890a61991263

Lists all the way through
author Adam Chlipala <adamc@hcoop.net>
date Sat, 09 Aug 2008 16:48:32 -0400
parents 8a70e2919e86
children ab86aa858e6c
comparison
equal deleted inserted replaced
195:85b5f663bb86 196:890a61991263
50 val xts1 = sortFields xts1 50 val xts1 = sortFields xts1
51 val xts2 = sortFields xts2 51 val xts2 = sortFields xts2
52 in 52 in
53 joinL compareFields (xts1, xts2) 53 joinL compareFields (xts1, xts2)
54 end 54 end
55 | (TDatatype (_, n1, _), TDatatype (_, n2, _)) => Int.compare (n1, n2) 55 | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2)
56 | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2)) 56 | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2))
57 57
58 | (TFun _, _) => LESS 58 | (TFun _, _) => LESS
59 | (_, TFun _) => GREATER 59 | (_, TFun _) => GREATER
60 60
295 | DVal vi => 295 | DVal vi =>
296 S.map2 (mfvi ctx vi, 296 S.map2 (mfvi ctx vi,
297 fn vi' => 297 fn vi' =>
298 (DVal vi', loc)) 298 (DVal vi', loc))
299 | DValRec vis => 299 | DValRec vis =>
300 S.map2 (ListUtil.mapfold (mfvi ctx) vis, 300 let
301 fn vis' => 301 val ctx' = foldl (fn ((x, n, t, _, s), ctx') => bind (ctx', NamedE (x, n, t, NONE, s))) ctx vis
302 (DValRec vis', loc)) 302 in
303 S.map2 (ListUtil.mapfold (mfvi ctx') vis,
304 fn vis' =>
305 (DValRec vis', loc))
306 end
303 | DExport (ek, s, n, ts) => 307 | DExport (ek, s, n, ts) =>
304 S.map2 (ListUtil.mapfold mft ts, 308 S.map2 (ListUtil.mapfold mft ts,
305 fn ts' => 309 fn ts' =>
306 (DExport (ek, s, n, ts'), loc)) 310 (DExport (ek, s, n, ts'), loc))
307 311
348 val ctx' = 352 val ctx' =
349 case #1 d' of 353 case #1 d' of
350 DDatatype (x, n, xncs) => 354 DDatatype (x, n, xncs) =>
351 let 355 let
352 val ctx = bind (ctx, Datatype (x, n, xncs)) 356 val ctx = bind (ctx, Datatype (x, n, xncs))
353 val t = (TDatatype (classifyDatatype xncs, n, xncs), #2 d') 357 val t = (TDatatype (n, ref (classifyDatatype xncs, xncs)), #2 d')
354 in 358 in
355 foldl (fn ((x, n, to), ctx) => 359 foldl (fn ((x, n, to), ctx) =>
356 let 360 let
357 val t = case to of 361 val t = case to of
358 NONE => t 362 NONE => t
362 end) 366 end)
363 ctx xncs 367 ctx xncs
364 end 368 end
365 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s)) 369 | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s))
366 | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) => 370 | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) =>
367 bind (ctx, NamedE (x, n, t, SOME e, s))) ctx vis 371 bind (ctx, NamedE (x, n, t, NONE, s))) ctx vis
368 | DExport _ => ctx 372 | DExport _ => ctx
369 in 373 in
370 S.map2 (mff ctx' ds', 374 S.map2 (mff ctx' ds',
371 fn ds' => 375 fn ds' =>
372 d' :: ds') 376 d' :: ds')