Mercurial > urweb
changeset 437:1a4c1b5f4d8f
Add time to some type classes
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 30 Oct 2008 14:40:42 -0400 (2008-10-30) |
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>