summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
authorkrangelov <kr.angelov@gmail.com>2020-10-02 19:55:24 +0200
committerkrangelov <kr.angelov@gmail.com>2020-10-02 19:55:24 +0200
commitf3a8658cc1ed5b2721ee9d3f670f6b9a49f0f049 (patch)
tree8a311ec3c3a454088fa3c74b4464f974fe5aee21 /src/compiler/GF/Compile
parentbfb94d1e48fded159bbf63a992564cb24e987772 (diff)
parentf56fbcf86e472262d07c6bd713f6955cfbcfee8a (diff)
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs4
-rw-r--r--src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs10
-rw-r--r--src/compiler/GF/Compile/Update.hs3
3 files changed, 16 insertions, 1 deletions
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 0558715c6..35c25cc0d 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -41,6 +41,7 @@ import Control.Monad
import Control.Monad.Identity
--import Control.Exception
--import Debug.Trace(trace)
+import qualified Control.Monad.Fail as Fail
----------------------------------------------------------------------
-- main conversion function
@@ -196,6 +197,9 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
-> ([ProtoFCat],[Symbol])
-> Branch b}
+instance Fail.MonadFail CnvMonad where
+ fail = bug
+
instance Applicative CnvMonad where
pure = return
(<*>) = ap
diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
index 8fd6023b3..b35aaf9ed 100644
--- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
module GF.Compile.TypeCheck.ConcreteNew( checkLType, inferLType ) where
-- The code here is based on the paper:
@@ -19,6 +20,7 @@ import GF.Text.Pretty
import Data.List (nub, (\\), tails)
import qualified Data.IntMap as IntMap
import Data.Maybe(fromMaybe,isNothing)
+import qualified Control.Monad.Fail as Fail
checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type)
checkLType ge t ty = runTcM $ do
@@ -646,8 +648,16 @@ instance Monad TcM where
f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of
TcOk x ms msgs -> unTcM (g x) ms msgs
TcFail msgs -> TcFail msgs)
+
+#if !(MIN_VERSION_base(4,13,0))
+ -- Monad(fail) will be removed in GHC 8.8+
+ fail = Fail.fail
+#endif
+
+instance Fail.MonadFail TcM where
fail = tcError . pp
+
instance Applicative TcM where
pure = return
(<*>) = ap
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index 143a4f96f..4399405b8 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -27,9 +27,10 @@ import Data.List
import qualified Data.Map as Map
import Control.Monad
import GF.Text.Pretty
+import qualified Control.Monad.Fail as Fail
-- | combine a list of definitions into a balanced binary search tree
-buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
+buildAnyTree :: Fail.MonadFail m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
buildAnyTree m = go Map.empty
where
go map [] = return map