remove GF.Devel.PrGrammar and use GF.Grammar.PrGrammar instead

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

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

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

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
 

src-3.0/GF/Devel/PrGrammar.hs

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