From d43dc372d0dbc90031696d8503c05654e6605f84 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 31 Aug 2008 14:27:01 -0400
Subject: Monoized a WHERE clause with a comparison

---
 src/mono_opt.sml | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

(limited to 'src/mono_opt.sml')

diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 4b417217..1430dfe2 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -79,6 +79,12 @@ val urlifyString = String.translate (fn #" " => "+"
                                                   str ch
                                               else
                                                   "%" ^ hexIt ch)
+
+
+val sqlifyInt = attrifyInt
+val sqlifyFloat = attrifyFloat
+
+fun sqlifyString s = "E'" ^ String.toString s ^ "'"
         
 fun exp e =
     case e of
@@ -203,6 +209,21 @@ fun exp e =
       | EWrite (EFfiApp ("Basis", "urlifyBool", [e]), _) =>
         EFfiApp ("Basis", "urlifyBool_w", [e])
 
+      | EFfiApp ("Basis", "sqlifyInt", [(EPrim (Prim.Int n), _)]) =>
+        EPrim (Prim.String (sqlifyInt n))
+      | EFfiApp ("Basis", "sqlifyFloat", [(EPrim (Prim.Float n), _)]) =>
+        EPrim (Prim.String (sqlifyFloat n))
+      | EFfiApp ("Basis", "sqlifyBool", [b as (_, loc)]) =>
+        optExp (ECase (b,
+                       [((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc),
+                         (EPrim (Prim.String "TRUE"), loc)),
+                        ((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "False", arg = NONE}, NONE), loc),
+                         (EPrim (Prim.String "FALSE"), loc))],
+                       {disc = (TFfi ("Basis", "bool"), loc),
+                        result = (TFfi ("Basis", "string"), loc)}), loc)
+      | EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) =>
+        EPrim (Prim.String (sqlifyString n))
+
       | EWrite (ECase (discE, pes, {disc, ...}), loc) =>
         optExp (ECase (discE,
                        map (fn (p, e) => (p, (EWrite e, loc))) pes,
-- 
cgit v1.2.3