Mercurial > urweb
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') |