GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-10 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

correctly distinguish between fun and data judgements

Browse Source
This commit is contained in:
krangelov
2021-11-18 13:50:09 +01:00
parent 7ff38bfcbe
commit 06980404a9
27 changed files with 59 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/compiler/GF/Command/Importing.hs
View File

@@ -1,7 +1,6 @@
module GF.Command.Importing (importGrammar, importSource) where
import PGF2
import PGF2.Internal(unionPGF)
import GF.Compile
import GF.Compile.Multi (readMulti)
@@ -50,6 +49,8 @@ ioUnionPGF (Just one) two =
Nothing -> putStrLn "Abstract changed, previous concretes discarded." >> return (Just two)
Just pgf -> return (Just pgf)
unionPGF = error "TODO: unionPGF"
importSource :: Options -> [FilePath] -> IO SourceGrammar
importSource opts files = fmap (snd.snd) (batchCompile opts files)

1
src/compiler/GF/Compile/CFGtoPGF.hs
View File

@@ -7,7 +7,6 @@ import GF.Infra.Option
import GF.Compile.OptimizePGF
import PGF2
import PGF2.Internal
import qualified Data.Set as Set
import qualified Data.Map as Map

2
src/compiler/GF/Compile/Export.hs
View File

@@ -4,7 +4,6 @@ import PGF2
import GF.Compile.PGFtoHaskell
--import GF.Compile.PGFtoAbstract
import GF.Compile.PGFtoJava
import GF.Compile.PGFtoJSON
import GF.Infra.Option
--import GF.Speech.CFG
import GF.Speech.PGFToCFG
@@ -35,7 +34,6 @@ exportPGF opts fmt pgf =
FmtPGFPretty -> multi "txt" (showPGF)
FmtCanonicalGF -> [] -- canon "gf" (render80 . abstract2canonical)
FmtCanonicalJson-> []
FmtJSON -> multi "json" pgf2json
FmtHaskell -> multi "hs" (grammar2haskell opts name)
FmtJava -> multi "java" (grammar2java opts name)
FmtBNF -> single "bnf" bnfPrinter

6
src/compiler/GF/Compile/GenerateBC.hs
View File

@@ -5,7 +5,7 @@ import GF.Grammar
import GF.Grammar.Lookup(lookupAbsDef,lookupFunType)
import GF.Data.Operations
import PGF2(Literal(..))
import PGF2.Internal(CodeLabel,Instr(..),IVal(..),TailInfo(..))
import PGF2.ByteCode
import qualified Data.Map as Map
import Data.List(nub,mapAccumL)
import Data.Maybe(fromMaybe)
@@ -19,9 +19,7 @@ generateByteCode gr arity eqs =
b = if arity == 0 || null eqs
then instrs
else CHECK_ARGS arity:instrs
in case bs of
[[FAIL]] -> [] -- in the runtime this is a more efficient variant of [[FAIL]]
_ -> reverse bs
in reverse bs
where
is = push_is (arity-1) arity []

2
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -48,7 +48,7 @@ grammar2PGF opts gr am probs = do
pgf <- modifyPGF pgf $ do
sequence_ [setAbstractFlag name value | (name,value) <- optionsPGF aflags]
sequence_ [createCategory c ctxt p | (c,ctxt,p) <- cats]
sequence_ [createFunction f ty arity p | (f,ty,arity,_,p) <- funs]
sequence_ [createFunction f ty arity bcode p | (f,ty,arity,bcode,p) <- funs]
forM_ (allConcretes gr am) $ \cm ->
createConcrete (mi2i cm) $ do
let cflags = err (const noOptions) mflags (lookupModule gr cm)

1
src/compiler/GF/Compile/PGFtoHaskell.hs
View File

@@ -17,7 +17,6 @@
module GF.Compile.PGFtoHaskell (grammar2haskell) where
import PGF2
import PGF2.Internal
import GF.Data.Operations
import GF.Infra.Option

111
src/compiler/GF/Compile/PGFtoJSON.hs
View File

@@ -1,111 +0,0 @@
module GF.Compile.PGFtoJSON (pgf2json) where
import PGF2
import PGF2.Internal
import Text.JSON
import qualified Data.Map as Map
pgf2json :: PGF -> String
pgf2json pgf = error "TODO: pgf2json"
{- encode $ makeObj
[ ("abstract", abstract2json pgf)
, ("concretes", makeObj $ map concrete2json
(Map.toList (languages pgf)))
]
abstract2json :: PGF -> JSValue
abstract2json pgf =
makeObj
[ ("name", showJSON (abstractName pgf))
, ("startcat", showJSON (showType [] (startCat pgf)))
, ("funs", makeObj $ map (absdef2json pgf) (functions pgf))
]
absdef2json :: PGF -> Fun -> (String,JSValue)
absdef2json pgf f = (f,sig)
where
Just (hypos,cat,_) = fmap unType (functionType pgf f)
sig = makeObj
[ ("args", showJSON $ map (\(_,_,ty) -> showType [] ty) hypos)
, ("cat", showJSON cat)
]
lit2json :: Literal -> JSValue
lit2json (LStr s) = showJSON s
lit2json (LInt n) = showJSON n
lit2json (LFlt d) = showJSON d
concrete2json :: (ConcName,Concr) -> (String,JSValue)
concrete2json (c,cnc) = (c,obj)
where
obj = makeObj
[ ("flags", makeObj [(k, lit2json v) | (k,v) <- concrFlags cnc])
, ("productions", makeObj [(show fid, showJSON (map frule2json (concrProductions cnc fid))) | (_,start,end,_) <- concrCategories cnc, fid <- [start..end]])
, ("functions", showJSON [ffun2json funid (concrFunction cnc funid) | funid <- [0..concrTotalFuns cnc-1]])
, ("sequences", showJSON [seq2json seqid (concrSequence cnc seqid) | seqid <- [0..concrTotalSeqs cnc-1]])
, ("categories", makeObj $ map cat2json (concrCategories cnc))
, ("totalfids", showJSON (concrTotalCats cnc))
]
cat2json :: (Cat,FId,FId,[String]) -> (String,JSValue)
cat2json (cat,start,end,_) = (cat, ixs)
where
ixs = makeObj
[ ("start", showJSON start)
, ("end", showJSON end)
]
frule2json :: Production -> JSValue
frule2json (PApply fid args) =
makeObj
[ ("type", showJSON "Apply")
, ("fid", showJSON fid)
, ("args", showJSON (map farg2json args))
]
frule2json (PCoerce arg) =
makeObj
[ ("type", showJSON "Coerce")
, ("arg", showJSON arg)
]
farg2json :: PArg -> JSValue
farg2json (PArg hypos fid) =
makeObj
[ ("type", showJSON "PArg")
, ("hypos", JSArray $ map (showJSON . snd) hypos)
, ("fid", showJSON fid)
]
ffun2json :: FunId -> (Fun,[SeqId]) -> JSValue
ffun2json funid (fun,seqids) =
makeObj
[ ("name", showJSON fun)
, ("lins", showJSON seqids)
]
seq2json :: SeqId -> [Symbol] -> JSValue
seq2json seqid seq = showJSON [sym2json sym | sym <- seq]
sym2json :: Symbol -> JSValue
sym2json (SymCat n l) = new "SymCat" [showJSON n, showJSON l]
sym2json (SymLit n l) = new "SymLit" [showJSON n, showJSON l]
sym2json (SymVar n l) = new "SymVar" [showJSON n, showJSON l]
sym2json (SymKS t) = new "SymKS" [showJSON t]
sym2json (SymKP ts alts) = new "SymKP" [JSArray (map sym2json ts), JSArray (map alt2json alts)]
sym2json SymBIND = new "SymKS" [showJSON "&+"]
sym2json SymSOFT_BIND = new "SymKS" [showJSON "&+"]
sym2json SymSOFT_SPACE = new "SymKS" [showJSON "&+"]
sym2json SymCAPIT = new "SymKS" [showJSON "&|"]
sym2json SymALL_CAPIT = new "SymKS" [showJSON "&|"]
sym2json SymNE = new "SymNE" []
alt2json :: ([Symbol],[String]) -> JSValue
alt2json (ps,ts) = new "Alt" [showJSON (map sym2json ps), showJSON ts]
new :: String -> [JSValue] -> JSValue
new f xs =
makeObj
[ ("type", showJSON f)
, ("args", showJSON xs)
]
-}

22
src/compiler/GF/Compiler.hs
View File

@@ -1,7 +1,6 @@
module GF.Compiler (mainGFC, linkGrammars, writeGrammar, writeOutputs) where
import PGF2
import PGF2.Internal(unionPGF,writeConcr)
import GF.Compile as S(batchCompile,link,srcAbsName)
import GF.CompileInParallel as P(parallelBatchCompile)
import GF.Compile.Export
@@ -148,6 +147,8 @@ unionPGFFiles opts fs =
readPGFVerbose f =
putPointE Normal opts ("Reading " ++ f ++ "...") $ liftIO $ readPGF f
unionPGF = error "TODO: unionPGF"
-- | Export the PGF to the 'OutputFormat's specified in the 'Options'.
-- Calls 'exportPGF'.
writeOutputs :: Options -> PGF -> IOE ()
@@ -162,22 +163,9 @@ writeOutputs opts pgf = do
writeGrammar :: Options -> PGF -> IOE ()
writeGrammar opts pgf =
if fst (flag optLinkTargets opts)
then if flag optSplitPGF opts
then writeSplitPGF
else writeNormalPGF
then do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
writing opts outfile (writePGF outfile pgf)
else return ()
where
writeNormalPGF =
do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
writing opts outfile (writePGF outfile pgf)
writeSplitPGF =
do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
writing opts outfile $ writePGF outfile pgf
forM_ (Map.toList (languages pgf)) $ \(concrname,concr) -> do
let outfile = outputPath opts (concrname <.> "pgf_c")
writing opts outfile (writeConcr outfile concr)
writeOutput :: Options -> FilePath-> String -> IOE ()
writeOutput opts file str = writing opts path $ writeUTF8File path str
@@ -189,7 +177,7 @@ grammarName :: Options -> PGF -> String
grammarName opts pgf = grammarName' opts (abstractName pgf)
grammarName' opts abs = fromMaybe abs (flag optName opts)
outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
outputJustPGF opts = null (flag optOutputFormats opts)
outputPath opts file = maybe id (</>) (flag optOutputDir opts) file

5
src/compiler/GF/Infra/Option.hs
View File

@@ -170,7 +170,6 @@ data Flags = Flags {
optPMCFG :: Bool,
optOptimizations :: Set Optimization,
optOptimizePGF :: Bool,
optSplitPGF :: Bool,
optCFGTransforms :: Set CFGTransform,
optLibraryPath :: [FilePath],
optStartCat :: Maybe String,
@@ -282,7 +281,6 @@ defaultFlags = Flags {
optPMCFG = True,
optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],
optOptimizePGF = False,
optSplitPGF = False,
optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter,
CFGTopDownFilter, CFGMergeIdentical],
optLibraryPath = [],
@@ -378,8 +376,6 @@ optDescr =
"Select an optimization package. OPT = all | values | parametrize | none",
Option [] ["optimize-pgf"] (NoArg (optimize_pgf True))
"Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",
Option [] ["split-pgf"] (NoArg (splitPGF True))
"Split the PGF into one file per language. This allows the runtime to load only individual languages",
Option [] ["cfg"] (ReqArg cfgTransform "TRANS") "Enable or disable specific CFG transformations. TRANS = merge, no-merge, bottomup, no-bottomup, ...",
Option [] ["heuristic_search_factor"] (ReqArg (readDouble (\d o -> o { optHeuristicFactor = Just d })) "FACTOR") "Set the heuristic search factor for statistical parsing",
Option [] ["case_sensitive"] (onOff (\v -> set $ \o -> o{optCaseSensitive=v}) True) "Set the parser in case-sensitive/insensitive mode [sensitive by default]",
@@ -451,7 +447,6 @@ optDescr =
Nothing -> fail $ "Unknown optimization package: " ++ x
optimize_pgf x = set $ \o -> o { optOptimizePGF = x }
splitPGF x = set $ \o -> o { optSplitPGF = x }
cfgTransform x = let (x', b) = case x of
'n':'o':'-':rest -> (rest, False)

1
src/compiler/GF/Speech/PGFToCFG.hs
View File

@@ -7,7 +7,6 @@
module GF.Speech.PGFToCFG (bnfPrinter, pgfToCFG) where
import PGF2
import PGF2.Internal
import GF.Grammar.CFG hiding (Symbol)
import Data.Map (Map)