summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--demo/batchFun.ur14
-rw-r--r--demo/crud.ur22
-rw-r--r--demo/crud2.ur4
-rw-r--r--demo/crud3.ur4
-rw-r--r--demo/list.ur4
-rw-r--r--demo/metaform.ur4
-rw-r--r--demo/sum.ur4
-rw-r--r--demo/tcSum.ur4
-rw-r--r--demo/view.ur2
-rw-r--r--src/monoize.sml2
-rw-r--r--src/reduce.sml3
-rw-r--r--src/urweb.grm2
12 files changed, 38 insertions, 31 deletions
diff --git a/demo/batchFun.ur b/demo/batchFun.ur
index 35276d0e..4243970a 100644
--- a/demo/batchFun.ur
+++ b/demo/batchFun.ur
@@ -8,7 +8,7 @@ con colMeta = fn t_state :: (Type * Type) =>
ReadState : t_state.2 -> transaction t_state.1}
con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
-fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
+fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
name : colMeta (t, source string) =
{Nam = name,
Show = txt,
@@ -49,7 +49,7 @@ functor Make(M : sig
(foldR2 [fst] [colMeta]
[fn cols => $(map (fn t :: (Type * Type) =>
sql_exp [] [] [] t.1) cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] input col acc =>
acc ++ {nm = @sql_inject col.Inject input})
{} [M.cols] M.fl (r -- #Id) M.cols
@@ -74,7 +74,7 @@ functor Make(M : sig
<tr>
<td>{[r.Id]}</td>
{foldRX2 [colMeta] [fst] [_]
- (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] m v =>
<xml><td>{m.Show v}</td></xml>)
[M.cols] M.fl M.cols (r -- #Id)}
@@ -90,7 +90,7 @@ functor Make(M : sig
<tr>
<th>Id</th>
{foldRX [colMeta] [_]
- (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] m =>
<xml><th>{[m.Nam]}</th></xml>)
[M.cols] M.fl M.cols}
@@ -105,7 +105,7 @@ functor Make(M : sig
id <- source "";
inps <- foldR [colMeta] [fn r => transaction ($(map snd r))]
- (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) [[nm] ~ rest] m acc =>
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m acc =>
s <- m.NewState;
r <- acc;
return ({nm = s} ++ r))
@@ -116,7 +116,7 @@ functor Make(M : sig
fun add () =
id <- get id;
vs <- foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
- (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] m s acc =>
v <- m.ReadState s;
r <- acc;
@@ -146,7 +146,7 @@ functor Make(M : sig
<table>
<tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
{foldRX2 [colMeta] [snd] [_]
- (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] m s =>
<xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
[M.cols] M.fl M.cols inps}
diff --git a/demo/crud.ur b/demo/crud.ur
index 0b937ff1..baf157e5 100644
--- a/demo/crud.ur
+++ b/demo/crud.ur
@@ -8,12 +8,12 @@ con colMeta = fn t_formT :: (Type * Type) => {
}
con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
-fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
+fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
name : colMeta (t, string) =
{Nam = name,
Show = txt,
- Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
- WidgetPopulated = fn (nm :: Name) n =>
+ Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
+ WidgetPopulated = fn [nm :: Name] n =>
<xml><textbox{nm} value={show n}/></xml>,
Parse = readError,
Inject = _}
@@ -24,8 +24,8 @@ val string = default
fun bool name = {Nam = name,
Show = txt,
- Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
- WidgetPopulated = fn (nm :: Name) b =>
+ Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
+ WidgetPopulated = fn [nm :: Name] b =>
<xml><checkbox{nm} checked={b}/></xml>,
Parse = fn x => x,
Inject = _}
@@ -53,7 +53,7 @@ functor Make(M : sig
<tr>
<td>{[fs.T.Id]}</td>
{foldRX2 [fst] [colMeta] [tr]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] v col => <xml>
<td>{col.Show v}</td>
</xml>)
@@ -69,7 +69,7 @@ functor Make(M : sig
<tr>
<th>ID</th>
{foldRX [colMeta] [tr]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] col => <xml>
<th>{cdata col.Nam}</th>
</xml>)
@@ -82,7 +82,7 @@ functor Make(M : sig
<form>
{foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
<li> {cdata col.Nam}: {col.Widget [nm]}</li>
{useMore acc}
@@ -100,7 +100,7 @@ functor Make(M : sig
(foldR2 [snd] [colMeta]
[fn cols => $(map (fn t :: (Type * Type) =>
sql_exp [] [] [] t.1) cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] =>
fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
{} [M.cols] M.fl inputs M.cols
@@ -121,7 +121,7 @@ functor Make(M : sig
sql_exp [T = [Id = int]
++ map fst M.cols]
[] [] t.1) cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] =>
fn input col acc => acc ++ {nm =
@sql_inject col.Inject (col.Parse input)})
@@ -139,7 +139,7 @@ functor Make(M : sig
None => return <xml><body>Not found!</body></xml>
| Some fs => return <xml><body><form>
{foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
- (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
[[nm] ~ rest] (v : t.1) (col : colMeta t)
(acc : xml form [] (map snd rest)) =>
<xml>
diff --git a/demo/crud2.ur b/demo/crud2.ur
index 54992e28..a89b37b3 100644
--- a/demo/crud2.ur
+++ b/demo/crud2.ur
@@ -12,13 +12,13 @@ open Crud.Make(struct
<xml>Ready!</xml>
else
<xml>Not ready</xml>),
- Widget = (fn (nm :: Name) => <xml>
+ Widget = (fn [nm :: Name] => <xml>
<select{nm}>
<option>Ready</option>
<option>Not ready</option>
</select>
</xml>),
- WidgetPopulated = (fn (nm :: Name) b => <xml>
+ WidgetPopulated = (fn [nm :: Name] b => <xml>
<select{nm}>
<option selected={b}>Ready</option>
<option selected={not b}>Not ready</option>
diff --git a/demo/crud3.ur b/demo/crud3.ur
index efc6c06e..c336af30 100644
--- a/demo/crud3.ur
+++ b/demo/crud3.ur
@@ -8,13 +8,13 @@ open Crud.Make(struct
val cols = {Text = {Nam = "Text",
Show = txt,
- Widget = (fn (nm :: Name) => <xml>
+ Widget = (fn [nm :: Name] => <xml>
<subform{nm}>
<textbox{#A}/>
<textbox{#B}/>
</subform>
</xml>),
- WidgetPopulated = (fn (nm :: Name) s => <xml>
+ WidgetPopulated = (fn [nm :: Name] s => <xml>
<subform{nm}>
<textbox{#A} value={s}/>
<textbox{#B}/>
diff --git a/demo/list.ur b/demo/list.ur
index 107bf92c..961708ea 100644
--- a/demo/list.ur
+++ b/demo/list.ur
@@ -1,6 +1,6 @@
datatype list t = Nil | Cons of t * list t
-fun length (t ::: Type) (ls : list t) =
+fun length [t] (ls : list t) =
let
fun length' (ls : list t) (acc : int) =
case ls of
@@ -10,7 +10,7 @@ fun length (t ::: Type) (ls : list t) =
length' ls 0
end
-fun rev (t ::: Type) (ls : list t) =
+fun rev [t] (ls : list t) =
let
fun rev' (ls : list t) (acc : list t) =
case ls of
diff --git a/demo/metaform.ur b/demo/metaform.ur
index 26462215..54bf0fc7 100644
--- a/demo/metaform.ur
+++ b/demo/metaform.ur
@@ -6,7 +6,7 @@ functor Make (M : sig
fun handler values = return <xml><body>
{foldURX2 [string] [string] [body]
- (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] name value => <xml>
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name value => <xml>
<li> {[name]} = {[value]}</li>
</xml>)
[M.fs] M.fl M.names values}
@@ -15,7 +15,7 @@ functor Make (M : sig
fun main () = return <xml><body>
<form>
{foldUR [string] [fn cols :: {Unit} => xml form [] (mapU string cols)]
- (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] name
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name
(acc : xml form [] (mapU string rest)) => <xml>
<li> {[name]}: <textbox{nm}/></li>
{useMore acc}
diff --git a/demo/sum.ur b/demo/sum.ur
index d967454c..483cbf0a 100644
--- a/demo/sum.ur
+++ b/demo/sum.ur
@@ -1,6 +1,6 @@
-fun sum (fs ::: {Unit}) (fl : folder fs) (x : $(mapU int fs)) =
+fun sum [fs ::: {Unit}] (fl : folder fs) (x : $(mapU int fs)) =
foldUR [int] [fn _ => int]
- (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] n acc => n + acc)
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
0 [fs] fl x
fun main () = return <xml><body>
diff --git a/demo/tcSum.ur b/demo/tcSum.ur
index 13cefc39..57e61c38 100644
--- a/demo/tcSum.ur
+++ b/demo/tcSum.ur
@@ -1,6 +1,6 @@
-fun sum (t ::: Type) (_ : num t) (fs ::: {Unit}) (fl : folder fs) (x : $(mapU t fs)) =
+fun sum [t] (_ : num t) [fs ::: {Unit}] (fl : folder fs) (x : $(mapU t fs)) =
foldUR [t] [fn _ => t]
- (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] n acc => n + acc)
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
zero [fs] fl x
fun main () = return <xml><body>
diff --git a/demo/view.ur b/demo/view.ur
index ce1242e0..84c179f4 100644
--- a/demo/view.ur
+++ b/demo/view.ur
@@ -1,7 +1,7 @@
table t : { A : int }
view v = SELECT t.A AS A FROM t WHERE t.A > 7
-fun list (u ::: Type) (_ : fieldsOf u [A = int]) (title : string) (x : u) =
+fun list [u] (_ : fieldsOf u [A = int]) (title : string) (x : u) =
xml <- queryX (SELECT * FROM x)
(fn r : {X : {A : int}} => <xml><li>{[r.X.A]}</li></xml>);
return <xml>
diff --git a/src/monoize.sml b/src/monoize.sml
index 87c4d86c..4d7a666e 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -148,6 +148,8 @@ fun monoType env =
(L'.TFfi ("Basis", "string"), loc)
| L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_table"), _), _), _), _) =>
(L'.TFfi ("Basis", "string"), loc)
+ | L.CApp ((L.CFfi ("Basis", "sql_view"), _), _) =>
+ (L'.TFfi ("Basis", "string"), loc)
| L.CFfi ("Basis", "sql_sequence") =>
(L'.TFfi ("Basis", "string"), loc)
| L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) =>
diff --git a/src/reduce.sml b/src/reduce.sml
index 9460d3fe..a6c0b38a 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -390,6 +390,9 @@ fun kindConAndExp (namedC, namedE) =
| _ => default ()
end
+ | ECase (_, [((PRecord [], _), e)], _) => exp env e
+ | ECase (_, [((PWild, _), e)], _) => exp env e
+
| ECase (e, pes, {disc, result}) =>
let
fun patBinds (p, _) =
diff --git a/src/urweb.grm b/src/urweb.grm
index 638ede12..0d2c1d47 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -985,6 +985,7 @@ earg : patS (fn (e, t) =>
val e' = case #1 patS of
PVar x => (EAbs (x, NONE, e), loc)
+ | PAnnot ((PVar x, _), t) => (EAbs (x, SOME t, e), loc)
| _ => (EAbs ("$x", SOME pt,
(ECase ((EVar ([], "$x", DontInfer),
loc),
@@ -1001,6 +1002,7 @@ eargp : pterm (fn (e, t) =>
val e' = case #1 pterm of
PVar x => (EAbs (x, NONE, e), loc)
+ | PAnnot ((PVar x, _), t) => (EAbs (x, SOME t, e), loc)
| _ => (EAbs ("$x", SOME pt,
(ECase ((EVar ([], "$x", DontInfer),
loc),
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 23:16:59 +0000