Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 11 additions & 6 deletions .github/workflows/build-all-versions.yml
Original file line number Diff line number Diff line change
Expand Up @@ -12,28 +12,34 @@ jobs:
name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-latest, macos-latest, windows-latest]
cabal: ["latest"]
ghc:
- "8.6.5"
- "8.8.3"
- "8.10.7"
- "9.6.6"
exclude:
- os: macos-latest
ghc: 8.8.3
- os: macos-latest
ghc: 8.6.5
- os: macos-latest
ghc: 8.10.7
- os: windows-latest
ghc: 8.8.3
- os: windows-latest
ghc: 8.6.5
- os: windows-latest
ghc: 8.10.7

steps:
- uses: actions/checkout@v2
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'

- uses: haskell/actions/setup@v2
- uses: haskell-actions/setup@v2
id: setup-haskell-cabal
name: Setup Haskell
with:
Expand All @@ -44,7 +50,7 @@ jobs:
run: |
cabal freeze

- uses: actions/cache@v1
- uses: actions/cache@v4
name: Cache ~/.cabal/store
with:
path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
Expand All @@ -66,14 +72,13 @@ jobs:
strategy:
matrix:
stack: ["latest"]
ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.0.2"]
# ghc: ["8.8.3"]
ghc: ["8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.0.2", "9.6.6"]

steps:
- uses: actions/checkout@v2
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'

- uses: haskell/actions/setup@v2
- uses: haskell-actions/setup@v2
name: Setup Haskell Stack
with:
ghc-version: ${{ matrix.ghc }}
Expand All @@ -85,7 +90,7 @@ jobs:
- run: sed -i.bak 's/"C compiler link flags", "/&-no-pie /' /home/runner/.ghcup/ghc/7.10.3/lib/ghc-7.10.3/settings
if: matrix.ghc == '7.10.3'

- uses: actions/cache@v1
- uses: actions/cache@v4
name: Cache ~/.stack
with:
path: ~/.stack
Expand Down
22 changes: 14 additions & 8 deletions gf.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -73,12 +73,12 @@ library
build-depends:
-- GHC 8.0.2 to GHC 8.10.4
array >= 0.5.1 && < 0.6,
base >= 4.9.1 && < 4.17,
base >= 4.9.1 && < 4.22,
bytestring >= 0.10.8 && < 0.12,
containers >= 0.5.7 && < 0.7,
exceptions >= 0.8.3 && < 0.11,
ghc-prim >= 0.5.0 && < 0.9.0,
mtl >= 2.2.1 && < 2.3,
ghc-prim >= 0.5.0 && <= 0.10.0,
mtl >= 2.2.1 && <= 2.3.1,
pretty >= 1.1.3 && < 1.2,
random >= 1.1 && < 1.3,
utf8-string >= 1.0.1.1 && < 1.1
Expand Down Expand Up @@ -155,10 +155,10 @@ library
directory >= 1.3.0 && < 1.4,
filepath >= 1.4.1 && < 1.5,
haskeline >= 0.7.3 && < 0.9,
json >= 0.9.1 && < 0.11,
json >= 0.9.1 && <= 0.11,
parallel >= 3.2.1.1 && < 3.3,
process >= 1.4.3 && < 1.7,
time >= 1.6.0 && < 1.10
time >= 1.6.0 && <= 1.12.2

hs-source-dirs: src/compiler
exposed-modules:
Expand Down Expand Up @@ -346,8 +346,14 @@ library
Win32 >= 2.3.1.1 && < 2.7
else
build-depends:
terminfo >=0.4.0 && < 0.5,
unix >= 2.7.2 && < 2.8
terminfo >=0.4.0 && < 0.5

if impl(ghc >= 9.6.6)
build-depends: unix >= 2.8

else
build-depends: unix >= 2.7.2 && < 2.8


if impl(ghc>=8.2)
ghc-options: -fhide-source-paths
Expand Down Expand Up @@ -392,7 +398,7 @@ test-suite gf-tests
main-is: run.hs
hs-source-dirs: testsuite
build-depends:
base >= 4.9.1 && < 4.16,
base >= 4.9.1,
Cabal >= 1.8,
directory >= 1.3.0 && < 1.4,
filepath >= 1.4.1 && < 1.5,
Expand Down
18 changes: 9 additions & 9 deletions src/compiler/GF/Compile/Compute/Concrete.hs
Original file line number Diff line number Diff line change
Expand Up @@ -172,11 +172,11 @@ value env t0 =
ImplArg t -> (VImplArg.) # value env t
Table p res -> liftM2 VTblType # value env p <# value env res
RecType rs -> do lovs <- mapPairsM (value env) rs
return $ \vs->VRecType $ mapSnd ($vs) lovs
return $ \vs->VRecType $ mapSnd ($ vs) lovs
t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
FV ts -> ((vfv .) # sequence) # mapM (value env) ts
R as -> do lovs <- mapPairsM (value env.snd) as
return $ \ vs->VRec $ mapSnd ($vs) lovs
return $ \ vs->VRec $ mapSnd ($ vs) lovs
T i cs -> valueTable env i cs
V ty ts -> do pvs <- paramValues env ty
((VV ty pvs .) . sequence) # mapM (value env) ts
Expand Down Expand Up @@ -376,10 +376,10 @@ valueTable env i cs =
where
dynamic cs' ty _ = cases cs' # value env ty

cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))
cases cs' vty vs = err keep ($ vs) (convertv cs' (vty vs))
where
keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $
VT wild (vty vs) (mapSnd ($vs) cs')
VT wild (vty vs) (mapSnd ($ vs) cs')

wild = case i of TWild _ -> True; _ -> False

Expand All @@ -392,7 +392,7 @@ valueTable env i cs =
convert' cs' ((pty,vs),pvs) =
do sts <- mapM (matchPattern cs') vs
return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
(mapFst ($vs) sts)
(mapFst ($ vs) sts)

valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
pvs <- linPattVars p'
Expand Down Expand Up @@ -430,19 +430,19 @@ apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
apply' env t [] = value env t
apply' env t vs =
case t of
QC x -> return $ \ svs -> VCApp x (map ($svs) vs)
QC x -> return $ \ svs -> VCApp x (map ($ svs) vs)
{-
Q x@(m,f) | m==cPredef -> return $
let constr = --trace ("predef "++show x) .
VApp x
in \ svs -> maybe constr id (Map.lookup f predefs)
$ map ($svs) vs
$ map ($ svs) vs
| otherwise -> do r <- resource env x
return $ \ svs -> vapply (gloc env) r (map ($svs) vs)
return $ \ svs -> vapply (gloc env) r (map ($ svs) vs)
-}
App t1 t2 -> apply' env t1 . (:vs) =<< value env t2
_ -> do fv <- value env t
return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)
return $ \ svs -> vapply (gloc env) (fv svs) (map ($ svs) vs)

vapply :: GLocation -> Value -> [Value] -> Value
vapply loc v [] = v
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Compile/GeneratePMCFG.hs
Original file line number Diff line number Diff line change
Expand Up @@ -201,11 +201,11 @@ instance Fail.MonadFail CnvMonad where
fail = bug

instance Applicative CnvMonad where
pure = return
pure a = CM (\gr c s -> c a s)
(<*>) = ap

instance Monad CnvMonad where
return a = CM (\gr c s -> c a s)
return = pure
CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)

instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
Original file line number Diff line number Diff line change
Expand Up @@ -644,7 +644,7 @@ data TcResult a
newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}

instance Monad TcM where
return x = TcM (\ms msgs -> TcOk x ms msgs)
return = pure
f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of
TcOk x ms msgs -> unTcM (g x) ms msgs
TcFail msgs -> TcFail msgs)
Expand All @@ -659,7 +659,7 @@ instance Fail.MonadFail TcM where


instance Applicative TcM where
pure = return
pure x = TcM (\ms msgs -> TcOk x ms msgs)
(<*>) = ap

instance Functor TcM where
Expand Down
18 changes: 9 additions & 9 deletions src/compiler/GF/CompileInParallel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,11 +61,11 @@ parallelBatchCompile jobs opts rootfiles0 =

usesPresent (_,paths) = take 1 libs==["present"]
where
libs = [p|path<-paths,
let (d,p0) = splitAt n path
p = dropSlash p0,
d==lib_dir,p `elem` all_modes]
n = length lib_dir
libs = [p | path<-paths,
let (d,p0) = splitAt n path
p = dropSlash p0,
d==lib_dir, p `elem` all_modes]
n = length lib_dir

all_modes = ["alltenses","present"]

Expand Down Expand Up @@ -175,7 +175,7 @@ batchCompile1 lib_dir (opts,filepaths) =
" from being compiled."
else return (maximum ts,(cnc,gr))

splitEither es = ([x|Left x<-es],[y|Right y<-es])
splitEither es = ([x | Left x<-es], [y | Right y<-es])

canonical path = liftIO $ D.canonicalizePath path `catch` const (return path)

Expand Down Expand Up @@ -238,12 +238,12 @@ runCO (CO m) = do (o,x) <- m
instance Functor m => Functor (CollectOutput m) where
fmap f (CO m) = CO (fmap (fmap f) m)

instance (Functor m,Monad m) => Applicative (CollectOutput m) where
pure = return
instance (Functor m,Monad m) => Applicative (CollectOutput m) where
pure x = CO (return (return (),x))
(<*>) = ap

instance Monad m => Monad (CollectOutput m) where
return x = CO (return (return (),x))
return = pure
CO m >>= f = CO $ do (o1,x) <- m
let CO m2 = f x
(o2,y) <- m2
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Data/BacktrackM.hs
Original file line number Diff line number Diff line change
Expand Up @@ -64,11 +64,11 @@ finalStates :: BacktrackM s () -> s -> [s]
finalStates bm = map fst . runBM bm

instance Applicative (BacktrackM s) where
pure = return
pure a = BM (\c s b -> c a s b)
(<*>) = ap

instance Monad (BacktrackM s) where
return a = BM (\c s b -> c a s b)
return = pure
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
where unBM (BM m) = m

Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Data/ErrM.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ fromErr :: a -> Err a -> a
fromErr a = err (const a) id

instance Monad Err where
return = Ok
return = pure
Ok a >>= f = f a
Bad s >>= f = Bad s

Expand All @@ -54,7 +54,7 @@ instance Functor Err where
fmap f (Bad s) = Bad s

instance Applicative Err where
pure = return
pure = Ok
(<*>) = ap

-- | added by KJ
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Grammar/Lexer.x
Original file line number Diff line number Diff line change
Expand Up @@ -283,11 +283,11 @@ instance Functor P where
fmap = liftA

instance Applicative P where
pure = return
pure a = a `seq` (P $ \s -> POk s a)
(<*>) = ap

instance Monad P where
return a = a `seq` (P $ \s -> POk s a)
return = pure
(P m) >>= k = P $ \ s -> case m s of
POk s a -> unP (k a) s
PFailed posn err -> PFailed posn err
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Infra/CheckM.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ newtype Check a
instance Functor Check where fmap = liftM

instance Monad Check where
return x = Check $ \{-ctxt-} ws -> (ws,Success x)
return = pure
f >>= g = Check $ \{-ctxt-} ws ->
case unCheck f {-ctxt-} ws of
(ws,Success x) -> unCheck (g x) {-ctxt-} ws
Expand All @@ -58,7 +58,7 @@ instance Fail.MonadFail Check where
fail = raise

instance Applicative Check where
pure = return
pure x = Check $ \{-ctxt-} ws -> (ws,Success x)
(<*>) = ap

instance ErrorMonad Check where
Expand Down
4 changes: 2 additions & 2 deletions src/compiler/GF/Infra/SIO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,11 +52,11 @@ newtype SIO a = SIO {unS::PutStr->IO a}
instance Functor SIO where fmap = liftM

instance Applicative SIO where
pure = return
pure x = SIO (const (pure x))
(<*>) = ap

instance Monad SIO where
return x = SIO (const (return x))
return = pure
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h

instance Fail.MonadFail SIO where
Expand Down
1 change: 1 addition & 0 deletions src/compiler/GF/Interactive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ import qualified Text.ParserCombinators.ReadP as RP
import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
import Control.Exception(SomeException,fromException,evaluate,try)
import Control.Monad.State hiding (void)
import Control.Monad (join, when, (<=<))
import qualified GF.System.Signal as IO(runInterruptibly)
#ifdef SERVER_MODE
import GF.Server(server)
Expand Down
1 change: 1 addition & 0 deletions src/runtime/c/configure.ac
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ AM_PROG_CC_C_O
-Wall\
-Wextra\
-Wno-missing-field-initializers\
-fpermissive\
-Wno-unused-parameter\
-Wno-unused-value"
fi]
Expand Down
2 changes: 1 addition & 1 deletion src/runtime/haskell/Data/Binary/Builder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,7 @@ instance Semigroup Builder where
instance Monoid Builder where
mempty = empty
{-# INLINE mempty #-}
mappend = append
mappend = (<>)
{-# INLINE mappend #-}

------------------------------------------------------------------------
Expand Down
4 changes: 2 additions & 2 deletions src/runtime/haskell/Data/Binary/Get.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,11 +127,11 @@ instance Functor Get where
{-# INLINE fmap #-}

instance Applicative Get where
pure = return
pure a = Get (\s -> (a, s))
(<*>) = ap

instance Monad Get where
return a = Get (\s -> (a, s))
return = pure
{-# INLINE return #-}

m >>= k = Get (\s -> case unGet m s of
Expand Down
Loading
Loading