mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
Fix most build errors
This commit is contained in:
@@ -44,7 +44,7 @@ pgfEnv pgf = Env pgf mos
|
|||||||
|
|
||||||
class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
|
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)
|
typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
|
||||||
. flip inferExpr e . pgf) =<< getPGFEnv
|
. flip inferExpr e . pgf) =<< getPGFEnv
|
||||||
|
|
||||||
|
|||||||
@@ -196,6 +196,9 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
|
|||||||
-> ([ProtoFCat],[Symbol])
|
-> ([ProtoFCat],[Symbol])
|
||||||
-> Branch b}
|
-> Branch b}
|
||||||
|
|
||||||
|
instance MonadFail CnvMonad where
|
||||||
|
fail = bug
|
||||||
|
|
||||||
instance Applicative CnvMonad where
|
instance Applicative CnvMonad where
|
||||||
pure = return
|
pure = return
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|||||||
@@ -29,7 +29,7 @@ import Control.Monad
|
|||||||
import GF.Text.Pretty
|
import GF.Text.Pretty
|
||||||
|
|
||||||
-- | combine a list of definitions into a balanced binary search tree
|
-- | 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
|
buildAnyTree m = go Map.empty
|
||||||
where
|
where
|
||||||
go map [] = return map
|
go map [] = return map
|
||||||
|
|||||||
@@ -256,6 +256,9 @@ instance Output m => Output (CollectOutput m) where
|
|||||||
putStrLnE s = CO (return (putStrLnE s,()))
|
putStrLnE s = CO (return (putStrLnE s,()))
|
||||||
putStrE s = CO (return (putStrE s,()))
|
putStrE s = CO (return (putStrE s,()))
|
||||||
|
|
||||||
|
instance MonadFail m => MonadFail (CollectOutput m) where
|
||||||
|
fail = CO . fail
|
||||||
|
|
||||||
instance ErrorMonad m => ErrorMonad (CollectOutput m) where
|
instance ErrorMonad m => ErrorMonad (CollectOutput m) where
|
||||||
raise e = CO (raise e)
|
raise e = CO (raise e)
|
||||||
handle (CO m) h = CO $ handle m (unCO . h)
|
handle (CO m) h = CO $ handle m (unCO . h)
|
||||||
|
|||||||
@@ -35,7 +35,7 @@ type OneOutput = (Maybe FullPath,CompiledModule)
|
|||||||
type CompiledModule = Module
|
type CompiledModule = Module
|
||||||
|
|
||||||
compileOne, reuseGFO, useTheSource ::
|
compileOne, reuseGFO, useTheSource ::
|
||||||
(Output m,ErrorMonad m,MonadIO m) =>
|
(Output m,ErrorMonad m,MonadIO m, MonadFail m) =>
|
||||||
Options -> Grammar -> FullPath -> m OneOutput
|
Options -> Grammar -> FullPath -> m OneOutput
|
||||||
|
|
||||||
-- | Compile a given source file (or just load a .gfo file),
|
-- | Compile a given source file (or just load a .gfo file),
|
||||||
|
|||||||
@@ -88,10 +88,10 @@ checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where
|
|||||||
overloaded s = length (filter (==s) ss) > 1
|
overloaded s = length (filter (==s) ss) > 1
|
||||||
|
|
||||||
-- | this is what happens when matching two values in the same module
|
-- | 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
|
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)
|
unifyMaybeBy f (Just p1) (Just p2)
|
||||||
| f p1==f p2 = return (Just p1)
|
| f p1==f p2 = return (Just p1)
|
||||||
| otherwise = fail ""
|
| otherwise = fail ""
|
||||||
|
|||||||
@@ -237,7 +237,7 @@ isPredefConstant t = case t of
|
|||||||
Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
|
Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
checkPredefError :: Monad m => Term -> m Term
|
checkPredefError :: MonadFail m => Term -> m Term
|
||||||
checkPredefError t =
|
checkPredefError t =
|
||||||
case t of
|
case t of
|
||||||
Error s -> fail ("Error: "++s)
|
Error s -> fail ("Error: "++s)
|
||||||
|
|||||||
@@ -53,6 +53,9 @@ instance Monad Check where
|
|||||||
(ws,Success x) -> unCheck (g x) {-ctxt-} ws
|
(ws,Success x) -> unCheck (g x) {-ctxt-} ws
|
||||||
(ws,Fail msg) -> (ws,Fail msg)
|
(ws,Fail msg) -> (ws,Fail msg)
|
||||||
|
|
||||||
|
instance MonadFail Check where
|
||||||
|
fail = raise
|
||||||
|
|
||||||
instance Applicative Check where
|
instance Applicative Check where
|
||||||
pure = return
|
pure = return
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|||||||
@@ -547,7 +547,7 @@ lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs]
|
|||||||
lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
|
lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
|
||||||
lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x]
|
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]"
|
onOff f def = OptArg g "[on,off]"
|
||||||
where g ma = maybe (return def) readOnOff ma >>= f
|
where g ma = maybe (return def) readOnOff ma >>= f
|
||||||
readOnOff x = case map toLower x of
|
readOnOff x = case map toLower x of
|
||||||
@@ -555,7 +555,7 @@ onOff f def = OptArg g "[on,off]"
|
|||||||
"off" -> return False
|
"off" -> return False
|
||||||
_ -> fail $ "Expected [on,off], got: " ++ show x
|
_ -> fail $ "Expected [on,off], got: " ++ show x
|
||||||
|
|
||||||
readOutputFormat :: Monad m => String -> m OutputFormat
|
readOutputFormat :: MonadFail m => String -> m OutputFormat
|
||||||
readOutputFormat s =
|
readOutputFormat s =
|
||||||
maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
|
maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
|
||||||
|
|
||||||
|
|||||||
@@ -58,6 +58,9 @@ instance Monad SIO where
|
|||||||
return x = SIO (const (return x))
|
return x = SIO (const (return x))
|
||||||
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
|
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
|
||||||
|
|
||||||
|
instance MonadFail SIO where
|
||||||
|
fail = liftSIO . fail
|
||||||
|
|
||||||
instance Output SIO where
|
instance Output SIO where
|
||||||
ePutStr = lift0 . ePutStr
|
ePutStr = lift0 . ePutStr
|
||||||
ePutStrLn = lift0 . ePutStrLn
|
ePutStrLn = lift0 . ePutStrLn
|
||||||
|
|||||||
Reference in New Issue
Block a user