summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src-3.0/GF/Command/Commands.hs42
-rw-r--r--src-3.0/GF/Command/Importing.hs20
-rw-r--r--src-3.0/GF/Command/Interpreter.hs2
-rw-r--r--src-3.0/GF/Compile.hs20
-rw-r--r--src-3.0/GF/Compile/Export.hs16
-rw-r--r--src-3.0/GF/Compile/GFCCtoHaskell.hs6
-rw-r--r--src-3.0/GF/Compile/GFCCtoJS.hs14
-rw-r--r--src-3.0/GF/Compile/GrammarToGFCC.hs20
-rw-r--r--src-3.0/GF/Compile/OptimizeGFCC.hs16
-rw-r--r--src-3.0/GF/Infra/Option.hs10
-rw-r--r--src-3.0/GFC.hs18
-rw-r--r--src-3.0/GFI.hs18
-rw-r--r--src-3.0/PGF.hs60
-rw-r--r--src-3.0/PGF/Check.hs53
-rw-r--r--src-3.0/PGF/Data.hs28
-rw-r--r--src-3.0/PGF/Generate.hs20
-rw-r--r--src-3.0/PGF/Linearize.hs20
-rw-r--r--src-3.0/PGF/Macros.hs72
-rw-r--r--src-3.0/PGF/Raw/Convert.hs28
-rw-r--r--src-3.0/PGF/ShowLinearize.hs30
20 files changed, 246 insertions, 267 deletions
diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs
index bf5c737cc..f3789d669 100644
--- a/src-3.0/GF/Command/Commands.hs
+++ b/src-3.0/GF/Command/Commands.hs
@@ -47,10 +47,10 @@ emptyCommandInfo = CommandInfo {
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
lookCommand = Map.lookup
-commandHelpAll :: MultiGrammar -> [Option] -> String
-commandHelpAll mgr opts = unlines
+commandHelpAll :: PGF -> [Option] -> String
+commandHelpAll pgf opts = unlines
[commandHelp (isOpt "full" opts) (co,info)
- | (co,info) <- Map.assocs (allCommands mgr)]
+ | (co,info) <- Map.assocs (allCommands pgf)]
commandHelp :: Bool -> (String,CommandInfo) -> String
commandHelp full (co,info) = unlines $ [
@@ -82,14 +82,14 @@ isOpt :: String -> [Option] -> Bool
isOpt o opts = elem o [x | OOpt (Ident x) <- opts]
-- this list must be kept sorted by the command name!
-allCommands :: MultiGrammar -> Map.Map String CommandInfo
-allCommands mgr = Map.fromAscList [
+allCommands :: PGF -> Map.Map String CommandInfo
+allCommands pgf = Map.fromAscList [
("gr", emptyCommandInfo {
longname = "generate_random",
synopsis = "generates a list of random trees, by default one tree",
flags = ["cat","number"],
exec = \opts _ -> do
- ts <- generateRandom mgr (optCat opts)
+ ts <- generateRandom pgf (optCat opts)
return $ fromTrees $ take (optNum opts) ts
}),
("gt", emptyCommandInfo {
@@ -98,7 +98,7 @@ allCommands mgr = Map.fromAscList [
flags = ["cat","depth","number"],
exec = \opts _ -> do
let dp = return $ valIntOpts "depth" 4 opts
- let ts = generateAllDepth mgr (optCat opts) dp
+ let ts = generateAllDepth pgf (optCat opts) dp
return $ fromTrees $ take (optNumInf opts) ts
}),
("h", emptyCommandInfo {
@@ -107,10 +107,10 @@ allCommands mgr = Map.fromAscList [
options = ["full"],
exec = \opts ts -> return ([], case ts of
[t] -> let co = (showTree t) in
- case lookCommand co (allCommands mgr) of ---- new map ??!!
+ case lookCommand co (allCommands pgf) of ---- new map ??!!
Just info -> commandHelp True (co,info)
_ -> "command not found"
- _ -> commandHelpAll mgr opts)
+ _ -> commandHelpAll pgf opts)
}),
("l", emptyCommandInfo {
exec = \opts -> return . fromStrings . map (optLin opts),
@@ -127,33 +127,31 @@ allCommands mgr = Map.fromAscList [
})
]
where
- lin opts t = unlines [linearize mgr lang t | lang <- optLangs opts]
- par opts s = concat [parse mgr lang (optCat opts) s | lang <- optLangs opts]
+ lin opts t = unlines [linearize pgf lang t | lang <- optLangs opts]
+ par opts s = concat [parse pgf lang (optCat opts) s | lang <- optLangs opts]
optLin opts t = unlines [linea lang t | lang <- optLangs opts] where
linea lang = case opts of
- _ | isOpt "all" opts -> allLinearize gr (mkCId lang)
- _ | isOpt "table" opts -> tableLinearize gr (mkCId lang)
- _ | isOpt "term" opts -> termLinearize gr (mkCId lang)
- _ | isOpt "record" opts -> recordLinearize gr (mkCId lang)
- _ -> linearize mgr lang
+ _ | isOpt "all" opts -> allLinearize pgf (mkCId lang)
+ _ | isOpt "table" opts -> tableLinearize pgf (mkCId lang)
+ _ | isOpt "term" opts -> termLinearize pgf (mkCId lang)
+ _ | isOpt "record" opts -> recordLinearize pgf (mkCId lang)
+ _ -> linearize pgf lang
optLangs opts = case valIdOpts "lang" "" opts of
- "" -> languages mgr
+ "" -> languages pgf
lang -> [lang]
- optCat opts = valIdOpts "cat" (lookStartCat gr) opts
+ optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
optNum opts = valIntOpts "number" 1 opts
optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
- gr = gfcc mgr
-
fromTrees ts = (ts,unlines (map showTree ts))
fromStrings ss = (map EStr ss, unlines ss)
fromString s = ([EStr s], s)
toStrings ts = [s | EStr s <- ts]
prGrammar opts = case valIdOpts "printer" "" opts of
- "cats" -> unwords $ categories mgr
- v -> prGFCC (read v) gr
+ "cats" -> unwords $ categories pgf
+ v -> prPGF (read v) pgf
diff --git a/src-3.0/GF/Command/Importing.hs b/src-3.0/GF/Command/Importing.hs
index 91bcdcb73..d4eeb18ce 100644
--- a/src-3.0/GF/Command/Importing.hs
+++ b/src-3.0/GF/Command/Importing.hs
@@ -13,20 +13,18 @@ import Data.List (nubBy)
import System.FilePath
-- import a grammar in an environment where it extends an existing grammar
-importGrammar :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar
-importGrammar mgr0 opts files =
+importGrammar :: PGF -> Options -> [FilePath] -> IO PGF
+importGrammar pgf0 opts files =
case takeExtensions (last files) of
s | elem s [".gf",".gfo"] -> do
- res <- appIOE $ compileToGFCC opts files
+ res <- appIOE $ compileToPGF opts files
case res of
- Ok gfcc2 -> do let gfcc3 = unionGFCC (gfcc mgr0) gfcc2
- return $ MultiGrammar gfcc3
- Bad msg -> do putStrLn msg
- return mgr0
- ".gfcc" -> do
- gfcc2 <- mapM file2gfcc files >>= return . foldl1 unionGFCC
- let gfcc3 = unionGFCC (gfcc mgr0) gfcc2
- return $ MultiGrammar gfcc3
+ Ok pgf2 -> do return $ unionPGF pgf0 pgf2
+ Bad msg -> do putStrLn msg
+ return pgf0
+ ".pgf" -> do
+ pgf2 <- mapM file2pgf files >>= return . foldl1 unionPGF
+ return $ unionPGF pgf0 pgf2
importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar
importSource src0 opts files = do
diff --git a/src-3.0/GF/Command/Interpreter.hs b/src-3.0/GF/Command/Interpreter.hs
index 825c2862b..c33d6453a 100644
--- a/src-3.0/GF/Command/Interpreter.hs
+++ b/src-3.0/GF/Command/Interpreter.hs
@@ -17,7 +17,7 @@ import GF.Data.ErrM ----
import qualified Data.Map as Map
data CommandEnv = CommandEnv {
- multigrammar :: MultiGrammar,
+ multigrammar :: PGF,
commands :: Map.Map String CommandInfo
}
diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs
index fb1f8ba0b..677aa4104 100644
--- a/src-3.0/GF/Compile.hs
+++ b/src-3.0/GF/Compile.hs
@@ -1,4 +1,4 @@
-module GF.Compile (batchCompile, link, compileToGFCC) where
+module GF.Compile (batchCompile, link, compileToPGF) where
-- the main compiler passes
import GF.Compile.GetGrammar
@@ -39,27 +39,31 @@ import PGF.Check
import PGF.Data
--- | Compiles a number of source files and builds a 'GFCC' structure for them.
-compileToGFCC :: Options -> [FilePath] -> IOE GFCC
-compileToGFCC opts fs =
+-- | Compiles a number of source files and builds a 'PGF' structure for them.
+compileToPGF :: Options -> [FilePath] -> IOE PGF
+compileToPGF opts fs =
do gr <- batchCompile opts fs
let name = justModuleName (last fs)
link opts name gr
-link :: Options -> String -> SourceGrammar -> IOE GFCC
+link :: Options -> String -> SourceGrammar -> IOE PGF
link opts cnc gr =
do gc1 <- putPointE Normal opts "linking ... " $
let (abs,gc0) = mkCanon2gfcc opts cnc gr
- in ioeIO $ checkGFCCio gc0
+ in case checkPGF gc0 of
+ Ok (gc,b) -> do
+ ioeIO $ putStrLn $ if b then "OK" else "Corrupted PGF"
+ return gc
+ Bad s -> fail s
return $ buildParser opts $ optimize opts gc1
-optimize :: Options -> GFCC -> GFCC
+optimize :: Options -> PGF -> PGF
optimize opts = cse . suf
where os = moduleFlag optOptimizations opts
cse = if OptCSE `elem` os then cseOptimize else id
suf = if OptStem `elem` os then suffixOptimize else id
-buildParser :: Options -> GFCC -> GFCC
+buildParser :: Options -> PGF -> PGF
buildParser opts =
if moduleFlag optBuildParser opts then addParsers else id
diff --git a/src-3.0/GF/Compile/Export.hs b/src-3.0/GF/Compile/Export.hs
index 2b36b10a9..ab5dcb393 100644
--- a/src-3.0/GF/Compile/Export.hs
+++ b/src-3.0/GF/Compile/Export.hs
@@ -1,8 +1,8 @@
module GF.Compile.Export where
-import PGF.Data (GFCC)
+import PGF.Data (PGF)
import PGF.Raw.Print (printTree)
-import PGF.Raw.Convert (fromGFCC)
+import PGF.Raw.Convert (fromPGF)
import GF.Compile.GFCCtoHaskell
import GF.Compile.GFCCtoJS
import GF.Infra.Option
@@ -10,13 +10,13 @@ import GF.Text.UTF8
-- top-level access to code generation
-prGFCC :: OutputFormat -> GFCC -> String
-prGFCC fmt gr = case fmt of
- FmtGFCC -> printGFCC gr
- FmtJavaScript -> gfcc2js gr
+prPGF :: OutputFormat -> PGF -> String
+prPGF fmt gr = case fmt of
+ FmtPGF -> printPGF gr
+ FmtJavaScript -> pgf2js gr
FmtHaskell -> grammar2haskell gr
FmtHaskellGADT -> grammar2haskellGADT gr
-printGFCC :: GFCC -> String
-printGFCC = encodeUTF8 . printTree . fromGFCC
+printPGF :: PGF -> String
+printPGF = encodeUTF8 . printTree . fromPGF
diff --git a/src-3.0/GF/Compile/GFCCtoHaskell.hs b/src-3.0/GF/Compile/GFCCtoHaskell.hs
index 9a5fb7ca2..94210b65e 100644
--- a/src-3.0/GF/Compile/GFCCtoHaskell.hs
+++ b/src-3.0/GF/Compile/GFCCtoHaskell.hs
@@ -27,12 +27,12 @@ import Data.List --(isPrefixOf, find, intersperse)
import qualified Data.Map as Map
-- | the main function
-grammar2haskell :: GFCC -> String
+grammar2haskell :: PGF -> String
grammar2haskell gr = encodeUTF8 $ foldr (++++) [] $
haskPreamble ++ [datatypes gr', gfinstances gr']
where gr' = hSkeleton gr
-grammar2haskellGADT :: GFCC -> String
+grammar2haskellGADT :: PGF -> String
grammar2haskellGADT gr = encodeUTF8 $ foldr (++++) [] $
["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++
haskPreamble ++ [datatypesGADT gr', gfinstances gr']
@@ -173,7 +173,7 @@ fInstance m (cat,rules) =
--type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
-hSkeleton :: GFCC -> (String,HSkeleton)
+hSkeleton :: PGF -> (String,HSkeleton)
hSkeleton gr =
(prCId (absname gr),
[(prCId c, [(prCId f, map prCId cs) | (f, (cs,_)) <- fs]) |
diff --git a/src-3.0/GF/Compile/GFCCtoJS.hs b/src-3.0/GF/Compile/GFCCtoJS.hs
index 1c24627a3..024de7273 100644
--- a/src-3.0/GF/Compile/GFCCtoJS.hs
+++ b/src-3.0/GF/Compile/GFCCtoJS.hs
@@ -1,4 +1,4 @@
-module GF.Compile.GFCCtoJS (gfcc2js) where
+module GF.Compile.GFCCtoJS (pgf2js) where
import PGF.CId
import PGF.Data
@@ -16,14 +16,14 @@ import qualified Data.Array as Array
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
-gfcc2js :: GFCC -> String
-gfcc2js gfcc =
+pgf2js :: PGF -> String
+pgf2js pgf =
encodeUTF8 $ JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
where
- n = prCId $ absname gfcc
- as = abstract gfcc
- cs = Map.assocs (concretes gfcc)
- start = M.lookStartCat gfcc
+ n = prCId $ absname pgf
+ as = abstract pgf
+ cs = Map.assocs (concretes pgf)
+ start = M.lookStartCat pgf
grammar = new "GFGrammar" [js_abstract, js_concrete]
js_abstract = abstract2js start as
js_concrete = JS.EObj $ map (concrete2js start n) cs
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index 677354280..bf87d42fe 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/src-3.0/GF/Compile/GrammarToGFCC.hs
@@ -37,13 +37,13 @@ import Debug.Trace ----
traceD s t = t
--- the main function: generate GFCC from GF.
+-- the main function: generate PGF from GF.
prGrammar2gfcc :: Options -> String -> SourceGrammar -> (String,String)
-prGrammar2gfcc opts cnc gr = (abs,printGFCC gc) where
+prGrammar2gfcc opts cnc gr = (abs,printPGF gc) where
(abs,gc) = mkCanon2gfcc opts cnc gr
-mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.GFCC)
+mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.PGF)
mkCanon2gfcc opts cnc gr =
(prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr)
where
@@ -51,18 +51,18 @@ mkCanon2gfcc opts cnc gr =
pars = mkParamLincat gr
-- Adds parsers for all concretes
-addParsers :: D.GFCC -> D.GFCC
-addParsers gfcc = gfcc { D.concretes = Map.map conv (D.concretes gfcc) }
+addParsers :: D.PGF -> D.PGF
+addParsers pgf = pgf { D.concretes = Map.map conv (D.concretes pgf) }
where
- conv cnc = cnc { D.parser = Just (buildParserInfo (convertConcrete (D.abstract gfcc) cnc)) }
+ conv cnc = cnc { D.parser = Just (buildParserInfo (convertConcrete (D.abstract pgf) cnc)) }
--- Generate GFCC from GFCM.
+-- Generate PGF from GFCM.
-- this assumes a grammar translated by canon2canon
-canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.GFCC
+canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.PGF
canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
(if dump opts DumpCanon then trace (prGrammar cgr) else id) $
- D.GFCC an cns gflags abs cncs
+ D.PGF an cns gflags abs cncs
where
-- abstract
an = (i2i a)
@@ -176,7 +176,7 @@ mkTerm tr = case tr of
C.S ts -> concatMap flats ts
_ -> [t]
--- encoding GFCC-internal lincats as terms
+-- encoding PGF-internal lincats as terms
mkCType :: Type -> C.Term
mkCType t = case t of
EInt i -> C.C $ fromInteger i
diff --git a/src-3.0/GF/Compile/OptimizeGFCC.hs b/src-3.0/GF/Compile/OptimizeGFCC.hs
index 16cdf9ac3..c73d5bbcb 100644
--- a/src-3.0/GF/Compile/OptimizeGFCC.hs
+++ b/src-3.0/GF/Compile/OptimizeGFCC.hs
@@ -12,12 +12,12 @@ import qualified Data.Map as Map
-- back-end optimization:
-- suffix analysis followed by common subexpression elimination
-optGFCC :: GFCC -> GFCC
-optGFCC = cseOptimize . suffixOptimize
+optPGF :: PGF -> PGF
+optPGF = cseOptimize . suffixOptimize
-suffixOptimize :: GFCC -> GFCC
-suffixOptimize gfcc = gfcc {
- concretes = Map.map opt (concretes gfcc)
+suffixOptimize :: PGF -> PGF
+suffixOptimize pgf = pgf {
+ concretes = Map.map opt (concretes pgf)
}
where
opt cnc = cnc {
@@ -26,9 +26,9 @@ suffixOptimize gfcc = gfcc {
printnames = Map.map optTerm (printnames cnc)
}
-cseOptimize :: GFCC -> GFCC
-cseOptimize gfcc = gfcc {
- concretes = Map.map subex (concretes gfcc)
+cseOptimize :: PGF -> PGF
+cseOptimize pgf = pgf {
+ concretes = Map.map subex (concretes pgf)
}
-- analyse word form lists into prefix + suffixes
diff --git a/src-3.0/GF/Infra/Option.hs b/src-3.0/GF/Infra/Option.hs
index 2d34ae441..c950be587 100644
--- a/src-3.0/GF/Infra/Option.hs
+++ b/src-3.0/GF/Infra/Option.hs
@@ -73,7 +73,7 @@ data Phase = Preproc | Convert | Compile | Link
data Encoding = UTF_8 | ISO_8859_1
deriving (Show,Eq,Ord)
-data OutputFormat = FmtGFCC | FmtJavaScript | FmtHaskell | FmtHaskellGADT
+data OutputFormat = FmtPGF | FmtJavaScript | FmtHaskell | FmtHaskellGADT
deriving (Eq,Ord)
data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
@@ -252,7 +252,7 @@ defaultFlags = Flags {
optShowCPUTime = False,
optEmitGFO = True,
optGFODir = ".",
- optOutputFormats = [FmtGFCC],
+ optOutputFormats = [FmtPGF],
optOutputFile = Nothing,
optOutputDir = Nothing,
optRecomp = RecompIfNewer,
@@ -344,7 +344,7 @@ optDescr =
Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).",
Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",
Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .",
- Option [] ["make"] (NoArg (phase Link)) "Build .gfcc file and other output files.",
+ Option [] ["make"] (NoArg (phase Link)) "Build .pgf file and other output files.",
Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",
Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",
Option [] ["emit-gfo"] (NoArg (emitGFO True)) "Create .gfo files (default).",
@@ -352,7 +352,7 @@ optDescr =
Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').",
Option ['f'] ["output-format"] (ReqArg outFmt "FMT")
(unlines ["Output format. FMT can be one of:",
- "Multiple concrete: gfcc (default), gar, js, ...",
+ "Multiple concrete: pgf (default), gar, js, ...",
"Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...",
"Abstract only: haskell, ..."]),
Option ['o'] ["output-file"] (ReqArg outFile "FILE")
@@ -392,7 +392,7 @@ optDescr =
outputFormats :: [(String,OutputFormat)]
outputFormats =
- [("gfcc", FmtGFCC),
+ [("pgf", FmtPGF),
("js", FmtJavaScript),
("haskell", FmtHaskell),
("haskell_gadt", FmtHaskellGADT)]
diff --git a/src-3.0/GFC.hs b/src-3.0/GFC.hs
index 72381b6ab..1c773630d 100644
--- a/src-3.0/GFC.hs
+++ b/src-3.0/GFC.hs
@@ -22,16 +22,16 @@ mainGFC opts fs =
let cnc = justModuleName (last fs)
if flag optStopAfterPhase opts == Compile
then return ()
- else do gfcc <- link opts cnc gr
- writeOutputs opts gfcc
+ else do pgf <- link opts cnc gr
+ writeOutputs opts pgf
-writeOutputs :: Options -> GFCC -> IOE ()
-writeOutputs opts gfcc = mapM_ (\fmt -> writeOutput opts fmt gfcc) (flag optOutputFormats opts)
+writeOutputs :: Options -> PGF -> IOE ()
+writeOutputs opts pgf = mapM_ (\fmt -> writeOutput opts fmt pgf) (flag optOutputFormats opts)
-writeOutput :: Options -> OutputFormat-> GFCC -> IOE ()
-writeOutput opts fmt gfcc =
- do let path = outputFilePath opts fmt (prCId (absname gfcc))
- s = prGFCC fmt gfcc
+writeOutput :: Options -> OutputFormat-> PGF -> IOE ()
+writeOutput opts fmt pgf =
+ do let path = outputFilePath opts fmt (prCId (absname pgf))
+ s = prPGF fmt pgf
writeOutputFile path s
outputFilePath :: Options -> OutputFormat -> String -> FilePath
@@ -40,7 +40,7 @@ outputFilePath opts fmt name0 = addDir name <.> fmtExtension fmt
addDir = maybe id (</>) (flag optOutputDir opts)
fmtExtension :: OutputFormat -> String
-fmtExtension FmtGFCC = "gfcc"
+fmtExtension FmtPGF = "pgf"
fmtExtension FmtJavaScript = "js"
fmtExtension FmtHaskell = "hs"
fmtExtension FmtHaskellGADT = "hs"
diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs
index 49d612978..24de6c70c 100644
--- a/src-3.0/GFI.hs
+++ b/src-3.0/GFI.hs
@@ -19,7 +19,7 @@ import Paths_gf
mainGFI :: Options -> [FilePath] -> IO ()
mainGFI opts files = do
putStrLn welcome
- env <- importInEnv emptyMultiGrammar opts files
+ env <- importInEnv emptyPGF opts files
loop (GFEnv emptyGrammar env [] 0)
return ()
@@ -50,7 +50,7 @@ loop gfenv0 = do
loopNewCPU gfenv
-- other special commands, working on GFEnv
- "e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyMultiGrammar}}
+ "e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyPGF}}
"ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv
"q":_ -> putStrLn "See you." >> return gfenv
@@ -64,13 +64,13 @@ loopNewCPU gfenv = do
putStrLn (show ((cpu' - cputime gfenv) `div` 1000000000) ++ " msec")
loop $ gfenv {cputime = cpu'}
-importInEnv :: MultiGrammar -> Options -> [FilePath] -> IO CommandEnv
-importInEnv mgr0 opts files = do
- mgr1 <- case files of
- [] -> return mgr0
- _ -> importGrammar mgr0 opts files
- let env = CommandEnv mgr1 (allCommands mgr1)
- putStrLn $ unwords $ "\nLanguages:" : languages mgr1
+importInEnv :: PGF -> Options -> [FilePath] -> IO CommandEnv
+importInEnv pgf0 opts files = do
+ pgf1 <- case files of
+ [] -> return pgf0
+ _ -> importGrammar pgf0 opts files
+ let env = CommandEnv pgf1 (allCommands pgf1)
+ putStrLn $ unwords $ "\nLanguages:" : languages pgf1
return env
welcome = unlines [
diff --git a/src-3.0/PGF.hs b/src-3.0/PGF.hs
index 9e4ed7aab..9e0a6007e 100644
--- a/src-3.0/PGF.hs
+++ b/src-3.0/PGF.hs
@@ -13,7 +13,7 @@
-- embedded GF systems. AR 19/9/2007
-----------------------------------------------------------------------------
-module PGF where
+module PGF(module PGF, PGF, emptyPGF) where
import PGF.CId
import PGF.Linearize
@@ -43,51 +43,46 @@ import qualified Text.ParserCombinators.ReadP as RP
-- Interface
---------------------------------------------------
-data MultiGrammar = MultiGrammar {gfcc :: GFCC}
type Language = String
type Category = String
type Tree = Exp
-file2grammar :: FilePath -> IO MultiGrammar
+file2pgf :: FilePath -> IO PGF
-linearize :: MultiGrammar -> Language -> Tree -> String
-parse :: MultiGrammar -> Language -> Category -> String -> [Tree]
+linearize :: PGF -> Language -> Tree -> String
+parse :: PGF -> Language -> Category -> String -> [Tree]
-linearizeAll :: MultiGrammar -> Tree -> [String]
-linearizeAllLang :: MultiGrammar -> Tree -> [(Language,String)]
+linearizeAll :: PGF -> Tree -> [String]
+linearizeAllLang :: PGF -> Tree -> [(Language,String)]
-parseAll :: MultiGrammar -> Category -> String -> [[Tree]]
-parseAllLang :: MultiGrammar -> Category -> String -> [(Language,[Tree])]
+parseAll :: PGF -> Category -> String -> [[Tree]]
+parseAllLang :: PGF -> Category -> String -> [(Language,[Tree])]
-generateAll :: MultiGrammar -> Category -> [Tree]
-generateRandom :: MultiGrammar -> Category -> IO [Tree]
-generateAllDepth :: MultiGrammar -> Category -> Maybe Int -> [Tree]
+generateAll :: PGF -> Category -> [Tree]
+generateRandom :: PGF -> Category -> IO [Tree]
+generateAllDepth :: PGF -> Category -> Maybe Int -> [Tree]
readTree :: String -> Tree
showTree :: Tree -> String
-languages :: MultiGrammar -> [Language]
-categories :: MultiGrammar -> [Category]
+languages :: PGF -> [Language]
+categories :: PGF -> [Category]
-startCat :: MultiGrammar -> Category
+startCat :: PGF -> Category
---------------------------------------------------
-- Implementation
---------------------------------------------------
-file2grammar f = do
- gfcc <- file2gfcc f
- return (MultiGrammar gfcc)
-
-file2gfcc f = do
+file2pgf f = do
s <- readFileIf f
g <- parseGrammar s
- return $ toGFCC g
+ return $! toPGF g
-linearize mgr lang = PGF.Linearize.linearize (gfcc mgr) (mkCId lang)
+linearize pgf lang = PGF.Linearize.linearize pgf (mkCId lang)
-parse mgr lang cat s =
- case lookParser (gfcc mgr) (mkCId lang) of
+parse pgf lang cat s =
+ case lookParser pgf (mkCId lang) of
Nothing -> error "no parser"
Just pinfo -> case parseFCF "bottomup" pinfo (mkCId cat) (words s) of
Ok x -> x
@@ -102,12 +97,12 @@ parseAll mgr cat = map snd . parseAllLang mgr cat
parseAllLang mgr cat s =
[(lang,ts) | lang <- languages mgr, let ts = parse mgr lang cat s, not (null ts)]
-generateRandom mgr cat = do
+generateRandom pgf cat = do
gen <- newStdGen
- return $ genRandom gen (gfcc mgr) (mkCId cat)
+ return $ genRandom gen pgf (mkCId cat)
-generateAll mgr cat = generate (gfcc mgr) (mkCId cat) Nothing
-generateAllDepth mgr cat = generate (gfcc mgr) (mkCId cat)
+generateAll pgf cat = generate pgf (mkCId cat) Nothing
+generateAllDepth pgf cat = generate pgf (mkCId cat)
readTree s = case RP.readP_to_S (pExp False) s of
[(x,"")] -> x
@@ -158,15 +153,14 @@ ppExp isNested (EVar id) = PP.text (prCId id)
ppParens True = PP.parens
ppParens False = id
-abstractName mgr = prCId (absname (gfcc mgr))
+abstractName pgf = prCId (absname pgf)
-languages mgr = [prCId l | l <- cncnames (gfcc mgr)]
+languages pgf = [prCId l | l <- cncnames pgf]
-categories mgr = [prCId c | c <- Map.keys (cats (abstract (gfcc mgr)))]
+categories pgf = [prCId c | c <- Map.keys (cats (abstract pgf))]
-startCat mgr = lookStartCat (gfcc mgr)
+startCat pgf = lookStartCat pgf
-emptyMultiGrammar = MultiGrammar emptyGFCC
------------ for internal use only
diff --git a/src-3.0/PGF/Check.hs b/src-3.0/PGF/Check.hs
index 9d5dd21ec..f66b9189d 100644
--- a/src-3.0/PGF/Check.hs
+++ b/src-3.0/PGF/Check.hs
@@ -1,4 +1,4 @@
-module PGF.Check (checkGFCC, checkGFCCio, checkGFCCmaybe) where
+module PGF.Check (checkPGF) where
import PGF.CId
import PGF.Data
@@ -9,26 +9,11 @@ import qualified Data.Map as Map
import Control.Monad
import Debug.Trace
-checkGFCCio :: GFCC -> IO GFCC
-checkGFCCio gfcc = case checkGFCC gfcc of
- Ok (gc,b) -> do
- putStrLn $ if b then "OK" else "Corrupted GFCC"
- return gc
- Bad s -> do
- putStrLn s
- error "building GFCC failed"
-
----- needed in old Custom
-checkGFCCmaybe :: GFCC -> Maybe GFCC
-checkGFCCmaybe gfcc = case checkGFCC gfcc of
- Ok (gc,b) -> return gc
- Bad s -> Nothing
-
-checkGFCC :: GFCC -> Err (GFCC,Bool)
-checkGFCC gfcc = do
- (cs,bs) <- mapM (checkConcrete gfcc)
- (Map.assocs (concretes gfcc)) >>= return . unzip
- return (gfcc {concretes = Map.fromAscList cs}, and bs)
+checkPGF :: PGF -> Err (PGF,Bool)
+checkPGF pgf = do
+ (cs,bs) <- mapM (checkConcrete pgf)
+ (Map.assocs (concretes pgf)) >>= return . unzip
+ return (pgf {concretes = Map.fromAscList cs}, and bs)
-- errors are non-fatal; replace with 'fail' to change this
@@ -43,18 +28,18 @@ labelBoolErr ms iob = do
if b then return (x,b) else (msg ms >> return (x,b))
-checkConcrete :: GFCC -> (CId,Concr) -> Err ((CId,Concr),Bool)
-checkConcrete gfcc (lang,cnc) =
+checkConcrete :: PGF -> (CId,Concr) -> Err ((CId,Concr),Bool)
+checkConcrete pgf (lang,cnc) =
labelBoolErr ("happened in language " ++ prCId lang) $ do
(rs,bs) <- mapM checkl (Map.assocs (lins cnc)) >>= return . unzip
return ((lang,cnc{lins = Map.fromAscList rs}),and bs)
where
- checkl = checkLin gfcc lang
+ checkl = checkLin pgf lang
-checkLin :: GFCC -> CId -> (CId,Term) -> Err ((CId,Term),Bool)
-checkLin gfcc lang (f,t) =
+checkLin :: PGF -> CId -> (CId,Term) -> Err ((CId,Term),Bool)
+checkLin pgf lang (f,t) =
labelBoolErr ("happened in function " ++ prCId f) $ do
- (t',b) <- checkTerm (lintype gfcc lang f) t --- $ inline gfcc lang t
+ (t',b) <- checkTerm (lintype pgf lang f) t --- $ inline pgf lang t
return ((f,t'),b)
inferTerm :: [CType] -> Term -> Err (Term,CType)
@@ -137,22 +122,22 @@ ints = C
str :: CType
str = S []
-lintype :: GFCC -> CId -> CId -> LinType
-lintype gfcc lang fun = case typeSkeleton (lookType gfcc fun) of
+lintype :: PGF -> CId -> CId -> LinType
+lintype pgf lang fun = case typeSkeleton (lookType pgf fun) of
(cs,c) -> (map vlinc cs, linc c) ---- HOAS
where
- linc = lookLincat gfcc lang
+ linc = lookLincat pgf lang
vlinc (0,c) = linc c
vlinc (i,c) = case linc c of
R ts -> R (ts ++ replicate i str)
-inline :: GFCC -> CId -> Term -> Term
-inline gfcc lang t = case t of
+inline :: PGF -> CId -> Term -> Term
+inline pgf lang t = case t of
F c -> inl $ look c
_ -> composSafeOp inl t
where
- inl = inline gfcc lang
- look = lookLin gfcc lang
+ inl = inline pgf lang
+ look = lookLin pgf lang
composOp :: Monad m => (Term -> m Term) -> Term -> m Term
composOp f trm = case trm of
diff --git a/src-3.0/PGF/Data.hs b/src-3.0/PGF/Data.hs
index 2750cbdfa..8c836c893 100644
--- a/src-3.0/PGF/Data.hs
+++ b/src-3.0/PGF/Data.hs
@@ -8,9 +8,9 @@ import qualified Data.Map as Map
import Data.List
import Data.Array
--- internal datatypes for GFCC
+-- internal datatypes for PGF
-data GFCC = GFCC {
+data PGF = PGF {
absname :: CId ,
cncnames :: [CId] ,
gflags :: Map.Map CId String, -- value of a global flag
@@ -120,17 +120,17 @@ fcatVar = (-4)
-- print statistics
-statGFCC :: GFCC -> String
-statGFCC gfcc = unlines [
- "Abstract\t" ++ prCId (absname gfcc),
- "Concretes\t" ++ unwords (map prCId (cncnames gfcc)),
- "Categories\t" ++ unwords (map prCId (Map.keys (cats (abstract gfcc))))
+statGFCC :: PGF -> String
+statGFCC pgf = unlines [
+ "Abstract\t" ++ prCId (absname pgf),
+ "Concretes\t" ++ unwords (map prCId (cncnames pgf)),
+ "Categories\t" ++ unwords (map prCId (Map.keys (cats (abstract pgf))))
]
-- merge two GFCCs; fails is differens absnames; priority to second arg
-unionGFCC :: GFCC -> GFCC -> GFCC
-unionGFCC one two = case absname one of
+unionPGF :: PGF -> PGF -> PGF
+unionPGF one two = case absname one of
n | n == wildCId -> two -- extending empty grammar
| n == absname two -> one { -- extending grammar with same abstract
concretes = Map.union (concretes two) (concretes one),
@@ -138,8 +138,8 @@ unionGFCC one two = case absname one of
}
_ -> one -- abstracts don't match ---- print error msg
-emptyGFCC :: GFCC
-emptyGFCC = GFCC {
+emptyPGF :: PGF
+emptyPGF = PGF {
absname = wildCId,
cncnames = [] ,
gflags = Map.empty,
@@ -149,9 +149,9 @@ emptyGFCC = GFCC {
-- encode idenfifiers and strings in UTF8
-utf8GFCC :: GFCC -> GFCC
-utf8GFCC gfcc = gfcc {
- concretes = Map.map u8concr (concretes gfcc)
+utf8GFCC :: PGF -> PGF
+utf8GFCC pgf = pgf {
+ concretes = Map.map u8concr (concretes pgf)
}
where
u8concr cnc = cnc {
diff --git a/src-3.0/PGF/Generate.hs b/src-3.0/PGF/Generate.hs
index ac5c25b08..4c369c6d0 100644
--- a/src-3.0/PGF/Generate.hs
+++ b/src-3.0/PGF/Generate.hs
@@ -8,8 +8,8 @@ import qualified Data.Map as M
import System.Random
-- generate an infinite list of trees exhaustively
-generate :: GFCC -> CId -> Maybe Int -> [Exp]
-generate gfcc cat dp = concatMap (\i -> gener i cat) depths
+generate :: PGF -> CId -> Maybe Int -> [Exp]
+generate pgf cat dp = concatMap (\i -> gener i cat) depths
where
gener 0 c = [EApp f [] | (f, ([],_)) <- fns c]
gener i c = [
@@ -20,12 +20,12 @@ generate gfcc cat dp = concatMap (\i -> gener i cat) depths
let tr = EApp f ts,
depth tr >= i
]
- fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat gfcc c]
+ fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat pgf c]
depths = maybe [0 ..] (\d -> [0..d]) dp
-- generate an infinite list of trees randomly
-genRandom :: StdGen -> GFCC -> CId -> [Exp]
-genRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
+genRandom :: StdGen -> PGF -> CId -> [Exp]
+genRandom gen pgf cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
timeout = 47 -- give up
@@ -55,7 +55,7 @@ genRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
in (t:ts, k + ks)
_ -> ([],0)
- fns cat = [(f,(fst (catSkeleton ty))) | (f,ty) <- functionsToCat gfcc cat]
+ fns cat = [(f,(fst (catSkeleton ty))) | (f,ty) <- functionsToCat pgf cat]
{-
@@ -63,8 +63,8 @@ genRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
-- note: you cannot throw away rules with unknown words from the grammar
-- because it is not known which field in each rule may match the input
-searchParse :: Int -> GFCC -> CId -> [String] -> [Exp]
-searchParse i gfcc cat ws = [t | t <- gen, s <- lins t, words s == ws] where
- gen = take i $ generate gfcc cat
- lins t = [linearize gfcc lang t | lang <- cncnames gfcc]
+searchParse :: Int -> PGF -> CId -> [String] -> [Exp]
+searchParse i pgf cat ws = [t | t <- gen, s <- lins t, words s == ws] where
+ gen = take i $ generate pgf cat
+ lins t = [linearize pgf lang t | lang <- cncnames pgf]
-}
diff --git a/src-3.0/PGF/Linearize.hs b/src-3.0/PGF/Linearize.hs
index d84c48f89..2d23e8653 100644
--- a/src-3.0/PGF/Linearize.hs
+++ b/src-3.0/PGF/Linearize.hs
@@ -8,10 +8,10 @@ import Data.List
import Debug.Trace
--- linearization and computation of concrete GFCC Terms
+-- linearization and computation of concrete PGF Terms
-linearize :: GFCC -> CId -> Exp -> String
-linearize mcfg lang = realize . linExp mcfg lang
+linearize :: PGF -> CId -> Exp -> String
+linearize pgf lang = realize . linExp pgf lang
realize :: Term -> String
realize trm = case trm of
@@ -25,8 +25,8 @@ realize trm = case trm of
TM s -> s
_ -> "ERROR " ++ show trm ---- debug
-linExp :: GFCC -> CId -> Exp -> Term
-linExp gfcc lang = lin
+linExp :: PGF -> CId -> Exp -> Term
+linExp pgf lang = lin
where
lin (EAbs xs e ) = case lin e of
R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
@@ -38,12 +38,12 @@ linExp gfcc lang = lin
lin (EVar x ) = TM (prCId x)
lin (EMeta i ) = TM (show i)
- comp = compute gfcc lang
- look = lookLin gfcc lang
+ comp = compute pgf lang
+ look = lookLin pgf lang
-compute :: GFCC -> CId -> [Term] -> Term -> Term
-compute mcfg lang args = comp where
+compute :: PGF -> CId -> [Term] -> Term -> Term
+compute pgf lang args = comp where
comp trm = case trm of
P r p -> proj (comp r) (comp p)
W s t -> W s (comp t)
@@ -54,7 +54,7 @@ compute mcfg lang args = comp where
S ts -> S $ filter (/= S []) $ map comp ts
_ -> trm
- look = lookOper mcfg lang
+ look = lookOper pgf lang
idx xs i = if i > length xs - 1
then trace
diff --git a/src-3.0/PGF/Macros.hs b/src-3.0/PGF/Macros.hs
index 6c6fef1e5..01ab1bb6b 100644
--- a/src-3.0/PGF/Macros.hs
+++ b/src-3.0/PGF/Macros.hs
@@ -8,58 +8,58 @@ import qualified Data.Array as Array
import Data.Maybe
import Data.List
--- operations for manipulating GFCC grammars and objects
+-- operations for manipulating PGF grammars and objects
-lookLin :: GFCC -> CId -> CId -> Term
-lookLin gfcc lang fun =
- lookMap tm0 fun $ lins $ lookMap (error "no lang") lang $ concretes gfcc
+lookLin :: PGF -> CId -> CId -> Term
+lookLin pgf lang fun =
+ lookMap tm0 fun $ lins $ lookMap (error "no lang") lang $ concretes pgf
-lookOper :: GFCC -> CId -> CId -> Term
-lookOper gfcc lang fun =
- lookMap tm0 fun $ opers $ lookMap (error "no lang") lang $ concretes gfcc
+lookOper :: PGF -> CId -> CId -> Term
+lookOper pgf lang fun =
+ lookMap tm0 fun $ opers $ lookMap (error "no lang") lang $ concretes pgf
-lookLincat :: GFCC -> CId -> CId -> Term
-lookLincat gfcc lang fun =
- lookMap tm0 fun $ lincats $ lookMap (error "no lang") lang $ concretes gfcc
+lookLincat :: PGF -> CId -> CId -> Term
+lookLincat pgf lang fun =
+ lookMap tm0 fun $ lincats $ lookMap (error "no lang") lang $ concretes pgf
-lookParamLincat :: GFCC -> CId -> CId -> Term
-lookParamLincat gfcc lang fun =
- lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes gfcc
+lookParamLincat :: PGF -> CId -> CId -> Term
+lookParamLincat pgf lang fun =
+ lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes pgf
-lookType :: GFCC -> CId -> Type
-lookType gfcc f =
- fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc))
+lookType :: PGF -> CId -> Type
+lookType pgf f =
+ fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf))
-lookParser :: GFCC -> CId -> Maybe ParserInfo
-lookParser gfcc lang = parser $ lookMap (error "no lang") lang $ concretes gfcc
+lookParser :: PGF -> CId -> Maybe ParserInfo
+lookParser pgf lang = parser $ lookMap (error "no lang") lang $ concretes pgf
-lookFCFG :: GFCC -> CId -> Maybe FGrammar
-lookFCFG gfcc lang = fmap toFGrammar $ lookParser gfcc lang
+lookFCFG :: PGF -> CId -> Maybe FGrammar
+lookFCFG pgf lang = fmap toFGrammar $ lookParser pgf lang
where
toFGrammar :: ParserInfo -> FGrammar
toFGrammar pinfo = (Array.elems (allRules pinfo), startupCats pinfo)
-lookStartCat :: GFCC -> String
-lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat"))
- [gflags gfcc, aflags (abstract gfcc)]
+lookStartCat :: PGF -> String
+lookStartCat pgf = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat"))
+ [gflags pgf, aflags (abstract pgf)]
-lookGlobalFlag :: GFCC -> CId -> String
-lookGlobalFlag gfcc f =
- lookMap "?" f (gflags gfcc)
+lookGlobalFlag :: PGF -> CId -> String
+lookGlobalFlag pgf f =
+ lookMap "?" f (gflags pgf)
-lookAbsFlag :: GFCC -> CId -> String
-lookAbsFlag gfcc f =
- lookMap "?" f (aflags (abstract gfcc))
+lookAbsFlag :: PGF -> CId -> String
+lookAbsFlag pgf f =
+ lookMap "?" f (aflags (abstract pgf))
-lookCncFlag :: GFCC -> CId -> CId -> String
-lookCncFlag gfcc lang f =
- lookMap "?" f $ cflags $ lookMap (error "no lang") lang $ concretes gfcc
+lookCncFlag :: PGF -> CId -> CId -> String
+lookCncFlag pgf lang f =
+ lookMap "?" f $ cflags $ lookMap (error "no lang") lang $ concretes pgf
-functionsToCat :: GFCC -> CId -> [(CId,Type)]
-functionsToCat gfcc cat =
- [(f,ty) | f <- fs, Just (ty,_) <- [Map.lookup f $ funs $ abstract gfcc]]
+functionsToCat :: PGF -> CId -> [(CId,Type)]
+functionsToCat pgf cat =
+ [(f,ty) | f <- fs, Just (ty,_) <- [Map.lookup f $ funs $ abstract pgf]]
where
- fs = lookMap [] cat $ catfuns $ abstract gfcc
+ fs = lookMap [] cat $ catfuns $ abstract pgf
depth :: Exp -> Int
depth (EAbs _ t) = depth t
diff --git a/src-3.0/PGF/Raw/Convert.hs b/src-3.0/PGF/Raw/Convert.hs
index 9954f3eb5..3caa07aec 100644
--- a/src-3.0/PGF/Raw/Convert.hs
+++ b/src-3.0/PGF/Raw/Convert.hs
@@ -1,4 +1,4 @@
-module PGF.Raw.Convert (toGFCC,fromGFCC) where
+module PGF.Raw.Convert (toPGF,fromPGF) where
import PGF.CId
import PGF.Data
@@ -12,10 +12,10 @@ import qualified Data.Map as Map
pgfMajorVersion, pgfMinorVersion :: Integer
(pgfMajorVersion, pgfMinorVersion) = (1,0)
--- convert parsed grammar to internal GFCC
+-- convert parsed grammar to internal PGF
-toGFCC :: Grammar -> GFCC
-toGFCC (Grm [
+toPGF :: Grammar -> PGF
+toPGF (Grm [
App "pgf" (AInt v1 : AInt v2 : App a []:cs),
App "flags" gfs,
ab@(
@@ -24,7 +24,7 @@ toGFCC (Grm [
App "cat" cts
]),
App "concrete" ccs
- ]) = GFCC {
+ ]) = PGF {
absname = mkCId a,
cncnames = [mkCId c | App c [] <- cs],
gflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- gfs],
@@ -135,20 +135,20 @@ toTerm e = case e of
--- from internal to parser --
------------------------------
-fromGFCC :: GFCC -> Grammar
-fromGFCC gfcc0 = Grm [
+fromPGF :: PGF -> Grammar
+fromPGF pgf0 = Grm [
App "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion
- : App (prCId (absname gfcc)) [] : map (flip App [] . prCId) (cncnames gfcc)),
- App "flags" [App (prCId f) [AStr v] | (f,v) <- Map.toList (gflags gfcc `Map.union` aflags agfcc)],
+ : App (prCId (absname pgf)) [] : map (flip App [] . prCId) (cncnames pgf)),
+ App "flags" [App (prCId f) [AStr v] | (f,v) <- Map.toList (gflags pgf `Map.union` aflags apgf)],
App "abstract" [
- App "fun" [App (prCId f) [fromType t,fromExp d] | (f,(t,d)) <- Map.toList (funs agfcc)],
- App "cat" [App (prCId f) (map fromHypo hs) | (f,hs) <- Map.toList (cats agfcc)]
+ App "fun" [App (prCId f) [fromType t,fromExp d] | (f,(t,d)) <- Map.toList (funs apgf)],
+ App "cat" [App (prCId f) (map fromHypo hs) | (f,hs) <- Map.toList (cats apgf)]
],
- App "concrete" [App (prCId lang) (fromConcrete c) | (lang,c) <- Map.toList (concretes gfcc)]
+ App "concrete" [App (prCId lang) (fromConcrete c) | (lang,c) <- Map.toList (concretes pgf)]
]
where
- gfcc = utf8GFCC gfcc0
- agfcc = abstract gfcc
+ pgf = utf8GFCC pgf0
+ apgf = abstract pgf
fromConcrete cnc = [
App "flags" [App (prCId f) [AStr v] | (f,v) <- Map.toList (cflags cnc)],
App "lin" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lins cnc)],
diff --git a/src-3.0/PGF/ShowLinearize.hs b/src-3.0/PGF/ShowLinearize.hs
index 2aecbffbd..a1c1e476a 100644
--- a/src-3.0/PGF/ShowLinearize.hs
+++ b/src-3.0/PGF/ShowLinearize.hs
@@ -37,7 +37,7 @@ prRecord = prr where
RS s -> prQuotedString s
RCon s -> s
--- uses the encoding of record types in GFCC.paramlincat
+-- uses the encoding of record types in PGF.paramlincat
mkRecord :: Term -> Term -> Record
mkRecord typ trm = case (typ,trm) of
(R rs, R ts) -> RR [(str lab, mkRecord ty t) | (P lab ty, t) <- zip rs ts]
@@ -50,18 +50,18 @@ mkRecord typ trm = case (typ,trm) of
str = realize
-- show all branches, without labels and params
-allLinearize :: GFCC -> CId -> Exp -> String
-allLinearize gfcc lang = concat . map pr . tabularLinearize gfcc lang where
+allLinearize :: PGF -> CId -> Exp -> String
+allLinearize pgf lang = concat . map pr . tabularLinearize pgf lang where
pr (p,vs) = unlines vs
-- show all branches, with labels and params
-tableLinearize :: GFCC -> CId -> Exp -> String
-tableLinearize gfcc lang = unlines . map pr . tabularLinearize gfcc lang where
+tableLinearize :: PGF -> CId -> Exp -> String
+tableLinearize pgf lang = unlines . map pr . tabularLinearize pgf lang where
pr (p,vs) = p +++ ":" +++ unwords (intersperse "|" vs)
-- create a table from labels+params to variants
-tabularLinearize :: GFCC -> CId -> Exp -> [(String,[String])]
-tabularLinearize gfcc lang = branches . recLinearize gfcc lang where
+tabularLinearize :: PGF -> CId -> Exp -> [(String,[String])]
+tabularLinearize pgf lang = branches . recLinearize pgf lang where
branches r = case r of
RR fs -> [(lab +++ b,s) | (lab,t) <- fs, (b,s) <- branches t]
RT fs -> [(lab +++ b,s) | (lab,t) <- fs, (b,s) <- branches t]
@@ -70,17 +70,17 @@ tabularLinearize gfcc lang = branches . recLinearize gfcc lang where
RCon _ -> []
-- show record in GF-source-like syntax
-recordLinearize :: GFCC -> CId -> Exp -> String
-recordLinearize gfcc lang = prRecord . recLinearize gfcc lang
+recordLinearize :: PGF -> CId -> Exp -> String
+recordLinearize pgf lang = prRecord . recLinearize pgf lang
-- create a GF-like record, forming the basis of all functions above
-recLinearize :: GFCC -> CId -> Exp -> Record
-recLinearize gfcc lang exp = mkRecord typ $ linExp gfcc lang exp where
+recLinearize :: PGF -> CId -> Exp -> Record
+recLinearize pgf lang exp = mkRecord typ $ linExp pgf lang exp where
typ = case exp of
- EApp f _ -> lookParamLincat gfcc lang $ valCat $ lookType gfcc f
+ EApp f _ -> lookParamLincat pgf lang $ valCat $ lookType pgf f
--- show GFCC term
-termLinearize :: GFCC -> CId -> Exp -> String
-termLinearize gfcc lang = show . linExp gfcc lang
+-- show PGF term
+termLinearize :: PGF -> CId -> Exp -> String
+termLinearize pgf lang = show . linExp pgf lang
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 17:41:45 +0000