summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/compiler/GF/Compile/GetGrammar.hs1
-rw-r--r--src/compiler/GF/CompileInParallel.hs12
-rw-r--r--src/compiler/GF/CompileOne.hs19
-rw-r--r--src/compiler/GF/Compiler.hs4
-rw-r--r--src/compiler/GF/Data/Operations.hs22
-rw-r--r--src/compiler/GF/Grammar.hs10
-rw-r--r--src/compiler/GF/Grammar/Grammar.hs11
-rw-r--r--src/compiler/GF/Grammar/MMacros.hs4
-rw-r--r--src/compiler/GF/Grammar/Macros.hs2
-rw-r--r--src/compiler/GF/Grammar/Printer.hs3
-rw-r--r--src/compiler/GF/Grammar/Values.hs6
-rw-r--r--src/compiler/GF/Infra/Ident.hs6
-rw-r--r--src/compiler/GF/Infra/Option.hs14
-rw-r--r--src/compiler/GF/Infra/UseIO.hs26
-rw-r--r--src/compiler/GF/Interactive.hs3
-rw-r--r--src/compiler/GF/System/Console.hs5
16 files changed, 92 insertions, 56 deletions
diff --git a/src/compiler/GF/Compile/GetGrammar.hs b/src/compiler/GF/Compile/GetGrammar.hs
index b4d2e13ef..4e2523d0b 100644
--- a/src/compiler/GF/Compile/GetGrammar.hs
+++ b/src/compiler/GF/Compile/GetGrammar.hs
@@ -35,6 +35,7 @@ import GF.System.Directory(removeFile,getCurrentDirectory)
import System.FilePath(makeRelative)
--getSourceModule :: Options -> FilePath -> IOE SourceModule
+-- | Read a source file and parse it (after applying preprocessors specified in the options)
getSourceModule opts file0 =
--errIn file0 $
do tmp <- liftIO $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs
index 702602f4a..e9047b4e7 100644
--- a/src/compiler/GF/CompileInParallel.hs
+++ b/src/compiler/GF/CompileInParallel.hs
@@ -1,5 +1,5 @@
-- | Parallel grammar compilation
-module GF.CompileInParallel(batchCompile) where
+module GF.CompileInParallel(parallelBatchCompile) where
import Prelude hiding (catch)
import Control.Monad(join,ap,when,unless)
import Control.Applicative
@@ -19,8 +19,14 @@ import GF.Infra.Ident(identS)
import GF.Text.Pretty
import qualified Data.ByteString.Lazy as BS
--- | Compile the given grammar files and everything they depend on
-batchCompile jobs opts rootfiles0 =
+-- | Compile the given grammar files and everything they depend on.
+-- This function compiles modules in parallel.
+-- It keeps modules compiled in /present/ and /alltenses/ mode apart,
+-- storing the @.gfo@ files in separate subdirectories to avoid creating
+-- the broken PGF files that can result from mixing different modes in the
+-- same concrete syntax.
+
+parallelBatchCompile jobs opts rootfiles0 =
do rootfiles <- mapM canonical rootfiles0
lib_dir <- canonical =<< getLibraryDirectory opts
filepaths <- mapM (getPathFromFile lib_dir opts) rootfiles
diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index 1d008326c..8c68f013a 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -1,4 +1,5 @@
-module GF.CompileOne(OneOutput,CompiledModule,
+module GF.CompileOne(-- ** Compiling a single module
+ OneOutput,CompiledModule,
compileOne,reuseGFO,useTheSource
--, CompileSource, compileSourceModule
) where
@@ -18,9 +19,9 @@ import GF.Grammar.Printer(ppModule,TermPrintQual(..))
import GF.Grammar.Binary(decodeModule,encodeModule)
import GF.Infra.Option
-import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,Output(..),putPointE)
+import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,MonadIO(..),Output(..),putPointE)
import GF.Infra.CheckM(runCheck')
-import GF.Data.Operations(liftErr,(+++))
+import GF.Data.Operations(ErrorMonad,liftErr,(+++))
import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)
import qualified Data.Map as Map
@@ -30,9 +31,13 @@ import Control.Monad((<=<))
type OneOutput = (Maybe FullPath,CompiledModule)
type CompiledModule = SourceModule
---compileOne :: Options -> SourceGrammar -> FullPath -> IOE OneOutput
+compileOne, reuseGFO, useTheSource ::
+ (Output m,ErrorMonad m,MonadIO m) =>
+ Options -> SourceGrammar -> FullPath -> m OneOutput
+
-- | Compile a given source file (or just load a .gfo file),
-- given a 'SourceGrammar' containing everything it depends on.
+-- Calls 'reuseGFO' or 'useTheSource'.
compileOne opts srcgr file =
if isGFO file
then reuseGFO opts srcgr file
@@ -40,7 +45,7 @@ compileOne opts srcgr file =
if b1 then useTheSource opts srcgr file
else reuseGFO opts srcgr (gf2gfo opts file)
--- | For compiled gf, read the file and update environment.
+-- | Read a compiled GF module.
-- Also undo common subexp optimization, to enable normal computations.
reuseGFO opts srcgr file =
do sm00 <- putPointE Verbose opts ("+ reading" +++ file) $
@@ -62,7 +67,9 @@ reuseGFO opts srcgr file =
return (Just file,sm)
--useTheSource :: Options -> SourceGrammar -> FullPath -> IOE OneOutput
--- | For gf source, do full compilation and generate code.
+-- | 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)
useTheSource opts srcgr file =
do sm <- putpOpt ("- parsing" +++ file)
("- compiling" +++ file ++ "... ")
diff --git a/src/compiler/GF/Compiler.hs b/src/compiler/GF/Compiler.hs
index 3be8c6e14..407ef4e64 100644
--- a/src/compiler/GF/Compiler.hs
+++ b/src/compiler/GF/Compiler.hs
@@ -4,7 +4,7 @@ import PGF
import PGF.Internal(concretes,optimizePGF,unionPGF)
import PGF.Internal(putSplitAbs,encodeFile,runPut)
import GF.Compile as S(batchCompile,link,srcAbsName)
-import qualified GF.CompileInParallel as P(batchCompile)
+import GF.CompileInParallel as P(parallelBatchCompile)
import GF.Compile.Export
import GF.Compile.CFGtoPGF
import GF.Compile.GetGrammar
@@ -56,7 +56,7 @@ compileSourceFiles opts fs =
writePGF opts pgf
writeOutputs opts pgf
where
- batchCompile = maybe batchCompile' P.batchCompile (flag optJobs opts)
+ batchCompile = maybe batchCompile' parallelBatchCompile (flag optJobs opts)
batchCompile' opts fs = do (cnc,t,gr) <- S.batchCompile opts fs
return (t,[(cnc,gr)])
diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index ef34de27b..69b089623 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -14,19 +14,19 @@
-- Copyright (c) Aarne Ranta 1998-2000, under GNU General Public License (see GPL)
-----------------------------------------------------------------------------
-module GF.Data.Operations (-- * misc functions
+module GF.Data.Operations (-- ** Misc functions
ifNull,
- -- * the Error monad
+ -- ** The Error monad
Err(..), err, maybeErr, testErr, errVal, errIn,
lookupErr,
mapPairListM, mapPairsM, pairM,
singleton, --mapsErr, mapsErrTree,
- -- ** checking
+ -- ** Checking
checkUnique, unifyMaybeBy, unifyMaybe,
- -- * binary search trees; now with FiniteMap
+ -- ** Binary search trees; now with FiniteMap
BinTree, emptyBinTree, isInBinTree, justLookupTree,
lookupTree, --lookupTreeMany,
lookupTreeManyAll, updateTree,
@@ -36,28 +36,28 @@ module GF.Data.Operations (-- * misc functions
tree2list,
- -- * printing
+ -- ** Printing
indent, (+++), (++-), (++++), (+++++),
prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
numberedParagraphs, prConjList, prIfEmpty, wrapLines,
- -- * extra
+ -- ** Extra
combinations,
- -- * topological sorting with test of cyclicity
+ -- ** Topological sorting with test of cyclicity
topoTest, topoTest2,
- -- * the generic fix point iterator
+ -- ** The generic fix point iterator
iterFix,
- -- * chop into separator-separated parts
+ -- ** Chop into separator-separated parts
chunks, readIntArg,
- -- * state monad with error; from Agda 6\/11\/2001
+ -- ** State monad with error; from Agda 6\/11\/2001
STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM, done,
- -- * error monad class
+ -- ** Error monad class
ErrorMonad(..), checkAgain, checks, allChecks, doUntil,
liftErr
diff --git a/src/compiler/GF/Grammar.hs b/src/compiler/GF/Grammar.hs
index c540f77b8..58f514971 100644
--- a/src/compiler/GF/Grammar.hs
+++ b/src/compiler/GF/Grammar.hs
@@ -12,18 +12,18 @@
-- (Description of the module)
-----------------------------------------------------------------------------
-module GF.Grammar
- ( module GF.Infra.Ident,
- module GF.Grammar.Grammar,
+module GF.Grammar
+ ( module GF.Grammar.Grammar,
module GF.Grammar.Values,
module GF.Grammar.Macros,
module GF.Grammar.MMacros,
- module GF.Grammar.Printer
+ module GF.Grammar.Printer,
+ module GF.Infra.Ident
) where
-import GF.Infra.Ident
import GF.Grammar.Grammar
import GF.Grammar.Values
import GF.Grammar.Macros
import GF.Grammar.MMacros
import GF.Grammar.Printer
+import GF.Infra.Ident
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index 816a9f438..36904c579 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -15,6 +15,7 @@
-----------------------------------------------------------------------------
module GF.Grammar.Grammar (
+ -- ** Grammar modules
SourceGrammar, SourceModInfo(..), SourceModule, ModuleType(..),
emptySourceGrammar, mGrammar, modules, prependModule, moduleMap,
@@ -32,9 +33,8 @@ module GF.Grammar.Grammar (
abstractOfConcrete,
ModuleStatus(..),
-
- PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence,
-
+
+ -- ** Judgements and terms
Info(..),
Location(..), L(..), unLoc, noLoc, ppLocation, ppL,
Type,
@@ -58,7 +58,10 @@ module GF.Grammar.Grammar (
Altern,
Substitution,
varLabel, tupleLabel, linLabel, theLinLabel,
- ident2label, label2ident
+ ident2label, label2ident,
+
+ -- ** PMCFG
+ PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence
) where
import GF.Infra.Ident
diff --git a/src/compiler/GF/Grammar/MMacros.hs b/src/compiler/GF/Grammar/MMacros.hs
index 9f4587967..66d8a857f 100644
--- a/src/compiler/GF/Grammar/MMacros.hs
+++ b/src/compiler/GF/Grammar/MMacros.hs
@@ -28,6 +28,8 @@ import GF.Grammar.Macros
import Control.Monad
import GF.Text.Pretty
+-- ** Some more abstractions on grammars, esp. for Edit
+
{-
nodeTree :: Tree -> TrNode
argsTree :: Tree -> [Tree]
@@ -151,7 +153,7 @@ substTerm ss g c = case c of
metaSubstExp :: MetaSubst -> [(MetaId,Exp)]
metaSubstExp msubst = [(m, errVal (meta2exp m) (val2expSafe v)) | (m,v) <- msubst]
--- * belong here rather than to computation
+-- ** belong here rather than to computation
substitute :: [Var] -> Substitution -> Exp -> Err Exp
substitute v s = return . substTerm v s
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index dde1201d8..f5ddb7ae0 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -33,6 +33,8 @@ import Control.Monad (liftM, liftM2, liftM3)
import Data.List (sortBy,nub)
import GF.Text.Pretty
+-- ** Macros for constructing and analysing source code terms.
+
typeForm :: Type -> (Context, Cat, [Term])
typeForm t =
case t of
diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs
index da29e3ebd..63603c5f8 100644
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -8,7 +8,8 @@
-----------------------------------------------------------------------------
module GF.Grammar.Printer
- ( TermPrintQual(..)
+ ( -- ** Pretty printing
+ TermPrintQual(..)
, ppModule
, ppJudgement
, ppParams
diff --git a/src/compiler/GF/Grammar/Values.hs b/src/compiler/GF/Grammar/Values.hs
index 0476825df..7bfc8a24b 100644
--- a/src/compiler/GF/Grammar/Values.hs
+++ b/src/compiler/GF/Grammar/Values.hs
@@ -12,12 +12,12 @@
-- (Description of the module)
-----------------------------------------------------------------------------
-module GF.Grammar.Values (-- * values used in TC type checking
+module GF.Grammar.Values (-- ** Values used in TC type checking
Exp, Val(..), Env,
- -- * annotated tree used in editing
+ -- ** Annotated tree used in editing
--Z Tree, TrNode(..), Atom(..),
Binds, Constraints, MetaSubst,
- -- * for TC
+ -- ** For TC
valAbsInt, valAbsFloat, valAbsString, vType,
isPredefCat,
eType,
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs
index 272efca03..3c5402985 100644
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -12,15 +12,15 @@
-- (Description of the module)
-----------------------------------------------------------------------------
-module GF.Infra.Ident (-- * Identifiers
+module GF.Infra.Ident (-- ** Identifiers
Ident, ident2utf8, showIdent, prefixIdent,
identS, identC, identV, identA, identAV, identW,
argIdent, isArgIdent, getArgIndex,
varStr, varX, isWildIdent, varIndex,
- -- * Raw Identifiers
+ -- ** Raw Identifiers
RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
isPrefixOf, showRawIdent{-,
- -- * Refreshing identifiers
+ -- ** Refreshing identifiers
IdState, initIdStateN, initIdState,
lookVar, refVar, refVarPlus-}
) where
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index 8bcb52cc5..9785f6895 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -1,6 +1,6 @@
module GF.Infra.Option
(
- -- * Option types
+ -- ** Option types
Options,
Flags(..),
Mode(..), Phase(..), Verbosity(..),
@@ -8,21 +8,21 @@ module GF.Infra.Option
SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..),
Dump(..), Pass(..), Recomp(..),
outputFormatsExpl,
- -- * Option parsing
+ -- ** Option parsing
parseOptions, parseModuleOptions, fixRelativeLibPaths,
- -- * Option pretty-printing
+ -- ** Option pretty-printing
optionsGFO,
optionsPGF,
- -- * Option manipulation
+ -- ** Option manipulation
addOptions, concatOptions, noOptions,
modifyFlags,
helpMessage,
- -- * Checking specific options
+ -- ** Checking specific options
flag, cfgTransform, haskellOption, readOutputFormat,
isLexicalCat, isLiteralCat, renameEncoding, getEncoding, defaultEncoding,
- -- * Setting specific options
+ -- ** Setting specific options
setOptimization, setCFGTransform,
- -- * Convenience methods for checking options
+ -- ** Convenience methods for checking options
verbAtLeast, dump
) where
diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs
index 6de68bc44..e0477c1fc 100644
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -12,7 +12,9 @@
-- (Description of the module)
-----------------------------------------------------------------------------
-module GF.Infra.UseIO(module GF.Infra.UseIO,MonadIO(..),liftErr) where
+module GF.Infra.UseIO(module GF.Infra.UseIO,liftErr,
+ -- ** Reused
+ MonadIO(..),liftErr) where
import Prelude hiding (catch)
@@ -38,6 +40,8 @@ import Control.Exception(evaluate)
--putIfVerb :: MonadIO io => Options -> String -> io ()
putIfVerb opts msg = when (verbAtLeast opts Verbose) $ putStrLnE msg
+-- ** GF files path and library path manipulation
+
type FileName = String
type InitPath = String -- ^ the directory portion of a pathname
type FullPath = String
@@ -119,7 +123,7 @@ splitInModuleSearchPath s = case break isPathSep s of
--
--- * IO monad with error; adapted from state monad
+-- ** IO monad with error; adapted from state monad
newtype IOE a = IOE { appIOE :: IO (Err a) }
@@ -165,6 +169,8 @@ die :: String -> IO a
die s = do hPutStrLn stderr s
exitFailure
+-- ** Diagnostic output
+
class Monad m => Output m where
ePutStr, ePutStrLn, putStrE, putStrLnE :: String -> m ()
@@ -195,13 +201,21 @@ putPointE v opts msg act = do
return a
+-- | Because GHC adds the confusing text "user error" for failures caused by
+-- calls to fail.
+ioErrorText e = if isUserError e
+ then ioeGetErrorString e
+ else show e
+
+-- ** Timing
+
timeIt act =
do t1 <- liftIO $ getCPUTime
a <- liftIO . evaluate =<< act
t2 <- liftIO $ getCPUTime
return (t2-t1,a)
--- * File IO
+-- ** File IO
writeUTF8File :: FilePath -> String -> IO ()
writeUTF8File fpath content =
@@ -210,9 +224,3 @@ writeUTF8File fpath content =
readBinaryFile path = hGetContents =<< openBinaryFile path ReadMode
writeBinaryFile path s = withBinaryFile path WriteMode (flip hPutStr s)
-
--- | Because GHC adds the confusing text "user error" for failures caused by
--- calls to fail.
-ioErrorText e = if isUserError e
- then ioeGetErrorString e
- else show e
diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs
index 745f64f84..5944d04a7 100644
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -53,11 +53,13 @@ import GF.Infra.BuildInfo(buildInfo)
import Data.Version(showVersion)
import Paths_gf(version)
+-- | Run the GF Shell in quiet mode
mainRunGFI :: Options -> [FilePath] -> IO ()
mainRunGFI opts files = shell (beQuiet opts) files
beQuiet = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet}))
+-- | Run the interactive GF Shell
mainGFI :: Options -> [FilePath] -> IO ()
mainGFI opts files = do
P.putStrLn welcome
@@ -66,6 +68,7 @@ mainGFI opts files = do
shell opts files = loop opts =<< runSIO (importInEnv emptyGFEnv opts files)
#ifdef SERVER_MODE
+-- | Start GF Server
mainServerGFI opts0 port files =
server port root (execute1 opts)
=<< runSIO (importInEnv emptyGFEnv opts files)
diff --git a/src/compiler/GF/System/Console.hs b/src/compiler/GF/System/Console.hs
index ea901d55d..975b229f1 100644
--- a/src/compiler/GF/System/Console.hs
+++ b/src/compiler/GF/System/Console.hs
@@ -1,11 +1,14 @@
{-# LANGUAGE CPP #-}
-module GF.System.Console(setConsoleEncoding,changeConsoleEncoding) where
+module GF.System.Console(
+ -- ** Changing which character encoding to use for console IO
+ setConsoleEncoding,changeConsoleEncoding) where
import System.IO
#ifdef mingw32_HOST_OS
import System.Win32.Console
import System.Win32.NLS
#endif
+-- | Set the console encoding (for Windows, has no effect on Unix-like systems)
setConsoleEncoding =
#ifdef mingw32_HOST_OS
do codepage <- getACP