From 3bfcfa157dc291e03bfb4db3baed8b0098d76f50 Mon Sep 17 00:00:00 2001 From: hallgren Date: Tue, 21 Oct 2014 14:42:31 +0000 Subject: [PATCH] Renaming SourceGrammar to Grammar and similarly for some related types Included renamings: SourceGrammar -> Grammar SourceModule -> Module SourceModInfo -> ModuleInfo emptySourceGrammar -> emptyGrammar Also introduces a type synonym (which might be good to turn into a newtype): type ModuleName = Ident The reason is to make types like the following more self documenting: type Module = (ModuleName,ModuleInfo) type QIdent = (ModuleName,Ident) --- src/compiler/GF.hs | 4 +- src/compiler/GF/Compile.hs | 12 ++-- src/compiler/GF/CompileInParallel.hs | 4 +- src/compiler/GF/CompileOne.hs | 10 +-- src/compiler/GF/Grammar/Binary.hs | 4 +- src/compiler/GF/Grammar/Grammar.hs | 91 ++++++++++++++-------------- src/compiler/GF/Grammar/Printer.hs | 2 +- src/compiler/GF/Infra/Location.hs | 3 + src/compiler/GF/Interactive.hs | 12 ++-- 9 files changed, 75 insertions(+), 67 deletions(-) diff --git a/src/compiler/GF.hs b/src/compiler/GF.hs index dd5cc8b31..6fff0b3cb 100644 --- a/src/compiler/GF.hs +++ b/src/compiler/GF.hs @@ -19,6 +19,7 @@ module GF( module GF.Grammar.Binary, -- * Supporting infrastructure and system utilities + module GF.Infra.Location, module GF.Data.Operations, module GF.Infra.UseIO, module GF.Infra.Option, @@ -41,8 +42,9 @@ import GF.Grammar.Printer import GF.Infra.Ident import GF.Grammar.Binary +import GF.Infra.Location import GF.Data.Operations import GF.Infra.Option import GF.Infra.UseIO import GF.System.Console -import Data.Binary \ No newline at end of file +import Data.Binary diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs index 2eed7a6ff..6e7c84ce2 100644 --- a/src/compiler/GF/Compile.hs +++ b/src/compiler/GF/Compile.hs @@ -5,7 +5,7 @@ import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles, importsOfModule) import GF.CompileOne(compileOne) -import GF.Grammar.Grammar(SourceGrammar,emptySourceGrammar, +import GF.Grammar.Grammar(Grammar,emptyGrammar, abstractOfConcrete,prependModule)--,msrc,modules import GF.Infra.Ident(Ident,identS)--,showIdent @@ -32,7 +32,7 @@ compileToPGF opts fs = link opts =<< batchCompile opts fs -- | Link a grammar into a 'PGF' that can be used to 'PGF.linearize' and -- 'PGF.parse' with the "PGF" run-time system. -link :: Options -> (Ident,t,SourceGrammar) -> IOE PGF +link :: Options -> (Ident,t,Grammar) -> IOE PGF link opts (cnc,_,gr) = putPointE Normal opts "linking ... " $ do let abs = srcAbsName gr cnc @@ -46,7 +46,7 @@ link opts (cnc,_,gr) = srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc -- | Compile the given grammar files and everything they depend on -batchCompile :: Options -> [FilePath] -> IOE (Ident,UTCTime,SourceGrammar) +batchCompile :: Options -> [FilePath] -> IOE (Ident,UTCTime,Grammar) batchCompile opts files = do (gr,menv) <- foldM (compileModule opts) emptyCompileEnv files let cnc = identS (justModuleName (last files)) @@ -54,7 +54,7 @@ batchCompile opts files = do return (cnc,t,gr) {- -- to compile a set of modules, e.g. an old GF or a .cf file -compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar +compileSourceGrammar :: Options -> Grammar -> IOE Grammar compileSourceGrammar opts gr = do cwd <- getCurrentDirectory (_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing) @@ -104,10 +104,10 @@ compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr -- auxiliaries -- | The environment -type CompileEnv = (SourceGrammar,ModEnv) +type CompileEnv = (Grammar,ModEnv) emptyCompileEnv :: CompileEnv -emptyCompileEnv = (emptySourceGrammar,Map.empty) +emptyCompileEnv = (emptyGrammar,Map.empty) extendCompileEnv (gr,menv) (mfile,mo) = do menv2 <- case mfile of diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs index 52aab40f6..53f68c3a4 100644 --- a/src/compiler/GF/CompileInParallel.hs +++ b/src/compiler/GF/CompileInParallel.hs @@ -14,7 +14,7 @@ import GF.CompileOne(reuseGFO,useTheSource) import GF.Infra.Option import GF.Infra.UseIO import GF.Data.Operations -import GF.Grammar.Grammar(emptySourceGrammar,prependModule) +import GF.Grammar.Grammar(emptyGrammar,prependModule) import GF.Infra.Ident(identS) import GF.Text.Pretty import qualified Data.ByteString.Lazy as BS @@ -85,7 +85,7 @@ batchCompile1 lib_dir (opts,filepaths) = good (o,r) = do toLog o; return r bad e = do toLog (redPutStrLn e); fail "failed" redPutStrLn s = do ePutStr "\ESC[31m";ePutStr s;ePutStrLn "\ESC[m" - sgr <- liftIO $ newMVar emptySourceGrammar + sgr <- liftIO $ newMVar emptyGrammar let extendSgr sgr m = modifyMVar_ sgr $ \ gr -> do let gr' = prependModule gr m diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs index 17ef93935..3851b1f79 100644 --- a/src/compiler/GF/CompileOne.hs +++ b/src/compiler/GF/CompileOne.hs @@ -29,14 +29,14 @@ import GF.Text.Pretty(render,(<+>),($$)) --Doc, import Control.Monad((<=<)) type OneOutput = (Maybe FullPath,CompiledModule) -type CompiledModule = SourceModule +type CompiledModule = Module compileOne, reuseGFO, useTheSource :: (Output m,ErrorMonad m,MonadIO m) => - Options -> SourceGrammar -> FullPath -> m OneOutput + Options -> Grammar -> FullPath -> m OneOutput -- | Compile a given source file (or just load a .gfo file), --- given a 'SourceGrammar' containing everything it depends on. +-- given a 'Grammar' containing everything it depends on. -- Calls 'reuseGFO' or 'useTheSource'. compileOne opts srcgr file = if isGFO file @@ -66,7 +66,7 @@ reuseGFO opts srcgr file = return (Just file,sm) ---useTheSource :: Options -> SourceGrammar -> FullPath -> IOE OneOutput +--useTheSource :: Options -> Grammar -> FullPath -> IOE OneOutput -- | Compile GF module from source. It both returns the result and -- stores it in a @.gfo@ file -- (or a tags file, if running with the @-tags@ option) @@ -83,7 +83,7 @@ useTheSource opts srcgr file = | verbAtLeast opts Normal = putStrE m >> act | otherwise = putPointE Verbose opts v act -type CompileSource = SourceGrammar -> SourceModule -> IOE OneOutput +type CompileSource = Grammar -> Module -> IOE OneOutput --compileSourceModule :: Options -> FilePath -> Maybe FilePath -> CompileSource compileSourceModule opts cwd mb_gfFile gr = diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs index 1bdadabd6..76c3796bc 100644 --- a/src/compiler/GF/Grammar/Binary.hs +++ b/src/compiler/GF/Grammar/Binary.hs @@ -37,11 +37,11 @@ instance Binary Ident where then return identW else return (identC (rawIdentC bs)) -instance Binary SourceGrammar where +instance Binary Grammar where put = put . modules get = fmap mGrammar get -instance Binary SourceModInfo where +instance Binary ModuleInfo where put mi = do put (mtype mi,mstatus mi,mflags mi,mextend mi,mwith mi,mopens mi,mexdeps mi,msrc mi,mseqs mi,jments mi) get = do (mtype,mstatus,mflags,mextend,mwith,mopens,med,msrc,mseqs,jments) <- get return (ModInfo mtype mstatus mflags mextend mwith mopens med msrc mseqs jments) diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs index 36904c579..e9bf24046 100644 --- a/src/compiler/GF/Grammar/Grammar.hs +++ b/src/compiler/GF/Grammar/Grammar.hs @@ -16,8 +16,10 @@ module GF.Grammar.Grammar ( -- ** Grammar modules - SourceGrammar, SourceModInfo(..), SourceModule, ModuleType(..), - emptySourceGrammar, mGrammar, modules, prependModule, moduleMap, + Grammar, ModuleName, Module, ModuleInfo(..), + SourceGrammar, SourceModInfo, SourceModule, + ModuleType(..), + emptyGrammar, mGrammar, modules, prependModule, moduleMap, MInclude (..), OpenSpec(..), extends, isInherited, inheritAll, @@ -72,29 +74,27 @@ import GF.Data.Operations import PGF.Internal (FId, FunId, SeqId, LIndex, Sequence, BindType(..)) ---import Data.List -import Data.Array.IArray -import Data.Array.Unboxed +import Data.Array.IArray(Array) +import Data.Array.Unboxed(UArray) import qualified Data.Map as Map ---import qualified Data.Set as Set ---import qualified Data.IntMap as IntMap import GF.Text.Pretty ---import System.FilePath ---import Control.Monad.Identity - -data SourceGrammar = MGrammar { - moduleMap :: Map.Map Ident SourceModInfo, - modules :: [SourceModule] +-- ^ A grammar is a self-contained collection of grammar modules +data Grammar = MGrammar { + moduleMap :: Map.Map ModuleName ModuleInfo, + modules :: [Module] } -data SourceModInfo = ModInfo { +type ModuleName = Ident +type Module = (ModuleName, ModuleInfo) + +data ModuleInfo = ModInfo { mtype :: ModuleType, mstatus :: ModuleStatus, mflags :: Options, - mextend :: [(Ident,MInclude)], - mwith :: Maybe (Ident,MInclude,[(Ident,Ident)]), + mextend :: [(ModuleName,MInclude)], + mwith :: Maybe (ModuleName,MInclude,[(ModuleName,ModuleName)]), mopens :: [OpenSpec], mexdeps :: [Ident], msrc :: FilePath, @@ -102,9 +102,11 @@ data SourceModInfo = ModInfo { jments :: Map.Map Ident Info } -instance HasSourcePath SourceModInfo where sourcePath = msrc +type SourceGrammar = Grammar +type SourceModule = Module +type SourceModInfo = ModuleInfo -type SourceModule = (Ident, SourceModInfo) +instance HasSourcePath ModuleInfo where sourcePath = msrc -- | encoding the type of the module data ModuleType = @@ -118,7 +120,7 @@ data ModuleType = data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident] deriving (Eq,Show) -extends :: SourceModInfo -> [Ident] +extends :: ModuleInfo -> [ModuleName] extends = map fst . mextend isInherited :: MInclude -> Ident -> Bool @@ -127,12 +129,12 @@ isInherited c i = case c of MIOnly is -> elem i is MIExcept is -> notElem i is -inheritAll :: Ident -> (Ident,MInclude) +inheritAll :: ModuleName -> (ModuleName,MInclude) inheritAll i = (i,MIAll) data OpenSpec = - OSimple Ident - | OQualif Ident Ident + OSimple ModuleName + | OQualif ModuleName ModuleName deriving (Eq,Show) data ModuleStatus = @@ -146,7 +148,7 @@ openedModule o = case o of OQualif _ m -> m -- | initial dependency list -depPathModule :: SourceModInfo -> [OpenSpec] +depPathModule :: ModuleInfo -> [OpenSpec] depPathModule m = fors m ++ exts m ++ mopens m where fors m = @@ -157,7 +159,7 @@ depPathModule m = fors m ++ exts m ++ mopens m exts m = map OSimple (extends m) -- | all dependencies -allDepsModule :: SourceGrammar -> SourceModInfo -> [OpenSpec] +allDepsModule :: Grammar -> ModuleInfo -> [OpenSpec] allDepsModule gr m = iterFix add os0 where os0 = depPathModule m add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], @@ -165,21 +167,21 @@ allDepsModule gr m = iterFix add os0 where mods = modules gr -- | select just those modules that a given one depends on, including itself -partOfGrammar :: SourceGrammar -> (Ident,SourceModInfo) -> SourceGrammar +partOfGrammar :: Grammar -> (Ident,ModuleInfo) -> Grammar partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor] where mods = modules gr modsFor = (i:) $ map openedModule $ allDepsModule gr m -- | all modules that a module extends, directly or indirectly, with restricts -allExtends :: SourceGrammar -> Ident -> [SourceModule] +allExtends :: Grammar -> Ident -> [Module] allExtends gr m = case lookupModule gr m of Ok mi -> (m,mi) : concatMap (allExtends gr . fst) (mextend mi) _ -> [] -- | the same as 'allExtends' plus that an instance extends its interface -allExtendsPlus :: SourceGrammar -> Ident -> [Ident] +allExtendsPlus :: Grammar -> ModuleName -> [ModuleName] allExtendsPlus gr i = case lookupModule gr i of Ok m -> i : concatMap (allExtendsPlus gr) (exts m) @@ -188,38 +190,39 @@ allExtendsPlus gr i = exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]] -- | initial search path: the nonqualified dependencies -searchPathModule :: SourceModInfo -> [Ident] +searchPathModule :: ModuleInfo -> [ModuleName] searchPathModule m = [i | OSimple i <- depPathModule m] +prependModule :: Grammar -> Module -> Grammar prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms) -emptySourceGrammar :: SourceGrammar -emptySourceGrammar = mGrammar [] +emptyGrammar = mGrammar [] +mGrammar :: [Module] -> Grammar mGrammar ms = MGrammar (Map.fromList ms) ms -- | we store the module type with the identifier -abstractOfConcrete :: ErrorMonad m => SourceGrammar -> Ident -> m Ident +abstractOfConcrete :: ErrorMonad m => Grammar -> ModuleName -> m ModuleName abstractOfConcrete gr c = do n <- lookupModule gr c case mtype n of MTConcrete a -> return a _ -> raise $ render ("expected concrete" <+> c) -lookupModule :: ErrorMonad m => SourceGrammar -> Ident -> m SourceModInfo +lookupModule :: ErrorMonad m => Grammar -> ModuleName -> m ModuleInfo lookupModule gr m = case Map.lookup m (moduleMap gr) of Just i -> return i Nothing -> raise $ render ("unknown module" <+> m <+> "among" <+> hsep (map fst (modules gr))) -isModAbs :: SourceModInfo -> Bool +isModAbs :: ModuleInfo -> Bool isModAbs m = case mtype m of MTAbstract -> True _ -> False -isModRes :: SourceModInfo -> Bool +isModRes :: ModuleInfo -> Bool isModRes m = case mtype m of MTResource -> True @@ -227,7 +230,7 @@ isModRes m = MTInstance _ -> True _ -> False -isModCnc :: SourceModInfo -> Bool +isModCnc :: ModuleInfo -> Bool isModCnc m = case mtype m of MTConcrete _ -> True @@ -253,49 +256,49 @@ sameMType m n = _ -> m == n -- | don't generate code for interfaces and for incomplete modules -isCompilableModule :: SourceModInfo -> Bool +isCompilableModule :: ModuleInfo -> Bool isCompilableModule m = case mtype m of MTInterface -> False _ -> mstatus m == MSComplete -- | interface and "incomplete M" are not complete -isCompleteModule :: SourceModInfo -> Bool +isCompleteModule :: ModuleInfo -> Bool isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface -- | all abstract modules sorted from least to most dependent -allAbstracts :: SourceGrammar -> [Ident] +allAbstracts :: Grammar -> [ModuleName] allAbstracts gr = case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of Left is -> is Right cycles -> error $ render ("Cyclic abstract modules:" <+> vcat (map hsep cycles)) -- | the last abstract in dependency order (head of list) -greatestAbstract :: SourceGrammar -> Maybe Ident +greatestAbstract :: Grammar -> Maybe ModuleName greatestAbstract gr = case allAbstracts gr of [] -> Nothing as -> return $ last as -- | all resource modules -allResources :: SourceGrammar -> [Ident] +allResources :: Grammar -> [ModuleName] allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m] -- | the greatest resource in dependency order -greatestResource :: SourceGrammar -> Maybe Ident +greatestResource :: Grammar -> Maybe ModuleName greatestResource gr = case allResources gr of [] -> Nothing a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008 -- | all concretes for a given abstract -allConcretes :: SourceGrammar -> Ident -> [Ident] +allConcretes :: Grammar -> ModuleName -> [ModuleName] allConcretes gr a = [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m] -- | all concrete modules for any abstract -allConcreteModules :: SourceGrammar -> [Ident] +allConcreteModules :: Grammar -> [ModuleName] allConcreteModules gr = [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m] @@ -342,7 +345,7 @@ type Type = Term type Cat = QIdent type Fun = QIdent -type QIdent = (Ident,Ident) +type QIdent = (ModuleName,Ident) data Term = Vr Ident -- ^ variable diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs index 63603c5f8..0bf6ce504 100644 --- a/src/compiler/GF/Grammar/Printer.hs +++ b/src/compiler/GF/Grammar/Printer.hs @@ -41,7 +41,7 @@ data TermPrintQual = Unqualified | Qualified | Internal deriving Eq -instance Pretty SourceGrammar where +instance Pretty Grammar where pp = vcat . map (ppModule Qualified) . modules ppModule :: TermPrintQual -> SourceModule -> Doc diff --git a/src/compiler/GF/Infra/Location.hs b/src/compiler/GF/Infra/Location.hs index b38482ff9..36bfab044 100644 --- a/src/compiler/GF/Infra/Location.hs +++ b/src/compiler/GF/Infra/Location.hs @@ -1,6 +1,9 @@ +-- | Source locations module GF.Infra.Location where import GF.Text.Pretty +-- ** Source locations + class HasSourcePath a where sourcePath :: a -> FilePath data Location diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs index 2af5b092b..bcef32294 100644 --- a/src/compiler/GF/Interactive.hs +++ b/src/compiler/GF/Interactive.hs @@ -153,7 +153,7 @@ execute1 opts gfenv0 s0 = continue = return . Just stop = return Nothing env = commandenv gfenv0 - sgr = sourcegrammar gfenv0 + sgr = grammar gfenv0 gfenv = gfenv0 {history = s0 : history gfenv0} pwords s = case words s of w:ws -> getCommandOp w :ws @@ -280,7 +280,7 @@ execute1 opts gfenv0 s0 = continue gfenv' empty = continue $ gfenv { - commandenv=emptyCommandEnv, sourcegrammar = emptySourceGrammar + commandenv=emptyCommandEnv, grammar = emptyGrammar } define_command (f:ws) = @@ -355,8 +355,8 @@ fetchCommand gfenv = do importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv importInEnv gfenv opts files | flag optRetainResource opts = - do src <- importSource (sourcegrammar gfenv) opts files - return $ gfenv {sourcegrammar = src} + do src <- importSource (grammar gfenv) opts files + return $ gfenv {grammar = src} | otherwise = do let opts' = addOptions (setOptimization OptCSE False) opts pgf0 = multigrammar (commandenv gfenv) @@ -398,14 +398,14 @@ prompt env abs = abstractName (multigrammar env) data GFEnv = GFEnv { - sourcegrammar :: SourceGrammar, -- gfo grammar -retain + grammar :: Grammar, -- gfo grammar -retain commandenv :: CommandEnv, history :: [String] } emptyGFEnv :: GFEnv emptyGFEnv = - GFEnv emptySourceGrammar (mkCommandEnv emptyPGF) [] {-0-} + GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] {-0-} wordCompletion gfenv (left,right) = do case wc_type (reverse left) of