Mercurial > urweb
comparison src/monoize.sml @ 260:645d0e8da643
Monoize relops
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 31 Aug 2008 15:47:32 -0400 |
parents | d1b679dbbc25 |
children | ee51e9d35c9b |
comparison
equal
deleted
inserted
replaced
259:d1b679dbbc25 | 260:645d0e8da643 |
---|---|
584 | _ => NONE) tables | 584 | _ => NONE) tables |
585 in | 585 in |
586 if List.exists (fn x => x = NONE) tables then | 586 if List.exists (fn x => x = NONE) tables then |
587 NONE | 587 NONE |
588 else | 588 else |
589 SOME (List.mapPartial (fn x => x) tables) | 589 let |
590 val tables = List.mapPartial (fn x => x) tables | |
591 val tables = ListMergeSort.sort | |
592 (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) | |
593 tables | |
594 val tables = map (fn (x, xts) => | |
595 (x, ListMergeSort.sort | |
596 (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) | |
597 xts)) tables | |
598 in | |
599 SOME tables | |
600 end | |
590 end | 601 end |
591 in | 602 in |
592 case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of | 603 case (doTables tables, doTables grouped, doTables stables, monoType env (L.TRecord sexps, loc)) of |
593 (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) => | 604 (SOME tables, SOME grouped, SOME stables, (L'.TRecord sexps, _)) => |
594 ((L'.EAbs ("r", | 605 ((L'.EAbs ("r", |
782 _), _), | 793 _), _), |
783 _), _), | 794 _), _), |
784 _), _), | 795 _), _), |
785 (L.CName tab, _)), _), | 796 (L.CName tab, _)), _), |
786 (L.CName field, _)) => ((L'.EPrim (Prim.String (tab ^ "." ^ field)), loc), fm) | 797 (L.CName field, _)) => ((L'.EPrim (Prim.String (tab ^ "." ^ field)), loc), fm) |
787 | 798 |
799 | L.ECApp ( | |
800 (L.ECApp ( | |
801 (L.ECApp ( | |
802 (L.ECApp ( | |
803 (L.EFfi ("Basis", "sql_relop"), _), | |
804 _), _), | |
805 _), _), | |
806 _), _), | |
807 _) => | |
808 let | |
809 val s = (L'.TFfi ("Basis", "string"), loc) | |
810 fun sc s = (L'.EPrim (Prim.String s), loc) | |
811 in | |
812 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), | |
813 (L'.EAbs ("e1", s, (L'.TFun (s, s), loc), | |
814 (L'.EAbs ("e2", s, s, | |
815 strcat loc [sc "((", | |
816 (L'.ERel 1, loc), | |
817 sc ") ", | |
818 (L'.ERel 2, loc), | |
819 sc " (", | |
820 (L'.ERel 0, loc), | |
821 sc "))"]), loc)), loc)), loc), | |
822 fm) | |
823 end | |
824 | |
825 | L.EFfi ("Basis", "sql_union") => ((L'.EPrim (Prim.String "UNION"), loc), fm) | |
826 | L.EFfi ("Basis", "sql_intersect") => ((L'.EPrim (Prim.String "INTERSECT"), loc), fm) | |
827 | L.EFfi ("Basis", "sql_except") => ((L'.EPrim (Prim.String "EXCEPT"), loc), fm) | |
828 | |
788 | L.EApp ( | 829 | L.EApp ( |
789 (L.ECApp ( | 830 (L.ECApp ( |
790 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), | 831 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), |
791 _), _), | 832 _), _), |
792 se) => | 833 se) => |