# HG changeset patch # User Adam Chlipala # Date 1220802810 14400 # Node ID df00701f2323fb459be12149b0f2942f7f5a6bef # Parent 0cc956a3216f95e11d702b22a815f6104203c300 'read' type class diff -r 0cc956a3216f -r df00701f2323 lib/basis.urs --- 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 *) diff -r 0cc956a3216f -r df00701f2323 src/cjr.sml --- 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 diff -r 0cc956a3216f -r df00701f2323 src/cjr_print.sml --- 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) => diff -r 0cc956a3216f -r df00701f2323 src/cjrize.sml --- 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 diff -r 0cc956a3216f -r df00701f2323 src/mono.sml --- 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 diff -r 0cc956a3216f -r df00701f2323 src/mono_print.sml --- 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(", diff -r 0cc956a3216f -r df00701f2323 src/mono_reduce.sml --- 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 diff -r 0cc956a3216f -r df00701f2323 src/mono_util.sml --- 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, diff -r 0cc956a3216f -r df00701f2323 src/monoize.sml --- 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 diff -r 0cc956a3216f -r df00701f2323 tests/fromString.ur --- 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 diff -r 0cc956a3216f -r df00701f2323 tests/show.ur --- 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 - 6 = {cdata (show _ 6)}
- 12.34 = {cdata (show _ 12.34)}
- Hi = {cdata (show _ "Hi")}
- False = {cdata (show _ False)}
- diff -r 0cc956a3216f -r df00701f2323 tests/show.urp --- 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 diff -r 0cc956a3216f -r df00701f2323 tests/toString.ur --- 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 - 6 = {cdata (intToString 6)}
- 12.34 = {cdata (floatToString 12.34)}
- False = {cdata (boolToString False)}
+ 6 = {cdata (show _ 6)}
+ 12.34 = {cdata (show _ 12.34)}
+ Hi = {cdata (show _ "Hi")}
+ False = {cdata (show _ False)}