From 959d40db68f4c2df04cabb7677724900d4f71db4 Mon Sep 17 00:00:00 2001 From: Chris Done Date: Mon, 24 Feb 2020 16:19:20 +0000 Subject: [PATCH] Patch for newer GHCs --- src/Control/Monad/Supply.hs | 11 ++++++++--- src/Duet/Infer.hs | 2 +- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs index 1aa36ae..8d46d92 100644 --- a/src/Control/Monad/Supply.hs +++ b/src/Control/Monad/Supply.hs @@ -47,9 +47,14 @@ newtype Supply s a = Supply (SupplyT s Identity a) deriving (Functor, Applicative, Monad, MonadSupply s, MonadFix) instance Monad m => MonadSupply s (SupplyT s m) where - supply = SupplyT $ do (x:xs) <- get - put xs - return x + supply = + SupplyT $ do + result <- get + case result of + (x:xs) -> do + put xs + return x + _ -> error "Exhausted supply in Control.Monad.Supply.hs" peek = SupplyT $ gets head exhausted = SupplyT $ gets null diff --git a/src/Duet/Infer.hs b/src/Duet/Infer.hs index f625e68..d9010fe 100644 --- a/src/Duet/Infer.hs +++ b/src/Duet/Infer.hs @@ -901,7 +901,7 @@ inferExpressionType ce as (ApplicationExpression l e f) = do let scheme = (Forall [] (Qualified (ps++qs) t)) return (ps ++ qs, t, ApplicationExpression (TypeSignature l scheme) e' f') inferExpressionType ce as (InfixExpression l x (i,op) y) = do - (ps, ts, ApplicationExpression l' (ApplicationExpression _ (op') x') y') <- + (ps, ts, ~(ApplicationExpression l' (ApplicationExpression _ (op') x') y')) <- inferExpressionType ce as