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

some dead code elimination

Browse Source
This commit is contained in:
Krasimir Angelov
2017-08-30 20:42:04 +02:00
parent 070d00a20c
commit 16828fb91e
1 changed files with 12 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
src/compiler/GF/Command/Commands2.hs
View File

@@ -188,7 +188,7 @@ pgfCommands = Map.fromList [
mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP"],
exec = needPGF $ \ opts _ env@(pgf,_) ->
let ts = map fst (generateAll pgf cat)
cat = optCat pgf opts
cat = optType pgf opts
in returnFromCExprs (takeOptNum opts ts),
needsTypeCheck = False
}),
@@ -392,7 +392,7 @@ pgfCommands = Map.fromList [
("tree","convert strings into trees")
],
exec = needPGF $ \opts _ env@(pgf, mos) -> do
let file = valStrOpts "file" "_gftmp" opts
let file = optFile opts
let exprs [] = ([],empty)
exprs ((n,s):ls) | null s
= exprs ls
@@ -688,7 +688,7 @@ pgfCommands = Map.fromList [
cParse env@(pgf,_) opts ss =
parsed [ parse cnc cat s | s<-ss,(lang,cnc)<-cncs]
where
cat = optCat pgf opts
cat = optType pgf opts
cncs = optConcs env opts
parsed rs = Piped (Exprs ts,unlines msgs)
where
@@ -738,35 +738,6 @@ pgfCommands = Map.fromList [
pick l = (,) l `fmap` Map.lookup l cncs
{-
optLins pgf opts ts = case opts of
_ | isOpt "groups" opts ->
map (unlines . snd) $ H.groupResults
[[(lang, linear pgf opts lang t) | lang <- optLangs pgf opts] | t <- ts]
_ -> map (optLin pgf opts) ts
optLin pgf opts t = unlines $
case opts of
_ | isOpt "treebank" opts && isOpt "chunks" opts ->
(H.showCId (H.abstractName pgf) ++ ": " ++ H.showExpr [] t) :
[H.showCId lang ++ ": " ++ li | (lang,li) <- linChunks pgf opts t] --linear pgf opts lang t | lang <- optLangs pgf opts]
_ | isOpt "treebank" opts ->
(H.showCId (H.abstractName pgf) ++ ": " ++ H.showExpr [] t) :
[H.showCId lang ++ ": " ++ linear pgf opts lang t | lang <- optLangs pgf opts]
_ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t
_ -> [linear pgf opts lang t | lang <- optLangs pgf opts]
linChunks pgf opts t =
[(lang, unwords (intersperse "<+>" (map (linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts]
linear :: H.PGF -> [Option] -> H.CId -> H.Expr -> String
linear pgf opts lang = let unl = unlex opts lang in case opts of
_ | isOpt "all" opts -> unlines . concat . intersperse [[]] .
map (map (unl . snd)) . H.tabularLinearizes pgf lang
_ | isOpt "list" opts -> commaList . concat . intersperse [[]] .
map (map (unl . snd)) . H.tabularLinearizes pgf lang
_ | isOpt "table" opts -> unlines . concat . intersperse [[]] .
map (map (\(p,v) -> p+++":"+++unl v)) . H.tabularLinearizes pgf lang
_ | isOpt "bracket" opts -> unwords . map H.showBracketedString . H.bracketedLinearize pgf lang
_ -> unl . H.linearize pgf lang
-- replace each non-atomic constructor with mkC, where C is the val cat
tree2mk pgf = H.showExpr [] . t2m where
t2m t = case H.unApp t of
@@ -802,20 +773,11 @@ pgfCommands = Map.fromList [
optRestricted opts pgf =
H.restrictPGF (\f -> and [H.hasLin pgf la f | la <- optLangs pgf opts]) pgf
optLang = optLangFlag "lang"
optLangs = optLangsFlag "lang"
optLangsFlag f pgf opts = case valStrOpts f "" opts of
"" -> H.languages pgf
lang -> map (completeLang pgf) (chunks ',' lang)
completeLang pgf la = let cla = (H.mkCId la) in
if elem cla (H.languages pgf)
then cla
else (H.mkCId (H.showCId (H.abstractName pgf) ++ la))
optLangFlag f pgf opts = head $ optLangsFlag f pgf opts ++ [H.wildCId]
optOpenTypes opts = case valStrOpts "openclass" "" opts of
"" -> []
cats -> mapMaybe H.readType (chunks ',' cats)
@@ -834,25 +796,19 @@ pgfCommands = Map.fromList [
(_,file) -> do
src <- restricted $ readFile file
return $ transliterateWithFile file src True
optFile opts = valStrOpts "file" "_gftmp" opts
-}
optCat pgf opts =
optFile opts = valStrOpts "file" "_gftmp" opts
optType pgf opts =
case listFlags "cat" opts of
v:_ -> mkType [] (valueString v) []
v:_ -> let str = valueString v
in case readType str of
Just ty -> case checkType pgf ty of
Left msg -> error msg
Right ty -> ty
Nothing -> error ("Can't parse '"++str++"' as a type")
_ -> startCat pgf
{-
optType pgf opts =
let str = valStrOpts "cat" (H.showCId $ H.lookStartCat pgf) opts
in case H.readType str of
Just ty -> case H.checkType pgf ty of
Left tcErr -> error $ render (H.ppTcError tcErr)
Right ty -> ty
Nothing -> error ("Can't parse '"++str++"' as a type")
optComm opts = valStrOpts "command" "" opts
-}
optViewFormat opts = valStrOpts "format" "png" opts
optViewGraph opts = valStrOpts "view" "open" opts
{-