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