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