Mercurial > urweb

changeset 290:df00701f2323

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'read' type class
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 11:53:30 -0400
parents 0cc956a3216f
children 550100a44cca
files lib/basis.urs src/cjr.sml src/cjr_print.sml src/cjrize.sml src/mono.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sml tests/fromString.ur tests/show.ur tests/show.urp tests/toString.ur
diffstat 13 files changed, 82 insertions(+), 20 deletions(-) [+]
line wrap: on
line diff
--- a/lib/basis.urs	Sun Sep 07 11:41:04 2008 -0400
+++ b/lib/basis.urs	Sun Sep 07 11:53:30 2008 -0400
@@ -30,9 +30,12 @@
 val show_string : show string
 val show_bool : show bool
 
-val stringToInt : string -> option int
-val stringToFloat : string -> option float
-val stringToBool : string -> option bool
+class read
+val read : t ::: Type -> read t -> string -> option t
+val read_int : read int
+val read_float : read float
+val read_string : read string
+val read_bool : read bool
 
 
 (** SQL *)
--- a/src/cjr.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/cjr.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -60,6 +60,7 @@
        | ERel of int
        | ENamed of int
        | ECon of datatype_kind * patCon * exp option
+       | ESome of typ * exp
        | EFfi of string * string
        | EFfiApp of string * string * exp list
        | EApp of exp * exp
--- a/src/cjr_print.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/cjr_print.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -520,6 +520,31 @@
                  newline,
                  string "})"]          
         end
+      | ESome (t, e) =>
+        (case #1 t of
+             TDatatype _ => p_exp' par env e
+           | TFfi ("Basis", "string") => p_exp' par env e
+           | _ => box [string "({",
+                       newline,
+                       p_typ env t,
+                       space,
+                       string "*tmp",
+                       space,
+                       string "=",
+                       space,
+                       string "lw_malloc(ctx, sizeof(",
+                       p_typ env t,
+                       string "));",
+                       newline,
+                       string "*tmp",
+                       space,
+                       string "=",
+                       p_exp' par env e,
+                       string ";",
+                       newline,
+                       string "tmp;",
+                       newline,
+                       string "})"])
 
       | EFfi (m, x) => box [string "lw_", string m, string "_", string x]
       | EError (e, t) =>
--- a/src/cjrize.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/cjrize.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -211,6 +211,13 @@
         in
             ((L'.ECon (dk, pc, eo), loc), sm)
         end
+      | L.ESome (t, e) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+            val (e, sm) = cifyExp (e, sm)
+        in
+            ((L'.ESome (t, e), loc), sm)
+        end
       | L.EFfi mx => ((L'.EFfi mx, loc), sm)
       | L.EFfiApp (m, x, es) =>
         let
--- a/src/mono.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/mono.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -60,6 +60,7 @@
        | ERel of int
        | ENamed of int
        | ECon of datatype_kind * patCon * exp option
+       | ESome of typ * exp
        | EFfi of string * string
        | EFfiApp of string * string * exp list
        | EApp of exp * exp
--- a/src/mono_print.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/mono_print.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -132,6 +132,9 @@
       | ECon (_, pc, SOME e) => parenIf par (box [p_patCon env pc,
                                                   space,
                                                   p_exp' true env e])
+      | ESome (_, e) => parenIf par (box [string "Some",
+                                          space,
+                                          p_exp' true env e])
 
       | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
       | EFfiApp (m, x, es) => box [string "FFI(",
--- a/src/mono_reduce.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/mono_reduce.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -45,6 +45,7 @@
       | ERel _ => false
       | ENamed _ => false
       | ECon (_, _, eo) => (case eo of NONE => false | SOME e => impure e)
+      | ESome (_, e) => impure e
       | EFfi _ => false
       | EFfiApp _ => false
       | EApp ((EFfi _, _), _) => false
--- a/src/mono_util.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/mono_util.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -145,6 +145,12 @@
                 S.map2 (mfe ctx e,
                         fn e' =>
                            (ECon (dk, n, SOME e'), loc))
+              | ESome (t, e) =>
+                S.bind2 (mft t,
+                         fn t' =>
+                            S.map2 (mfe ctx e,
+                                 fn e' =>
+                                    (ESome (t', e'), loc)))
               | EFfi _ => S.return2 eAll
               | EFfiApp (m, x, es) =>
                 S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es,
--- a/src/monoize.sml	Sun Sep 07 11:41:04 2008 -0400
+++ b/src/monoize.sml	Sun Sep 07 11:53:30 2008 -0400
@@ -85,6 +85,9 @@
 
                   | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
                     (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
+                  | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
+                    (L'.TFun ((L'.TFfi ("Basis", "string"), loc),
+                              (L'.TOption (mt env dtmap t), loc)), loc)
 
                   | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
@@ -490,6 +493,28 @@
           | L.EFfi ("Basis", "show_bool") =>
             ((L'.EFfi ("Basis", "boolToString"), loc), fm)
 
+          | L.ECApp ((L.EFfi ("Basis", "read"), _), t) =>
+            let
+                val t = monoType env t
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("f", (L'.TFun (t, s), loc), (L'.TFun (t, s), loc),
+                           (L'.ERel 0, loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "read_int") =>
+            ((L'.EFfi ("Basis", "stringToInt"), loc), fm)
+          | L.EFfi ("Basis", "read_float") =>
+            ((L'.EFfi ("Basis", "stringToFloat"), loc), fm)
+          | L.EFfi ("Basis", "read_string") =>
+            let
+                val s = (L'.TFfi ("Basis", "string"), loc)
+            in
+                ((L'.EAbs ("s", s, (L'.TOption s, loc),
+                           (L'.ESome (s, (L'.ERel 0, loc)), loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "read_bool") =>
+            ((L'.EFfi ("Basis", "stringToBool"), loc), fm)
+
           | L.ECApp ((L.EFfi ("Basis", "return"), _), t) =>
             let
                 val t = monoType env t
--- a/tests/fromString.ur	Sun Sep 07 11:41:04 2008 -0400
+++ b/tests/fromString.ur	Sun Sep 07 11:53:30 2008 -0400
@@ -1,15 +1,15 @@
 fun s2i s =
-        case stringToInt s of
+        case read _ s of
           None => 0
         | Some n => n
 
 fun s2f s =
-        case stringToFloat s of
+        case read _ s of
           None => 0.0
         | Some n => n
 
 fun s2b s =
-        case stringToBool s of
+        case read _ s of
           None => False
         | Some b => b
 
--- a/tests/show.ur	Sun Sep 07 11:41:04 2008 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,6 +0,0 @@
-fun main () : transaction page = return <html><body>
-        6 = {cdata (show _ 6)}<br/>
-        12.34 = {cdata (show _ 12.34)}<br/>
-        Hi = {cdata (show _ "Hi")}<br/>
-        False = {cdata (show _ False)}<br/>
-</body></html>
--- a/tests/show.urp	Sun Sep 07 11:41:04 2008 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,5 +0,0 @@
-debug
-database dbname=test
-exe /tmp/webapp
-
-show
--- a/tests/toString.ur	Sun Sep 07 11:41:04 2008 -0400
+++ b/tests/toString.ur	Sun Sep 07 11:53:30 2008 -0400
@@ -1,5 +1,6 @@
 fun main () : transaction page = return <html><body>
-        6 = {cdata (intToString 6)}<br/>
-        12.34 = {cdata (floatToString 12.34)}<br/>
-        False = {cdata (boolToString False)}<br/>
+        6 = {cdata (show _ 6)}<br/>
+        12.34 = {cdata (show _ 12.34)}<br/>
+        Hi = {cdata (show _ "Hi")}<br/>
+        False = {cdata (show _ False)}<br/>
 </body></html>