From 734c66710e9bffa986c094e8c584295b33cd2f63 Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Wed, 2 Nov 2011 13:57:11 +0000 Subject: merge GF.Infra.Modules and GF.Grammar.Grammar. This is a preparation for the separate PGF building --- src/compiler/GF/Compile/CheckGrammar.hs | 7 +++---- src/compiler/GF/Compile/Coding.hs | 3 +-- src/compiler/GF/Compile/Compute/AppPredefined.hs | 1 - src/compiler/GF/Compile/Compute/ConcreteLazy.hs | 1 - src/compiler/GF/Compile/GeneratePMCFG.hs | 13 ++++++------- src/compiler/GF/Compile/GetGrammar.hs | 15 ++++----------- src/compiler/GF/Compile/GrammarToPGF.hs | 23 +++++++++++------------ src/compiler/GF/Compile/ModDeps.hs | 10 ++++------ src/compiler/GF/Compile/Optimize.hs | 7 +++---- src/compiler/GF/Compile/ReadFiles.hs | 5 ++--- src/compiler/GF/Compile/Refresh.hs | 3 +-- src/compiler/GF/Compile/Rename.hs | 5 ++--- src/compiler/GF/Compile/SubExOpt.hs | 11 +++++------ src/compiler/GF/Compile/TypeCheck/Concrete.hs | 1 - src/compiler/GF/Compile/Update.hs | 9 ++++----- 15 files changed, 46 insertions(+), 68 deletions(-) (limited to 'src/compiler/GF/Compile') diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs index 44e2e552b..2b82bc781 100644 --- a/src/compiler/GF/Compile/CheckGrammar.hs +++ b/src/compiler/GF/Compile/CheckGrammar.hs @@ -23,7 +23,6 @@ module GF.Compile.CheckGrammar(checkModule) where import GF.Infra.Ident -import GF.Infra.Modules import GF.Compile.TypeCheck.Abstract import GF.Compile.TypeCheck.Concrete @@ -56,13 +55,13 @@ checkModule ms m@(name,mo) = checkIn (text "checking module" <+> ppIdent name) $ where updateCheckInfo (name,mo) (i,info) = do info <- checkInfo ms (name,mo) i info - return (name,updateModule mo i info) + return (name,mo{jments=updateTree (i,info) (jments mo)}) -- check if restricted inheritance modules are still coherent -- i.e. that the defs of remaining names don't depend on omitted names checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check () checkRestrictedInheritance mos (name,mo) = do - let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll] -- names with restr. inh. + let irs = [ii | ii@(_,mi) <- mextend mo, mi /= MIAll] -- names with restr. inh. let mrs = [((i,m),mi) | (i,m) <- mos, Just mi <- [lookup i irs]] -- the restr. modules themself, with restr. infos mapM_ checkRem mrs @@ -90,7 +89,7 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do -- check that all abstract constants are in concrete; build default lin and lincats jsc <- foldM checkAbs jsc (tree2list jsa) - return (cm,replaceJudgements cnc jsc) + return (cm,cnc{jments=jsc}) where checkAbs js i@(c,info) = case info of diff --git a/src/compiler/GF/Compile/Coding.hs b/src/compiler/GF/Compile/Coding.hs index e7c90b850..1b8753afe 100644 --- a/src/compiler/GF/Compile/Coding.hs +++ b/src/compiler/GF/Compile/Coding.hs @@ -3,7 +3,6 @@ module GF.Compile.Coding where import GF.Grammar.Grammar import GF.Grammar.Macros import GF.Text.Coding -import GF.Infra.Modules import GF.Infra.Option import GF.Data.Operations @@ -18,7 +17,7 @@ decodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule decodeStringsInModule enc mo = codeSourceModule (decodeUnicode enc . BS.pack) mo codeSourceModule :: (String -> String) -> SourceModule -> SourceModule -codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo))) +codeSourceModule co (id,mo) = (id,mo{jments = mapTree codj (jments mo)}) where codj (c,info) = case info of ResOper pty pt -> ResOper (codeLTerms co pty) (codeLTerms co pt) diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs index 8732a8e06..af440ba0d 100644 --- a/src/compiler/GF/Compile/Compute/AppPredefined.hs +++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs @@ -17,7 +17,6 @@ module GF.Compile.Compute.AppPredefined ( ) where import GF.Infra.Ident -import GF.Infra.Modules import GF.Infra.Option import GF.Data.Operations import GF.Grammar diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs index c120ab03a..c5bdc8a75 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs +++ b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs @@ -18,7 +18,6 @@ import GF.Data.Operations import GF.Grammar.Grammar import GF.Infra.Ident import GF.Infra.Option -import GF.Infra.Modules import GF.Data.Str import GF.Grammar.ShowTerm import GF.Grammar.Printer diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index a3406dd0e..aaa4a2961 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -17,7 +17,6 @@ import PGF.Data hiding (Type) import GF.Infra.Option import GF.Grammar hiding (Env, mkRecord, mkTable) -import qualified GF.Infra.Modules as M import GF.Grammar.Lookup import GF.Grammar.Predef import GF.Data.BacktrackM @@ -53,21 +52,21 @@ convertConcrete opts0 gr am cm = do where (m,mo) = cm - opts = addOptions (M.flags (snd am)) opts0 + opts = addOptions (mflags (snd am)) opts0 pflindefs = [ ((m,id),term,lincat) | - (id,GF.Grammar.CncCat (Just (L _ lincat)) (Just (L _ term)) _) <- Map.toList (M.jments mo)] + (id,GF.Grammar.CncCat (Just (L _ lincat)) (Just (L _ term)) _) <- Map.toList (jments mo)] pfrules = [ (PFRule id args ([],res) (map (\(_,_,ty) -> ty) cont) val term) | - (id,GF.Grammar.CncFun (Just (cat,cont,val)) (Just (L _ term)) _) <- Map.toList (M.jments mo), + (id,GF.Grammar.CncFun (Just (cat,cont,val)) (Just (L _ term)) _) <- Map.toList (jments mo), let (ctxt,res,_) = err error typeForm (lookupFunType gr (fst am) id) args = [catSkeleton ty | (_,_,ty) <- ctxt]] - flags = Map.fromList [(mkCId f,LStr x) | (f,x) <- optionsPGF (M.flags mo)] + flags = Map.fromList [(mkCId f,LStr x) | (f,x) <- optionsPGF (mflags mo)] - printnames = Map.fromAscList [(i2i id, name) | (id,info) <- Map.toList (M.jments mo), name <- prn info] + printnames = Map.fromAscList [(i2i id, name) | (id,info) <- Map.toList (jments mo), name <- prn info] where prn (GF.Grammar.CncFun _ _ (Just (L _ tr))) = [flatten tr] prn (GF.Grammar.CncCat _ _ (Just (L _ tr))) = [flatten tr] @@ -519,7 +518,7 @@ emptyGrammarEnv gr (m,mo) = lincats = Map.insert cVar (Sort cStr) $ Map.fromAscList - [(c, ty) | (c,GF.Grammar.CncCat (Just (L _ ty)) _ _) <- Map.toList (M.jments mo)] + [(c, ty) | (c,GF.Grammar.CncCat (Just (L _ ty)) _ _) <- Map.toList (jments mo)] addApplication :: GrammarEnv -> FId -> (FunId,[FId]) -> GrammarEnv addApplication (GrammarEnv last_id catSet seqSet funSet lindefSet crcSet appSet prodSet) fid p = diff --git a/src/compiler/GF/Compile/GetGrammar.hs b/src/compiler/GF/Compile/GetGrammar.hs index 339f28578..914a19aac 100644 --- a/src/compiler/GF/Compile/GetGrammar.hs +++ b/src/compiler/GF/Compile/GetGrammar.hs @@ -12,12 +12,11 @@ -- this module builds the internal GF grammar that is sent to the type checker ----------------------------------------------------------------------------- -module GF.Compile.GetGrammar (getSourceModule, addOptionsToModule) where +module GF.Compile.GetGrammar (getSourceModule) where import GF.Data.Operations import GF.Infra.UseIO -import GF.Infra.Modules import GF.Infra.Option import GF.Grammar.Lexer import GF.Grammar.Parser @@ -40,16 +39,10 @@ getSourceModule opts file0 = ioe $ Left (Pn l c,msg) -> do file <- writeTemp tmp let location = file++":"++show l++":"++show c return (Bad (location++": "++msg)) - Right mo -> do removeTemp tmp - return (Ok (addOptionsToModule opts (setSrcPath file0 mo))) + Right (i,mi) -> do removeTemp tmp + return (Ok (i,mi{mflags=mflags mi `addOptions` opts, msrc=file0})) `catch` (return . Bad . show) -setSrcPath :: FilePath -> SourceModule -> SourceModule -setSrcPath fpath = mapSourceModule (\m -> m{msrc=fpath}) - -addOptionsToModule :: Options -> SourceModule -> SourceModule -addOptionsToModule opts = mapSourceModule (\m -> m { flags = flags m `addOptions` opts }) - runPreprocessor :: Temporary -> String -> IO Temporary runPreprocessor tmp0 p = maybe external internal (lookup p builtin_preprocessors) @@ -100,4 +93,4 @@ keepTemp tmp = Internal str -> return str removeTemp (Temp path) = removeFile path -removeTemp _ = return () \ No newline at end of file +removeTemp _ = return () diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs index 81d2b3632..06ececb3c 100644 --- a/src/compiler/GF/Compile/GrammarToPGF.hs +++ b/src/compiler/GF/Compile/GrammarToPGF.hs @@ -16,7 +16,6 @@ import qualified GF.Grammar.Lookup as Look import qualified GF.Grammar as A import qualified GF.Grammar.Macros as GM --import qualified GF.Compile.Compute.Concrete as Compute ---- -import qualified GF.Infra.Modules as M import qualified GF.Infra.Option as O import GF.Infra.Ident @@ -40,7 +39,7 @@ traceD s t = t mkCanon2pgf :: Options -> Ident -> SourceGrammar -> IO D.PGF mkCanon2pgf opts cnc gr = (canon2pgf opts gr . reorder abs) gr where - abs = err (const cnc) id $ M.abstractOfConcrete gr cnc + abs = err (const cnc) id $ abstractOfConcrete gr cnc -- Generate PGF from grammar. @@ -58,17 +57,17 @@ canon2pgf opts gr (am,cms) = do where mkAbstr (a,abm) = return (i2i a, D.Abstr flags funs cats) where - flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (M.flags abm)] + flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (mflags abm)] funs = Map.fromAscList [(i2i f, (mkType [] ty, mkArrity ma, mkDef pty, 0)) | - (f,AbsFun (Just (L _ ty)) ma pty _) <- Map.toAscList (M.jments abm)] + (f,AbsFun (Just (L _ ty)) ma pty _) <- Map.toAscList (jments abm)] cats = Map.fromAscList [(i2i c, (snd (mkContext [] cont),catfuns c)) | - (c,AbsCat (Just (L _ cont))) <- Map.toAscList (M.jments abm)] + (c,AbsCat (Just (L _ cont))) <- Map.toAscList (jments abm)] catfuns cat = (map (\x -> (0,snd x)) . sortBy (compare `on` fst)) - [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _ (Just True)) <- tree2list (M.jments abm), snd (GM.valCat ty) == cat] + [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _ (Just True)) <- tree2list (jments abm), snd (GM.valCat ty) == cat] mkConcr am cm@(lang,mo) = do cnc <- convertConcrete opts gr am cm @@ -154,12 +153,12 @@ compilePatt eqs = whilePP eqs Map.empty reorder :: Ident -> SourceGrammar -> AbsConcsGrammar reorder abs cg = -- M.MGrammar $ - ((abs, M.ModInfo M.MTAbstract M.MSComplete aflags [] Nothing [] [] "" adefs), - [(cnc, M.ModInfo (M.MTConcrete abs) M.MSComplete cflags [] Nothing [] [] "" cdefs) - | cnc <- M.allConcretes cg abs, let (cflags,cdefs) = concr cnc]) + ((abs, ModInfo MTAbstract MSComplete aflags [] Nothing [] [] "" adefs), + [(cnc, ModInfo (MTConcrete abs) MSComplete cflags [] Nothing [] [] "" cdefs) + | cnc <- allConcretes cg abs, let (cflags,cdefs) = concr cnc]) where aflags = - concatOptions (reverse [M.flags mo | (_,mo) <- M.modules cg, M.isModAbs mo]) + concatOptions (reverse [mflags mo | (_,mo) <- modules cg, isModAbs mo]) adefs = Map.fromList (predefADefs ++ Look.allOrigInfos cg abs) @@ -169,8 +168,8 @@ reorder abs cg = concr la = (flags, Map.fromList (predefCDefs ++ jments)) where - flags = concatOptions [M.flags mo | (i,mo) <- M.modules cg, M.isModCnc mo, - Just r <- [lookup i (M.allExtendSpecs cg la)]] + flags = concatOptions [mflags mo | (i,mo) <- modules cg, isModCnc mo, + Just r <- [lookup i (allExtendSpecs cg la)]] jments = Look.allOrigInfos cg la predefCDefs = [(c, CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing) | c <- [cInt,cFloat,cString]] diff --git a/src/compiler/GF/Compile/ModDeps.hs b/src/compiler/GF/Compile/ModDeps.hs index 1e689aabc..71d428290 100644 --- a/src/compiler/GF/Compile/ModDeps.hs +++ b/src/compiler/GF/Compile/ModDeps.hs @@ -68,17 +68,15 @@ moduleDeps :: [SourceModule] -> Err Dependencies moduleDeps ms = mapM deps ms where deps (c,m) = errIn ("checking dependencies of module" +++ prt c) $ case mtype m of MTConcrete a -> do - aty <- lookupModuleType gr a - testErr (aty == MTAbstract) "the of-module is not an abstract syntax" + am <- lookupModuleType gr a + testErr (mtype am == MTAbstract) "the of-module is not an abstract syntax" chDep (IdentM c (MTConcrete a)) (extends m) (MTConcrete a) (opens m) MTResource t -> chDep (IdentM c t) (extends m) t (opens m) t chDep it es ety os oty = do - ests <- mapM (lookupModuleType gr) es - testErr (all (compatMType ety) ests) "inappropriate extension module type" ----- osts <- mapM (lookupModuleType gr . openedModule) os ----- testErr (all (compatOType oty) osts) "inappropriate open module type" + ems <- mapM (lookupModuleType gr) es + testErr (all (compatMType ety . mtype) ests) "inappropriate extension module type" let ab = case it of IdentM _ (MTConcrete a) -> [IdentM a MTAbstract] _ -> [] ---- diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs index 95ee460ef..303bdb8d0 100644 --- a/src/compiler/GF/Compile/Optimize.hs +++ b/src/compiler/GF/Compile/Optimize.hs @@ -17,7 +17,6 @@ module GF.Compile.Optimize (optimizeModule) where import GF.Grammar.Grammar import GF.Infra.Ident -import GF.Infra.Modules import GF.Grammar.Printer import GF.Grammar.Macros import GF.Grammar.Lookup @@ -49,11 +48,11 @@ optimizeModule opts ms m@(name,mi) return (name,mi) | otherwise = return m where - oopts = opts `addOptions` flagsModule m + oopts = opts `addOptions` mflags mi updateEvalInfo mi (i,info) = do - info' <- evalInfo oopts ms (name,mi) i info - return (updateModule mi i info') + info <- evalInfo oopts ms (name,mi) i info + return (mi{jments=updateTree (i,info) (jments mi)}) evalInfo :: Options -> [SourceModule] -> SourceModule -> Ident -> Info -> Err Info evalInfo opts ms m c info = do diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs index 68f16a5d8..5c3ac660d 100644 --- a/src/compiler/GF/Compile/ReadFiles.hs +++ b/src/compiler/GF/Compile/ReadFiles.hs @@ -26,7 +26,6 @@ module GF.Compile.ReadFiles import GF.Infra.UseIO import GF.Infra.Option import GF.Infra.Ident -import GF.Infra.Modules import GF.Data.Operations import GF.Grammar.Lexer import GF.Grammar.Parser @@ -169,10 +168,10 @@ importsOfModule (m,mi) = (modName m,depModInfo mi []) where depModInfo mi = depModType (mtype mi) . - depExtends (extend mi) . + depExtends (mextend mi) . depWith (mwith mi) . depExDeps (mexdeps mi). - depOpens (opens mi) + depOpens (mopens mi) depModType (MTAbstract) xs = xs depModType (MTResource) xs = xs diff --git a/src/compiler/GF/Compile/Refresh.hs b/src/compiler/GF/Compile/Refresh.hs index 3780db2cf..86e423317 100644 --- a/src/compiler/GF/Compile/Refresh.hs +++ b/src/compiler/GF/Compile/Refresh.hs @@ -19,7 +19,6 @@ module GF.Compile.Refresh (refreshTerm, refreshTermN, import GF.Data.Operations import GF.Grammar.Grammar import GF.Infra.Ident -import GF.Infra.Modules import GF.Grammar.Macros import Control.Monad @@ -114,7 +113,7 @@ refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule] refreshModule (k,ms) mi@(i,mo) | isModCnc mo || isModRes mo = do (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo - return (k', (i, replaceJudgements mo (buildTree js')) : ms) + return (k', (i,mo{jments=buildTree js'}) : ms) | otherwise = return (k, mi:ms) where refreshRes (k,cs) ci@(c,info) = case info of diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs index 4c959c194..805e85464 100644 --- a/src/compiler/GF/Compile/Rename.hs +++ b/src/compiler/GF/Compile/Rename.hs @@ -31,7 +31,6 @@ module GF.Compile.Rename ( import GF.Grammar.Grammar import GF.Grammar.Values import GF.Grammar.Predef -import GF.Infra.Modules import GF.Infra.Ident import GF.Infra.CheckM import GF.Grammar.Macros @@ -63,7 +62,7 @@ renameModule :: [SourceModule] -> SourceModule -> Check SourceModule renameModule ms mo@(m,mi) = checkIn (text "renaming module" <+> ppIdent m) $ do status <- buildStatus (mGrammar ms) m mi js <- checkMap (renameInfo status mo) (jments mi) - return (m, mi{opens = map forceQualif (opens mi), jments = js}) + return (m, mi{mopens = map forceQualif (mopens mi), jments = js}) type Status = (StatusTree, [(OpenSpec, StatusTree)]) @@ -129,7 +128,7 @@ tree2status o = case o of buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Check Status buildStatus gr c mo = let mo' = self2status c mo in do let gr1 = prependModule gr (c,mo) - ops = [OSimple e | e <- allExtends gr1 c] ++ opens mo + ops = [OSimple e | e <- allExtends gr1 c] ++ mopens mo mods <- checkErr $ mapM (lookupModule gr1 . openedModule) ops let sts = map modInfo2status $ zip ops mods return $ if isModCnc mo diff --git a/src/compiler/GF/Compile/SubExOpt.hs b/src/compiler/GF/Compile/SubExOpt.hs index 808e4dca8..453c8e3ca 100644 --- a/src/compiler/GF/Compile/SubExOpt.hs +++ b/src/compiler/GF/Compile/SubExOpt.hs @@ -27,7 +27,6 @@ import GF.Grammar.Grammar import GF.Grammar.Lookup import GF.Infra.Ident import qualified GF.Grammar.Macros as C -import qualified GF.Infra.Modules as M import GF.Data.Operations import Control.Monad @@ -38,17 +37,17 @@ import Data.List subexpModule :: SourceModule -> SourceModule subexpModule (n,mo) = errVal (n,mo) $ do - let ljs = tree2list (M.jments mo) + let ljs = tree2list (jments mo) (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0) js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs - return (n,M.replaceJudgements mo js2) + return (n,mo{jments=js2}) unsubexpModule :: SourceModule -> SourceModule unsubexpModule sm@(i,mo) - | hasSub ljs = (i,M.replaceJudgements mo (rebuild (map unparInfo ljs))) + | hasSub ljs = (i,mo{jments=rebuild (map unparInfo ljs)}) | otherwise = sm where - ljs = tree2list (M.jments mo) + ljs = tree2list (jments mo) -- perform this iff the module has opers hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs] @@ -61,7 +60,7 @@ unsubexpModule sm@(i,mo) Q (m,c) | isOperIdent c -> --- name convention of subexp opers errVal t $ liftM unparTerm $ lookupResDef gr (m,c) _ -> C.composSafeOp unparTerm t - gr = M.mGrammar [sm] + gr = mGrammar [sm] rebuild = buildTree . concat -- implementation diff --git a/src/compiler/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/GF/Compile/TypeCheck/Concrete.hs index 59d045a4c..bad122db2 100644 --- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs +++ b/src/compiler/GF/Compile/TypeCheck/Concrete.hs @@ -2,7 +2,6 @@ module GF.Compile.TypeCheck.Concrete( checkLType, inferLType, computeLType, ppType ) where import GF.Infra.CheckM -import GF.Infra.Modules import GF.Data.Operations import GF.Grammar diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs index fe9bd5984..2a95df4d5 100644 --- a/src/compiler/GF/Compile/Update.hs +++ b/src/compiler/GF/Compile/Update.hs @@ -18,7 +18,6 @@ import GF.Infra.Ident import GF.Grammar.Grammar import GF.Grammar.Printer import GF.Grammar.Lookup -import GF.Infra.Modules import GF.Infra.Option import GF.Data.Operations @@ -50,7 +49,7 @@ extendModule gr (name,m) ---- compiled anyway), extensions are not built for them. ---- Should be replaced by real control. AR 4/2/2005 | mstatus m == MSIncomplete && isModCnc m = return (name,m) - | otherwise = do m' <- foldM extOne m (extend m) + | otherwise = do m' <- foldM extOne m (mextend m) return (name,m') where extOne mo (n,cond) = do @@ -69,7 +68,7 @@ extendModule gr (name,m) return $ if isCompl then mo {jments = js1} - else mo {extend = filter ((/=n) . fst) (extend mo) + else mo {mextend= filter ((/=n) . fst) (mextend mo) ,mexdeps= nub (n : mexdeps mo) ,jments = js1 } @@ -95,12 +94,12 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ src_ js_)) = do js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi) --- to avoid double inclusions, in instance I of I0 = J0 ** ... case extends mi of - [] -> return $ replaceJudgements mi js' + [] -> return mi{jments=js'} j0s -> do m0s <- mapM (lookupModule gr) j0s let notInM0 c _ = all (not . isInBinTree c . jments) m0s let js2 = filterBinTree notInM0 js' - return $ replaceJudgements mi js2 + return mi{jments=js2} _ -> return mi -- add the instance opens to an incomplete module "with" instances -- cgit v1.2.3