summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@chalmers.se>2008-05-22 15:23:56 +0000
committerkr.angelov <kr.angelov@chalmers.se>2008-05-22 15:23:56 +0000
commit2ecfbf154365177265eed3e1dce5e673ab4b5028 (patch)
tree1d0886667c6d24aa5459dc5e5c68d8352d2da746
parent4c0004f714ff6257abf7187afafae3a57b286c44 (diff)
remove GF.Devel.PrGrammar and use GF.Grammar.PrGrammar instead
-rw-r--r--src-3.0/GF/Compile.hs18
-rw-r--r--src-3.0/GF/Compile/GetGrammar.hs1
-rw-r--r--src-3.0/GF/Compile/GrammarToGFCC.hs7
-rw-r--r--src-3.0/GF/Devel/ModDeps.hs8
-rw-r--r--src-3.0/GF/Devel/PrGrammar.hs233
5 files changed, 14 insertions, 253 deletions
diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs
index 56fd56ce2..7e1ce0356 100644
--- a/src-3.0/GF/Compile.hs
+++ b/src-3.0/GF/Compile.hs
@@ -15,13 +15,12 @@ import GF.Compile.Update
import GF.Grammar.Grammar
import GF.Grammar.Refresh
import GF.Grammar.Lookup
+import GF.Grammar.PrGrammar
import GF.Infra.Ident
import GF.Infra.Option
-import GF.Infra.CompactPrint
import GF.Infra.Modules
import GF.Infra.UseIO
-import GF.Devel.PrGrammar
import GF.Source.GrammarToSource
import qualified GF.Source.AbsGF as A
@@ -66,9 +65,6 @@ intermOut opts opt s = if oElem opt opts then
ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s)
else return ()
-prMod :: SourceModule -> String
-prMod = compactPrint . prModule
-
-- | the environment
type CompileEnv = (Int,SourceGrammar,ModEnv)
@@ -159,25 +155,25 @@ compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
mos = modules gr
mo1 <- ioeErr $ rebuildModule mos mo
- intermOut opts (iOpt "show_rebuild") (prMod mo1)
+ intermOut opts (iOpt "show_rebuild") (prModule mo1)
mo1b <- ioeErr $ extendModule mos mo1
- intermOut opts (iOpt "show_extend") (prMod mo1b)
+ intermOut opts (iOpt "show_extend") (prModule mo1b)
case mo1b of
(_,ModMod n) | not (isCompleteModule n) -> do
return (k,mo1b) -- refresh would fail, since not renamed
_ -> do
mo2:_ <- putpp " renaming " $ ioeErr $ renameModule mos mo1b
- intermOut opts (iOpt "show_rename") (prMod mo2)
+ intermOut opts (iOpt "show_rename") (prModule mo2)
(mo3:_,warnings) <- putpp " type checking" $ ioeErr $ showCheckModule mos mo2
if null warnings then return () else putp warnings $ return ()
- intermOut opts (iOpt "show_typecheck") (prMod mo3)
+ intermOut opts (iOpt "show_typecheck") (prModule mo3)
(k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,mos) mo3
- intermOut opts (iOpt "show_refresh") (prMod mo3r)
+ intermOut opts (iOpt "show_refresh") (prModule mo3r)
let eenv = () --- emptyEEnv
(mo4,eenv') <-
@@ -192,7 +188,7 @@ generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
generateModuleCode opts file minfo = do
let minfo1 = subexpModule minfo
out = prGrammar (MGrammar [minfo1])
- putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
+ putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ out
return minfo1
where
putp = putPointE opts
diff --git a/src-3.0/GF/Compile/GetGrammar.hs b/src-3.0/GF/Compile/GetGrammar.hs
index 220e58665..8e6c887bf 100644
--- a/src-3.0/GF/Compile/GetGrammar.hs
+++ b/src-3.0/GF/Compile/GetGrammar.hs
@@ -20,7 +20,6 @@ import qualified GF.Source.ErrM as E
import GF.Infra.UseIO
import GF.Infra.Modules
import GF.Grammar.Grammar
-import GF.Devel.PrGrammar
import qualified GF.Source.AbsGF as A
import GF.Source.SourceToGrammar
---- import Macros
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index 23c210f28..93fe856ad 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/src-3.0/GF/Compile/GrammarToGFCC.hs
@@ -3,14 +3,14 @@ module GF.Compile.GrammarToGFCC (prGrammar2gfcc,mkCanon2gfcc,addParsers) where
import GF.Compile.OptimizeGF (unshareModule)
-import GF.Grammar.Grammar
-import qualified GF.Grammar.Lookup as Look
-
import qualified GF.GFCC.Macros as CM
import qualified GF.GFCC.DataGFCC as C
import qualified GF.GFCC.DataGFCC as D
import GF.GFCC.CId
import GF.Grammar.Predef
+import GF.Grammar.PrGrammar
+import GF.Grammar.Grammar
+import qualified GF.Grammar.Lookup as Look
import qualified GF.Grammar.Abstract as A
import qualified GF.Grammar.Macros as GM
import qualified GF.Infra.Modules as M
@@ -18,7 +18,6 @@ import qualified GF.Infra.Option as O
import GF.Conversion.SimpleToFCFG (convertConcrete)
import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
-import GF.Devel.PrGrammar
import GF.Devel.PrintGFCC
import GF.Devel.ModDeps
import GF.Infra.Ident
diff --git a/src-3.0/GF/Devel/ModDeps.hs b/src-3.0/GF/Devel/ModDeps.hs
index ec5702910..cfe502f5f 100644
--- a/src-3.0/GF/Devel/ModDeps.hs
+++ b/src-3.0/GF/Devel/ModDeps.hs
@@ -20,13 +20,13 @@ module GF.Devel.ModDeps (mkSourceGrammar,
requiredCanModules
) where
-import GF.Grammar.Grammar
import GF.Infra.Ident
import GF.Infra.Option
-import GF.Devel.PrGrammar
-import GF.Compile.Update
-import GF.Grammar.Lookup
import GF.Infra.Modules
+import GF.Grammar.Grammar
+import GF.Grammar.PrGrammar
+import GF.Grammar.Lookup
+import GF.Compile.Update
import GF.Data.Operations
diff --git a/src-3.0/GF/Devel/PrGrammar.hs b/src-3.0/GF/Devel/PrGrammar.hs
deleted file mode 100644
index 44d1c3200..000000000
--- a/src-3.0/GF/Devel/PrGrammar.hs
+++ /dev/null
@@ -1,233 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : PrGrammar
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/04 11:45:38 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.16 $
---
--- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003
---
--- printing and prettyprinting class
---
--- 8\/1\/2004:
--- Usually followed principle: 'prt_' for displaying in the editor, 'prt'
--- in writing grammars to a file. For some constructs, e.g. 'prMarkedTree',
--- only the former is ever needed.
------------------------------------------------------------------------------
-
-module GF.Devel.PrGrammar where
-
-import GF.Data.Operations
-import GF.Data.Zipper
-import GF.Grammar.Grammar
-import GF.Infra.Modules
-import qualified GF.Source.PrintGF as P
-import GF.Grammar.Values
-import GF.Source.GrammarToSource
---- import GFC (CanonGrammar) --- cycle of modules
-
-import GF.Infra.Option
-import GF.Infra.Ident
-import GF.Data.Str
-
-import Data.List (intersperse)
-
-class Print a where
- prt :: a -> String
- -- | printing with parentheses, if needed
- prt2 :: a -> String
- -- | pretty printing
- prpr :: a -> [String]
- -- | printing without ident qualifications
- prt_ :: a -> String
- prt2 = prt
- prt_ = prt
- prpr = return . prt
-
--- 8/1/2004
---- Usually followed principle: prt_ for displaying in the editor, prt
---- in writing grammars to a file. For some constructs, e.g. prMarkedTree,
---- only the former is ever needed.
-
--- | to show terms etc in error messages
-prtBad :: Print a => String -> a -> Err b
-prtBad s a = Bad (s +++ prt a)
-
-prGrammar :: SourceGrammar -> String
-prGrammar = P.printTree . trGrammar
-
-prModule :: (Ident, SourceModInfo) -> String
-prModule = P.printTree . trModule
-
-instance Print Term where
- prt = P.printTree . trt
- prt_ = prExp
-
-instance Print Ident where
- prt = P.printTree . tri
-
-instance Print Patt where
- prt = P.printTree . trp
-
-instance Print Label where
- prt = P.printTree . trLabel
-
-instance Print MetaSymb where
- prt (MetaSymb i) = "?" ++ show i
-
-prParam :: Param -> String
-prParam (c,co) = prt c +++ prContext co
-
-prContext :: Context -> String
-prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
-
-
--- printing values and trees in editing
-
-instance Print a => Print (Tr a) where
- prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees)
- prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t)
-
--- | we cannot define the method prt_ in this way
-prt_Tree :: Tree -> String
-prt_Tree = prt_ . tree2exp
-
-instance Print TrNode where
- prt (N (bi,at,vt,(cs,ms),_)) =
- prBinds bi ++
- prt at +++ ":" +++ prt vt
- +++ prConstraints cs +++ prMetaSubst ms
- prt_ (N (bi,at,vt,(cs,ms),_)) =
- prBinds bi ++
- prt_ at +++ ":" +++ prt_ vt
- +++ prConstraints cs +++ prMetaSubst ms
-
-prMarkedTree :: Tr (TrNode,Bool) -> [String]
-prMarkedTree = prf 1 where
- prf ind t@(Tr (node, trees)) =
- prNode ind node : concatMap (prf (ind + 2)) trees
- prNode ind node = case node of
- (n, False) -> indent ind (prt_ n)
- (n, _) -> '*' : indent (ind - 1) (prt_ n)
-
-prTree :: Tree -> [String]
-prTree = prMarkedTree . mapTr (\n -> (n,False))
-
--- | a pretty-printer for parsable output
-tree2string :: Tree -> String
-tree2string = unlines . prprTree
-
-prprTree :: Tree -> [String]
-prprTree = prf False where
- prf par t@(Tr (node, trees)) =
- parIf par (prn node : concat [prf (ifPar t) t | t <- trees])
- prn (N (bi,at,_,_,_)) = prb bi ++ prt_ at
- prb [] = ""
- prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
- parIf par (s:ss) = map (indent 2) $
- if par
- then ('(':s) : ss ++ [")"]
- else s:ss
- ifPar (Tr (N ([],_,_,_,_), [])) = False
- ifPar _ = True
-
-
--- auxiliaries
-
-prConstraints :: Constraints -> String
-prConstraints = concat . prConstrs
-
-prMetaSubst :: MetaSubst -> String
-prMetaSubst = concat . prMSubst
-
-prEnv :: Env -> String
----- prEnv [] = prCurly "" ---- for debugging
-prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e
-
-prConstrs :: Constraints -> [String]
-prConstrs = map (\ (v,w) -> prCurly (prt v ++ "<>" ++ prt w))
-
-prMSubst :: MetaSubst -> [String]
-prMSubst = map (\ (m,e) -> prCurly ("?" ++ show m ++ "=" ++ prt e))
-
-prBinds bi = if null bi
- then []
- else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> "
- where
- prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t)
-
-instance Print Val where
- prt (VGen i x) = prt x ++ "{-" ++ show i ++ "-}" ---- latter part for debugging
- prt (VApp u v) = prt u +++ prv1 v
- prt (VCn mc) = prQIdent_ mc
- prt (VClos env e) = case e of
- Meta _ -> prt_ e ++ prEnv env
- _ -> prt_ e ---- ++ prEnv env ---- for debugging
- prt VType = "Type"
-
-prv1 v = case v of
- VApp _ _ -> prParenth $ prt v
- VClos _ _ -> prParenth $ prt v
- _ -> prt v
-
-instance Print Atom where
- prt (AtC f) = prQIdent f
- prt (AtM i) = prt i
- prt (AtV i) = prt i
- prt (AtL s) = prQuotedString s
- prt (AtI i) = show i
- prt (AtF i) = show i
- prt_ (AtC (_,f)) = prt f
- prt_ a = prt a
-
-prQIdent :: QIdent -> String
-prQIdent (m,f) = prt m ++ "." ++ prt f
-
-prQIdent_ :: QIdent -> String
-prQIdent_ (_,f) = prt f
-
--- | print terms without qualifications
-prExp :: Term -> String
-prExp e = case e of
- App f a -> pr1 f +++ pr2 a
- Abs x b -> "\\" ++ prt x +++ "->" +++ prExp b
- Prod x a b -> "(\\" ++ prt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b
- Q _ c -> prt c
- QC _ c -> prt c
- _ -> prt e
- where
- pr1 e = case e of
- Abs _ _ -> prParenth $ prExp e
- Prod _ _ _ -> prParenth $ prExp e
- _ -> prExp e
- pr2 e = case e of
- App _ _ -> prParenth $ prExp e
- _ -> pr1 e
-
--- | option @-strip@ strips qualifications
-prTermOpt :: Options -> Term -> String
-prTermOpt opts = if oElem nostripQualif opts then prt else prExp
-
--- | to get rid of brackets in the editor
-prRefinement :: Term -> String
-prRefinement t = case t of
- Q m c -> prQIdent (m,c)
- QC m c -> prQIdent (m,c)
- _ -> prt t
-
-prOperSignature :: (QIdent,Type) -> String
-prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t
-
--- to look up a constant etc in a search tree
-
-lookupIdent :: Ident -> BinTree Ident b -> Err b
-lookupIdent c t = case lookupTree prt c t of
- Ok v -> return v
- _ -> prtBad "unknown identifier" c
-
-lookupIdentInfo :: Module Ident f a -> Ident -> Err a
-lookupIdentInfo mo i = lookupIdent i (jments mo)