Mercurial > urweb

changeset 437:1a4c1b5f4d8f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add time to some type classes
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Oct 2008 14:40:42 -0400
parents 024478c34f4d
children 1c27f03d9bd2
files lib/basis.urs src/monoize.sml tests/time.ur
diffstat 3 files changed, 26 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/lib/basis.urs	Thu Oct 30 14:36:48 2008 -0400
+++ b/lib/basis.urs	Thu Oct 30 14:40:42 2008 -0400
@@ -19,6 +19,7 @@
 val eq_float : eq float
 val eq_string : eq string
 val eq_bool : eq bool
+val eq_time : eq time
 val mkEq : t ::: Type -> (t -> t -> bool) -> eq t
 
 class num
@@ -41,6 +42,7 @@
 val ord_float : ord float
 val ord_string : ord string
 val ord_bool : ord bool
+val ord_time : ord time
 
 
 (** String operations *)
@@ -164,6 +166,7 @@
 val sql_int : sql_injectable int
 val sql_float : sql_injectable float
 val sql_string : sql_injectable string
+val sql_time : sql_injectable time
 val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> exps ::: {Type}
                  -> t ::: Type
                  -> sql_injectable t -> t -> sql_exp tables agg exps t
@@ -216,6 +219,7 @@
 val sql_maxable_int : sql_maxable int
 val sql_maxable_float : sql_maxable float
 val sql_maxable_string : sql_maxable string
+val sql_maxable_time : sql_maxable time
 val sql_max : t ::: Type -> sql_maxable t -> sql_aggregate t
 val sql_min : t ::: Type -> sql_maxable t -> sql_aggregate t
 
--- a/src/monoize.sml	Thu Oct 30 14:36:48 2008 -0400
+++ b/src/monoize.sml	Thu Oct 30 14:40:42 2008 -0400
@@ -597,6 +597,13 @@
                                  (L'.TFfi ("Basis", "bool"), loc),
                                  (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
              fm)
+          | L.EFfi ("Basis", "eq_time") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc),
+                       (L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                       (L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc),
+                                 (L'.TFfi ("Basis", "bool"), loc),
+                                 (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
+             fm)
           | L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) =>
             let
                 val t = monoType env t
@@ -799,6 +806,19 @@
                        boolBin "<",
                        boolBin "<=")
             end
+          | L.EFfi ("Basis", "ord_time") =>
+            let
+                fun boolBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc),
+                                        (L'.TFfi ("Basis", "bool"), loc),
+                                        (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                ordEx ((L'.TFfi ("Basis", "time"), loc),
+                       boolBin "<",
+                       boolBin "<=")
+            end
                        
           | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
             let
--- a/tests/time.ur	Thu Oct 30 14:36:48 2008 -0400
+++ b/tests/time.ur	Thu Oct 30 14:40:42 2008 -0400
@@ -1,3 +1,4 @@
 val now : time = readError "10/30/08 14:35:42"
+val later : time = readError "10/30/08 14:37:42"
 
-fun main () = return <xml>{[now]}</xml>
+fun main () = return <xml>{[now]}, {[now = now]}, {[now = later]}, {[later < now]}, {[now < later]}</xml>