summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-10-30 14:40:42 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-10-30 14:40:42 -0400
commit49330740529a9d1448bff0fd3123e8946ab3915d (patch)
tree3bf696058ebb4bf033bed7475be602a25aeeb88c
parentd321a012ed51bf14ce6271198ccb29784efb7bd5 (diff)
Add time to some type classes
-rw-r--r--lib/basis.urs4
-rw-r--r--src/monoize.sml20
-rw-r--r--tests/time.ur3
3 files changed, 26 insertions, 1 deletions
diff --git a/lib/basis.urs b/lib/basis.urs
index ba8f3d40..ffb13330 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -19,6 +19,7 @@ val eq_int : eq int
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_int : ord int
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_bool : sql_injectable bool
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 @@ class sql_maxable
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
diff --git a/src/monoize.sml b/src/monoize.sml
index 273efafe..0557bb4c 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -597,6 +597,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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
diff --git a/tests/time.ur b/tests/time.ur
index 393939e9..7b8b93ef 100644
--- a/tests/time.ur
+++ b/tests/time.ur
@@ -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>