summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/basis.urs9
-rw-r--r--src/cjr.sml1
-rw-r--r--src/cjr_print.sml25
-rw-r--r--src/cjrize.sml7
-rw-r--r--src/mono.sml1
-rw-r--r--src/mono_print.sml3
-rw-r--r--src/mono_reduce.sml1
-rw-r--r--src/mono_util.sml6
-rw-r--r--src/monoize.sml25
-rw-r--r--tests/fromString.ur6
-rw-r--r--tests/show.ur6
-rw-r--r--tests/show.urp5
-rw-r--r--tests/toString.ur7
13 files changed, 82 insertions, 20 deletions
diff --git a/lib/basis.urs b/lib/basis.urs
index 4275e195..b2f3122d 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -30,9 +30,12 @@ val show_float : show float
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 --git a/src/cjr.sml b/src/cjr.sml
index d4c88246..74c4bca2 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -60,6 +60,7 @@ datatype exp' =
| 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 --git a/src/cjr_print.sml b/src/cjr_print.sml
index 8ca7c09d..905c4e10 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -520,6 +520,31 @@ fun p_exp' par env (e, loc) =
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 --git a/src/cjrize.sml b/src/cjrize.sml
index a45cf02d..e137c6fd 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -211,6 +211,13 @@ fun cifyExp (eAll as (e, loc), sm) =
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 --git a/src/mono.sml b/src/mono.sml
index 3885c789..8c69443a 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -60,6 +60,7 @@ datatype exp' =
| 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 --git a/src/mono_print.sml b/src/mono_print.sml
index da777a82..a2c55b6a 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -132,6 +132,9 @@ fun p_exp' par env (e, _) =
| 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 --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index c1972729..42f32256 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -45,6 +45,7 @@ fun impure (e, _) =
| 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 --git a/src/mono_util.sml b/src/mono_util.sml
index b2fdff52..90ae3a4f 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -145,6 +145,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
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 --git a/src/monoize.sml b/src/monoize.sml
index 802b12f8..e0f73802 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -85,6 +85,9 @@ fun monoType env =
| 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| 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 --git a/tests/fromString.ur b/tests/fromString.ur
index 673503ae..7c1c5a34 100644
--- a/tests/fromString.ur
+++ b/tests/fromString.ur
@@ -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 --git a/tests/show.ur b/tests/show.ur
deleted file mode 100644
index 6a22fe64..00000000
--- a/tests/show.ur
+++ /dev/null
@@ -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>
diff --git a/tests/show.urp b/tests/show.urp
deleted file mode 100644
index fa69257a..00000000
--- a/tests/show.urp
+++ /dev/null
@@ -1,5 +0,0 @@
-debug
-database dbname=test
-exe /tmp/webapp
-
-show
diff --git a/tests/toString.ur b/tests/toString.ur
index f51ef098..6a22fe64 100644
--- a/tests/toString.ur
+++ b/tests/toString.ur
@@ -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>
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 15:39:36 +0000