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

Renaming SourceGrammar to Grammar and similarly for some related types

Browse Source 
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:
hallgren
2014-10-21 14:42:31 +00:00
parent f6441b2292
commit 3bfcfa157d
9 changed files with 75 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF.hs
View File

@@ -19,6 +19,7 @@ module GF(
module GF.Grammar.Binary, module GF.Grammar.Binary,
-- * Supporting infrastructure and system utilities -- * Supporting infrastructure and system utilities
module GF.Infra.Location,
module GF.Data.Operations, module GF.Data.Operations,
module GF.Infra.UseIO, module GF.Infra.UseIO,
module GF.Infra.Option, module GF.Infra.Option,
@@ -41,8 +42,9 @@ import GF.Grammar.Printer
import GF.Infra.Ident import GF.Infra.Ident
import GF.Grammar.Binary import GF.Grammar.Binary
import GF.Infra.Location
import GF.Data.Operations import GF.Data.Operations
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.UseIO import GF.Infra.UseIO
import GF.System.Console import GF.System.Console
import Data.Binary import Data.Binary

12
src/compiler/GF/Compile.hs
View File

@@ -5,7 +5,7 @@ import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
importsOfModule) importsOfModule)
import GF.CompileOne(compileOne) import GF.CompileOne(compileOne)
import GF.Grammar.Grammar(SourceGrammar,emptySourceGrammar, import GF.Grammar.Grammar(Grammar,emptyGrammar,
abstractOfConcrete,prependModule)--,msrc,modules abstractOfConcrete,prependModule)--,msrc,modules
import GF.Infra.Ident(Ident,identS)--,showIdent 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 -- | Link a grammar into a 'PGF' that can be used to 'PGF.linearize' and
-- 'PGF.parse' with the "PGF" run-time system. -- '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) = link opts (cnc,_,gr) =
putPointE Normal opts "linking ... " $ do putPointE Normal opts "linking ... " $ do
let abs = srcAbsName gr cnc let abs = srcAbsName gr cnc
@@ -46,7 +46,7 @@ link opts (cnc,_,gr) =
srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc
-- | Compile the given grammar files and everything they depend on -- | 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 batchCompile opts files = do
(gr,menv) <- foldM (compileModule opts) emptyCompileEnv files (gr,menv) <- foldM (compileModule opts) emptyCompileEnv files
let cnc = identS (justModuleName (last files)) let cnc = identS (justModuleName (last files))
@@ -54,7 +54,7 @@ batchCompile opts files = do
return (cnc,t,gr) return (cnc,t,gr)
{- {-
-- to compile a set of modules, e.g. an old GF or a .cf file -- 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 compileSourceGrammar opts gr = do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
(_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing) (_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing)
@@ -104,10 +104,10 @@ compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr
-- auxiliaries -- auxiliaries
-- | The environment -- | The environment
type CompileEnv = (SourceGrammar,ModEnv) type CompileEnv = (Grammar,ModEnv)
emptyCompileEnv :: CompileEnv emptyCompileEnv :: CompileEnv
emptyCompileEnv = (emptySourceGrammar,Map.empty) emptyCompileEnv = (emptyGrammar,Map.empty)
extendCompileEnv (gr,menv) (mfile,mo) = extendCompileEnv (gr,menv) (mfile,mo) =
do menv2 <- case mfile of do menv2 <- case mfile of

4
src/compiler/GF/CompileInParallel.hs
View File

@@ -14,7 +14,7 @@ import GF.CompileOne(reuseGFO,useTheSource)
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.UseIO import GF.Infra.UseIO
import GF.Data.Operations import GF.Data.Operations
import GF.Grammar.Grammar(emptySourceGrammar,prependModule) import GF.Grammar.Grammar(emptyGrammar,prependModule)
import GF.Infra.Ident(identS) import GF.Infra.Ident(identS)
import GF.Text.Pretty import GF.Text.Pretty
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
@@ -85,7 +85,7 @@ batchCompile1 lib_dir (opts,filepaths) =
good (o,r) = do toLog o; return r good (o,r) = do toLog o; return r
bad e = do toLog (redPutStrLn e); fail "failed" bad e = do toLog (redPutStrLn e); fail "failed"
redPutStrLn s = do ePutStr "\ESC[31m";ePutStr s;ePutStrLn "\ESC[m" redPutStrLn s = do ePutStr "\ESC[31m";ePutStr s;ePutStrLn "\ESC[m"
sgr <- liftIO $ newMVar emptySourceGrammar sgr <- liftIO $ newMVar emptyGrammar
let extendSgr sgr m = let extendSgr sgr m =
modifyMVar_ sgr $ \ gr -> modifyMVar_ sgr $ \ gr ->
do let gr' = prependModule gr m do let gr' = prependModule gr m

10
src/compiler/GF/CompileOne.hs
View File

@@ -29,14 +29,14 @@ import GF.Text.Pretty(render,(<+>),($$)) --Doc,
import Control.Monad((<=<)) import Control.Monad((<=<))
type OneOutput = (Maybe FullPath,CompiledModule) type OneOutput = (Maybe FullPath,CompiledModule)
type CompiledModule = SourceModule type CompiledModule = Module
compileOne, reuseGFO, useTheSource :: compileOne, reuseGFO, useTheSource ::
(Output m,ErrorMonad m,MonadIO m) => (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), -- | 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'. -- Calls 'reuseGFO' or 'useTheSource'.
compileOne opts srcgr file = compileOne opts srcgr file =
if isGFO file if isGFO file
@@ -66,7 +66,7 @@ reuseGFO opts srcgr file =
return (Just file,sm) 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 -- | Compile GF module from source. It both returns the result and
-- stores it in a @.gfo@ file -- stores it in a @.gfo@ file
-- (or a tags file, if running with the @-tags@ option) -- (or a tags file, if running with the @-tags@ option)
@@ -83,7 +83,7 @@ useTheSource opts srcgr file =
| verbAtLeast opts Normal = putStrE m >> act | verbAtLeast opts Normal = putStrE m >> act
| otherwise = putPointE Verbose opts v 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 :: Options -> FilePath -> Maybe FilePath -> CompileSource
compileSourceModule opts cwd mb_gfFile gr = compileSourceModule opts cwd mb_gfFile gr =

4
src/compiler/GF/Grammar/Binary.hs
View File

@@ -37,11 +37,11 @@ instance Binary Ident where
then return identW then return identW
else return (identC (rawIdentC bs)) else return (identC (rawIdentC bs))
instance Binary SourceGrammar where instance Binary Grammar where
put = put . modules put = put . modules
get = fmap mGrammar get 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) 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 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) return (ModInfo mtype mstatus mflags mextend mwith mopens med msrc mseqs jments)

91
src/compiler/GF/Grammar/Grammar.hs
View File

@@ -16,8 +16,10 @@
module GF.Grammar.Grammar ( module GF.Grammar.Grammar (
-- ** Grammar modules -- ** Grammar modules
SourceGrammar, SourceModInfo(..), SourceModule, ModuleType(..), Grammar, ModuleName, Module, ModuleInfo(..),
emptySourceGrammar, mGrammar, modules, prependModule, moduleMap, SourceGrammar, SourceModInfo, SourceModule,
ModuleType(..),
emptyGrammar, mGrammar, modules, prependModule, moduleMap,
MInclude (..), OpenSpec(..), MInclude (..), OpenSpec(..),
extends, isInherited, inheritAll, extends, isInherited, inheritAll,
@@ -72,29 +74,27 @@ import GF.Data.Operations
import PGF.Internal (FId, FunId, SeqId, LIndex, Sequence, BindType(..)) import PGF.Internal (FId, FunId, SeqId, LIndex, Sequence, BindType(..))
--import Data.List import Data.Array.IArray(Array)
import Data.Array.IArray import Data.Array.Unboxed(UArray)
import Data.Array.Unboxed
import qualified Data.Map as Map import qualified Data.Map as Map
--import qualified Data.Set as Set
--import qualified Data.IntMap as IntMap
import GF.Text.Pretty import GF.Text.Pretty
--import System.FilePath
--import Control.Monad.Identity
-- ^ A grammar is a self-contained collection of grammar modules
data SourceGrammar = MGrammar { data Grammar = MGrammar {
moduleMap :: Map.Map Ident SourceModInfo, moduleMap :: Map.Map ModuleName ModuleInfo,
modules :: [SourceModule] modules :: [Module]
} }
data SourceModInfo = ModInfo { type ModuleName = Ident
type Module = (ModuleName, ModuleInfo)
data ModuleInfo = ModInfo {
mtype :: ModuleType, mtype :: ModuleType,
mstatus :: ModuleStatus, mstatus :: ModuleStatus,
mflags :: Options, mflags :: Options,
mextend :: [(Ident,MInclude)], mextend :: [(ModuleName,MInclude)],
mwith :: Maybe (Ident,MInclude,[(Ident,Ident)]), mwith :: Maybe (ModuleName,MInclude,[(ModuleName,ModuleName)]),
mopens :: [OpenSpec], mopens :: [OpenSpec],
mexdeps :: [Ident], mexdeps :: [Ident],
msrc :: FilePath, msrc :: FilePath,
@@ -102,9 +102,11 @@ data SourceModInfo = ModInfo {
jments :: Map.Map Ident Info 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 -- | encoding the type of the module
data ModuleType = data ModuleType =
@@ -118,7 +120,7 @@ data ModuleType =
data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident] data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
deriving (Eq,Show) deriving (Eq,Show)
extends :: SourceModInfo -> [Ident] extends :: ModuleInfo -> [ModuleName]
extends = map fst . mextend extends = map fst . mextend
isInherited :: MInclude -> Ident -> Bool isInherited :: MInclude -> Ident -> Bool
@@ -127,12 +129,12 @@ isInherited c i = case c of
MIOnly is -> elem i is MIOnly is -> elem i is
MIExcept is -> notElem i is MIExcept is -> notElem i is
inheritAll :: Ident -> (Ident,MInclude) inheritAll :: ModuleName -> (ModuleName,MInclude)
inheritAll i = (i,MIAll) inheritAll i = (i,MIAll)
data OpenSpec = data OpenSpec =
OSimple Ident OSimple ModuleName
| OQualif Ident Ident | OQualif ModuleName ModuleName
deriving (Eq,Show) deriving (Eq,Show)
data ModuleStatus = data ModuleStatus =
@@ -146,7 +148,7 @@ openedModule o = case o of
OQualif _ m -> m OQualif _ m -> m
-- | initial dependency list -- | initial dependency list
depPathModule :: SourceModInfo -> [OpenSpec] depPathModule :: ModuleInfo -> [OpenSpec]
depPathModule m = fors m ++ exts m ++ mopens m depPathModule m = fors m ++ exts m ++ mopens m
where where
fors m = fors m =
@@ -157,7 +159,7 @@ depPathModule m = fors m ++ exts m ++ mopens m
exts m = map OSimple (extends m) exts m = map OSimple (extends m)
-- | all dependencies -- | all dependencies
allDepsModule :: SourceGrammar -> SourceModInfo -> [OpenSpec] allDepsModule :: Grammar -> ModuleInfo -> [OpenSpec]
allDepsModule gr m = iterFix add os0 where allDepsModule gr m = iterFix add os0 where
os0 = depPathModule m os0 = depPathModule m
add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], 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 mods = modules gr
-- | select just those modules that a given one depends on, including itself -- | 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] partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
where where
mods = modules gr mods = modules gr
modsFor = (i:) $ map openedModule $ allDepsModule gr m modsFor = (i:) $ map openedModule $ allDepsModule gr m
-- | all modules that a module extends, directly or indirectly, with restricts -- | all modules that a module extends, directly or indirectly, with restricts
allExtends :: SourceGrammar -> Ident -> [SourceModule] allExtends :: Grammar -> Ident -> [Module]
allExtends gr m = allExtends gr m =
case lookupModule gr m of case lookupModule gr m of
Ok mi -> (m,mi) : concatMap (allExtends gr . fst) (mextend mi) Ok mi -> (m,mi) : concatMap (allExtends gr . fst) (mextend mi)
_ -> [] _ -> []
-- | the same as 'allExtends' plus that an instance extends its interface -- | the same as 'allExtends' plus that an instance extends its interface
allExtendsPlus :: SourceGrammar -> Ident -> [Ident] allExtendsPlus :: Grammar -> ModuleName -> [ModuleName]
allExtendsPlus gr i = allExtendsPlus gr i =
case lookupModule gr i of case lookupModule gr i of
Ok m -> i : concatMap (allExtendsPlus gr) (exts m) Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
@@ -188,38 +190,39 @@ allExtendsPlus gr i =
exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]] exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
-- | initial search path: the nonqualified dependencies -- | initial search path: the nonqualified dependencies
searchPathModule :: SourceModInfo -> [Ident] searchPathModule :: ModuleInfo -> [ModuleName]
searchPathModule m = [i | OSimple i <- depPathModule m] 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) prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)
emptySourceGrammar :: SourceGrammar emptyGrammar = mGrammar []
emptySourceGrammar = mGrammar []
mGrammar :: [Module] -> Grammar
mGrammar ms = MGrammar (Map.fromList ms) ms mGrammar ms = MGrammar (Map.fromList ms) ms
-- | we store the module type with the identifier -- | 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 abstractOfConcrete gr c = do
n <- lookupModule gr c n <- lookupModule gr c
case mtype n of case mtype n of
MTConcrete a -> return a MTConcrete a -> return a
_ -> raise $ render ("expected concrete" <+> c) _ -> 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 lookupModule gr m = case Map.lookup m (moduleMap gr) of
Just i -> return i Just i -> return i
Nothing -> raise $ render ("unknown module" <+> m <+> "among" <+> hsep (map fst (modules gr))) Nothing -> raise $ render ("unknown module" <+> m <+> "among" <+> hsep (map fst (modules gr)))
isModAbs :: SourceModInfo -> Bool isModAbs :: ModuleInfo -> Bool
isModAbs m = isModAbs m =
case mtype m of case mtype m of
MTAbstract -> True MTAbstract -> True
_ -> False _ -> False
isModRes :: SourceModInfo -> Bool isModRes :: ModuleInfo -> Bool
isModRes m = isModRes m =
case mtype m of case mtype m of
MTResource -> True MTResource -> True
@@ -227,7 +230,7 @@ isModRes m =
MTInstance _ -> True MTInstance _ -> True
_ -> False _ -> False
isModCnc :: SourceModInfo -> Bool isModCnc :: ModuleInfo -> Bool
isModCnc m = isModCnc m =
case mtype m of case mtype m of
MTConcrete _ -> True MTConcrete _ -> True
@@ -253,49 +256,49 @@ sameMType m n =
_ -> m == n _ -> m == n
-- | don't generate code for interfaces and for incomplete modules -- | don't generate code for interfaces and for incomplete modules
isCompilableModule :: SourceModInfo -> Bool isCompilableModule :: ModuleInfo -> Bool
isCompilableModule m = isCompilableModule m =
case mtype m of case mtype m of
MTInterface -> False MTInterface -> False
_ -> mstatus m == MSComplete _ -> mstatus m == MSComplete
-- | interface and "incomplete M" are not complete -- | interface and "incomplete M" are not complete
isCompleteModule :: SourceModInfo -> Bool isCompleteModule :: ModuleInfo -> Bool
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
-- | all abstract modules sorted from least to most dependent -- | all abstract modules sorted from least to most dependent
allAbstracts :: SourceGrammar -> [Ident] allAbstracts :: Grammar -> [ModuleName]
allAbstracts gr = allAbstracts gr =
case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
Left is -> is Left is -> is
Right cycles -> error $ render ("Cyclic abstract modules:" <+> vcat (map hsep cycles)) Right cycles -> error $ render ("Cyclic abstract modules:" <+> vcat (map hsep cycles))
-- | the last abstract in dependency order (head of list) -- | the last abstract in dependency order (head of list)
greatestAbstract :: SourceGrammar -> Maybe Ident greatestAbstract :: Grammar -> Maybe ModuleName
greatestAbstract gr = greatestAbstract gr =
case allAbstracts gr of case allAbstracts gr of
[] -> Nothing [] -> Nothing
as -> return $ last as as -> return $ last as
-- | all resource modules -- | all resource modules
allResources :: SourceGrammar -> [Ident] allResources :: Grammar -> [ModuleName]
allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m] allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]
-- | the greatest resource in dependency order -- | the greatest resource in dependency order
greatestResource :: SourceGrammar -> Maybe Ident greatestResource :: Grammar -> Maybe ModuleName
greatestResource gr = greatestResource gr =
case allResources gr of case allResources gr of
[] -> Nothing [] -> Nothing
a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008 a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
-- | all concretes for a given abstract -- | all concretes for a given abstract
allConcretes :: SourceGrammar -> Ident -> [Ident] allConcretes :: Grammar -> ModuleName -> [ModuleName]
allConcretes gr a = allConcretes gr a =
[i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m] [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
-- | all concrete modules for any abstract -- | all concrete modules for any abstract
allConcreteModules :: SourceGrammar -> [Ident] allConcreteModules :: Grammar -> [ModuleName]
allConcreteModules gr = allConcreteModules gr =
[i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m] [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
@@ -342,7 +345,7 @@ type Type = Term
type Cat = QIdent type Cat = QIdent
type Fun = QIdent type Fun = QIdent
type QIdent = (Ident,Ident) type QIdent = (ModuleName,Ident)
data Term = data Term =
Vr Ident -- ^ variable Vr Ident -- ^ variable

2
src/compiler/GF/Grammar/Printer.hs
View File

@@ -41,7 +41,7 @@ data TermPrintQual
= Unqualified | Qualified | Internal = Unqualified | Qualified | Internal
deriving Eq deriving Eq
instance Pretty SourceGrammar where instance Pretty Grammar where
pp = vcat . map (ppModule Qualified) . modules pp = vcat . map (ppModule Qualified) . modules
ppModule :: TermPrintQual -> SourceModule -> Doc ppModule :: TermPrintQual -> SourceModule -> Doc

3
src/compiler/GF/Infra/Location.hs
View File

@@ -1,6 +1,9 @@
-- | Source locations
module GF.Infra.Location where module GF.Infra.Location where
import GF.Text.Pretty import GF.Text.Pretty
-- ** Source locations
class HasSourcePath a where sourcePath :: a -> FilePath class HasSourcePath a where sourcePath :: a -> FilePath
data Location data Location

12
src/compiler/GF/Interactive.hs
View File

@@ -153,7 +153,7 @@ execute1 opts gfenv0 s0 =
continue = return . Just continue = return . Just
stop = return Nothing stop = return Nothing
env = commandenv gfenv0 env = commandenv gfenv0
sgr = sourcegrammar gfenv0 sgr = grammar gfenv0
gfenv = gfenv0 {history = s0 : history gfenv0} gfenv = gfenv0 {history = s0 : history gfenv0}
pwords s = case words s of pwords s = case words s of
w:ws -> getCommandOp w :ws w:ws -> getCommandOp w :ws
@@ -280,7 +280,7 @@ execute1 opts gfenv0 s0 =
continue gfenv' continue gfenv'
empty = continue $ gfenv { empty = continue $ gfenv {
commandenv=emptyCommandEnv, sourcegrammar = emptySourceGrammar commandenv=emptyCommandEnv, grammar = emptyGrammar
} }
define_command (f:ws) = define_command (f:ws) =
@@ -355,8 +355,8 @@ fetchCommand gfenv = do
importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv
importInEnv gfenv opts files importInEnv gfenv opts files
| flag optRetainResource opts = | flag optRetainResource opts =
do src <- importSource (sourcegrammar gfenv) opts files do src <- importSource (grammar gfenv) opts files
return $ gfenv {sourcegrammar = src} return $ gfenv {grammar = src}
| otherwise = | otherwise =
do let opts' = addOptions (setOptimization OptCSE False) opts do let opts' = addOptions (setOptimization OptCSE False) opts
pgf0 = multigrammar (commandenv gfenv) pgf0 = multigrammar (commandenv gfenv)
@@ -398,14 +398,14 @@ prompt env
abs = abstractName (multigrammar env) abs = abstractName (multigrammar env)
data GFEnv = GFEnv { data GFEnv = GFEnv {
sourcegrammar :: SourceGrammar, -- gfo grammar -retain grammar :: Grammar, -- gfo grammar -retain
commandenv :: CommandEnv, commandenv :: CommandEnv,
history :: [String] history :: [String]
} }
emptyGFEnv :: GFEnv emptyGFEnv :: GFEnv
emptyGFEnv = emptyGFEnv =
GFEnv emptySourceGrammar (mkCommandEnv emptyPGF) [] {-0-} GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] {-0-}
wordCompletion gfenv (left,right) = do wordCompletion gfenv (left,right) = do
case wc_type (reverse left) of case wc_type (reverse left) of