comparison src/core_util.sml @ 623:588b9d16b00a

Start of kind polymorphism, up to the point where demo/hello elaborates with updated Basis/Top
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Feb 2009 16:10:25 -0500
parents 8998114760c1
children 230654093b51
comparison
equal deleted inserted replaced
622:d64533157f40 623:588b9d16b00a
451 | (ECutMulti (e1, c1, _), ECutMulti (e2, c2, _)) => 451 | (ECutMulti (e1, c1, _), ECutMulti (e2, c2, _)) =>
452 join (compare (e1, e2), 452 join (compare (e1, e2),
453 fn () => Con.compare (c1, c2)) 453 fn () => Con.compare (c1, c2))
454 | (ECutMulti _, _) => LESS 454 | (ECutMulti _, _) => LESS
455 | (_, ECutMulti _) => GREATER 455 | (_, ECutMulti _) => GREATER
456
457 | (EFold _, EFold _) => EQUAL
458 | (EFold _, _) => LESS
459 | (_, EFold _) => GREATER
460 456
461 | (ECase (e1, pes1, _), ECase (e2, pes2, _)) => 457 | (ECase (e1, pes1, _), ECase (e2, pes2, _)) =>
462 join (compare (e1, e2), 458 join (compare (e1, e2),
463 fn () => joinL (fn ((p1, e1), (p2, e2)) => 459 fn () => joinL (fn ((p1, e1), (p2, e2)) =>
464 join (pCompare (p1, p2), 460 join (pCompare (p1, p2),
607 S.bind2 (mfc ctx c, 603 S.bind2 (mfc ctx c,
608 fn c' => 604 fn c' =>
609 S.map2 (mfc ctx rest, 605 S.map2 (mfc ctx rest,
610 fn rest' => 606 fn rest' =>
611 (ECutMulti (e', c', {rest = rest'}), loc)))) 607 (ECutMulti (e', c', {rest = rest'}), loc))))
612 | EFold k =>
613 S.map2 (mfk k,
614 fn k' =>
615 (EFold k', loc))
616 608
617 | ECase (e, pes, {disc, result}) => 609 | ECase (e, pes, {disc, result}) =>
618 S.bind2 (mfe ctx e, 610 S.bind2 (mfe ctx e,
619 fn e' => 611 fn e' =>
620 S.bind2 (ListUtil.mapfold (fn (p, e) => 612 S.bind2 (ListUtil.mapfold (fn (p, e) =>