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

replace GFCC with PGF in (almost) all places

Browse Source
This commit is contained in:
krasimir
2008-05-30 11:15:33 +00:00
parent 1172539a95
commit 8bb0c32a9c
20 changed files with 246 additions and 267 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
src-3.0/GF/Command/Commands.hs
View File

@@ -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

20
src-3.0/GF/Command/Importing.hs
View File

@@ -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

2
src-3.0/GF/Command/Interpreter.hs
View File

@@ -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
}

20
src-3.0/GF/Compile.hs
View File

@@ -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

16
src-3.0/GF/Compile/Export.hs
View File

@@ -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

6
src-3.0/GF/Compile/GFCCtoHaskell.hs
View File

@@ -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]) |

14
src-3.0/GF/Compile/GFCCtoJS.hs
View File

@@ -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

20
src-3.0/GF/Compile/GrammarToGFCC.hs
View File

@@ -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

16
src-3.0/GF/Compile/OptimizeGFCC.hs
View File

@@ -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

10
src-3.0/GF/Infra/Option.hs
View File

@@ -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)]