GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

common subexp elimination

Browse Source
This commit is contained in:
aarne
2005-09-18 21:55:46 +00:00
parent 076452779c
commit db4cf670d0
6 changed files with 229 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

88
src/GF/Canon/PrintGFC.hs
View File

@@ -16,6 +16,22 @@ type Doc = [ShowS] -> [ShowS]
doc :: ShowS -> Doc
doc = (:)
docs :: ShowS -> Doc
docs x y = concatD [spc, doc x, spc ] y
spc = doc (showString "&")
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of
"*" :ts -> realnew . rend i ts --H
"&":"&":ts -> showChar ' ' . rend i ts --H
"&" :ts -> rend i ts --H
t :ts -> showString t . rend i ts
_ -> id
realnew = showChar '\n' --H
{-
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of
@@ -26,20 +42,24 @@ render d = rend 0 (map ($ "") $ d []) "" where
"[" :ts -> showChar '[' . rend i ts
"(" :ts -> showChar '(' . rend i ts
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
"}" : ";":ts -> new (i-1) . showChar '}' . showChar ';' . new (i-1) . rend (i-1) ts
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
";" :ts -> showChar ';' . new i . rend i ts
t : "," :ts -> showString t . space "," . rend i ts
t : "@" :ts -> showString t . showChar '@' . rend i ts
t : "," :ts -> showString t . showChar ',' . rend i ts
t : ")" :ts -> showString t . showChar ')' . rend i ts
t : "]" :ts -> showString t . showChar ']' . rend i ts
t : ">" :ts -> showString t . showString ">" . rend i ts --H
t : "." :ts -> showString t . showString "." . rend i ts --H
t : ">" :ts -> showString t . showChar '>' . rend i ts --H
t : "." :ts -> showString t . showChar '.' . rend i ts --H
t@"=>" :ts -> showString t . rend i ts --H
t@"->" :ts -> showString t . rend i ts --H
t :ts -> realspace t . rend i ts --H
_ -> id
space t = showString t . showChar ' ' -- H
realspace t = showString t . (\s -> if null s then "" else (' ':s)) -- H
new i s = s -- H
realnew = showChar '\n' --H
-}
parenth :: Doc -> Doc
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
@@ -79,14 +99,14 @@ prPrec i j = if j<i then parenth else id
instance Print Integer where
prt _ x = doc (shows x)
prt _ x = docs (shows x)
instance Print Double where
prt _ x = doc (shows x)
prt _ x = docs (shows x)
instance Print Ident where
prt _ i = doc (showString $ prIdent i) -- H
prt _ i = docs (showString $ prIdent i) -- H
prtList es = case es of
[] -> (concatD [])
[x] -> (concatD [prt 0 x])
@@ -94,13 +114,13 @@ instance Print Ident where
instance Print Canon where
prt i e = case e of
MGr ids id modules -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";") , prt 0 modules])
MGr ids id modules -> prPrec i 0 (concatD [spc, doc (showString "grammar") , spc, prt 0 ids , spc , doc (showString "of") , spc, prt 0 id , doc (showString ";") , prt 0 modules])
Gr modules -> prPrec i 0 (concatD [prt 0 modules])
instance Print Line where
prt i e = case e of
LMulti ids id -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";")])
LMulti ids id -> prPrec i 0 (concatD [spc, doc (showString "grammar") , spc, prt 0 ids , spc, doc (showString "of") , spc, prt 0 id , doc (showString ";")])
LHeader modtype extend open -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{")])
LFlag flag -> prPrec i 0 (concatD [prt 0 flag , doc (showString ";")])
LDef def -> prPrec i 0 (concatD [prt 0 def , doc (showString ";")])
@@ -117,10 +137,10 @@ instance Print Module where
instance Print ModType where
prt i e = case e of
MTAbs id -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 id])
MTCnc id0 id -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 id0 , doc (showString "of") , prt 0 id])
MTRes id -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 id])
MTTrans id0 id1 id -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id0 , doc (showString ":") , prt 0 id1 , doc (showString "->") , prt 0 id])
MTAbs id -> prPrec i 0 (concatD [spc, doc (showString "abstract") , spc , prt 0 id])
MTCnc id0 id -> prPrec i 0 (concatD [spc, doc (showString "concrete") , spc, prt 0 id0 , spc, doc (showString "of") , spc, prt 0 id])
MTRes id -> prPrec i 0 (concatD [spc, doc (showString "resource") , spc, prt 0 id])
MTTrans id0 id1 id -> prPrec i 0 (concatD [spc, doc (showString "transfer") , spc, prt 0 id0 , doc (showString ":") , prt 0 id1 , doc (showString "->") , prt 0 id])
instance Print Extend where
@@ -131,13 +151,13 @@ instance Print Extend where
instance Print Open where
prt i e = case e of
Opens ids -> prPrec i 0 (concatD [doc (showString "open") , prt 0 ids , doc (showString "in")])
Opens ids -> prPrec i 0 (concatD [spc, doc (showString "open") , spc, prt 0 ids , docs (showString "in")])
NoOpens -> prPrec i 0 (concatD [])
instance Print Flag where
prt i e = case e of
Flg id0 id -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 id0 , doc (showString "=") , prt 0 id])
Flg id0 id -> prPrec i 0 (concatD [spc, doc (showString "flags") , spc, prt 0 id0 , doc (showString "=") , prt 0 id])
prtList es = case es of
[] -> (concatD [])
@@ -145,18 +165,18 @@ instance Print Flag where
instance Print Def where
prt i e = case e of
AbsDCat id decls cidents -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 id , doc (showString "[") , prt 0 decls , doc (showString "]") , doc (showString "=") , prt 0 cidents])
AbsDFun id exp0 exp -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
AbsDTrans id exp -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id , doc (showString "=") , prt 0 exp])
ResDPar id pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 id , doc (showString "=") , prt 0 pardefs])
ResDOper id ctype term -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 id , doc (showString ":") , prt 0 ctype , doc (showString "=") , prt 0 term])
CncDCat id ctype term0 term -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 id , doc (showString "=") , prt 0 ctype , doc (showString "=") , prt 0 term0 , doc (showString ";") , prt 0 term])
CncDFun id cident argvars term0 term -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 id , doc (showString ":") , prt 0 cident , doc (showString "=") , doc (showString "\\") , prt 0 argvars , doc (showString "->") , prt 0 term0 , doc (showString ";") , prt 0 term])
AnyDInd id0 status id -> prPrec i 0 (concatD [prt 0 id0 , prt 0 status , doc (showString "in") , prt 0 id])
AbsDCat id decls cidents -> prPrec i 0 (concatD [docs (showString "cat") , prt 0 id , doc (showString "[") , prt 0 decls , doc (showString "]") , doc (showString "=") , prt 0 cidents])
AbsDFun id exp0 exp -> prPrec i 0 (concatD [docs (showString "fun") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
AbsDTrans id exp -> prPrec i 0 (concatD [docs (showString "transfer") , prt 0 id , doc (showString "=") , prt 0 exp])
ResDPar id pardefs -> prPrec i 0 (concatD [docs (showString "param") , prt 0 id , doc (showString "=") , prt 0 pardefs])
ResDOper id ctype term -> prPrec i 0 (concatD [docs (showString "oper") , prt 0 id , doc (showString ":") , prt 0 ctype , doc (showString "=") , prt 0 term])
CncDCat id ctype term0 term -> prPrec i 0 (concatD [docs (showString "lincat") , prt 0 id , doc (showString "=") , prt 0 ctype , doc (showString "=") , prt 0 term0 , doc (showString ";") , prt 0 term])
CncDFun id cident argvars term0 term -> prPrec i 0 (concatD [docs (showString "lin") , prt 0 id , doc (showString ":") , prt 0 cident , doc (showString "=") , doc (showString "\\") , prt 0 argvars , doc (showString "->") , prt 0 term0 , doc (showString ";") , prt 0 term])
AnyDInd id0 status id -> prPrec i 0 (concatD [prt 0 id0 , prt 0 status , docs (showString "in") , prt 0 id])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "*NEW") , prt 0 xs]) -- H
x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "*") , prt 0 xs]) -- H
instance Print ParDef where
@@ -170,7 +190,7 @@ instance Print ParDef where
instance Print Status where
prt i e = case e of
Canon -> prPrec i 0 (concatD [doc (showString "data")])
Canon -> prPrec i 0 (concatD [docs (showString "data")])
NonCan -> prPrec i 0 (concatD [])
@@ -188,13 +208,13 @@ instance Print Exp where
EProd id exp0 exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp])
EAbs id exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 id , doc (showString "->") , prt 0 exp])
EAtom atom -> prPrec i 2 (concatD [prt 0 atom])
EData -> prPrec i 2 (concatD [doc (showString "data")])
EData -> prPrec i 2 (concatD [docs (showString "data")])
EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")])
instance Print Sort where
prt i e = case e of
SType -> prPrec i 0 (concatD [doc (showString "Type")])
SType -> prPrec i 0 (concatD [docs (showString "Type")])
instance Print Equation where
@@ -242,8 +262,8 @@ instance Print CType where
RecType labellings -> prPrec i 0 (concatD [doc (showString "{") , prt 0 labellings , doc (showString "}")])
Table ctype0 ctype -> prPrec i 0 (concatD [doc (showString "(") , prt 0 ctype0 , doc (showString "=>") , prt 0 ctype , doc (showString ")")])
Cn cident -> prPrec i 0 (concatD [prt 0 cident])
TStr -> prPrec i 0 (concatD [doc (showString "Str")])
TInts n -> prPrec i 0 (concatD [doc (showString "Ints") , prt 0 n])
TStr -> prPrec i 0 (concatD [docs (showString "Str")])
TInts n -> prPrec i 0 (concatD [docs (showString "Ints") , prt 0 n])
prtList es = case es of
[] -> (concatD [])
@@ -266,11 +286,11 @@ instance Print Term where
LI id -> prPrec i 2 (concatD [doc (showString "$") , prt 0 id])
R assigns -> prPrec i 2 (concatD [doc (showString "{") , prt 0 assigns , doc (showString "}")])
P term label -> prPrec i 1 (concatD [prt 2 term , doc (showString ".") , prt 0 label])
T ctype cases -> prPrec i 1 (concatD [doc (showString "table") , prt 0 ctype , doc (showString "{") , prt 0 cases , doc (showString "}")])
V ctype terms -> prPrec i 1 (concatD [doc (showString "table") , prt 0 ctype , doc (showString "[") , prt 2 terms , doc (showString "]")])
T ctype cases -> prPrec i 1 (concatD [docs (showString "table") , prt 0 ctype , doc (showString "{") , prt 0 cases , doc (showString "}")])
V ctype terms -> prPrec i 1 (concatD [docs (showString "table") , prt 0 ctype , doc (showString "[") , prt 2 terms , doc (showString "]")])
S term0 term -> prPrec i 1 (concatD [prt 1 term0 , doc (showString "!") , prt 2 term])
C term0 term -> prPrec i 0 (concatD [prt 0 term0 , doc (showString "++") , prt 1 term])
FV terms -> prPrec i 1 (concatD [doc (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")])
FV terms -> prPrec i 1 (concatD [docs (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")])
EInt n -> prPrec i 2 (concatD [prt 0 n])
K tokn -> prPrec i 2 (concatD [prt 0 tokn])
E -> prPrec i 2 (concatD [doc (showString "[") , doc (showString "]")])
@@ -282,7 +302,7 @@ instance Print Term where
instance Print Tokn where
prt i e = case e of
KS str -> prPrec i 0 (concatD [prt 0 str])
KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")])
KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , docs (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")])
KM str -> prPrec i 0 (concatD [prt 0 str])
@@ -333,7 +353,7 @@ instance Print Patt where
prt i e = case e of
PC cident patts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 patts , doc (showString ")")])
PV id -> prPrec i 0 (concatD [prt 0 id])
PW -> prPrec i 0 (concatD [doc (showString "_")])
PW -> prPrec i 0 (concatD [docs (showString "_")])
PR pattassigns -> prPrec i 0 (concatD [doc (showString "{") , prt 0 pattassigns , doc (showString "}")])
PI n -> prPrec i 0 (concatD [prt 0 n])

152
src/GF/Canon/Subexpressions.hs Normal file
View File

@@ -0,0 +1,152 @@
----------------------------------------------------------------------
-- |
-- Module : Subexpressions
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/18 22:55:46 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.1 $
--
-- Common subexpression elimination.
-- all tables. AR 18\/9\/2005.
-----------------------------------------------------------------------------
module GF.Canon.Subexpressions where -- (subelimCanon) where
import GF.Canon.AbsGFC
import GF.Infra.Ident
import GF.Canon.GFC
import GF.Canon.Look
import GF.Grammar.PrGrammar
import GF.Canon.CMacros as C
import GF.Data.Operations
import qualified GF.Infra.Modules as M
import Control.Monad
import Data.FiniteMap
import Data.List
type TermList = FiniteMap Term (Int,Int) -- number of occs, id
type TermM a = STM (TermList,Int) a
prSubtermStat :: CanonGrammar -> String
prSubtermStat gr = unlines [prt mo ++++ expsIn mo js | (mo,js) <- mos] where
mos = [(i, tree2list (M.jments m)) | (i, M.ModMod m) <- M.modules gr, M.isModCnc m]
expsIn mo js = err id id $ do
(js', (tree,nu)) <- appSTM (getSubtermsMod mo js) (emptyFM,0)
let list0 = filter ((>1) . fst . snd) $ fmToList tree
let list1 = sortBy (\ (_,(m,_)) (_,(n,_)) -> compare n m) list0
return $ unlines [show n ++ "\t" ++ prt trm | (trm,(n,_)) <- list1]
elimSubtermsMod :: (Ident,CanonModInfo) -> Err (Ident, CanonModInfo)
elimSubtermsMod (mo,m) = case m of
M.ModMod (M.Module mt st fs me ops js) -> do
(js',(tree,_)) <- appSTM (getSubtermsMod mo (tree2list js)) (emptyFM,0)
js2 <- liftM buildTree $ addSubexpConsts tree js'
return (mo,M.ModMod (M.Module mt st fs me ops js2))
_ -> return (mo,m)
addSubexpConsts :: FiniteMap Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)]
addSubexpConsts tree lins = do
let opers = [oper id trm | (trm,(nu,id)) <- list, nu > 1]
mapM filterOne $ opers ++ lins
where
filterOne (f,def) = case def of
CncFun ci xs trm pn -> do
trm' <- recomp trm
return (f,CncFun ci xs trm' pn)
ResOper ty trm -> do
trm' <- recomp trm
return (f,ResOper ty trm')
_ -> return (f,def)
recomp t = case t of
I (CIQ _ e) -> do
(nu,exp) <- getCount e
if nu > 1 then return t else recomp exp
_ -> composOp recomp t
list = fmToList tree
tree' = listToFM $ map (\ (e, (nu,id)) -> (ident id,(nu,e))) $ list
getCount e = case lookupFM tree' e of
Just v -> return v
_ -> return (2,undefined) --- global from elsewhere: keep
oper id trm = (ident id, ResOper TStr trm) --- type TStr does not matter
getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM [(Ident,Info)]
getSubtermsMod mo js = do
js' <- mapM getInfo js
tryAgain
tryAgain --- do twice instead of fixpoint iteration
return js' ----
where
getInfo fi@(f,i) = case i of
CncFun ci xs trm pn -> do
trm' <- getSubterms mo trm
return $ (f,CncFun ci xs trm' pn)
_ -> return fi
tryAgain = do
(ts,i) <- readSTM
let trms = map fst $ fmToList ts
mapM (getSubtermsAgain mo) trms
(ts',i') <- readSTM
if False ---- i' > i || count ts' > count ts
then tryAgain
else return ()
count = sum . map (fst . snd) . fmToList -- how many subterms there are
getSubterms :: Ident -> Term -> TermM Term
getSubterms mo t = case t of
Par _ (_:_) -> add t
T _ cs -> add t
V _ ts -> add t
K (KP _ _) -> add t
_ -> composOp (getSubterms mo) t
where
add t = do
(ts,i) <- readSTM
let
((count,id),next) = case lookupFM ts t of
Just (nu,id) -> ((nu+1,id), i)
_ -> ((1, i ), i+1)
writeSTM (addToFM ts t (count,id), next)
return $ I $ cident mo id
-- this is used in later phases of iteration
getSubtermsAgain :: Ident -> Term -> TermM Term
getSubtermsAgain mo t = case t of
T ty cs -> do
let (ps,ts) = unzip [(p,t) | Cas p t <- cs]
ts' <- mapM (getSubterms mo) ts
return $ T ty $ [Cas p t | (p,t) <- zip ps ts']
V ty ts -> do
liftM (V ty) $ mapM (getSubterms mo) ts
Par _ _ -> return t
K _ -> return t
_ -> getSubterms mo t
ident :: Int -> Ident
ident i = identC ("A''" ++ show i) ---
cident :: Ident -> Int -> CIdent
cident mo = CIQ mo . ident
unSubelimCanon :: CanonGrammar -> CanonGrammar
unSubelimCanon gr@(M.MGrammar modules) =
M.MGrammar $ map unparModule modules where
unparModule (i,m) = case m of
M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) ->
(i, M.ModMod (M.Module mt st fs me ops (mapTree unparInfo js)))
_ -> (i,m)
unparInfo (c,info) = case info of
CncFun k xs t m -> (c, CncFun k xs (unparTerm t) m)
_ -> (c,info)
unparTerm t = case t of
I c -> errVal t $ liftM unparTerm $ lookupGlobal gr c
_ -> C.composSafeOp unparTerm t

13
src/GF/Compile/Compile.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/06/10 21:04:01 $
-- > CVS $Date: 2005/09/18 22:55:46 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.41 $
-- > CVS $Revision: 1.42 $
--
-- The top-level compilation chain from source file to gfc\/gfr.
-----------------------------------------------------------------------------
@@ -38,6 +38,7 @@ import GF.Compile.CheckGrammar
import GF.Compile.Optimize
import GF.Compile.GrammarToCanon
import GF.Canon.Share
import GF.Canon.Subexpressions (elimSubtermsMod)
import qualified GF.Canon.CanonToGrammar as CG
@@ -283,7 +284,7 @@ generateModuleCode opts path minfo@(name,info) = do
minfo0 <- ioeErr $ redModInfo minfo
let oopts = addOptions opts (iOpts (flagsModule minfo))
optim = maybe "share" id $ getOptVal oopts useOptimizer
minfo' <- return $
minfo1 <- return $
case optim of
"parametrize" -> shareModule paramOpt minfo0 -- parametrization and sharing
"values" -> shareModule valOpt minfo0 -- tables as courses-of-values
@@ -292,6 +293,12 @@ generateModuleCode opts path minfo@(name,info) = do
"none" -> minfo0 -- no optimization
_ -> shareModule shareOpt minfo0 -- sharing; default
-- do common subexpression elimination if required by flag "subs"
minfo' <-
if oElem elimSubs opts
then ioeErr $ elimSubtermsMod minfo1
else return minfo1
-- for resource, also emit gfr.
--- Also for incomplete, to create timestamped gfc/gfr files
case info of

10
src/GF/Compile/ShellState.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/01 09:53:18 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.46 $
-- > CVS $Date: 2005/09/18 22:55:46 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.47 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -21,6 +21,7 @@ import GF.Grammar.Macros
import GF.Grammar.MMacros
import GF.Canon.Look
import GF.Canon.Subexpressions
import GF.Grammar.LookAbs
import GF.Compile.ModDeps
import qualified GF.Infra.Modules as M
@@ -185,7 +186,8 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
let concrs = maybe [] (M.allConcretes cgr) abstr0
concr0 = ifNull Nothing (return . head) concrs
notInrts f = notElem f $ map fst rts
cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all...
sub = if oElem elimSubs opts then unSubelimCanon else id
cfs <- mapM (canon2cf opts (sub cgr)) concrs --- why need to update all...
let pinfosOld = map (CnvOld.pInfo opts cgr) concrs -- peb 18/6 (OBSOLETE)

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

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/06/10 21:04:01 $
-- > CVS $Date: 2005/09/18 22:55:46 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.30 $
-- > CVS $Revision: 1.31 $
--
-- Options and flags used in GF shell commands and files.
--
@@ -189,6 +189,7 @@ checkCirc = iOpt "nocirc"
noCheckCirc = iOpt "nocheckcirc"
lexerByNeed = iOpt "cflexer"
useUTF8id = iOpt "utf8id"
elimSubs = iOpt "subs"
-- ** linearization

6
src/GF/UseGrammar/Custom.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/14 16:26:22 $
-- > CVS $Date: 2005/09/18 22:55:46 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.73 $
-- > CVS $Revision: 1.74 $
--
-- A database for customizable GF shell commands.
--
@@ -82,6 +82,7 @@ import qualified GF.Conversion.Types as CnvTypes
import qualified GF.Conversion.Haskell as CnvHaskell
import qualified GF.Conversion.Prolog as CnvProlog
import GF.Canon.Unparametrize
import GF.Canon.Subexpressions
import GF.Canon.GFC
import qualified GF.Canon.MkGFC as MC
@@ -260,6 +261,7 @@ customGrammarPrinter =
,(strCI "printnames", C.prPrintnamesGrammar . stateGrammarST)
,(strCI "stat", prStatistics . stateGrammarST)
,(strCI "unpar", prCanon . unparametrizeCanon . stateGrammarST)
,(strCI "subs", prSubtermStat . stateGrammarST)
{- ----
(strCI "gf", prt . st2grammar . stateGrammarST) -- DEFAULT