Mercurial > urweb
changeset 288:4260ad920c36
Converting string to int
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 07 Sep 2008 11:33:13 -0400 |
| parents | 3ed7a7c7b060 |
| children | 0cc956a3216f |
| files | include/urweb.h lib/basis.urs src/c/urweb.c src/cjr.sml src/cjr_print.sml src/cjrize.sml src/core_print.sml src/corify.sml src/expl_print.sml src/mono.sml src/mono_env.sml src/mono_print.sml src/mono_util.sml src/monoize.sml tests/fromString.ur tests/fromString.urp |
| diffstat | 16 files changed, 204 insertions(+), 32 deletions(-) [+] |
line wrap: on
line diff
--- a/include/urweb.h Sun Sep 07 10:52:51 2008 -0400 +++ b/include/urweb.h Sun Sep 07 11:33:13 2008 -0400 @@ -77,3 +77,5 @@ 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);
--- a/lib/basis.urs Sun Sep 07 10:52:51 2008 -0400 +++ b/lib/basis.urs Sun Sep 07 11:33:13 2008 -0400 @@ -6,7 +6,7 @@ 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 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_string : show string val show_bool : show bool +val stringToInt : string -> option int + (** SQL *)
--- a/src/c/urweb.c Sun Sep 07 10:52:51 2008 -0400 +++ b/src/c/urweb.c Sun Sep 07 11:33:13 2008 -0400 @@ -756,3 +756,16 @@ 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; +}
--- a/src/cjr.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/cjr.sml Sun Sep 07 11:33:13 2008 -0400 @@ -36,6 +36,7 @@ | 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 @@ | 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
--- a/src/cjr_print.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/cjr_print.sml Sun Sep 07 11:33:13 2008 -0400 @@ -90,6 +90,12 @@ 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 @@ 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 @@ 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
--- a/src/cjrize.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/cjrize.sml Sun Sep 07 11:33:13 2008 -0400 @@ -111,6 +111,12 @@ ((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 @@ 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
--- a/src/core_print.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/core_print.sml Sun Sep 07 11:33:13 2008 -0400 @@ -306,18 +306,30 @@ 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,
--- a/src/corify.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/corify.sml Sun Sep 07 11:33:13 2008 -0400 @@ -607,6 +607,7 @@ 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 @@ (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
--- a/src/expl_print.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/expl_print.sml Sun Sep 07 11:33:13 2008 -0400 @@ -316,18 +316,30 @@ 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
--- a/src/mono.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/mono.sml Sun Sep 07 11:33:13 2008 -0400 @@ -36,6 +36,7 @@ | 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 @@ | 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
--- a/src/mono_env.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/mono_env.sml Sun Sep 07 11:33:13 2008 -0400 @@ -118,5 +118,7 @@ | 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
--- a/src/mono_print.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/mono_print.sml Sun Sep 07 11:33:13 2008 -0400 @@ -62,6 +62,11 @@ 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 @@ | 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 @@ 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
--- a/src/mono_util.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/mono_util.sml Sun Sep 07 11:33:13 2008 -0400 @@ -50,6 +50,7 @@ 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 @@ | (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 @@ 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 @@ | 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'))
--- a/src/monoize.sml Sun Sep 07 10:52:51 2008 -0400 +++ b/src/monoize.sml Sun Sep 07 11:33:13 2008 -0400 @@ -80,6 +80,9 @@ (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 @@ | 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/fromString.ur Sun Sep 07 11:33:13 2008 -0400 @@ -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> +