summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/compiler/GF.hs4
-rw-r--r--src/compiler/GF/Compile.hs12
-rw-r--r--src/compiler/GF/CompileInParallel.hs4
-rw-r--r--src/compiler/GF/CompileOne.hs10
-rw-r--r--src/compiler/GF/Grammar/Binary.hs4
-rw-r--r--src/compiler/GF/Grammar/Grammar.hs91
-rw-r--r--src/compiler/GF/Grammar/Printer.hs2
-rw-r--r--src/compiler/GF/Infra/Location.hs3
-rw-r--r--src/compiler/GF/Interactive.hs12
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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 13:21:55 +0000