From 251845f83ea52965b5205fd231ffa2c87bb34de6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 16:20:35 +0200 Subject: [PATCH 01/30] First attempt at fixing incompabilities with newer cabal --- Setup.hs | 1 - .../GF/Compile/TypeCheck/ConcreteNew.hs | 15 +++++++++++++++ src/compiler/GF/Data/ErrM.hs | 19 ++++++++++++++++++- src/compiler/GF/Grammar/Lexer.x | 13 +++++++++++++ src/compiler/GF/Infra/UseIO.hs | 11 +++++++++++ src/runtime/haskell/Data/Binary/Get.hs | 9 +++++++++ src/tools/c/GFCC/ErrM.hs | 13 ++++++++++++- 7 files changed, 78 insertions(+), 3 deletions(-) diff --git a/Setup.hs b/Setup.hs index 27524dbe5..1ee9cec92 100644 --- a/Setup.hs +++ b/Setup.hs @@ -19,7 +19,6 @@ main = defaultMainWithHooks simpleUserHooks , preInst = gfPreInst , postInst = gfPostInst , postCopy = gfPostCopy - , sDistHook = gfSDist } where gfPreBuild args = gfPre args . buildDistPref diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index 8fd6023b3..fab3173dc 100644 --- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs @@ -19,6 +19,10 @@ import GF.Text.Pretty import Data.List (nub, (\\), tails) import qualified Data.IntMap as IntMap import Data.Maybe(fromMaybe,isNothing) +#if !MIN_VERSION_base(4,11,0) +-- Control.Monad.Fail import is redundant since GHC 8.8.1 +import qualified Control.Monad.Fail as Fail +#endif checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type) checkLType ge t ty = runTcM $ do @@ -646,7 +650,18 @@ 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)) fail = tcError . pp +#endif + +instance Fail.MonadFail TcM where + fail = tcError . pp + + +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + instance Applicative TcM where pure = return diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs index 033c1efac..0cef54816 100644 --- a/src/compiler/GF/Data/ErrM.hs +++ b/src/compiler/GF/Data/ErrM.hs @@ -16,6 +16,10 @@ module GF.Data.ErrM where import Control.Monad (MonadPlus(..),ap) import Control.Applicative +#if !MIN_VERSION_base(4,11,0) +-- Control.Monad.Fail import is redundant since GHC 8.8.1 +import qualified Control.Monad.Fail as Fail +#endif -- | Like 'Maybe' type with error msgs data Err a = Ok a | Bad String @@ -33,10 +37,23 @@ fromErr a = err (const a) id instance Monad Err where return = Ok - fail = Bad Ok a >>= f = f a Bad s >>= f = Bad s +#if !(MIN_VERSION_base(4,11,0)) + fail = Bad +#endif + +instance Fail.MonadFail Err where + fail = Bad + +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + + + + + -- | added 2\/10\/2003 by PEB instance Functor Err where fmap f (Ok a) = Ok (f a) diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x index d1550dd09..c19a32e3b 100644 --- a/src/compiler/GF/Grammar/Lexer.x +++ b/src/compiler/GF/Grammar/Lexer.x @@ -1,5 +1,6 @@ -- -*- haskell -*- { +{-# LANGUAGE CPP #-} module GF.Grammar.Lexer ( Token(..), Posn(..) , P, runP, runPartial, token, lexer, getPosn, failLoc @@ -18,6 +19,9 @@ import qualified Data.Map as Map import Data.Word(Word8) import Data.Char(readLitChar) --import Debug.Trace(trace) + +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail } @@ -282,7 +286,16 @@ instance Monad P where (P m) >>= k = P $ \ s -> case m s of POk s a -> unP (k a) s PFailed posn err -> PFailed posn err + +#if !(MIN_VERSION_base(4,13,0)) fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg +#endif + +instance Fail.MonadFail P where + fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg + + + runP :: P a -> BS.ByteString -> Either (Posn,String) a runP p bs = snd <$> runP' p (Pn 1 0,bs) diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs index e27b6e075..4c5a26d32 100644 --- a/src/compiler/GF/Infra/UseIO.hs +++ b/src/compiler/GF/Infra/UseIO.hs @@ -159,6 +159,9 @@ instance ErrorMonad IO where then h (ioeGetErrorString e) else ioError e {- +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + instance Functor IOE where fmap = liftM instance Applicative IOE where @@ -170,7 +173,15 @@ instance Monad IOE where IOE c >>= f = IOE $ do x <- c -- Err a appIOE $ err raise f x -- f :: a -> IOE a + + #if !(MIN_VERSION_base(4,13,0)) fail = raise + #endif + +instance Fail.MonadFail IOE where + fail = raise + + -} -- | Print the error message and return a default value if the IO operation 'fail's diff --git a/src/runtime/haskell/Data/Binary/Get.hs b/src/runtime/haskell/Data/Binary/Get.hs index 6e98434f5..01561d7d9 100644 --- a/src/runtime/haskell/Data/Binary/Get.hs +++ b/src/runtime/haskell/Data/Binary/Get.hs @@ -101,6 +101,10 @@ import GHC.Word --import GHC.Int #endif +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + + -- | The parse state data S = S {-# UNPACK #-} !B.ByteString -- current chunk L.ByteString -- the rest of the input @@ -126,6 +130,11 @@ instance Monad Get where (a, s') -> unGet (k a) s') {-# INLINE (>>=) #-} +#if !(MIN_VERSION_base(4,13,0)) + fail = failDesc +#endif + +instance Fail.MonadFail Get where fail = failDesc instance MonadFix Get where diff --git a/src/tools/c/GFCC/ErrM.hs b/src/tools/c/GFCC/ErrM.hs index 820473ccd..78295d30e 100644 --- a/src/tools/c/GFCC/ErrM.hs +++ b/src/tools/c/GFCC/ErrM.hs @@ -4,6 +4,10 @@ -- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. module GFCC.ErrM where +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail + + -- the Error monad: like Maybe type with error msgs data Err a = Ok a | Bad String @@ -11,6 +15,13 @@ data Err a = Ok a | Bad String instance Monad Err where return = Ok - fail = Bad Ok a >>= f = f a Bad s >>= f = Bad s + +#if !(MIN_VERSION_base(4,13,0)) + fail = Bad +#endif + +instance Fail.MonadFail Err where + fail = Bad + From b8812b54b2dd70df1038a5cd953b4bbb8ac1e9b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 16:51:24 +0200 Subject: [PATCH 02/30] fix newer ghc: Don't try to be backwards compatible --- src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs | 14 +------------- src/compiler/GF/Data/BacktrackM.hs | 2 ++ src/compiler/GF/Data/ErrM.hs | 15 +-------------- src/compiler/GF/Grammar/Lexer.x | 12 ++---------- 4 files changed, 6 insertions(+), 37 deletions(-) diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index fab3173dc..3b9e62d04 100644 --- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs @@ -19,10 +19,6 @@ import GF.Text.Pretty import Data.List (nub, (\\), tails) import qualified Data.IntMap as IntMap import Data.Maybe(fromMaybe,isNothing) -#if !MIN_VERSION_base(4,11,0) --- Control.Monad.Fail import is redundant since GHC 8.8.1 -import qualified Control.Monad.Fail as Fail -#endif checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type) checkLType ge t ty = runTcM $ do @@ -651,16 +647,8 @@ instance Monad TcM where TcOk x ms msgs -> unTcM (g x) ms msgs TcFail msgs -> TcFail msgs) -#if !(MIN_VERSION_base(4,13,0)) +instance MonadFail TcM where fail = tcError . pp -#endif - -instance Fail.MonadFail TcM where - fail = tcError . pp - - --- Control.Monad.Fail import will become redundant in GHC 8.8+ -import qualified Control.Monad.Fail as Fail instance Applicative TcM where diff --git a/src/compiler/GF/Data/BacktrackM.hs b/src/compiler/GF/Data/BacktrackM.hs index f5ae63997..87ea4dc5a 100644 --- a/src/compiler/GF/Data/BacktrackM.hs +++ b/src/compiler/GF/Data/BacktrackM.hs @@ -69,6 +69,8 @@ instance Monad (BacktrackM s) where return a = BM (\c s b -> c a s b) BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b) where unBM (BM m) = m + +instance MonadFail (BacktrackM s) where fail _ = mzero instance Functor (BacktrackM s) where diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs index 0cef54816..5ea7f0734 100644 --- a/src/compiler/GF/Data/ErrM.hs +++ b/src/compiler/GF/Data/ErrM.hs @@ -16,10 +16,6 @@ module GF.Data.ErrM where import Control.Monad (MonadPlus(..),ap) import Control.Applicative -#if !MIN_VERSION_base(4,11,0) --- Control.Monad.Fail import is redundant since GHC 8.8.1 -import qualified Control.Monad.Fail as Fail -#endif -- | Like 'Maybe' type with error msgs data Err a = Ok a | Bad String @@ -40,17 +36,8 @@ instance Monad Err where Ok a >>= f = f a Bad s >>= f = Bad s -#if !(MIN_VERSION_base(4,11,0)) +instance MonadFail Err where fail = Bad -#endif - -instance Fail.MonadFail Err where - fail = Bad - --- Control.Monad.Fail import will become redundant in GHC 8.8+ -import qualified Control.Monad.Fail as Fail - - diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x index c19a32e3b..57577ba16 100644 --- a/src/compiler/GF/Grammar/Lexer.x +++ b/src/compiler/GF/Grammar/Lexer.x @@ -19,9 +19,6 @@ import qualified Data.Map as Map import Data.Word(Word8) import Data.Char(readLitChar) --import Debug.Trace(trace) - --- Control.Monad.Fail import will become redundant in GHC 8.8+ -import qualified Control.Monad.Fail as Fail } @@ -287,14 +284,9 @@ instance Monad P where POk s a -> unP (k a) s PFailed posn err -> PFailed posn err -#if !(MIN_VERSION_base(4,13,0)) + +instance MonadFail P where fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg -#endif - -instance Fail.MonadFail P where - fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg - - runP :: P a -> BS.ByteString -> Either (Posn,String) a From 0581d6827ea2e4aac371eb05f3bf5508f3f40edc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 17:29:10 +0200 Subject: [PATCH 03/30] Fix most build errors --- src/compiler/GF/Command/Commands.hs | 2 +- src/compiler/GF/Compile/GeneratePMCFG.hs | 3 +++ src/compiler/GF/Compile/Update.hs | 2 +- src/compiler/GF/CompileInParallel.hs | 3 +++ src/compiler/GF/CompileOne.hs | 2 +- src/compiler/GF/Data/Operations.hs | 4 ++-- src/compiler/GF/Grammar/Macros.hs | 2 +- src/compiler/GF/Infra/CheckM.hs | 3 +++ src/compiler/GF/Infra/Option.hs | 4 ++-- src/compiler/GF/Infra/SIO.hs | 3 +++ 10 files changed, 20 insertions(+), 8 deletions(-) diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 72e57fcf5..718874d0c 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -44,7 +44,7 @@ pgfEnv pgf = Env pgf mos class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv -instance (Monad m,HasPGFEnv m) => TypeCheckArg m where +instance (Monad m,HasPGFEnv m,MonadFail m) => TypeCheckArg m where typeCheckArg e = (either (fail . render . ppTcError) (return . fst) . flip inferExpr e . pgf) =<< getPGFEnv diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index 0558715c6..ac90852f3 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -196,6 +196,9 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar -> ([ProtoFCat],[Symbol]) -> Branch b} +instance MonadFail CnvMonad where + fail = bug + instance Applicative CnvMonad where pure = return (<*>) = ap diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs index 143a4f96f..93e281b6a 100644 --- a/src/compiler/GF/Compile/Update.hs +++ b/src/compiler/GF/Compile/Update.hs @@ -29,7 +29,7 @@ import Control.Monad import GF.Text.Pretty -- | combine a list of definitions into a balanced binary search tree -buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info) +buildAnyTree :: MonadFail m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info) buildAnyTree m = go Map.empty where go map [] = return map diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 68ac7aa4a..460869539 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -256,6 +256,9 @@ instance Output m => Output (CollectOutput m) where putStrLnE s = CO (return (putStrLnE s,())) putStrE s = CO (return (putStrE s,())) +instance MonadFail m => MonadFail (CollectOutput m) where + fail = CO . fail + instance ErrorMonad m => ErrorMonad (CollectOutput m) where raise e = CO (raise e) handle (CO m) h = CO $ handle m (unCO . h) diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs index e873d6119..117a6b9a5 100644 --- a/src/compiler/GF/CompileOne.hs +++ b/src/compiler/GF/CompileOne.hs @@ -35,7 +35,7 @@ type OneOutput = (Maybe FullPath,CompiledModule) type CompiledModule = Module compileOne, reuseGFO, useTheSource :: - (Output m,ErrorMonad m,MonadIO m) => + (Output m,ErrorMonad m,MonadIO m, MonadFail m) => Options -> Grammar -> FullPath -> m OneOutput -- | Compile a given source file (or just load a .gfo file), diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs index 4daa9c5d8..a9fedcaff 100644 --- a/src/compiler/GF/Data/Operations.hs +++ b/src/compiler/GF/Data/Operations.hs @@ -88,10 +88,10 @@ checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where overloaded s = length (filter (==s) ss) > 1 -- | this is what happens when matching two values in the same module -unifyMaybe :: (Eq a, Monad m) => Maybe a -> Maybe a -> m (Maybe a) +unifyMaybe :: (Eq a, MonadFail m) => Maybe a -> Maybe a -> m (Maybe a) unifyMaybe = unifyMaybeBy id -unifyMaybeBy :: (Eq b, Monad m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a) +unifyMaybeBy :: (Eq b, MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a) unifyMaybeBy f (Just p1) (Just p2) | f p1==f p2 = return (Just p1) | otherwise = fail "" diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs index 4c92fae8c..56dc5cfb7 100644 --- a/src/compiler/GF/Grammar/Macros.hs +++ b/src/compiler/GF/Grammar/Macros.hs @@ -237,7 +237,7 @@ isPredefConstant t = case t of Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True _ -> False -checkPredefError :: Monad m => Term -> m Term +checkPredefError :: MonadFail m => Term -> m Term checkPredefError t = case t of Error s -> fail ("Error: "++s) diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs index c5f9ba255..b0d9f1221 100644 --- a/src/compiler/GF/Infra/CheckM.hs +++ b/src/compiler/GF/Infra/CheckM.hs @@ -53,6 +53,9 @@ instance Monad Check where (ws,Success x) -> unCheck (g x) {-ctxt-} ws (ws,Fail msg) -> (ws,Fail msg) +instance MonadFail Check where + fail = raise + instance Applicative Check where pure = return (<*>) = ap diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs index c4108cbe3..20e625114 100644 --- a/src/compiler/GF/Infra/Option.hs +++ b/src/compiler/GF/Infra/Option.hs @@ -547,7 +547,7 @@ lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs] lookupReadsPrec :: [(String,a)] -> Int -> ReadS a lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x] -onOff :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a) +onOff :: MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a) onOff f def = OptArg g "[on,off]" where g ma = maybe (return def) readOnOff ma >>= f readOnOff x = case map toLower x of @@ -555,7 +555,7 @@ onOff f def = OptArg g "[on,off]" "off" -> return False _ -> fail $ "Expected [on,off], got: " ++ show x -readOutputFormat :: Monad m => String -> m OutputFormat +readOutputFormat :: MonadFail m => String -> m OutputFormat readOutputFormat s = maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs index 75c57601b..2cb6d1ccd 100644 --- a/src/compiler/GF/Infra/SIO.hs +++ b/src/compiler/GF/Infra/SIO.hs @@ -58,6 +58,9 @@ instance Monad SIO where return x = SIO (const (return x)) SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h +instance MonadFail SIO where + fail = liftSIO . fail + instance Output SIO where ePutStr = lift0 . ePutStr ePutStrLn = lift0 . ePutStrLn From 3bd1f01959facd80be7ab9087b17247803f0d179 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 17:38:21 +0200 Subject: [PATCH 04/30] Fix a few warnings --- src/server/CGI.hs | 2 +- src/server/CGIUtils.hs | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/server/CGI.hs b/src/server/CGI.hs index 1a77351e2..821f93b9c 100644 --- a/src/server/CGI.hs +++ b/src/server/CGI.hs @@ -4,7 +4,7 @@ import Network.CGI as C( CGI,ContentType(..),Accept(..),Language(..), getVarWithDefault,readInput,negotiate,requestAcceptLanguage,getInput, setHeader,output,outputFPS,outputError, - handleErrors,catchCGI,throwCGI, + handleErrors, liftIO) import Network.CGI.Protocol as C(CGIResult(..),CGIRequest(..),Input(..), Headers,HeaderName(..)) diff --git a/src/server/CGIUtils.hs b/src/server/CGIUtils.hs index 04bb8f22c..3c5ce2274 100644 --- a/src/server/CGIUtils.hs +++ b/src/server/CGIUtils.hs @@ -15,11 +15,14 @@ import System.Posix #endif import CGI(CGI,CGIResult,setHeader,output,outputFPS,outputError, - getInput,catchCGI,throwCGI) + getInput) import Text.JSON import qualified Codec.Binary.UTF8.String as UTF8 (encodeString) import qualified Data.ByteString.Lazy as BS +import Control.Monad.Catch (MonadThrow(throwM)) +import Network.CGI.Monad (catchCGI) +import Control.Monad.Catch (MonadCatch(catch)) -- * Logging @@ -53,11 +56,11 @@ instance Exception CGIError where fromException (SomeException e) = cast e throwCGIError :: Int -> String -> [String] -> CGI a -throwCGIError c m t = throwCGI $ toException $ CGIError c m t +throwCGIError c m t = throwM $ toException $ CGIError c m t handleCGIErrors :: CGI CGIResult -> CGI CGIResult handleCGIErrors x = - x `catchCGI` \e -> case fromException e of + x `catch` \e -> case fromException e of Nothing -> throw e Just (CGIError c m t) -> do setXO; outputError c m t From 05903b271c6938a5e2b25479dc77b986d65c664a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 17:38:46 +0200 Subject: [PATCH 05/30] Fix testsuite compatability with newer Cabal --- testsuite/run.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/run.hs b/testsuite/run.hs index 71af1e403..6bf3c8158 100644 --- a/testsuite/run.hs +++ b/testsuite/run.hs @@ -1,6 +1,7 @@ import Data.List(partition) import System.IO import Distribution.Simple.BuildPaths(exeExtension) +import Distribution.System ( buildPlatform ) import System.Process(readProcess) import System.Directory(doesFileExist,getDirectoryContents) import System.FilePath((),(<.>),takeExtension) @@ -71,7 +72,7 @@ main = -- Should consult the Cabal configuration! run_gf = readProcess default_gf ["-run","-gf-lib-path="++gf_lib_path] -default_gf = "dist/build/gf/gf"<.>exeExtension +default_gf = "dist/build/gf/gf"<.>exeExtension buildPlatform gf_lib_path = "dist/build/rgl" -- | List files, excluding "." and ".." From e351e7b79a0817410a4a1dcf605923f1e824da6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 17:58:11 +0200 Subject: [PATCH 06/30] Remove NoMonadFailDesugaring flag I've fixed so everything has the fail it needs now --- gf.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/gf.cabal b/gf.cabal index b6d6c7111..a0fb968eb 100644 --- a/gf.cabal +++ b/gf.cabal @@ -98,8 +98,6 @@ Library --if impl(ghc>=7.8) -- ghc-options: +RTS -A20M -RTS ghc-prof-options: -fprof-auto - if impl(ghc>=8.6) - Default-extensions: NoMonadFailDesugaring exposed-modules: PGF From 85ab6daaaa6b6db0f4b29b7938e7772cddd518a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 5 Aug 2020 19:09:25 +0200 Subject: [PATCH 07/30] Add cabal dist-newtyle to gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 0ee62cfb2..10968810e 100644 --- a/.gitignore +++ b/.gitignore @@ -6,6 +6,7 @@ *.gfo *.pgf dist/ +dist-newstyle/ src/runtime/c/.libs/ src/runtime/c/Makefile src/runtime/c/Makefile.in From 47dbf9ac278857b367f2db254cce536da812010c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 19 Aug 2020 14:13:17 +0200 Subject: [PATCH 08/30] Add stack file for a more recent ghc --- stack-ghc8.8.3.yaml | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 stack-ghc8.8.3.yaml diff --git a/stack-ghc8.8.3.yaml b/stack-ghc8.8.3.yaml new file mode 100644 index 000000000..475b164d7 --- /dev/null +++ b/stack-ghc8.8.3.yaml @@ -0,0 +1,9 @@ +resolver: lts-16.8 # ghc 8.8.3 + +extra-deps: +- network-2.6.3.6 +- httpd-shed-0.4.0.3 +- cgi-3001.5.0.0@sha256:3d1193a328d5f627a021a0ef3927c1ae41dd341e32dba612fed52d0e3a6df056,2990 +- json-0.10@sha256:d9fc6b07ce92b8894825a17d2cf14799856767eb30c8bf55962baa579207d799,3210 +- multipart-0.2.0@sha256:b8770e3ff6089be4dd089a8250894b31287cca671f3d258190a505f9351fa8a9,1084 + From bf21b4768c70e710ff0d4509ae9165c3480dc048 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Fri, 21 Aug 2020 13:25:16 +0200 Subject: [PATCH 09/30] (Tutorial) Fix to make calculator example compile In abstract: startcat needs to be defined to run the commands that are shown later in the doc. In concrete: ss and SS are defined in Prelude. --- doc/tutorial/gf-tutorial.t2t | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/tutorial/gf-tutorial.t2t b/doc/tutorial/gf-tutorial.t2t index 525749822..a27af74a0 100644 --- a/doc/tutorial/gf-tutorial.t2t +++ b/doc/tutorial/gf-tutorial.t2t @@ -4200,7 +4200,8 @@ We construct a calculator with addition, subtraction, multiplication, and division of integers. ``` abstract Calculator = { - + flags startcat = Exp ; + cat Exp ; fun @@ -4226,7 +4227,7 @@ We begin with a concrete syntax that always uses parentheses around binary operator applications: ``` - concrete CalculatorP of Calculator = { + concrete CalculatorP of Calculator = open Prelude in { lincat Exp = SS ; From 0bb02eeb515d6d612474943da5d32aae49fa9384 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Sun, 30 Aug 2020 20:08:17 +0200 Subject: [PATCH 10/30] Add a page for all GF video tutorials --- doc/gf-video-tutorials.md | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 doc/gf-video-tutorials.md diff --git a/doc/gf-video-tutorials.md b/doc/gf-video-tutorials.md new file mode 100644 index 000000000..279aa81be --- /dev/null +++ b/doc/gf-video-tutorials.md @@ -0,0 +1,34 @@ +--- +title: "Video tutorials" +author: Inari Listenmaa +date: 2020-08-30 +--- + +GF has a YouTube channel [Grammatical Framework](https://www.youtube.com/channel/UCZ96DechSUVcXAhtOId9VVA). +In addition to its own uploads, the GF channel keeps a playlist [All GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics. +If you make a video about GF, let us know and we'll add it to the suitable playlist(s)! + +## General introduction to GF + +These videos introduce GF at a high level. + +#### Grammatical Framework: Formalizing the Grammars of the World + + + +#### Aarne Ranta: Automatic Translation for Consumers and Producers + + + +## Beginner resources + +These videos show how to install GF on your computer (Mac or Windows), and how to play with simple grammars in a [Jupyter notebook](https://github.com/GrammaticalFramework/gf-binder) (any platform, hosted at [mybinder.org](https://mybinder.org)). + + + +## Resource grammar tutorials + +These videos show incremental improvements to a [miniature version of the resource grammar](https://github.com/inariksit/comp-syntax-2020/tree/master/lab2/grammar/dummy#readme). +They assume some prior knowledge of GF, roughly lessons 1--3 from the [GF tutorial](http://www.grammaticalframework.org/doc/tutorial/gf-tutorial.html). + + From 254f03ecfead661a44f7385af122ddc908c806e0 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Sun, 30 Aug 2020 20:38:49 +0200 Subject: [PATCH 11/30] Fix wording + formatting slightly --- doc/gf-video-tutorials.md | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/doc/gf-video-tutorials.md b/doc/gf-video-tutorials.md index 279aa81be..9b301f758 100644 --- a/doc/gf-video-tutorials.md +++ b/doc/gf-video-tutorials.md @@ -1,22 +1,24 @@ --- title: "Video tutorials" -author: Inari Listenmaa -date: 2020-08-30 --- GF has a YouTube channel [Grammatical Framework](https://www.youtube.com/channel/UCZ96DechSUVcXAhtOId9VVA). -In addition to its own uploads, the GF channel keeps a playlist [All GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics. +In addition to its own uploads, the GF channel keeps a playlist of [all GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics. If you make a video about GF, let us know and we'll add it to the suitable playlist(s)! +- [General introduction to GF](#general-introduction-to-gf) +- [Beginner resources](#beginner-resources) +- [Resource grammar tutorials](#resource-grammar-tutorials) + ## General introduction to GF -These videos introduce GF at a high level. +These videos introduce GF at a high level, and present some use cases. -#### Grammatical Framework: Formalizing the Grammars of the World +__Grammatical Framework: Formalizing the Grammars of the World__ -#### Aarne Ranta: Automatic Translation for Consumers and Producers +__Aarne Ranta: Automatic Translation for Consumers and Producers__ From f6560d309e6a766befd91e4adbc5c68e3a23918e Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Sun, 30 Aug 2020 20:53:59 +0200 Subject: [PATCH 12/30] (Homepage) Change link of video tutorials to a page + small fixes Also added video tutorial link to the footer. --- bin/template.html | 3 ++- doc/gf-video-tutorials.md | 7 +++---- index.html | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/bin/template.html b/bin/template.html index 15306e1d9..b6b520954 100644 --- a/bin/template.html +++ b/bin/template.html @@ -82,9 +82,10 @@ $body$
  • GF Cloud
  • Tutorial - / + · RGL Tutorial
    • +
  • Video Tutorials
  • Download GF
    • diff --git a/doc/gf-video-tutorials.md b/doc/gf-video-tutorials.md index 9b301f758..72acce26e 100644 --- a/doc/gf-video-tutorials.md +++ b/doc/gf-video-tutorials.md @@ -2,8 +2,7 @@ title: "Video tutorials" --- -GF has a YouTube channel [Grammatical Framework](https://www.youtube.com/channel/UCZ96DechSUVcXAhtOId9VVA). -In addition to its own uploads, the GF channel keeps a playlist of [all GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics. +The GF [YouTube channel](https://www.youtube.com/channel/UCZ96DechSUVcXAhtOId9VVA) keeps a playlist of [all GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics. If you make a video about GF, let us know and we'll add it to the suitable playlist(s)! - [General introduction to GF](#general-introduction-to-gf) @@ -30,7 +29,7 @@ These videos show how to install GF on your computer (Mac or Windows), and how t ## Resource grammar tutorials -These videos show incremental improvements to a [miniature version of the resource grammar](https://github.com/inariksit/comp-syntax-2020/tree/master/lab2/grammar/dummy#readme). -They assume some prior knowledge of GF, roughly lessons 1--3 from the [GF tutorial](http://www.grammaticalframework.org/doc/tutorial/gf-tutorial.html). +These videos show incremental improvements to a [miniature version of the resource grammar](https://github.com/inariksit/comp-syntax-2020/tree/master/lab2/grammar/dummy#readme). +They assume some prior knowledge of GF, roughly lessons 1-3 from the [GF tutorial](http://www.grammaticalframework.org/doc/tutorial/gf-tutorial.html). diff --git a/index.html b/index.html index a14508a0a..44d8d50fe 100644 --- a/index.html +++ b/index.html @@ -39,7 +39,7 @@ / RGL Tutorial -
  • Video Tutorial
    • +
  • Video Tutorials
    • From bca0691cb028fe33ae1b77e71752d4e937490ff1 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Mon, 31 Aug 2020 15:54:33 +0200 Subject: [PATCH 13/30] (Tutorial) Minor typofixes + current error message --- doc/tutorial/gf-tutorial.t2t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/tutorial/gf-tutorial.t2t b/doc/tutorial/gf-tutorial.t2t index a27af74a0..469166090 100644 --- a/doc/tutorial/gf-tutorial.t2t +++ b/doc/tutorial/gf-tutorial.t2t @@ -898,7 +898,7 @@ Parentheses are only needed for grouping. Parsing something that is not in grammar will fail: ``` > parse "hello dad" - Unknown words: dad + The parser failed at token 2: "dad" > parse "world hello" no tree found @@ -2948,7 +2948,7 @@ We need the following combinations: ``` We also need **lexical insertion**, to form phrases from single words: ``` - mkCN : N -> NP ; + mkCN : N -> CN ; mkAP : A -> AP ; ``` Naming convention: to construct a //C//, use a function ``mk``//C//. @@ -2969,7 +2969,7 @@ can be built as follows: ``` mkCl (mkNP these_Det - (mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_CN))) + (mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_N))) (mkAP italian_AP) ``` The task now: to define the concrete syntax of ``Foods`` so that From 1234c715fc6fe19d0c9fce794e4dfedf190b8d18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Sat, 5 Sep 2020 14:39:26 +0200 Subject: [PATCH 14/30] Fix MonadFail for c-runtime as well --- src/compiler/GF/Command/Commands2.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs index 344b6b51d..41232fca8 100644 --- a/src/compiler/GF/Command/Commands2.hs +++ b/src/compiler/GF/Command/Commands2.hs @@ -25,7 +25,7 @@ data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr} pgfEnv pgf = Env (Just pgf) (languages pgf) emptyPGFEnv = Env Nothing Map.empty -class (Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv +class (MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv instance (Monad m,HasPGFEnv m) => TypeCheckArg m where typeCheckArg e = do env <- getPGFEnv From 7268253f5ae4b4883d28faa87b3e63295f04abfd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Sat, 5 Sep 2020 20:23:07 +0200 Subject: [PATCH 15/30] MonadFail: Make backwards-compatible --- gf.cabal | 1 + src/compiler/GF/Command/Commands2.hs | 2 +- src/compiler/GF/Compile/GeneratePMCFG.hs | 3 ++- src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs | 9 ++++++++- src/compiler/GF/Compile/Update.hs | 3 ++- src/compiler/GF/CompileInParallel.hs | 4 +++- src/compiler/GF/CompileOne.hs | 3 ++- src/compiler/GF/Data/BacktrackM.hs | 9 ++++++++- src/compiler/GF/Data/ErrM.hs | 9 ++++++++- src/compiler/GF/Data/Operations.hs | 5 +++-- src/compiler/GF/Grammar/Lexer.x | 3 ++- src/compiler/GF/Grammar/Macros.hs | 3 ++- src/compiler/GF/Infra/CheckM.hs | 3 ++- src/compiler/GF/Infra/Option.hs | 5 +++-- src/compiler/GF/Infra/SIO.hs | 3 ++- 15 files changed, 49 insertions(+), 16 deletions(-) diff --git a/gf.cabal b/gf.cabal index a0fb968eb..014a2feea 100644 --- a/gf.cabal +++ b/gf.cabal @@ -82,6 +82,7 @@ Library pretty, mtl, exceptions, + fail, ghc-prim hs-source-dirs: src/runtime/haskell diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs index 41232fca8..6d326cdce 100644 --- a/src/compiler/GF/Command/Commands2.hs +++ b/src/compiler/GF/Command/Commands2.hs @@ -25,7 +25,7 @@ data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr} pgfEnv pgf = Env (Just pgf) (languages pgf) emptyPGFEnv = Env Nothing Map.empty -class (MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv +class (Fail.MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv instance (Monad m,HasPGFEnv m) => TypeCheckArg m where typeCheckArg e = do env <- getPGFEnv diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index ac90852f3..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,7 +197,7 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar -> ([ProtoFCat],[Symbol]) -> Branch b} -instance MonadFail CnvMonad where +instance Fail.MonadFail CnvMonad where fail = bug instance Applicative CnvMonad where diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index 3b9e62d04..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 @@ -647,7 +649,12 @@ instance Monad TcM where TcOk x ms msgs -> unTcM (g x) ms msgs TcFail msgs -> TcFail msgs) -instance MonadFail TcM where +#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 diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs index 93e281b6a..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 :: MonadFail 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 diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 460869539..ed498a690 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -20,6 +20,8 @@ import GF.Infra.Ident(moduleNameS) import GF.Text.Pretty import GF.System.Console(TermColors(..),getTermColors) import qualified Data.ByteString.Lazy as BS +-- Control.Monad.Fail import will become redundant in GHC 8.8+ +import qualified Control.Monad.Fail as Fail -- | Compile the given grammar files and everything they depend on, -- like 'batchCompile'. This function compiles modules in parallel. @@ -256,7 +258,7 @@ instance Output m => Output (CollectOutput m) where putStrLnE s = CO (return (putStrLnE s,())) putStrE s = CO (return (putStrE s,())) -instance MonadFail m => MonadFail (CollectOutput m) where +instance Fail.MonadFail m => Fail.MonadFail (CollectOutput m) where fail = CO . fail instance ErrorMonad m => ErrorMonad (CollectOutput m) where diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs index 117a6b9a5..48761671a 100644 --- a/src/compiler/GF/CompileOne.hs +++ b/src/compiler/GF/CompileOne.hs @@ -30,12 +30,13 @@ import qualified Data.Map as Map import GF.Text.Pretty(render,(<+>),($$)) --Doc, import GF.System.Console(TermColors(..),getTermColors) import Control.Monad((<=<)) +import qualified Control.Monad.Fail as Fail type OneOutput = (Maybe FullPath,CompiledModule) type CompiledModule = Module compileOne, reuseGFO, useTheSource :: - (Output m,ErrorMonad m,MonadIO m, MonadFail m) => + (Output m,ErrorMonad m,MonadIO m, Fail.MonadFail m) => Options -> Grammar -> FullPath -> m OneOutput -- | Compile a given source file (or just load a .gfo file), diff --git a/src/compiler/GF/Data/BacktrackM.hs b/src/compiler/GF/Data/BacktrackM.hs index 87ea4dc5a..f947b838e 100644 --- a/src/compiler/GF/Data/BacktrackM.hs +++ b/src/compiler/GF/Data/BacktrackM.hs @@ -13,6 +13,7 @@ ----------------------------------------------------------------------------- {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-} +{-# LANGUAGE CPP #-} module GF.Data.BacktrackM ( -- * the backtracking state monad BacktrackM, @@ -32,6 +33,7 @@ import Data.List import Control.Applicative import Control.Monad import Control.Monad.State.Class +import qualified Control.Monad.Fail as Fail ---------------------------------------------------------------------- -- Combining endomorphisms and continuations @@ -70,7 +72,12 @@ instance Monad (BacktrackM s) where BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b) where unBM (BM m) = m -instance MonadFail (BacktrackM s) where +#if !(MIN_VERSION_base(4,13,0)) + -- Monad(fail) will be removed in GHC 8.8+ + fail = Fail.fail +#endif + +instance Fail.MonadFail (BacktrackM s) where fail _ = mzero instance Functor (BacktrackM s) where diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs index 5ea7f0734..288c61919 100644 --- a/src/compiler/GF/Data/ErrM.hs +++ b/src/compiler/GF/Data/ErrM.hs @@ -12,10 +12,12 @@ -- hack for BNFC generated files. AR 21/9/2003 ----------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} module GF.Data.ErrM where import Control.Monad (MonadPlus(..),ap) import Control.Applicative +import qualified Control.Monad.Fail as Fail -- | Like 'Maybe' type with error msgs data Err a = Ok a | Bad String @@ -36,7 +38,12 @@ instance Monad Err where Ok a >>= f = f a Bad s >>= f = Bad s -instance MonadFail Err where +#if !(MIN_VERSION_base(4,13,0)) + -- Monad(fail) will be removed in GHC 8.8+ + fail = Fail.fail +#endif + +instance Fail.MonadFail Err where fail = Bad diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs index a9fedcaff..08fa15c3e 100644 --- a/src/compiler/GF/Data/Operations.hs +++ b/src/compiler/GF/Data/Operations.hs @@ -53,6 +53,7 @@ import Control.Monad (liftM,liftM2) --,ap import GF.Data.ErrM import GF.Data.Relation +import qualified Control.Monad.Fail as Fail infixr 5 +++ infixr 5 ++- @@ -88,10 +89,10 @@ checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where overloaded s = length (filter (==s) ss) > 1 -- | this is what happens when matching two values in the same module -unifyMaybe :: (Eq a, MonadFail m) => Maybe a -> Maybe a -> m (Maybe a) +unifyMaybe :: (Eq a, Fail.MonadFail m) => Maybe a -> Maybe a -> m (Maybe a) unifyMaybe = unifyMaybeBy id -unifyMaybeBy :: (Eq b, MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a) +unifyMaybeBy :: (Eq b, Fail.MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a) unifyMaybeBy f (Just p1) (Just p2) | f p1==f p2 = return (Just p1) | otherwise = fail "" diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x index 57577ba16..fe455c58a 100644 --- a/src/compiler/GF/Grammar/Lexer.x +++ b/src/compiler/GF/Grammar/Lexer.x @@ -19,6 +19,7 @@ import qualified Data.Map as Map import Data.Word(Word8) import Data.Char(readLitChar) --import Debug.Trace(trace) +import qualified Control.Monad.Fail as Fail } @@ -285,7 +286,7 @@ instance Monad P where PFailed posn err -> PFailed posn err -instance MonadFail P where +instance Fail.MonadFail P where fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs index 56dc5cfb7..b088fe49c 100644 --- a/src/compiler/GF/Grammar/Macros.hs +++ b/src/compiler/GF/Grammar/Macros.hs @@ -32,6 +32,7 @@ import Control.Monad (liftM, liftM2, liftM3) import Data.List (sortBy,nub) import Data.Monoid import GF.Text.Pretty(render,(<+>),hsep,fsep) +import qualified Control.Monad.Fail as Fail -- ** Functions for constructing and analysing source code terms. @@ -237,7 +238,7 @@ isPredefConstant t = case t of Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True _ -> False -checkPredefError :: MonadFail m => Term -> m Term +checkPredefError :: Fail.MonadFail m => Term -> m Term checkPredefError t = case t of Error s -> fail ("Error: "++s) diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs index b0d9f1221..c0234999a 100644 --- a/src/compiler/GF/Infra/CheckM.hs +++ b/src/compiler/GF/Infra/CheckM.hs @@ -32,6 +32,7 @@ import System.FilePath(makeRelative) import Control.Parallel.Strategies(parList,rseq,using) import Control.Monad(liftM,ap) import Control.Applicative(Applicative(..)) +import qualified Control.Monad.Fail as Fail type Message = Doc type Error = Message @@ -53,7 +54,7 @@ instance Monad Check where (ws,Success x) -> unCheck (g x) {-ctxt-} ws (ws,Fail msg) -> (ws,Fail msg) -instance MonadFail Check where +instance Fail.MonadFail Check where fail = raise instance Applicative Check where diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs index 20e625114..11a4dd8ec 100644 --- a/src/compiler/GF/Infra/Option.hs +++ b/src/compiler/GF/Infra/Option.hs @@ -44,6 +44,7 @@ import Data.Set (Set) import qualified Data.Set as Set import PGF.Internal(Literal(..)) +import qualified Control.Monad.Fail as Fail usageHeader :: String usageHeader = unlines @@ -547,7 +548,7 @@ lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs] lookupReadsPrec :: [(String,a)] -> Int -> ReadS a lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x] -onOff :: MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a) +onOff :: Fail.MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a) onOff f def = OptArg g "[on,off]" where g ma = maybe (return def) readOnOff ma >>= f readOnOff x = case map toLower x of @@ -555,7 +556,7 @@ onOff f def = OptArg g "[on,off]" "off" -> return False _ -> fail $ "Expected [on,off], got: " ++ show x -readOutputFormat :: MonadFail m => String -> m OutputFormat +readOutputFormat :: Fail.MonadFail m => String -> m OutputFormat readOutputFormat s = maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs index 2cb6d1ccd..0ce431380 100644 --- a/src/compiler/GF/Infra/SIO.hs +++ b/src/compiler/GF/Infra/SIO.hs @@ -42,6 +42,7 @@ import qualified GF.Command.Importing as GF(importGrammar, importSource) #ifdef C_RUNTIME import qualified PGF2 #endif +import qualified Control.Monad.Fail as Fail -- * The SIO monad @@ -58,7 +59,7 @@ instance Monad SIO where return x = SIO (const (return x)) SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h -instance MonadFail SIO where +instance Fail.MonadFail SIO where fail = liftSIO . fail instance Output SIO where From 57c1014e9f2945aa01cd2e46623936fff1c0e1c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Sat, 5 Sep 2020 20:36:04 +0200 Subject: [PATCH 16/30] Update package database on ubuntu build Fixes 404 error: https://github.com/GrammaticalFramework/gf-core/runs/1076062405 --- .github/workflows/build-debian-package.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/build-debian-package.yml b/.github/workflows/build-debian-package.yml index 17bbef66b..09719aaa8 100644 --- a/.github/workflows/build-debian-package.yml +++ b/.github/workflows/build-debian-package.yml @@ -18,6 +18,7 @@ jobs: - name: Install build tools run: | + sudo apt update sudo apt install -y \ make \ dpkg-dev \ From 2b23e0f27e8b06e1c4fc5ba3fbbb430781093bff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Sat, 5 Sep 2020 20:45:08 +0200 Subject: [PATCH 17/30] Fix wrong indent --- src/compiler/GF/Data/BacktrackM.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/compiler/GF/Data/BacktrackM.hs b/src/compiler/GF/Data/BacktrackM.hs index f947b838e..14cbf90d2 100644 --- a/src/compiler/GF/Data/BacktrackM.hs +++ b/src/compiler/GF/Data/BacktrackM.hs @@ -73,8 +73,7 @@ instance Monad (BacktrackM s) where where unBM (BM m) = m #if !(MIN_VERSION_base(4,13,0)) - -- Monad(fail) will be removed in GHC 8.8+ - fail = Fail.fail + fail = Fail.fail #endif instance Fail.MonadFail (BacktrackM s) where From 57ce76dbc121ee554675b9ee6136441ec0bb5710 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Sat, 5 Sep 2020 20:57:30 +0200 Subject: [PATCH 18/30] Add two more missing MonadFail imports --- src/compiler/GF/Command/Commands.hs | 3 ++- src/compiler/GF/Command/Commands2.hs | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 718874d0c..0e5c61404 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -34,6 +34,7 @@ import Data.Maybe import qualified Data.Map as Map import GF.Text.Pretty import Data.List (sort) +import qualified Control.Monad.Fail as Fail --import Debug.Trace @@ -44,7 +45,7 @@ pgfEnv pgf = Env pgf mos class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv -instance (Monad m,HasPGFEnv m,MonadFail m) => TypeCheckArg m where +instance (Monad m,HasPGFEnv m,Fail.MonadFail m) => TypeCheckArg m where typeCheckArg e = (either (fail . render . ppTcError) (return . fst) . flip inferExpr e . pgf) =<< getPGFEnv diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs index 6d326cdce..100f877a9 100644 --- a/src/compiler/GF/Command/Commands2.hs +++ b/src/compiler/GF/Command/Commands2.hs @@ -18,6 +18,7 @@ import Data.Maybe import qualified Data.Map as Map import GF.Text.Pretty import Control.Monad(mplus) +import qualified Control.Monad.Fail as Fail data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr} From 150b592aa9da46b9fa9d19f4b0e692c52f35ebee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Tue, 8 Sep 2020 15:10:29 +0200 Subject: [PATCH 19/30] Add stack file for ghc8.8.4 --- stack-ghc8.8.4.yaml | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 stack-ghc8.8.4.yaml diff --git a/stack-ghc8.8.4.yaml b/stack-ghc8.8.4.yaml new file mode 100644 index 000000000..a62db170b --- /dev/null +++ b/stack-ghc8.8.4.yaml @@ -0,0 +1,9 @@ +resolver: lts-16.13 # ghc 8.8.4 + +extra-deps: +- network-2.6.3.6 +- httpd-shed-0.4.0.3 +- cgi-3001.5.0.0@sha256:3d1193a328d5f627a021a0ef3927c1ae41dd341e32dba612fed52d0e3a6df056,2990 +- json-0.10@sha256:d9fc6b07ce92b8894825a17d2cf14799856767eb30c8bf55962baa579207d799,3210 +- multipart-0.2.0@sha256:b8770e3ff6089be4dd089a8250894b31287cca671f3d258190a505f9351fa8a9,1084 + From 9d8cd55cd5e492ed8996fe86cc1145989f1bf51b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Wed, 9 Sep 2020 11:05:41 +0200 Subject: [PATCH 20/30] Import orphan instances of MonadFail for ghc<8 Also upgrade alex/happy so automatic install works --- gf.cabal | 3 +++ src/compiler/GF/Command/Interpreter.hs | 4 ++++ src/compiler/GF/Interactive.hs | 6 +++++- stack-ghc7.10.3.yaml | 11 +++++++++++ 4 files changed, 23 insertions(+), 1 deletion(-) diff --git a/gf.cabal b/gf.cabal index 014a2feea..0076e7638 100644 --- a/gf.cabal +++ b/gf.cabal @@ -83,6 +83,9 @@ Library mtl, exceptions, fail, + -- For compatability with ghc < 8 + -- We need transformers-compat >= 0.6.3, but that is only in newer snapshots where it is redundant. + transformers-compat, ghc-prim hs-source-dirs: src/runtime/haskell diff --git a/src/compiler/GF/Command/Interpreter.hs b/src/compiler/GF/Command/Interpreter.hs index bcb15d238..d1fd65a54 100644 --- a/src/compiler/GF/Command/Interpreter.hs +++ b/src/compiler/GF/Command/Interpreter.hs @@ -11,6 +11,9 @@ import GF.Infra.UseIO(putStrLnE) import Control.Monad(when) import qualified Data.Map as Map +import GF.Infra.UseIO (Output) +import qualified Control.Monad.Fail as Fail +-- import Control.Monad.State (StateT) data CommandEnv m = CommandEnv { commands :: Map.Map String (CommandInfo m), @@ -22,6 +25,7 @@ data CommandEnv m = CommandEnv { mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty --interpretCommandLine :: CommandEnv -> String -> SIO () +interpretCommandLine :: (Output m, TypeCheckArg m) => CommandEnv m -> String -> m () interpretCommandLine env line = case readCommandLine line of Just [] -> return () diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs index b68a1bc2f..c292fe944 100644 --- a/src/compiler/GF/Interactive.hs +++ b/src/compiler/GF/Interactive.hs @@ -38,6 +38,9 @@ import GF.Server(server) #endif import GF.Command.Messages(welcome) +import GF.Infra.UseIO (Output) +-- Provides an orphan instance of MonadFail for StateT in ghc versions < 8 +import Control.Monad.Trans.Instances () -- | Run the GF Shell in quiet mode (@gf -run@). mainRunGFI :: Options -> [FilePath] -> IO () @@ -131,7 +134,8 @@ execute1' s0 = "dt":ws -> define_tree ws -- ordinary commands _ -> do env <- gets commandenv - interpretCommandLine env s0 + -- () env s0 + -- interpretCommandLine env s0 continue where continue,stop :: ShellM Bool diff --git a/stack-ghc7.10.3.yaml b/stack-ghc7.10.3.yaml index a64e4e614..0761b54af 100644 --- a/stack-ghc7.10.3.yaml +++ b/stack-ghc7.10.3.yaml @@ -1 +1,12 @@ resolver: lts-6.35 # ghc 7.10.3 + +extra-deps: +- happy-1.19.9 +- alex-3.2.4 +- transformers-compat-0.6.5 + +allow-newer: true + +flags: + transformers-compat: + four: true \ No newline at end of file From 340f8d9b93fe7fa9dda35ffeda0760cfeafb980a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Sat, 12 Sep 2020 10:49:39 +0200 Subject: [PATCH 21/30] First attempt at github actions for stack --- .github/workflows/build-all-versions.yml | 95 ++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 .github/workflows/build-all-versions.yml diff --git a/.github/workflows/build-all-versions.yml b/.github/workflows/build-all-versions.yml new file mode 100644 index 000000000..52db74850 --- /dev/null +++ b/.github/workflows/build-all-versions.yml @@ -0,0 +1,95 @@ +# Based on the template here: https://kodimensional.dev/github-actions +name: Build with stack and cabal + +# Trigger the workflow on push or pull request, but only for the master branch +on: + pull_request: + push: + branches: [master] + +jobs: + cabal: + name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} + runs-on: ${{ matrix.os }} + strategy: + matrix: + os: [ubuntu-latest, macOS-latest, windows-latest] + cabal: ["3.2"] + ghc: + - "8.6.5" + - "8.8.3" + - "8.10.1" + exclude: + - os: macOS-latest + ghc: 8.8.3 + - os: macOS-latest + ghc: 8.6.5 + - os: windows-latest + ghc: 8.8.3 + - os: windows-latest + ghc: 8.6.5 + + steps: + - uses: actions/checkout@v2 + if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' + + - uses: actions/setup-haskell@v1.1.1 + id: setup-haskell-cabal + name: Setup Haskell + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: ${{ matrix.cabal }} + + - name: Freeze + run: | + cabal freeze + + - uses: actions/cache@v1 + name: Cache ~/.cabal/store + with: + path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} + key: ${{ runner.os }}-${{ matrix.ghc }} + # key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} + + - name: Build + run: | + cabal configure --enable-tests --enable-benchmarks --test-show-details=direct + cabal build all + + # - name: Test + # run: | + # cabal test all + + stack: + name: stack / ghc ${{ matrix.ghc }} + runs-on: ubuntu-latest + strategy: + matrix: + stack: ["2.3.3"] + ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4"] + # ghc: ["8.8.3"] + + steps: + - uses: actions/checkout@v2 + if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' + + - uses: actions/setup-haskell@v1.1 + name: Setup Haskell Stack + with: + # ghc-version: ${{ matrix.ghc }} + stack-version: ${{ matrix.stack }} + + - uses: actions/cache@v1 + name: Cache ~/.stack + with: + path: ~/.stack + key: ${{ runner.os }}-${{ matrix.ghc }}-stack + + - name: Build + run: | + stack build --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml + # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks + + # - name: Test + # run: | + # stack test --system-ghc \ No newline at end of file From 2fd1040724908943ef420480dd193e39bfc55f33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Fri, 11 Sep 2020 10:58:18 +0200 Subject: [PATCH 22/30] Fix incorrect type and update dependencies --- src/compiler/GF/Command/Interpreter.hs | 3 +-- stack-ghc8.6.5.yaml | 1 + 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/compiler/GF/Command/Interpreter.hs b/src/compiler/GF/Command/Interpreter.hs index d1fd65a54..1c38edf8b 100644 --- a/src/compiler/GF/Command/Interpreter.hs +++ b/src/compiler/GF/Command/Interpreter.hs @@ -13,7 +13,6 @@ import Control.Monad(when) import qualified Data.Map as Map import GF.Infra.UseIO (Output) import qualified Control.Monad.Fail as Fail --- import Control.Monad.State (StateT) data CommandEnv m = CommandEnv { commands :: Map.Map String (CommandInfo m), @@ -25,7 +24,7 @@ data CommandEnv m = CommandEnv { mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty --interpretCommandLine :: CommandEnv -> String -> SIO () -interpretCommandLine :: (Output m, TypeCheckArg m) => CommandEnv m -> String -> m () +interpretCommandLine :: (Fail.MonadFail m, Output m, TypeCheckArg m) => CommandEnv m -> String -> m () interpretCommandLine env line = case readCommandLine line of Just [] -> return () diff --git a/stack-ghc8.6.5.yaml b/stack-ghc8.6.5.yaml index 0f98f8dfc..99496798d 100644 --- a/stack-ghc8.6.5.yaml +++ b/stack-ghc8.6.5.yaml @@ -3,3 +3,4 @@ resolver: lts-14.3 # ghc 8.6.5 extra-deps: - network-2.6.3.6 - httpd-shed-0.4.0.3 +- cgi-3001.5.0.0 From 127a1b284210426e7e8ca5cef87b844a2809412d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Fri, 11 Sep 2020 10:58:54 +0200 Subject: [PATCH 23/30] Remove MonadFail requirements for aeson code --- src/compiler/GF/Grammar/CanonicalJSON.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/compiler/GF/Grammar/CanonicalJSON.hs b/src/compiler/GF/Grammar/CanonicalJSON.hs index 8b3464674..0ec7f43e6 100644 --- a/src/compiler/GF/Grammar/CanonicalJSON.hs +++ b/src/compiler/GF/Grammar/CanonicalJSON.hs @@ -6,6 +6,7 @@ import Text.JSON import Control.Applicative ((<|>)) import Data.Ratio (denominator, numerator) import GF.Grammar.Canonical +import Control.Monad (guard) encodeJSON :: FilePath -> Grammar -> IO () @@ -126,10 +127,10 @@ instance JSON LinType where -- records are encoded as records: showJSON (RecordType rows) = showJSON rows - readJSON o = do "Str" <- readJSON o; return StrType - <|> do "Float" <- readJSON o; return FloatType - <|> do "Int" <- readJSON o; return IntType - <|> do ptype <- readJSON o; return (ParamType ptype) + readJSON o = StrType <$ parseString "Str" o + <|> FloatType <$ parseString "Float" o + <|> IntType <$ parseString "Int" o + <|> ParamType <$> readJSON o <|> TableType <$> o!".tblarg" <*> o!".tblval" <|> TupleType <$> o!".tuple" <|> RecordType <$> readJSON o @@ -186,7 +187,7 @@ instance JSON LinPattern where -- and records as records: showJSON (RecordPattern r) = showJSON r - readJSON o = do "_" <- readJSON o; return WildPattern + readJSON o = do p <- parseString "_" o; return WildPattern <|> do p <- readJSON o; return (ParamPattern (Param p [])) <|> ParamPattern <$> readJSON o <|> RecordPattern <$> readJSON o @@ -237,7 +238,7 @@ instance JSON VarId where showJSON Anonymous = showJSON "_" showJSON (VarId x) = showJSON x - readJSON o = do "_" <- readJSON o; return Anonymous + readJSON o = do parseString "_" o; return Anonymous <|> VarId <$> readJSON o instance JSON QualId where @@ -268,6 +269,9 @@ instance JSON FlagValue where -------------------------------------------------------------------------------- -- ** Convenience functions +parseString :: String -> JSValue -> Result () +parseString s o = guard . (== s) =<< readJSON o + (!) :: JSON a => JSValue -> String -> Result a obj ! key = maybe (fail $ "CanonicalJSON.(!): Could not find key: " ++ show key) readJSON From 7d6a115cc136919f45b7e3435dcdfc1824eea3c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Mon, 14 Sep 2020 15:15:23 +0200 Subject: [PATCH 24/30] Bump stackage snapshots to latest versions --- stack-ghc8.6.5.yaml | 2 +- stack-ghc8.8.3.yaml | 9 --------- 2 files changed, 1 insertion(+), 10 deletions(-) delete mode 100644 stack-ghc8.8.3.yaml diff --git a/stack-ghc8.6.5.yaml b/stack-ghc8.6.5.yaml index 99496798d..2e66c7bf6 100644 --- a/stack-ghc8.6.5.yaml +++ b/stack-ghc8.6.5.yaml @@ -1,4 +1,4 @@ -resolver: lts-14.3 # ghc 8.6.5 +resolver: lts-14.27 # ghc 8.6.5 extra-deps: - network-2.6.3.6 diff --git a/stack-ghc8.8.3.yaml b/stack-ghc8.8.3.yaml deleted file mode 100644 index 475b164d7..000000000 --- a/stack-ghc8.8.3.yaml +++ /dev/null @@ -1,9 +0,0 @@ -resolver: lts-16.8 # ghc 8.8.3 - -extra-deps: -- network-2.6.3.6 -- httpd-shed-0.4.0.3 -- cgi-3001.5.0.0@sha256:3d1193a328d5f627a021a0ef3927c1ae41dd341e32dba612fed52d0e3a6df056,2990 -- json-0.10@sha256:d9fc6b07ce92b8894825a17d2cf14799856767eb30c8bf55962baa579207d799,3210 -- multipart-0.2.0@sha256:b8770e3ff6089be4dd089a8250894b31287cca671f3d258190a505f9351fa8a9,1084 - From 8bcdeedba01847325cc89378fed114bc0561bd4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= Date: Mon, 14 Sep 2020 17:44:23 +0200 Subject: [PATCH 25/30] Bump default stack.yaml to ghc8.6.5 --- stack.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/stack.yaml b/stack.yaml index 59e36c4fa..f5d21085c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,9 @@ -# This default stack file is a copy of stack-ghc8.2.2.yaml +# This default stack file is a copy of stack-ghc8.6.5.yaml # But committing a symlink is probably a bad idea, so it's a real copy -resolver: lts-11.22 # ghc 8.2.2 +resolver: lts-14.27 # ghc 8.6.5 extra-deps: -- cgi-3001.3.0.3 +- network-2.6.3.6 - httpd-shed-0.4.0.3 -- exceptions-0.10.2 +- cgi-3001.5.0.0 \ No newline at end of file From ab52572f4458d14cd66ad8ca487778022fb4ed8a Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Fri, 18 Sep 2020 09:25:08 +0200 Subject: [PATCH 26/30] Fix bug where shell commands were ignored, introduced by #71 --- src/compiler/GF/Interactive.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs index c292fe944..9987b7c39 100644 --- a/src/compiler/GF/Interactive.hs +++ b/src/compiler/GF/Interactive.hs @@ -102,7 +102,7 @@ timeIt act = -- | Optionally show how much CPU time was used to run an IO action optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a -optionallyShowCPUTime opts act +optionallyShowCPUTime opts act | not (verbAtLeast opts Normal) = act | otherwise = do (dt,r) <- timeIt act liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec" @@ -134,8 +134,7 @@ execute1' s0 = "dt":ws -> define_tree ws -- ordinary commands _ -> do env <- gets commandenv - -- () env s0 - -- interpretCommandLine env s0 + interpretCommandLine env s0 continue where continue,stop :: ShellM Bool @@ -367,7 +366,7 @@ wordCompletion gfenv (left,right) = do pgf = multigrammar gfenv cmdEnv = commandenv gfenv optLang opts = valCIdOpts "lang" (head (languages pgf)) opts - optType opts = + optType opts = let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts in case readType str of Just ty -> ty @@ -414,7 +413,7 @@ wc_type = cmd_name option x y (c :cs) | isIdent c = option x y cs | otherwise = cmd x cs - + optValue x y ('"':cs) = str x y cs optValue x y cs = cmd x cs @@ -432,7 +431,7 @@ wc_type = cmd_name where x1 = take (length x - length y - d) x x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1 - + cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of [x] -> Just x _ -> Nothing From db8b111e72ea25b407e8f4de88df692a7bcea300 Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Fri, 18 Sep 2020 10:34:45 +0200 Subject: [PATCH 27/30] Bump PGF2 to 1.2.1 --- src/runtime/haskell-bind/CHANGELOG.md | 5 +++++ src/runtime/haskell-bind/pgf2.cabal | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/runtime/haskell-bind/CHANGELOG.md b/src/runtime/haskell-bind/CHANGELOG.md index e9da7fac4..aed2d9c4f 100644 --- a/src/runtime/haskell-bind/CHANGELOG.md +++ b/src/runtime/haskell-bind/CHANGELOG.md @@ -1,3 +1,8 @@ +## 1.2.1 + +- Remove deprecated pgf_print_expr_tuple +- Added an API for cloning expressions/types/literals + ## 1.2.0 - Stop `pgf-shell` from being built by default. diff --git a/src/runtime/haskell-bind/pgf2.cabal b/src/runtime/haskell-bind/pgf2.cabal index a4e113f3b..4ef9ed4f0 100644 --- a/src/runtime/haskell-bind/pgf2.cabal +++ b/src/runtime/haskell-bind/pgf2.cabal @@ -1,5 +1,5 @@ name: pgf2 -version: 1.2.0 +version: 1.2.1 synopsis: Bindings to the C version of the PGF runtime description: GF, Grammatical Framework, is a programming language for multilingual grammar applications. From d95b3efd6bdea90cc37be5179527a2791b2b7717 Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Fri, 18 Sep 2020 10:49:21 +0200 Subject: [PATCH 28/30] Add instructions for uploading PGF2 to Hackage --- src/runtime/haskell-bind/HACKAGE.md | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 src/runtime/haskell-bind/HACKAGE.md diff --git a/src/runtime/haskell-bind/HACKAGE.md b/src/runtime/haskell-bind/HACKAGE.md new file mode 100644 index 000000000..d931ef8f9 --- /dev/null +++ b/src/runtime/haskell-bind/HACKAGE.md @@ -0,0 +1,10 @@ +# Instructions for uploading to Hackage + +You will need a Hackage account for steps 4 & 5. + +1. Bump the version number in `pgf2.cabal` +2. Add details in `CHANGELOG.md` +3. Run `stack sdist` (or `cabal sdist`) +4. Visit `https://hackage.haskell.org/upload` and upload the file `./.stack-work/dist/x86_64-osx/Cabal-2.2.0.1/pgf2-x.y.z.tar.gz` (or Cabal equivalent) +5. If successful, upload documentation with `./stack-haddock-upload.sh pgf2 x.y.z` (compilation on Hackage's servers will fail because of missing C libraries) +6. Commit and push to this repository (`gf-core`) From 2c2bd158a60eb3ac2bf84aa4b1831c4e0e6f96de Mon Sep 17 00:00:00 2001 From: aarneranta Date: Tue, 29 Sep 2020 09:05:15 +0200 Subject: [PATCH 29/30] link to CoLi paper, mention of iOS --- index.html | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/index.html b/index.html index 44d8d50fe..e3df1ae22 100644 --- a/index.html +++ b/index.html @@ -56,6 +56,7 @@
  • Reference Manual
  • Shell Reference
  • Best Practices [PDF]
    • +
  • Scaling Up (Computational Linguistics 2020)
    • @@ -173,6 +174,7 @@ least one, it may help you to get a first idea of what GF is.
  • macOS
  • Windows
  • Android mobile platform (via Java; runtime)
    • +
  • iOS mobile platform (iPhone, iPad)
  • via compilation to JavaScript, almost any platform that has a web browser (runtime)
    • @@ -226,6 +228,10 @@ least one, it may help you to get a first idea of what GF is.

    News

    +
    2020-09-29
    +
    + Abstract Syntax as Interlingua: Scaling Up the Grammatical Framework from Controlled Languages to Robust Pipelines. A paper in Computational Linguistics (2020) summarizing much of the development in GF in the past ten years. +
    2020-03-29
    Seventh GF Summer School in Singapore has been postponed because of the corona pandemic. From f56fbcf86e472262d07c6bd713f6955cfbcfee8a Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Tue, 29 Sep 2020 09:23:36 +0200 Subject: [PATCH 30/30] (Tutorial) Remove mentions to pt -typecheck The GF shell no longer has `put_tree -typecheck` option, and typechecking is done automatically when parsing. The metavariable thing is a bit unclear: you don't get it when parsing "dim the light", or "switch on the fan, but you do get it when you `gt` after adding `switchOn` and `switchOff`. ``` > p "switch on the fan" CAction fan (switchOff fan) (DKindOne fan) > gt CAction light dim (DKindOne light) CAction ?3 (switchOff ?3) (DKindOne ?3) CAction ?3 (switchOn ?3) (DKindOne ?3) ``` My hypothesis is that you don't get metavariable when parsing e.g. "dim the light", because even though `light` is suppressed in `CAction`, it still appears in `DKindOne`, so it gets to contribute to the whole tree with its string. --- doc/tutorial/gf-tutorial.t2t | 49 ++++++++---------------------------- 1 file changed, 10 insertions(+), 39 deletions(-) diff --git a/doc/tutorial/gf-tutorial.t2t b/doc/tutorial/gf-tutorial.t2t index 469166090..7467e107e 100644 --- a/doc/tutorial/gf-tutorial.t2t +++ b/doc/tutorial/gf-tutorial.t2t @@ -3718,49 +3718,25 @@ Concrete syntax does not know if a category is a dependent type. ``` Notice that the ``Kind`` argument is suppressed in linearization. -Parsing with dependent types is performed in two phases: +Parsing with dependent types consists of two phases: + context-free parsing + filtering through type checker +Parsing a type-correct command works as expected: -By just doing the first phase, the ``kind`` argument is not found: ``` > parse "dim the light" - CAction ? dim (DKindOne light) -``` -Moreover, type-incorrect commands are not rejected: -``` - > parse "dim the fan" - CAction ? dim (DKindOne fan) -``` -The term ``?`` is a **metavariable**, returned by the parser -for any subtree that is suppressed by a linearization rule. -These are the same kind of metavariables as were used #Rsecediting -to mark incomplete parts of trees in the syntax editor. - - - -#NEW - -===Solving metavariables=== - -Use the command ``put_tree = pt`` with the option ``-typecheck``: -``` - > parse "dim the light" | put_tree -typecheck CAction light dim (DKindOne light) ``` -The ``typecheck`` process may fail, in which case an error message -is shown and no tree is returned: +However, type-incorrect commands are rejected by the typecheck: ``` - > parse "dim the fan" | put_tree -typecheck - - Error in tree UCommand (CAction ? 0 dim (DKindOne fan)) : - (? 0 <> fan) (? 0 <> light) + > parse "dim the fan" + The parsing is successful but the type checking failed with error(s): + Couldn't match expected type Device light + against the interred type Device fan + In the expression: DKindOne fan ``` - - - #NEW ==Polymorphism== @@ -3786,23 +3762,19 @@ to express Haskell-type library functions: \_,_,_,f,x,y -> f y x ; ``` - #NEW ===Dependent types: exercises=== 1. Write an abstract syntax module with above contents and an appropriate English concrete syntax. Try to parse the commands -//dim the light// and //dim the fan//, with and without ``solve`` filtering. +//dim the light// and //dim the fan//. - -2. Perform random and exhaustive generation, with and without -``solve`` filtering. +2. Perform random and exhaustive generation. 3. Add some device kinds and actions to the grammar. - #NEW ==Proof objects== @@ -3912,7 +3884,6 @@ fun Classes for new actions can be added incrementally. - #NEW ==Variable bindings==