diff options
| -rw-r--r-- | lib/ur/monad.ur | 9 | ||||
| -rw-r--r-- | lib/ur/monad.urs | 6 | ||||
| -rw-r--r-- | src/c/urweb.c | 3 | ||||
| -rw-r--r-- | src/elaborate.sml | 3 |
4 files changed, 17 insertions, 4 deletions
diff --git a/lib/ur/monad.ur b/lib/ur/monad.ur index ab7742fe..8bff0133 100644 --- a/lib/ur/monad.ur +++ b/lib/ur/monad.ur @@ -81,6 +81,15 @@ fun mapR2 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tr :: K - return (acc ++ {nm = v'})) {} +fun mapR3 [K] [m] (_ : monad m) [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: K -> Type] + (f : nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m (tr t)) = + @@foldR3 [m] _ [tf1] [tf2] [tf3] [fn r => $(map tr r)] + (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] (v1 : tf1 t) (v2 : tf2 t) (v3 : tf3 t) + (acc : $(map tr rest)) => + v' <- f [nm] [t] v1 v2 v3; + return (acc ++ {nm = v'})) + {} + fun foldMapR [K] [m] (_ : monad m) [tf :: K -> Type] [tf' :: K -> Type] [tr :: {K} -> Type] (f : nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] => diff --git a/lib/ur/monad.urs b/lib/ur/monad.urs index ce823f4a..8ca8d0a3 100644 --- a/lib/ur/monad.urs +++ b/lib/ur/monad.urs @@ -58,6 +58,12 @@ val mapR2 : K --> m ::: (Type -> Type) -> monad m -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> m (tr t)) -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> m ($(map tr r)) +val mapR3 : K --> m ::: (Type -> Type) -> monad m + -> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> tf3 :: (K -> Type) + -> tr :: (K -> Type) + -> (nm :: Name -> t :: K -> tf1 t -> tf2 t -> tf3 t -> m (tr t)) + -> r ::: {K} -> folder r -> $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> m ($(map tr r)) + val foldMapR : K --> m ::: (Type -> Type) -> monad m -> tf :: (K -> Type) -> tf' :: (K -> Type) diff --git a/src/c/urweb.c b/src/c/urweb.c index cc0eab06..ef7eb9bb 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -818,9 +818,6 @@ static void uw_try_reconnecting(uw_context ctx) { ctx->db = NULL; } ctx->app->db_init(ctx); - - if (!ctx->db) - uw_error(ctx, FATAL, "Error reopening database connection"); } void uw_try_reconnecting_and_restarting(uw_context ctx) { diff --git a/src/elaborate.sml b/src/elaborate.sml index ca4e124c..1885345d 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -783,7 +783,8 @@ val sum = case c of - (L'.CRecord (_, xcs), _) => {fields = xcs, unifs = [], others = []} + (L'.CRecord (_, xcs), _) => {fields = map (fn (x, c) => (hnormCon env x, hnormCon env c)) xcs, + unifs = [], others = []} | (L'.CConcat (c1, c2), _) => let val s1 = recordSummary env c1 |