Converting string to int

16 files changed, 204 insertions, 32 deletions

diff --git a/include/urweb.h b/include/urweb.h
index 3995585e..84cc6719 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -77,3 +77,5 @@ char *lw_Basis_ensqlBool(lw_Basis_bool);
 lw_Basis_string lw_Basis_intToString(lw_context, lw_Basis_int);
 lw_Basis_string lw_Basis_floatToString(lw_context, lw_Basis_float);
 lw_Basis_string lw_Basis_boolToString(lw_context, lw_Basis_bool);
+
+lw_Basis_int *lw_Basis_stringToInt(lw_context, lw_Basis_string);
diff --git a/lib/basis.urs b/lib/basis.urs
index 22a033a0..e6072690 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -6,7 +6,7 @@ type unit = {}
 
 datatype bool = False | True
 
-(*datatype option t = None | Some of t*)
+datatype option t = None | Some of t
 
 
 (** Basic type classes *)
@@ -23,10 +23,6 @@ val eq_bool : eq bool
 
 val strcat : string -> string -> string
 
-val intToString : int -> string
-val floatToString : float -> string
-val boolToString : bool -> string
-
 class show
 val show : t ::: Type -> show t -> t -> string
 val show_int : show int
@@ -34,6 +30,8 @@ val show_float : show float
 val show_string : show string
 val show_bool : show bool
 
+val stringToInt : string -> option int
+
 
 (** SQL *)
 
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 9836e502..dce33bf1 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -756,3 +756,16 @@ lw_Basis_string lw_Basis_boolToString(lw_context ctx, lw_Basis_bool b) {
   else
     return "True";
 }
+
+
+lw_Basis_int *lw_Basis_stringToInt(lw_context ctx, lw_Basis_string s) {
+  char *endptr;
+  lw_Basis_int n = strtoll(s, &endptr, 10);
+
+  if (*s != '\0' && *endptr == '\0') {
+    lw_Basis_int *r = lw_malloc(ctx, sizeof(lw_Basis_int));
+    *r = n;
+    return r;
+  } else
+    return NULL;
+}
diff --git a/src/cjr.sml b/src/cjr.sml
index 398f94c6..d4c88246 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -36,6 +36,7 @@ datatype typ' =
        | TRecord of int
        | TDatatype of datatype_kind * int * (string * int * typ option) list ref
        | TFfi of string * string
+       | TOption of typ
 
 withtype typ = typ' located
 
@@ -49,6 +50,8 @@ datatype pat' =
        | PPrim of Prim.t
        | PCon of datatype_kind * patCon * pat option
        | PRecord of (string * pat * typ) list
+       | PNone of typ
+       | PSome of typ * pat
 
 withtype pat = pat' located
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 25a84b9c..8ca7c09d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -90,6 +90,12 @@ fun p_typ' par env (t, loc) =
               string ("__lwd_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n ^ "*")]
          handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n))
       | TFfi (m, x) => box [string "lw_", string m, string "_", string x]
+      | TOption t =>
+        (case #1 t of
+             TDatatype _ => p_typ' par env t
+           | TFfi ("Basis", "string") => p_typ' par env t
+           | _ => box [p_typ' par env t,
+                       string "*"])
 
 and p_typ env = p_typ' false env
 
@@ -127,6 +133,8 @@ fun p_pat_preamble env (p, _) =
                   in
                       (box [pp', pp], env)
                   end) (box [], env) xps
+      | PNone _ => (box [], env)
+      | PSome (_, p) => p_pat_preamble env p
 
 fun p_patCon env pc =
     case pc of
@@ -293,6 +301,65 @@ fun p_pat (env, exit, depth) (p, _) =
              env)
         end
 
+      | PNone t =>
+        (box [string "if",
+              space,
+              string "(disc",
+              string (Int.toString depth),
+              space,
+              string "!=",
+              space,
+              string "NULL)",
+              space,
+              exit,
+              newline],
+         env)
+
+      | PSome (t, p) =>
+        let
+            val (p, env) =
+                let
+                    val (p, env) = p_pat (env, exit, depth + 1) p
+                in
+                    (box [string "{",
+                          newline,
+                          p_typ env t,
+                          space,
+                          string "disc",
+                          string (Int.toString (depth + 1)),
+                          space,
+                          string "=",
+                          space,
+                          case #1 t of
+                              TDatatype _ => box [string "disc",
+                                                  string (Int.toString depth)]
+                            | TFfi ("Basis", "string") => box [string "disc",
+                                                               string (Int.toString depth)]
+                            | _ => box [string "*disc",
+                                        string (Int.toString depth)],
+                          string ";",
+                          newline,
+                          p,
+                          newline,
+                          string "}"],
+                     env)
+                end
+        in
+            (box [string "if",
+                  space,
+                  string "(disc",
+                  string (Int.toString depth),
+                  space,
+                  string "==",
+                  space,
+                  string "NULL)",
+                  space,
+                  exit,
+                  newline,
+                  p],
+             env)
+        end
+
 local
     val count = ref 0
 in
diff --git a/src/cjrize.sml b/src/cjrize.sml
index f3e24710..a45cf02d 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -111,6 +111,12 @@ fun cifyTyp x =
                          ((L'.TDatatype (dk, n, r), loc), sm)
                      end)
               | L.TFfi mx => ((L'.TFfi mx, loc), sm)
+              | L.TOption t =>
+                let
+                    val (t, sm) = cify dtmap (t, sm)
+                in
+                    ((L'.TOption t, loc), sm)
+                end
     in
         cify IM.empty x
     end
@@ -170,6 +176,20 @@ fun cifyPat ((p, loc), sm) =
         in
             ((L'.PRecord xps, loc), sm)
         end
+      | L.PNone t =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+        in
+            ((L'.PNone t, loc), sm)
+        end
+      | L.PSome (t, p) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+            val (p, sm) = cifyPat (p, sm)
+        in
+            ((L'.PSome (t, p), loc), sm)
+        end
+
 
 fun cifyExp (eAll as (e, loc), sm) =
     case e of
diff --git a/src/core_print.sml b/src/core_print.sml
index 0d5a61c1..cfd01e2d 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -306,18 +306,30 @@ fun p_exp' par env (e, _) =
                               p_con' true env c])
       | EFold _ => string "fold"
 
-      | ECase (e, pes, _) => parenIf par (box [string "case",
-                                               space,
-                                               p_exp env e,
-                                               space,
-                                               string "of",
-                                               space,
-                                               p_list_sep (box [space, string "|", space])
-                                                          (fn (p, e) => box [p_pat env p,
-                                                                             space,
-                                                                             string "=>",
-                                                                             space,
-                                                                             p_exp (E.patBinds env p) e]) pes])
+      | ECase (e, pes, {disc, result}) =>
+        parenIf par (box [string "case",
+                          space,
+                          p_exp env e,
+                          space,
+                          if !debug then
+                              box [string "in",
+                                   space,
+                                   p_con env disc,
+                                   space,
+                                   string "return",
+                                   space,
+                                   p_con env result,
+                                   space]
+                          else
+                              box [],
+                          string "of",
+                          space,
+                          p_list_sep (box [space, string "|", space])
+                                     (fn (p, e) => box [p_pat env p,
+                                                        space,
+                                                        string "=>",
+                                                        space,
+                                                        p_exp (E.patBinds env p) e]) pes])
 
       | EWrite e => box [string "write(",
                          p_exp env e,
diff --git a/src/corify.sml b/src/corify.sml
index 91c82375..fac83ee3 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -607,6 +607,7 @@ fun corifyDecl ((d, loc : EM.span), st) =
                                                    end) st xncs
 
             val nxs = length xs - 1
+            val cBase = c
             val c = ListUtil.foldli (fn (i, _, c) => (L'.CApp (c, (L'.CRel (nxs - i), loc)), loc)) c xs
             val k = (L'.KType, loc)
             val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs
@@ -623,7 +624,7 @@ fun corifyDecl ((d, loc : EM.span), st) =
                                   (L'.DVal (x, n, t, e, x), loc)
                               end) xncs
         in
-            ((L'.DCon (x, n, k', c), loc) :: cds, st)
+            ((L'.DCon (x, n, k', cBase), loc) :: cds, st)
         end
       | L.DVal (x, n, t, e) =>
         let
diff --git a/src/expl_print.sml b/src/expl_print.sml
index 05e6da02..10819fbc 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -316,18 +316,30 @@ fun p_exp' par env (e, loc) =
                          p_exp env e,
                          string ")"]
 
-      | ECase (e, pes, _) => parenIf par (box [string "case",
-                                               space,
-                                               p_exp env e,
-                                               space,
-                                               string "of",
-                                               space,
-                                               p_list_sep (box [space, string "|", space])
-                                                          (fn (p, e) => box [p_pat env p,
-                                                                             space,
-                                                                             string "=>",
-                                                                             space,
-                                                                             p_exp env e]) pes])
+      | ECase (e, pes, {disc, result}) =>
+        parenIf par (box [string "case",
+                          space,
+                          p_exp env e,
+                          space,
+                          if !debug then
+                              box [string "in",
+                                   space,
+                                   p_con env disc,
+                                   space,
+                                   string "return",
+                                   space,
+                                   p_con env result,
+                                   space]
+                          else
+                              box [],
+                          string "of",
+                          space,
+                          p_list_sep (box [space, string "|", space])
+                                     (fn (p, e) => box [p_pat env p,
+                                                        space,
+                                                        string "=>",
+                                                        space,
+                                                        p_exp env e]) pes])
 
 and p_exp env = p_exp' false env
 
diff --git a/src/mono.sml b/src/mono.sml
index 4ac21330..3885c789 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -36,6 +36,7 @@ datatype typ' =
        | TRecord of (string * typ) list
        | TDatatype of int * (datatype_kind * (string * int * typ option) list) ref
        | TFfi of string * string
+       | TOption of typ
 
 withtype typ = typ' located
 
@@ -49,6 +50,8 @@ datatype pat' =
        | PPrim of Prim.t
        | PCon of datatype_kind * patCon * pat option
        | PRecord of (string * pat * typ) list
+       | PNone of typ
+       | PSome of typ * pat
 
 withtype pat = pat' located
 
diff --git a/src/mono_env.sml b/src/mono_env.sml
index 387e887e..9981ec01 100644
--- a/src/mono_env.sml
+++ b/src/mono_env.sml
@@ -118,5 +118,7 @@ fun patBinds env (p, loc) =
       | PCon (_, _, NONE) => env
       | PCon (_, _, SOME p) => patBinds env p
       | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
+      | PNone _ => env
+      | PSome (_, p) => patBinds env p
 
 end
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 7ae28cf7..da777a82 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -62,6 +62,11 @@ fun p_typ' par env (t, _) =
               string (#1 (E.lookupDatatype env n)))
          handle E.UnboundNamed _ => string ("UNBOUND_DATATYPE_" ^ Int.toString n))
       | TFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
+      | TOption t =>
+        (case #1 t of
+             TDatatype _ => p_typ env t
+           | TFfi ("Basis", "string") => p_typ env t
+           | _ => box [p_typ env t, string "*"])
 
 and p_typ env = p_typ' false env
 
@@ -95,8 +100,8 @@ fun p_pat' par env (p, _) =
       | PPrim p => Prim.p_t p
       | PCon (_, n, NONE) => p_patCon env n
       | PCon (_, n, SOME p) => parenIf par (box [p_patCon env n,
-                                              space,
-                                              p_pat' true env p])
+                                                 space,
+                                                 p_pat' true env p])
       | PRecord xps =>
         box [string "{",
              p_list_sep (box [string ",", space]) (fn (x, p, _) =>
@@ -106,6 +111,10 @@ fun p_pat' par env (p, _) =
                                                            space,
                                                            p_pat env p]) xps,
              string "}"]
+      | PNone _ => string "None"
+      | PSome (_, p) => box [string "Some",
+                             space,
+                             p_pat' true env p]
 
 and p_pat x = p_pat' false x
 
diff --git a/src/mono_util.sml b/src/mono_util.sml
index f3604cf3..b2fdff52 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -50,6 +50,7 @@ fun compare ((t1, _), (t2, _)) =
         end
       | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2)
       | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2))
+      | (TOption t1, TOption t2) => compare (t1, t2)
 
       | (TFun _, _) => LESS
       | (_, TFun _) => GREATER
@@ -60,6 +61,9 @@ fun compare ((t1, _), (t2, _)) =
       | (TDatatype _, _) => LESS
       | (_, TDatatype _) => GREATER
 
+      | (TFfi _, _) => LESS
+      | (_, TFfi _) => GREATER
+
 and compareFields ((x1, t1), (x2, t2)) =
     join (String.compare (x1, x2),
           fn () => compare (t1, t2))
@@ -88,6 +92,10 @@ fun mapfold fc =
                      fn xts' => (TRecord xts', loc))
               | TDatatype _ => S.return2 cAll
               | TFfi _ => S.return2 cAll
+              | TOption t =>
+                S.map2 (mft t,
+                        fn t' =>
+                           (TOption t, loc))
     in
         mft
     end
@@ -186,6 +194,8 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                                                                     | PCon (_, _, SOME p) => pb (p, ctx)
                                                                     | PRecord xps => foldl (fn ((_, p, _), ctx) =>
                                                                                                pb (p, ctx)) ctx xps
+                                                                    | PNone _ => ctx
+                                                                    | PSome (_, p) => pb (p, ctx)
                                                           in
                                                               S.map2 (mfe (pb (p, ctx)) e,
                                                                    fn e' => (p, e'))
diff --git a/src/monoize.sml b/src/monoize.sml
index 4e2340a7..802b12f8 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -80,6 +80,9 @@ fun monoType env =
                     (L'.TRecord (map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs), loc)
                   | L.TRecord _ => poly ()
 
+                  | L.CApp ((L.CFfi ("Basis", "option"), _), t) =>
+                    (L'.TOption (mt env dtmap t), loc)
+
                   | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
                     (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
 
@@ -397,6 +400,8 @@ fun monoPat env (all as (p, loc)) =
           | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc)
           | L.PPrim p => (L'.PPrim p, loc)
           | L.PCon (dk, pc, [], po) => (L'.PCon (dk, monoPatCon env pc, Option.map (monoPat env) po), loc)
+          | L.PCon (L.Option, _, [t], NONE) => (L'.PNone (monoType env t), loc)
+          | L.PCon (L.Option, _, [t], SOME p) => (L'.PSome (monoType env t, monoPat env p), loc)
           | L.PCon _ => poly ()
           | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc)
     end
diff --git a/tests/fromString.ur b/tests/fromString.ur
new file mode 100644
index 00000000..d9a087e4
--- /dev/null
+++ b/tests/fromString.ur
@@ -0,0 +1,10 @@
+fun i2s s =
+        case stringToInt s of
+          None => 0
+        | Some n => n
+
+fun main () : transaction page = return <html><body>
+        Error = {cdata (show _ (i2s "Error"))}<br/>
+        3 = {cdata (show _ (i2s "+3"))}<br/>
+</body></html>
+
diff --git a/tests/fromString.urp b/tests/fromString.urp
new file mode 100644
index 00000000..0e6b6640
--- /dev/null
+++ b/tests/fromString.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+fromString