forked from GitHub/gf-core
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)
This commit is contained in:
@@ -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
|
||||
import Data.Binary
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user