msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Use ErrorMonad instead of IOE

Browse Source 
It probably ends up being the same thing, but the code is a little cleaner for it.
This commit is contained in:
John J. Camilleri
2021-03-03 09:36:48 +01:00
parent 4c09e4a340
commit 997d7c1694
1 changed files with 7 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/compiler/GF/Compile/GrammarToLPGF.hs
View File

@@ -8,7 +8,8 @@ import GF.Grammar.Grammar
import qualified GF.Grammar.Canonical as C import qualified GF.Grammar.Canonical as C
import GF.Compile.GrammarToCanonical (grammar2canonical) import GF.Compile.GrammarToCanonical (grammar2canonical)
import GF.Infra.Option import GF.Data.Operations (ErrorMonad (..))
import GF.Infra.Option (Options)
import GF.Infra.UseIO (IOE) import GF.Infra.UseIO (IOE)
import GF.Text.Pretty (pp, render) import GF.Text.Pretty (pp, render)
@@ -43,16 +44,15 @@ mkCanon2lpgf opts gr am = do
where where
canon@(C.Grammar ab cncs) = grammar2canonical opts am gr canon@(C.Grammar ab cncs) = grammar2canonical opts am gr
mkAbstract :: C.Abstract -> IOE (CId, L.Abstract) mkAbstract :: (ErrorMonad err) => C.Abstract -> err (CId, L.Abstract)
mkAbstract (C.Abstract modId flags cats funs) = return (mdi2i modId, L.Abstract {}) mkAbstract (C.Abstract modId flags cats funs) = return (mdi2i modId, L.Abstract {})
mkConcrete :: C.Concrete -> IOE (CId, L.Concrete) -- TODO don't need IO, use ErrM mkConcrete :: (ErrorMonad err) => C.Concrete -> err (CId, L.Concrete)
mkConcrete (C.Concrete modId absModId flags params' lincats lindefs) = do mkConcrete (C.Concrete modId absModId flags params' lincats lindefs) = do
let let
(C.Abstract _ _ _ funs) = ab (C.Abstract _ _ _ funs) = ab
params = inlineParamAliases params' -- TODO remove by making mkParamTuples return map params = inlineParamAliases params' -- TODO remove by making mkParamTuples return map
paramTuples = mkParamTuples params' paramTuples = mkParamTuples params'
-- mapM_ (\(C.ParamDef (C.ParamId (C.Qual _ pid)) _,ptup) -> putStrLn $ "# " ++ pid ++ "\n" ++ T.unpack (L.render $ L.pp ptup)) (zip params paramTuples)
let let
-- filter out record fields from defn which don't appear in lincat -- filter out record fields from defn which don't appear in lincat
@@ -227,14 +227,14 @@ mkCanon2lpgf opts gr am = do
v -> Left $ printf "val2lin not implemented for: %s" (show v) v -> Left $ printf "val2lin not implemented for: %s" (show v)
unless (null $ lefts es) (error $ unlines (lefts es)) unless (null $ lefts es) (raise $ unlines (lefts es))
return (mdi2i modId, L.Concrete { return (mdi2i modId, L.Concrete {
L.lins = lins L.lins = lins
}) })
-- | Remove ParamAliasDefs by inlining their definitions -- | Remove ParamAliasDefs by inlining their definitions
inlineParamAliases :: [C.ParamDef] -> [C.ParamDef] inlineParamAliases :: [C.ParamDef] -> [C.ParamDef] -- TODO use error monad
inlineParamAliases defs = if null aliases then defs else map rp' pdefs inlineParamAliases defs = if null aliases then defs else map rp' pdefs
where where
(aliases,pdefs) = L.partition isParamAliasDef defs (aliases,pdefs) = L.partition isParamAliasDef defs
@@ -252,7 +252,7 @@ inlineParamAliases defs = if null aliases then defs else map rp' pdefs
_ -> pid _ -> pid
-- | Build nested tuple of param values -- | Build nested tuple of param values
mkParamTuples :: [C.ParamDef] -> [L.LinFun] mkParamTuples :: [C.ParamDef] -> [L.LinFun] -- TODO use error monad
mkParamTuples defs = map (addIndexes . mk') pdefs mkParamTuples defs = map (addIndexes . mk') pdefs
where where
pdefs = inlineParamAliases defs pdefs = inlineParamAliases defs