diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index b6a992232..701a98f3b 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -47,7 +47,7 @@ import Data.Maybe
 import qualified Data.Map as Map
 --import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead!
 import GF.System.Process
-import Text.PrettyPrint
+import GF.Text.Pretty
 import Data.List (sort)
 --import Debug.Trace
 --import System.Random (newStdGen) ----
@@ -762,19 +762,19 @@ allCommands = Map.fromList [
                                 Just e  -> let (es,err) = exprs ls
                                            in case inferExpr pgf e of
                                                 Right (e,t) -> (e:es,err)
-                                                Left tcerr  -> (es,text "on line" <+> int n <> colon $$ nest 2 (ppTcError tcerr) $$ err)
+                                                Left tcerr  -> (es,"on line" <+> n <> ':' $$ nest 2 (ppTcError tcerr) $$ err)
                                 Nothing -> let (es,err) = exprs ls
-                                           in (es,text "on line" <+> int n <> colon <+> text "parse error" $$ err)
+                                           in (es,"on line" <+> n <> ':' <+> "parse error" $$ err)
            returnFromLines ls = case exprs ls of
-                                  (es, err) | null es   -> return $ pipeMessage $ render (err $$ text "no trees found")
+                                  (es, err) | null es   -> return $ pipeMessage $ render (err $$ "no trees found")
                                             | otherwise -> return $ pipeWithMessage es (render err)
 
        s <- restricted $ readFile file
        case opts of
          _ | isOpt "lines" opts && isOpt "tree" opts ->
-               returnFromLines (zip [1..] (lines s))
+               returnFromLines (zip [1::Int ..] (lines s))
          _ | isOpt "tree" opts ->
-               returnFromLines [(1,s)]
+               returnFromLines [(1::Int,s)]
          _ | isOpt "lines" opts -> return (fromStrings $ lines s)
          _ -> return (fromString s),
      flags = [("file","the input file name")]
@@ -1145,9 +1145,9 @@ allCommands = Map.fromList [
                                                         render (ppCat id cd $$
                                                                 if null (functionsToCat pgf id)
                                                                   then empty
-                                                                  else space $$
+                                                                  else ' ' $$
                                                                        vcat [ppFun fid (ty,0,Just [],0,0) | (fid,ty) <- functionsToCat pgf id] $$
-                                                                       space)
+                                                                       ' ')
                                                      let (_,_,prob,_) = cd
                                                      putStrLn ("Probability: "++show prob)
                                                      return void
@@ -1290,7 +1290,7 @@ allCommands = Map.fromList [
      | otherwise            = case po of
                                 ParseOk ts     -> let Piped (es',msg') = fromExprs ts
                                                   in (es'++es,msg'++msg)
-                                TypeError errs -> ([], render (text "The parsing is successful but the type checking failed with error(s):" $$
+                                TypeError errs -> ([], render ("The parsing is successful but the type checking failed with error(s):" $$
                                                                nest 2 (vcat (map (ppTcError . snd) errs)))
                                                        ++ "\n" ++ msg)
                                 ParseFailed i  -> ([], "The parser failed at token " ++ show (words s !! max 0 (i-1))
@@ -1448,13 +1448,13 @@ execToktok (pgf, _) opts exprs = do
 
 trie = render . pptss . toTrie . map toATree
   where
-    pptss [ts] = text "*"<+>nest 2 (ppts ts)
-    pptss tss  = vcat [int i<+>nest 2 (ppts ts)|(i,ts)<-zip [1..] tss]
+    pptss [ts] = "*"<+>nest 2 (ppts ts)
+    pptss tss  = vcat [i<+>nest 2 (ppts ts)|(i,ts)<-zip [(1::Int)..] tss]
 
     ppts = vcat . map ppt
 
     ppt t =
       case t of
-        Oth e     -> text (showExpr [] e)
-        Ap f [[]] -> text (showCId f)
-        Ap f tss  -> text (showCId f) $$ nest 2 (pptss tss)
+        Oth e     -> pp (showExpr [] e)
+        Ap f [[]] -> pp (showCId f)
+        Ap f tss  -> showCId f $$ nest 2 (pptss tss)
diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index 6cebd2196..207b6cb7c 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -1,4 +1,4 @@
-module GF.Compile (batchCompile, link, srcAbsName, compileToPGF, compileSourceGrammar) where
+module GF.Compile (batchCompile, link, srcAbsName, compileToPGF) where
 import Prelude hiding (catch)
 import GF.System.Catch
 
@@ -32,7 +32,7 @@ import qualified Data.Map as Map
 --import qualified Data.Set as Set
 import Data.List(nub)
 import Data.Time(UTCTime)
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 import PGF.Internal(optimizePGF)
 import PGF
@@ -59,7 +59,7 @@ batchCompile opts files = do
   let cnc = identS (justModuleName (last files))
       t = maximum . map fst $ Map.elems menv
   return (cnc,t,gr)
-
+{-
 -- to compile a set of modules, e.g. an old GF or a .cf file
 compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
 compileSourceGrammar opts gr = do
@@ -68,12 +68,12 @@ compileSourceGrammar opts gr = do
                      emptyCompileEnv
                      (modules gr)
   return gr'
-
+-}
 
 -- to output an intermediate stage
 intermOut :: Options -> Dump -> Doc -> IOE ()
 intermOut opts d doc
-  | dump opts d = ePutStrLn (render (text "\n\n--#" <+> text (show d) $$ doc))
+  | dump opts d = ePutStrLn (render ("\n\n--#" <+> show d $$ doc))
   | otherwise   = return ()
 
 warnOut opts warnings
@@ -118,8 +118,8 @@ compileModule opts1 env file = do
                        exists <- liftIO $ doesFileExist file1
                        if exists
                          then return file1
-                         else raise (render (text "None of these files exists:" $$ nest 2 (text file $$ text file1)))
-               else raise (render (text "File" <+> text file <+> text "does not exist."))
+                         else raise (render ("None of these files exists:" $$ nest 2 (file $$ file1)))
+               else raise (render ("File" <+> file <+> "does not exist."))
 
 compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
 compileOne opts env@(_,srcgr,_) file = do
@@ -171,32 +171,28 @@ compileOne opts env@(_,srcgr,_) file = do
    isConcr (_,m) = isModCnc m && mstatus m /= MSIncomplete
 
 compileSourceModule :: Options -> FilePath -> CompileEnv -> Maybe FilePath -> SourceModule -> IOE CompileEnv
-compileSourceModule opts cwd env@(k,gr,_) mb_gfFile mo@(i,mi) = do
+compileSourceModule opts cwd env@(k,gr,_) mb_gfFile mo0@(i,mi) = do
 
-  mo1  <- runPass Rebuild "" (rebuildModule cwd gr mo)
-  mo1b <- runPass Extend "" (extendModule cwd gr mo1)
+  mo1a <- runPass Rebuild "" (rebuildModule cwd gr mo0)
+  mo1b <- runPass Extend "" (extendModule cwd gr mo1a)
 
   case mo1b of
-    (_,n) | not (isCompleteModule n) ->
-      if tagsFlag then generateTags k mo1b else generateGFO k mo1b
+    (_,n) | not (isCompleteModule n) -> generateTagsOr generateGFO k mo1b
     _ -> do
       mo2 <- runPass Rename "renaming" $ renameModule cwd gr mo1b
       mo3 <- runPass TypeCheck "type checking" $ checkModule opts cwd gr mo2
-      if tagsFlag then generateTags k mo3 else compileCompleteModule k mo3
+      generateTagsOr compileCompleteModule k mo3
   where
     compileCompleteModule k mo3 = do
---    (k',mo3r:_) <- runPass2 (head.snd) Refresh "refreshing" $
---                   refreshModule (k,gr) mo3
-      let k' = k
-          mo3r = mo3
-      mo4 <- runPass2 id Optimize "optimizing" $ optimizeModule opts gr mo3r
+      mo4 <- runPass2 id Optimize "optimizing" $ optimizeModule opts gr mo3
       mo5 <- if isModCnc (snd mo4) && flag optPMCFG opts
              then runPass2' "generating PMCFG" $ generatePMCFG opts gr mb_gfFile mo4
              else runPass2' "" $ return mo4
-      generateGFO k' mo5
+      generateGFO k mo5
 
   ------------------------------
-    tagsFlag = flag optTagsOnly opts
+    generateTagsOr compile =
+       if flag optTagsOnly opts then generateTags else compile
 
     generateGFO k mo =
       do let mb_gfo = fmap (gf2gfo opts) mb_gfFile
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 5f2e94f68..10cbd4bb9 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -42,7 +42,7 @@ import GF.Infra.CheckM
 import Data.List
 import qualified Data.Set as Set
 import Control.Monad
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 -- | checking is performed in the dependency order of modules
 checkModule :: Options -> FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
@@ -78,8 +78,8 @@ checkRestrictedInheritance cwd sgr (name,mo) = checkInModule cwd mo NoLoc empty
            (f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
      case illegals of 
        [] -> return ()
-       cs -> checkWarn (text "In inherited module" <+> ppIdent i <> text ", dependence of excluded constants:" $$
-                         nest 2 (vcat [ppIdent f <+> text "on" <+> fsep (map ppIdent is) | (f,is) <- cs]))
+       cs -> checkWarn ("In inherited module" <+> i <> ", dependence of excluded constants:" $$
+                         nest 2 (vcat [f <+> "on" <+> fsep is | (f,is) <- cs]))
    allDeps = concatMap (allDependencies (const True) . jments . snd) mos
 
 checkCompleteGrammar :: Options -> FilePath -> SourceGrammar -> SourceModule -> SourceModule -> Check SourceModule
@@ -126,15 +126,15 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
                        Bad _  -> do noLinOf c
                                     return js
          where noLinOf c = when (verbAtLeast opts Normal) $
-                           checkWarn (text "no linearization of" <+> ppIdent c)
+                           checkWarn ("no linearization of" <+> c)
        AbsCat (Just _) -> case lookupIdent c js of
          Ok (AnyInd _ _) -> return js
          Ok (CncCat (Just _) _ _ _ _) -> return js
          Ok (CncCat Nothing md mr mp mpmcfg) -> do
-           checkWarn (text "no linearization type for" <+> ppIdent c <> text ", inserting default {s : Str}")
+           checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
            return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
          _ -> do
-           checkWarn (text "no linearization type for" <+> ppIdent c <> text ", inserting default {s : Str}")
+           checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
            return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js
        _ -> return js
      
@@ -145,11 +145,11 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
                                         do (cont,val) <- linTypeOfType gr cm ty
                                            let linty = (snd (valCat ty),cont,val)
                                            return $ updateTree (c,CncFun (Just linty) d mn mf) js
-                             _       -> do checkWarn (text "function" <+> ppIdent c <+> text "is not in abstract")
+                             _       -> do checkWarn ("function" <+> c <+> "is not in abstract")
                                            return js
        CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
                              Ok _ -> return $ updateTree i js
-                             _    -> do checkWarn (text "category" <+> ppIdent c <+> text "is not in abstract")
+                             _    -> do checkWarn ("category" <+> c <+> "is not in abstract")
                                         return js
        _                -> return $ updateTree i js
 
@@ -241,7 +241,7 @@ checkInfo opts cwd sgr (m,mo) c info = do
            return (Just (L locd ty'), Just (L locd de'))
          (Just (L loct ty), Nothing) -> do
            chIn loct "operation" $
-             checkError (text "No definition given to the operation")
+             checkError (pp "No definition given to the operation")
       return (ResOper pty' pde')
 
     ResOverload os tysts -> chIn NoLoc "overloading" $ do
@@ -263,8 +263,7 @@ checkInfo opts cwd sgr (m,mo) c info = do
     _ ->  return info
  where
    gr = prependModule sgr (m,mo)
-   chIn loc cat = checkInModule cwd mo loc
-                             (text "Happened in" <+> text cat <+> ppIdent c)
+   chIn loc cat = checkInModule cwd mo loc ("Happened in" <+> cat <+> c)
 
    mkPar (f,co) = do
        vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
@@ -272,7 +271,7 @@ checkInfo opts cwd sgr (m,mo) c info = do
 
    checkUniq xss = case xss of
      x:y:xs 
-      | x == y    -> checkError $ text "ambiguous for type" <+>
+      | x == y    -> checkError $ "ambiguous for type" <+>
                                   ppType (mkFunType (tail x) (head x))  
       | otherwise -> checkUniq $ y:xs
      _ -> return ()
@@ -282,7 +281,7 @@ checkInfo opts cwd sgr (m,mo) c info = do
      _ -> chIn loc cat $ checkError (vcat ss)
 
    compAbsTyp g t = case t of
-     Vr x -> maybe (checkError (text "no value given to variable" <+> ppIdent x)) return $ lookup x g
+     Vr x -> maybe (checkError ("no value given to variable" <+> x)) return $ lookup x g
      Let (x,(_,a)) b -> do
        a' <- compAbsTyp g a
        compAbsTyp ((x, a'):g) b
@@ -298,7 +297,7 @@ checkInfo opts cwd sgr (m,mo) c info = do
 checkReservedId :: Ident -> Check ()
 checkReservedId x =
   when (isReservedWord x) $
-       checkWarn (text "reserved word used as identifier:" <+> ppIdent x)
+       checkWarn ("reserved word used as identifier:" <+> x)
 
 -- auxiliaries
 
@@ -315,10 +314,10 @@ linTypeOfType cnc m typ = do
      let vars = mkRecType varLabel $ replicate n typeStr
 	 symb = argIdent n cat i
      rec <- if n==0 then return val else
-                       errIn (render (text "extending" $$
-                                      nest 2 (ppTerm Unqualified 0 vars) $$
-                                      text "with" $$
-                                      nest 2 (ppTerm Unqualified 0 val))) $
+                       errIn (render ("extending" $$
+                                      nest 2 vars $$
+                                      "with" $$
+                                      nest 2 val)) $
                              plusRecType vars val
      return (Explicit,symb,rec)
    lookLin (_,c) = checks [ --- rather: update with defLinType ?
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
index 7c471f1cc..c4793c023 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -1,7 +1,7 @@
 -- | Functions for computing the values of terms in the concrete syntax, in
 -- | preparation for PMCFG generation.
 module GF.Compile.Compute.ConcreteNew
-           (GlobalEnv, resourceValues, normalForm, ppL
+           (GlobalEnv, resourceValues, normalForm,
            --, Value(..), Env, value2term, eval, apply
            ) where
 
@@ -18,7 +18,7 @@ import GF.Data.Utilities(mapFst,mapSnd,mapBoth)
 import Control.Monad(ap,liftM,liftM2,mplus,unless)
 import Data.List (findIndex,intersect,nub,elemIndex,(\\)) --,isInfixOf
 --import Data.Char (isUpper,toUpper,toLower)
-import Text.PrettyPrint
+import GF.Text.Pretty
 import qualified Data.Map as Map
 --import Debug.Trace(trace)
 
@@ -109,7 +109,7 @@ value env t0 =
                                       brackets (fsep (map ppIdent (local env))),
                                       ppT 10 t0]) $
 --}
-  errIn (render $ ppT 0 t0) $
+  errIn (render t0) $
   case t0 of
     Vr x   -> var env x
     Q x@(m,f)
@@ -158,7 +158,7 @@ value env t0 =
     Glue t1 t2 -> ((ok2p (glue env).) # both id) # both (value env) (t1,t2)
     ELin c r -> (unlockVRec c.) # value env r
     EPatt p  -> return $ const (VPatt p) -- hmm
-    t -> fail.render $ text "value"<+>ppT 10 t $$ text (show t)
+    t -> fail.render $ "value"<+>ppT 10 t $$ show t
 
 paramValues env ty = do let ge = global env
                         ats <- allParamValues (srcgr env) =<< nfx ge ty
@@ -216,15 +216,15 @@ extR t vv =
       (VRecType rs1, VRecType rs2) ->
           case intersect (map fst rs1) (map fst rs2) of
             [] -> VRecType (rs1 ++ rs2)
-            ls -> error $ text "clash"<+>text (show ls)
+            ls -> error $ "clash"<+>show ls
       (VRec     rs1, VRec     rs2) -> plusVRec rs1 rs2
       (v1          , VRec [(l,_)]) | isLockLabel l -> v1 -- hmm
       (VS (VV t pvs vs) s,v2) -> VS (VV t pvs [extR t (v1,v2)|v1<-vs]) s
       (v1,v2) -> ok2 VExtR v1 v2 -- hmm
 --    (v1,v2) -> error $ text "not records" $$ text (show v1) $$ text (show v2)
   where
-    error explain = ppbug $ text "The term" <+> ppT 0 t
-                            <+> text "is not reducible" $$ explain
+    error explain = ppbug $ "The term" <+> t
+                            <+> "is not reducible" $$ explain
 
 glue env (v1,v2) = glu v1 v2
   where
@@ -249,8 +249,8 @@ glue env (v1,v2) = glu v1 v2
           (_,v2@(VApp NonExist _)) -> v2
 --        (v1,v2) -> ok2 VGlue v1 v2
           (v1,v2) -> error . render $
-                     ppL loc (hang (text "unsupported token gluing:") 4
-                                   (ppT 0 (Glue (vt v1) (vt v2))))
+                     ppL loc (hang "unsupported token gluing:" 4
+                                   (Glue (vt v1) (vt v2)))
 
     vt = value2term loc (local env)
     loc = gloc env
@@ -331,7 +331,7 @@ valueTable env i cs =
                              pvs = nub allpvs
                              dups = allpvs \\ pvs
                          unless (null dups) $
-                           fail.render $ hang (text "Pattern is not linear:") 4
+                           fail.render $ hang "Pattern is not linear:" 4
                                               (ppPatt Unqualified 0 p')
                          vt <- value (extend pvs env) t
                          return (p', \ vs -> Bind $ \ bs -> vt (push' p' bs pvs vs))
@@ -350,8 +350,8 @@ valueTable env i cs =
           PM qc -> do r <- resource env qc
                       case r of
                         VPatt p' -> inlinePattMacro p'
-                        _ -> ppbug $ hang (text "Expected pattern macro:") 4
-                                          (text (show r))
+                        _ -> ppbug $ hang "Expected pattern macro:" 4
+                                          (show r)
           _ -> composPattOp inlinePattMacro p
 --}
 
@@ -498,11 +498,7 @@ both f (x,y) = (,) # f x <# f y
 
 ppT = ppTerm Unqualified
 
-ppL (L loc x) msg = hang (ppLocation "" loc<>colon) 4
-                         (text "In"<+>ppIdent x<>colon<+>msg)
+bugloc loc s = ppbug $ ppL loc s
 
-bugloc loc s = ppbug $ ppL loc (text s)
-
-bug msg = ppbug (text msg)
-ppbug doc = error $ render $
-                    hang (text "Internal error in Compute.ConcreteNew:") 4 doc
+bug msg = ppbug msg
+ppbug doc = error $ render $ hang "Internal error in Compute.ConcreteNew:" 4 doc
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 9bd7c176f..b8edda00f 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -25,13 +25,13 @@ import GF.Data.BacktrackM
 import GF.Data.Operations
 import GF.Infra.UseIO (IOE,ePutStr,ePutStrLn)
 import GF.Data.Utilities (updateNthM) --updateNth
-import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues,ppL)
+import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.List as List
 --import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
-import Text.PrettyPrint hiding (Str)
+import GF.Text.Pretty
 import Data.Array.IArray
 import Data.Array.Unboxed
 --import Data.Maybe
@@ -148,13 +148,13 @@ floc opath loc id = maybe (L loc id) (\path->L (External path loc) id) opath
 
 convert opts gr cenv loc term ty@(_,val) pargs =
     case term' of
-      Error s -> fail $ render $ ppL loc (text $ "Predef.error: "++s)
+      Error s -> fail $ render $ ppL loc ("Predef.error: "++s)
       _ -> do {-when (verbAtLeast opts Verbose) $
                 ePutStrLn $
                   "\n"++take 10000 (renderStyle style{mode=OneLineMode}
-                    (text "term:"<+>ppU 0 term $$
-                     text "eta expanded:"<+>ppU 0 eterm $$
-                     text "normalized:"<+>ppU 0 term'))--}
+                    (text "term:"<+>term $$
+                     text "eta expanded:"<+>eterm $$
+                     text "normalized:"<+>term'))--}
               return $ runCnvMonad gr (conv term') (pargs,[])
   where
     conv t = convertTerm opts CNil val =<< unfactor t
@@ -189,16 +189,16 @@ unfactor t = CM (\gr c -> c (unfac gr t))
       case t of
         T (TTyped ty) [(PV x,u)] -> let u' = unfac gr u
                                         vs = allparams ty
-                                    in --trace ("expand single variable table into "++show (length vs)++" branches.\n"++render (ppU 0 t)) $
+                                    in --trace ("expand single variable table into "++show (length vs)++" branches.\n"++render t) $
                                        V ty [restore x v u' | v <- vs]
         T (TTyped ty) [(PW  ,u)] -> let u' = unfac gr u
                                         vs = allparams ty
-                                    in --trace ("expand wildcard table into "++show (length vs)++ "branches.\n"++render (ppU 0 t)) $
+                                    in --trace ("expand wildcard table into "++show (length vs)++ "branches.\n"++render t) $
                                        V ty [u' | _ <- vs]
         T (TTyped ty) _ -> -- convertTerm doesn't handle these tables
                            ppbug $
-                           sep [text "unfactor"<+>ppU 10 t,
-                                text (show t){-,
+                           sep ["unfactor"<+>ppU 10 t,
+                                pp (show t){-,
                                 fsep (map (ppU 10) (allparams ty))-}]
         _ -> composSafeOp (unfac gr) t
       where
@@ -376,7 +376,7 @@ computeCatRange gr lincat = compute (0,1) lincat
                                      (index,m) = st
                                  in ((index,m*length vs),CPar (m,zip vs [0..]))
 
-ppPath (CProj lbl path) = ppLabel lbl <+> ppPath path
+ppPath (CProj lbl path) = lbl <+> ppPath path
 ppPath (CSel  trm path) = ppU 5 trm   <+> ppPath path
 ppPath CNil             = empty
 
@@ -417,7 +417,7 @@ convertTerm opts sel ctype (Alts s alts)= do CStr s <- convertTerm opts CNil cty
   where
     unSym (CStr [])        = ""
     unSym (CStr [SymKS t]) = t
-    unSym _                = ppbug $ hang (text "invalid prefix in pre expression:") 4 (ppU 0 (Alts s alts))
+    unSym _                = ppbug $ hang ("invalid prefix in pre expression:") 4 (Alts s alts)
 
     unPatt (EPatt p) = fmap Strs (getPatts p)
     unPatt u         = return u
@@ -429,7 +429,7 @@ convertTerm opts sel ctype (Alts s alts)= do CStr s <- convertTerm opts CNil cty
         as <- getPatts a
         bs <- getPatts b
         return [K (s ++ t) | K s <- as, K t <- bs]
-      _ -> fail (render (text "not valid pattern in pre expression" <+> ppPatt Unqualified 0 p))
+      _ -> fail (render ("not valid pattern in pre expression" <+> ppPatt Unqualified 0 p))
 
 convertTerm opts sel ctype (Q (m,f))
   | m == cPredef &&
@@ -449,7 +449,7 @@ convertTerm opts sel@(CProj l _) ctype (ExtR t1@(R rs1) t2)
 
 convertTerm opts CNil ctype t           = do v <- evalTerm CNil t
                                              return (CPar v)
-convertTerm _    sel  _     t           = ppbug (text "convertTerm" <+> sep [parens (text (show sel)),ppU 10 t])
+convertTerm _    sel  _     t           = ppbug ("convertTerm" <+> sep [parens (show sel),ppU 10 t])
 
 convertArg :: Options -> Term -> Int -> Path -> CnvMonad (Value [Symbol])
 convertArg opts (RecType rs)  nr path =
@@ -489,8 +489,8 @@ convertTbl opts (CSel v sub_sel) ctype pt ts = do
   vs <- getAllParamValues pt
   case lookup v (zip vs ts) of
     Just t  -> convertTerm opts sub_sel ctype t
-    Nothing -> ppbug (text "convertTbl:" <+> (text "missing value" <+> ppU 0 v $$
-                                              text "among" <+> vcat (map (ppU 0) vs)))
+    Nothing -> ppbug ( "convertTbl:" <+> ("missing value" <+> v $$
+                                          "among" <+> vcat vs))
 convertTbl opts _ ctype _ _ = bug ("convertTbl: "++show ctype)
 
 
@@ -571,13 +571,13 @@ evalTerm path (V pt ts)    =
          do vs <- getAllParamValues pt
             case lookup trm (zip vs ts) of
               Just t  -> evalTerm path t
-              Nothing -> ppbug $ text "evalTerm: missing value:"<+>ppU 0 trm
-                                 $$ text "among:" <+>fsep (map (ppU 10) vs)
+              Nothing -> ppbug $ "evalTerm: missing value:"<+>trm
+                                 $$ "among:" <+>fsep (map (ppU 10) vs)
 evalTerm path (S term sel) = do v <- evalTerm CNil sel
                                 evalTerm (CSel v path) term
 evalTerm path (FV terms)   = variants terms >>= evalTerm path
 evalTerm path (EInt n)     = return (EInt n)
-evalTerm path t            = ppbug (text "evalTerm" <+> parens (ppU 0 t))
+evalTerm path t            = ppbug ("evalTerm" <+> parens t)
 --evalTerm path t            = ppbug (text "evalTerm" <+> sep [parens (text (show path)),parens (text (show t))])
 
 getVarIndex x = maybe err id $ getArgIndex x
@@ -654,7 +654,7 @@ restrictProtoFCat path v (PFCat cat f schema) = do
 mkArray    lst = listArray (0,length lst-1) lst
 mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
 
-bug msg = ppbug (text msg)
-ppbug = error . render . hang (text "Internal error in GeneratePMCFG:") 4
+bug msg = ppbug msg
+ppbug msg = error . render $ hang "Internal error in GeneratePMCFG:" 4 msg
 
 ppU = ppTerm Unqualified
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index ad4f42b50..0d45825f1 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -34,7 +34,7 @@ import GF.Infra.Option
 import Control.Monad
 --import Data.List
 import qualified Data.Set as Set
-import Text.PrettyPrint
+import GF.Text.Pretty
 import Debug.Trace
 
 
@@ -89,7 +89,7 @@ evalInfo opts resenv sgr m c info = do
     return (CncCat ptyp pde' pre' ppr' mpmcfg)
 
   CncFun (mt@(Just (_,cont,val))) pde ppr mpmcfg -> --trace (prt c) $
-       eIn (text "linearization in type" <+> ppTerm Unqualified 0 (mkProd cont val []) $$ text "of function") $ do
+       eIn ("linearization in type" <+> mkProd cont val [] $$ "of function") $ do
     pde' <- case pde of
       Just (L loc de) -> do de <- partEval opts gr (cont,val) de
                             return (Just (L loc (factor param c 0 de)))
@@ -112,7 +112,7 @@ evalInfo opts resenv sgr m c info = do
    gr = prependModule sgr m
    optim = flag optOptimizations opts
    param = OptParametrize `Set.member` optim
-   eIn cat = errIn (render (text "Error optimizing" <+> cat <+> ppIdent c <+> colon))
+   eIn cat = errIn (render ("Error optimizing" <+> cat <+> c <+> ':'))
 
 -- | the main function for compiling linearizations
 partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term
@@ -121,7 +121,7 @@ partEval opts = {-if flag optNewComp opts
                 {-else partEvalOld opts-}
 
 partEvalNew opts gr (context, val) trm =
-    errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $
+    errIn (render ("partial evaluation" <+> ppTerm Qualified 0 trm)) $
     checkPredefError trm
 {-
 partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $ do
@@ -169,13 +169,13 @@ mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
      QC p           -> do vs <- lookupParamValues gr p
                           case vs of
                             v:_ -> return v
-                            _   -> Bad (render (text "no parameter values given to type" <+> ppQIdent Qualified p))
+                            _   -> Bad (render ("no parameter values given to type" <+> ppQIdent Qualified p))
      RecType r  -> do
        let (ls,ts) = unzip r
        ts <- mapM mkDefField ts
        return $ R (zipWith assign ls ts)
      _ | Just _ <- isTypeInts typ -> return $ EInt 0 -- exists in all as first val
-     _ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
+     _ -> Bad (render ("linearization type field cannot be" <+> typ))
 
 mkLinReference :: SourceGrammar -> Type -> Err Term
 mkLinReference gr typ = 
@@ -196,7 +196,7 @@ mkLinReference gr typ =
        RecType rs -> do
          msum (map (\(l,ty) -> mkDefField ty (P trm l)) (sortRec rs))
        _ | Just _ <- isTypeInts typ -> Bad "no string"
-       _ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
+       _ -> Bad (render ("linearization type field cannot be" <+> typ))
 
 evalPrintname :: GlobalEnv -> Ident -> L Term -> L Term
 evalPrintname resenv c (L loc pr) = L loc (normalForm resenv (L loc c) pr)
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index 2974a1a36..6ade83a8c 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -40,7 +40,7 @@ import GF.Data.Operations
 
 import Control.Monad
 import Data.List (nub,(\\))
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 -- | this gives top-level access to renaming term input in the cc command
 renameSourceTerm :: SourceGrammar -> Ident -> Term -> Check Term
@@ -97,8 +97,8 @@ renameIdentTerm' env@(act,imps) t0 =
         Ok f -> return (f c)
         _    -> case lookupTreeManyAll showIdent opens c of
                   [f]  -> return (f c)
-                  []   -> alt c (text "constant not found:" <+> ppIdent c $$
-                                 text "given" <+> fsep (punctuate comma (map (ppIdent . fst) qualifs)))
+                  []   -> alt c ("constant not found:" <+> c $$
+                                 "given" <+> fsep (punctuate ',' (map fst qualifs)))
                   fs   -> case nub [f c | f <- fs]  of
                             [tr]     -> return tr
 {-
@@ -106,9 +106,9 @@ renameIdentTerm' env@(act,imps) t0 =
                                         -- name conflicts resolved as overloading in TypeCheck.RConcrete AR 31/1/2014
                                         -- the old definition is below and still presupposed in TypeCheck.Concrete
 -}
-                            ts@(t:_) -> do checkWarn (text "atomic term" <+> ppTerm Qualified 0 t0 $$
-                                                      text "conflict" <+> hsep (punctuate comma (map (ppTerm Qualified 0) ts)) $$
-                                                      text "given" <+> fsep (punctuate comma (map (ppIdent . fst) qualifs)))
+                            ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
+                                                      "conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
+                                                      "given" <+> fsep (punctuate ',' (map fst qualifs)))
                                            return t
 
             -- a warning will be generated in CheckGrammar, and the head returned
@@ -171,7 +171,7 @@ renameInfo cwd status (m,mi) i info =
     renMaybe ren Nothing  = return Nothing
 
     renLoc ren (L loc x) =
-      checkInModule cwd mi loc (text "Happened in the renaming of" <+> ppIdent i) $ do
+      checkInModule cwd mi loc ("Happened in the renaming of" <+> i) $ do
         x <- ren x
         return (L loc x)
 
@@ -222,7 +222,7 @@ renameTerm env vars = ren vars where
       | elem r vs -> return trm                                -- try var proj first ..
       | otherwise -> checks [ renid' (Q (r,label2ident l))      -- .. and qualified expression second.
                             , renid' t >>= \t -> return (P t l) -- try as a constant at the end
-                            , checkError (text "unknown qualified constant" <+> ppTerm Unqualified 0 trm)
+                            , checkError ("unknown qualified constant" <+> trm)
                             ]
 
     EPatt p -> do
@@ -244,8 +244,8 @@ renamePattern :: Status -> Patt -> Check (Patt,[Ident])
 renamePattern env patt =
     do r@(p',vs) <- renp patt
        let dupl = vs \\ nub vs
-       unless (null dupl) $ checkError (hang (text "[C.4.13] Pattern is not linear:") 4
-                                             (ppPatt Unqualified 0 patt))
+       unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4
+                                             patt)
        return r
   where
     renp patt = case patt of
@@ -253,7 +253,7 @@ renamePattern env patt =
         c' <- renid $ Vr c
         case c' of
           Q d -> renp $ PM d
-          _ -> checkError (text "unresolved pattern" <+> ppPatt Unqualified 0 patt)
+          _ -> checkError ("unresolved pattern" <+> patt)
 
       PC c ps -> do
         c' <- renid $ Cn c
@@ -261,8 +261,8 @@ renamePattern env patt =
           QC c -> do psvss <- mapM renp ps
                      let (ps,vs) = unzip psvss
                      return (PP c ps, concat vs)
-          Q  _ -> checkError (text "data constructor expected but" <+> ppTerm Qualified 0 c' <+> text "is found instead")
-          _    -> checkError (text "unresolved data constructor" <+> ppTerm Qualified 0 c')
+          Q  _ -> checkError ("data constructor expected but" <+> ppTerm Qualified 0 c' <+> "is found instead")
+          _    -> checkError ("unresolved data constructor" <+> ppTerm Qualified 0 c')
 
       PP c ps -> do
         (QC c') <- renid (QC c)
@@ -274,12 +274,12 @@ renamePattern env patt =
         x <- renid (Q c)
         c' <- case x of
                 (Q c') -> return c'
-                _      -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt)
+                _      -> checkError ("not a pattern macro" <+> ppPatt Qualified 0 patt)
         return (PM c', [])
 
       PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
                                                  QC c -> return (PP c [],[])
-                                                 _    -> checkError (text "not a constructor")
+                                                 _    -> checkError (pp "not a constructor")
                      , return (patt, [x])
                      ]
 
diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
index 7f78e4c40..67f6e5fda 100644
--- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -10,7 +10,7 @@ import GF.Infra.CheckM
 --import GF.Infra.UseIO
 import GF.Data.Operations
 
-import Text.PrettyPrint
+import GF.Text.Pretty
 import Data.List (nub, (\\), tails)
 import qualified Data.IntMap as IntMap
 
@@ -48,7 +48,7 @@ checkSigma gr scope t sigma = do                                -- GEN2
   let bad_tvs = filter (`elem` esc_tvs) skol_tvs
   if null bad_tvs
     then return (abs t)
-    else tcError (text "Type not polymorphic enough")
+    else tcError (pp "Type not polymorphic enough")
 
 tcRho :: SourceGrammar -> Scope -> Term -> Maybe Rho -> TcM (Term, Rho)
 tcRho gr scope t@(EInt _)   mb_ty = instSigma gr scope t (eval gr [] typeInt)   mb_ty
@@ -58,20 +58,20 @@ tcRho gr scope t@(Empty)    mb_ty = instSigma gr scope t (eval gr [] typeStr)
 tcRho gr scope t@(Vr v)     mb_ty = do                          -- VAR
   case lookup v scope of
     Just v_sigma -> instSigma gr scope t v_sigma mb_ty
-    Nothing      -> tcError (text "Unknown variable" <+> ppIdent v)
+    Nothing      -> tcError ("Unknown variable" <+> v)
 tcRho gr scope t@(Q id)     mb_ty
   | elem (fst id) [cPredef,cPredefAbs] = 
       case typPredefined (snd id) of
         Just ty -> instSigma gr scope t (eval gr [] ty) mb_ty
-        Nothing -> tcError (text "unknown in Predef:" <+> ppQIdent Qualified id)
+        Nothing -> tcError (pp "unknown in Predef:" <+> ppQIdent Qualified id)
   | otherwise = do
       case lookupResType gr id of
         Ok ty   -> instSigma gr scope t (eval gr [] ty) mb_ty
-        Bad err -> tcError (text err)
+        Bad err -> tcError (pp err)
 tcRho gr scope t@(QC id)     mb_ty = do
   case lookupResType gr id of
     Ok ty   -> instSigma gr scope t (eval gr [] ty) mb_ty
-    Bad err -> tcError (text err)
+    Bad err -> tcError (pp err)
 tcRho gr scope (App fun arg) mb_ty = do                         -- APP
   (fun,fun_ty) <- tcRho gr scope fun Nothing
   (arg_ty, res_ty) <- unifyFun gr scope (eval gr (scopeEnv scope) arg) fun_ty
@@ -148,9 +148,9 @@ tcRho gr scope t@(R rs) mb_ty = do
              Just ty -> case ty of
                           VRecType ltys -> checkRecFields gr scope rs ltys
                           VMeta _ _ _   -> inferRecFields gr scope rs
-                          _             -> tcError (text "Record type is inferred but:" $$
+                          _             -> tcError ("Record type is inferred but:" $$
                                                     nest 2 (ppTerm Unqualified 0 (value2term gr (scopeVars scope) ty)) $$
-                                                    text "is expected in the expresion:" $$
+                                                    "is expected in the expresion:" $$
                                                     nest 2 (ppTerm Unqualified 0 t))
   return (R        [(l, (Just (value2term gr (scopeVars scope) ty), t)) | (l,t,ty) <- lttys], 
           VRecType [(l, ty)                                             | (l,t,ty) <- lttys]
@@ -177,9 +177,9 @@ tcRho gr scope t@(ExtR t1 t2) mb_ty = do
     (VSort s1,VSort s2)
        | s1 == cType && s2 == cType -> instSigma gr scope (ExtR t1 t2) (VSort cType) mb_ty
     (VRecType rs1, VRecType rs2) 
-       | otherwise                  -> do tcWarn (text "bbbb")
+       | otherwise                  -> do tcWarn (pp "bbbb")
                                           instSigma gr scope (ExtR t1 t2) (VRecType (rs1 ++ rs2)) mb_ty
-    _                               -> tcError (text "Cannot type check" <+> ppTerm Unqualified 0 t)
+    _                               -> tcError ("Cannot type check" <+> ppTerm Unqualified 0 t)
 tcRho gr scope (ELin cat t) mb_ty = do  -- this could be done earlier, i.e. in the parser
   tcRho gr scope (ExtR t (R [(lockLabel cat,(Just (RecType []),R []))])) mb_ty
 tcRho gr scope (ELincat cat t) mb_ty = do  -- this could be done earlier, i.e. in the parser
@@ -216,7 +216,7 @@ tcPatt gr scope (PP c ps) ty0 =
                  (scope,ty) <- go scope (eval gr [] ty) ps
                  unify gr scope ty0 ty
                  return scope
-    Bad err -> tcError (text err)
+    Bad err -> tcError (pp err)
 tcPatt gr scope (PString s) ty0 = do
   unify gr scope ty0 (eval gr [] typeStr)
   return scope
@@ -252,13 +252,13 @@ inferRecFields gr scope rs =
 
 checkRecFields gr scope []          ltys
   | null ltys                            = return []
-  | otherwise                            = tcError (text "Missing fields:" <+> hsep (map (ppLabel . fst) ltys))
+  | otherwise                            = tcError ("Missing fields:" <+> hsep (map fst ltys))
 checkRecFields gr scope ((l,t):lts) ltys =
   case takeIt l ltys of
     (Just ty,ltys) -> do ltty  <- tcRecField gr scope l t (Just ty)
                          lttys <- checkRecFields gr scope lts ltys
                          return (ltty : lttys)
-    (Nothing,ltys) -> do tcWarn (text "Discarded field:" <+> ppLabel l)
+    (Nothing,ltys) -> do tcWarn ("Discarded field:" <+> l)
                          ltty  <- tcRecField gr scope l t Nothing
                          lttys <- checkRecFields gr scope lts ltys
                          return lttys     -- ignore the field
@@ -298,9 +298,9 @@ subsCheck gr scope t sigma1 sigma2 = do                        -- DEEP-SKOL
   let bad_tvs = filter (`elem` esc_tvs) skol_tvs
   if null bad_tvs
     then return (abs t)
-    else tcError (vcat [text "Subsumption check failed:",
+    else tcError (vcat [pp "Subsumption check failed:",
                         nest 2 (ppTerm Unqualified 0 (value2term gr (scopeVars scope) sigma1)),
-                        text "is not as polymorphic as",
+                        pp "is not as polymorphic as",
                         nest 2 (ppTerm Unqualified 0 (value2term gr (scopeVars scope) sigma2))])
 
 
@@ -365,8 +365,8 @@ unify gr scope (VRecType rs1) (VRecType rs2) = do
 unify gr scope v1 v2 = do
   t1 <- zonkTerm (value2term gr (scopeVars scope) v1)
   t2 <- zonkTerm (value2term gr (scopeVars scope) v2)
-  tcError (text "Cannot unify types:" <+> (ppTerm Unqualified 0 t1 $$ 
-                                           ppTerm Unqualified 0 t2))
+  tcError ("Cannot unify types:" <+> (ppTerm Unqualified 0 t1 $$ 
+                                      ppTerm Unqualified 0 t2))
 
 -- | Invariant: tv1 is a flexible type variable
 unifyVar :: SourceGrammar -> Scope -> MetaId -> Env -> [Value] -> Tau -> TcM ()
@@ -377,7 +377,7 @@ unifyVar gr scope i env vs ty2 = do            -- Check whether i is bound
     Unbound _ -> do let ty2' = value2term gr (scopeVars scope) ty2
                     ms2 <- getMetaVars gr [(scope,ty2)]
                     if i `elem` ms2
-                      then tcError (text "Occurs check for" <+> ppMeta i <+> text "in:" $$
+                      then tcError ("Occurs check for" <+> ppMeta i <+> "in:" $$
                                     nest 2 (ppTerm Unqualified 0 ty2'))
                       else setMeta i (Bound ty2')
 
@@ -465,7 +465,7 @@ instance Monad TcM where
   f >>= g  = TcM (\ms msgs -> case unTcM f ms msgs of
                                 TcOk x ms msgs -> unTcM (g x) ms msgs
                                 TcFail    msgs -> TcFail msgs)
-  fail     = tcError . text
+  fail     = tcError . pp
 
 instance Functor TcM where
   fmap f g = TcM (\ms msgs -> case unTcM g ms msgs of
@@ -476,7 +476,7 @@ tcError :: Message -> TcM a
 tcError msg = TcM (\ms msgs -> TcFail (msg : msgs))
 
 tcWarn :: Message -> TcM ()
-tcWarn msg = TcM (\ms msgs -> TcOk () ms ((text "Warning:" <+> msg) : msgs))
+tcWarn msg = TcM (\ms msgs -> TcOk () ms (("Warning:" <+> msg) : msgs))
 
 unimplemented str = fail ("Unimplemented: "++str)
 
@@ -494,7 +494,7 @@ getMeta :: MetaId -> TcM MetaValue
 getMeta i = TcM (\ms msgs -> 
   case IntMap.lookup i ms of
     Just mv -> TcOk mv ms msgs
-    Nothing -> TcFail ((text "Unknown metavariable" <+> ppMeta i) : msgs))
+    Nothing -> TcFail (("Unknown metavariable" <+> ppMeta i) : msgs))
 
 setMeta :: MetaId -> MetaValue -> TcM ()
 setMeta i mv = TcM (\ms msgs -> TcOk () (IntMap.insert i mv ms) msgs)
diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
index 16c6908da..ca8d789c1 100644
--- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
@@ -13,7 +13,7 @@ import GF.Compile.TypeCheck.Primitives
 
 import Data.List
 import Control.Monad
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 computeLType :: SourceGrammar -> Context -> Type -> Check Type
 computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
@@ -22,7 +22,7 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
     _ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed
       | isPredefConstant ty     -> return ty ---- shouldn't be needed
 
-    Q (m,ident) -> checkIn (text "module" <+> ppIdent m) $ do
+    Q (m,ident) -> checkIn ("module" <+> m) $ do
       ty' <- lookupResDef gr (m,ident)
       if ty' == ty then return ty else comp g ty' --- is this necessary to test?
 
@@ -30,7 +30,7 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
      over <- getOverload gr g (Just typeType) t
      case over of
        Just (tr,_) -> return tr
-       _ -> checkError (text "unresolved overloading of constants" <+> ppTerm Qualified 0 t) 
+       _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t) 
 
     Vr ident  -> checkLookup ident g -- never needed to compute!
 
@@ -79,26 +79,26 @@ inferLType gr g trm = case trm of
 
    Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
                                                 Just ty -> return ty
-                                                Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
+                                                Nothing -> checkError ("unknown in Predef:" <+> ident)
 
    Q ident -> checks [
      termWith trm $ lookupResType gr ident >>= computeLType gr g
      ,
      lookupResDef gr ident >>= inferLType gr g
      ,
-     checkError (text "cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
+     checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
      ]
 
    QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
                                                  Just ty -> return ty
-                                                 Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
+                                                 Nothing -> checkError ("unknown in Predef:" <+> ident)
 
    QC ident -> checks [
        termWith trm $ lookupResType gr ident >>= computeLType gr g
        ,
        lookupResDef gr ident >>= inferLType gr g
        ,
-       checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
+       checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
        ]
 
    Vr ident -> termWith trm $ checkLookup ident g
@@ -111,7 +111,7 @@ inferLType gr g trm = case trm of
      over <- getOverload gr g Nothing trm
      case over of
        Just trty -> return trty
-       _ -> checkError (text "unresolved overloading of constants" <+> ppTerm Qualified 0 trm) 
+       _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm) 
 
    App f a -> do
      over <- getOverload gr g Nothing trm
@@ -127,7 +127,7 @@ inferLType gr g trm = case trm of
                       then return val
                       else substituteLType [(bt,z,a')] val
              return (App f' a',ty) 
-           _ -> checkError (text "A function type is expected for" <+> ppTerm Unqualified 0 f <+> text "instead of type" <+> ppType fty)
+           _ -> checkError ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty)
 
    S f x -> do
      (f', fty) <- inferLType gr g f
@@ -135,7 +135,7 @@ inferLType gr g trm = case trm of
        Table arg val -> do
          x'<- justCheck g x arg
          return (S f' x', val)
-       _ -> checkError (text "table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
+       _ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
 
    P t i -> do
      (t',ty) <- inferLType gr g t   --- ??
@@ -143,16 +143,16 @@ inferLType gr g trm = case trm of
      let tr2 = P t' i
      termWith tr2 $ case ty' of
        RecType ts -> case lookup i ts of
-                       Nothing -> checkError (text "unknown label" <+> ppLabel i <+> text "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
+                       Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
                        Just x  -> return x
-       _          -> checkError (text "record type expected for:" <+> ppTerm Unqualified 0 t $$
-                                 text " instead of the inferred:" <+> ppTerm Unqualified 0 ty')
+       _          -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$
+                                 " instead of the inferred:" <+> ppTerm Unqualified 0 ty')
 
    R r -> do
      let (ls,fs) = unzip r
      fsts <- mapM inferM fs
      let ts = [ty | (Just ty,_) <- fsts]
-     checkCond (text "cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
+     checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
      return $ (R (zip ls fsts), RecType (zip ls ts))
 
    T (TTyped arg) pts -> do
@@ -164,7 +164,7 @@ inferLType gr g trm = case trm of
    T ti pts -> do  -- tries to guess: good in oper type inference
      let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
      case pts' of 
-       [] -> checkError (text "cannot infer table type of" <+> ppTerm Unqualified 0 trm)
+       [] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)
 ----       PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] 
        _  -> do 
          (arg,val) <- checks $ map (inferCase Nothing) pts'
@@ -198,7 +198,7 @@ inferLType gr g trm = case trm of
 
 ---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
    Strs (Cn c : ts) | c == cConflict -> do
-     checkWarn (text "unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
+     checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
      inferLType gr g (head ts)
 
    Strs ts -> do
@@ -231,7 +231,7 @@ inferLType gr g trm = case trm of
          checkLType gr g trm' rt ---- return (trm', rt)
        _ | rT' == typeType && sT' == typeType -> do
          return (trm', typeType)
-       _ -> checkError (text "records or record types expected in" <+> ppTerm Unqualified 0 trm)
+       _ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)
 
    Sort _     -> 
      termWith trm $ return typeType
@@ -263,7 +263,7 @@ inferLType gr g trm = case trm of
      ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
      return $ (ELin c trm', ty') 
 
-   _ -> checkError (text "cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
+   _ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
 
  where
    isPredef m = elem m [cPredef,cPredefAbs]
@@ -352,25 +352,25 @@ getOverload gr g mt ot = case appForm ot of
      case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of
        ([(_,val,fun)],_) -> return (mkApp fun tts, val)
        ([],[(pre,val,fun)]) -> do
-         checkWarn $  text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
-                      text "for" $$
+         checkWarn $  "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
+                      "for" $$
                       nest 2 (showTypes tys) $$
-                      text "using" $$
+                      "using" $$
                       nest 2 (showTypes pre)
          return (mkApp fun tts, val)
        ([],[]) -> do
-         checkError $ text "no overload instance of" <+> ppTerm Unqualified 0 f $$
-                      text "for" $$
+         checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$
+                      "for" $$
                       nest 2 stysError $$
-                      text "among" $$
+                      "among" $$
                       nest 2 (vcat stypsError) $$
-                      maybe empty (\x -> text "with value type" <+> ppType x) mt
+                      maybe empty (\x -> "with value type" <+> ppType x) mt
 
        (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
          ([(val,fun)],_) -> do
            return (mkApp fun tts, val)
          ([],[(val,fun)]) -> do
-           checkWarn (text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot) 
+           checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot) 
            return (mkApp fun tts, val)
 
 ----- unsafely exclude irritating warning AR 24/5/2008
@@ -382,9 +382,9 @@ getOverload gr g mt ot = case appForm ot of
 --  This gives ad hoc overloading the same behaviour as the choice of the first match in renaming did before. 
 --  But it also gives a chance to ambiguous overloadings that were banned before. 
          (nps1,nps2) -> do 
-              checkWarn $  text "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
-                  ----     text "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$ 
-                           text "resolved by selecting the first of the alternatives" $$
+              checkWarn $  "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
+                  ----     "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$ 
+                           "resolved by selecting the first of the alternatives" $$
                            nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])
               return $ head [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2]
 
@@ -421,10 +421,10 @@ checkLType gr g trm typ0 = do
         Prod bt' z a b -> do 
           (c',b') <- if isWildIdent z
                        then checkLType gr ((bt,x,a):g) c b
-                       else do b' <- checkIn (text "abs") $ substituteLType [(bt',z,Vr x)] b
+                       else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b
                                checkLType gr ((bt,x,a):g) c b'
           return $ (Abs bt x c', Prod bt' x a b')
-        _ -> checkError $ text "function type expected instead of" <+> ppType typ
+        _ -> checkError $ "function type expected instead of" <+> ppType typ
 
     App f a -> do
        over <- getOverload gr g (Just typ) trm
@@ -438,7 +438,7 @@ checkLType gr g trm typ0 = do
       over <- getOverload gr g Nothing trm
       case over of
         Just trty -> return trty
-        _ -> checkError (text "unresolved overloading of constants" <+> ppTerm Qualified 0 trm) 
+        _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm) 
 
     Q _ -> do
        over <- getOverload gr g (Just typ) trm
@@ -449,7 +449,7 @@ checkLType gr g trm typ0 = do
           termWith trm' $ checkEqLType gr g typ ty' trm'
 
     T _ [] ->
-      checkError (text "found empty table in type" <+> ppTerm Unqualified 0 typ)
+      checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)
     T _ cs -> case typ of 
       Table arg val -> do 
         case allParamValues gr arg of
@@ -458,12 +458,12 @@ checkLType gr g trm typ0 = do
             ps <- testOvershadow ps0 vs
             if null ps 
               then return () 
-              else checkWarn (text "patterns never reached:" $$
+              else checkWarn ("patterns never reached:" $$
                               nest 2 (vcat (map (ppPatt Unqualified 0) ps)))
           _ -> return () -- happens with variable types
         cs' <- mapM (checkCase arg val) cs
         return (T (TTyped arg) cs', typ)
-      _ -> checkError $ text "table type expected for table instead of" $$ nest 2 (ppType typ)
+      _ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)
     V arg0 vs ->
       case typ of
         Table arg1 val ->
@@ -477,7 +477,7 @@ checkLType gr g trm typ0 = do
          fsts <- mapM (checkM r) rr   -- check that they are found in the record
          return $ (R fsts, typ)       -- normalize record
 
-       _ -> checkError (text "record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
+       _ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
 
     ExtR r s -> case typ of
        _ | typ == typeType -> do
@@ -486,7 +486,7 @@ checkLType gr g trm typ0 = do
            RecType _ -> termWith trm' $ return typeType
            ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType 
                                       -- ext t = t ** ...
-           _ -> checkError (text "invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
+           _ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
 
        RecType rr -> do
 
@@ -496,7 +496,7 @@ checkLType gr g trm typ0 = do
              (s',typ2) <- inferLType gr g s
              case typ2 of
                RecType ss -> return $ map fst ss
-               _ ->  checkError (text "cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
+               _ ->  checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
          let ll1 = [l | (l,_) <- rr, notElem l ll2]
          (r',_) <- checkLType gr g r (RecType [field | field@(l,_) <- rr, elem l ll1])
          (s',_) <- checkLType gr g s (RecType [field | field@(l,_) <- rr, elem l ll2])
@@ -509,7 +509,7 @@ checkLType gr g trm typ0 = do
          s' <- justCheck g s ex
          return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ
 
-       _ -> checkError (text "record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
+       _ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
 
     FV vs -> do
       ttys <- mapM (flip (checkLType gr g) typ) vs
@@ -524,7 +524,7 @@ checkLType gr g trm typ0 = do
           (arg',val) <- checkLType gr g arg p
           checkEqLType gr g typ t trm
           return (S tab' arg', t)
-        _ -> checkError (text "table type expected for applied table instead of" <+> ppType ty')
+        _ -> checkError ("table type expected for applied table instead of" <+> ppType ty')
      , do
       (arg',ty) <- inferLType gr g arg
       ty'       <- computeLType gr g ty
@@ -565,9 +565,9 @@ checkLType gr g trm typ0 = do
      _ -> checkError $ 
             if isLockLabel l 
               then let cat = drop 5 (showIdent (label2ident l))
-                   in ppTerm Unqualified 0 (R rms) <+> text "is not in the lincat of" <+> text cat <> 
-                      text "; try wrapping it with lin" <+> text cat
-              else text "cannot find value for label" <+> ppLabel l <+> text "in" <+> ppTerm Unqualified 0 (R rms)
+                   in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <> 
+                      "; try wrapping it with lin" <+> cat
+              else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)
 
    checkCase arg val (p,t) = do
      cont <- pattContext gr g arg p
@@ -580,7 +580,7 @@ pattContext env g typ p = case p of
   PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
     t <- lookupResType env (q,c)
     let (cont,v) = typeFormCnc t
-    checkCond (text "wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) 
+    checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) 
               (length cont == length ps)
     checkEqLType env g typ v (patt2term p)
     mapM (\((_,_,ty),p) -> pattContext env g ty p) (zip cont ps) >>= return . concat
@@ -591,7 +591,7 @@ pattContext env g typ p = case p of
         let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
         ----- checkWarn $ prt p ++++ show pts ----- debug
         mapM (uncurry (pattContext env g)) pts >>= return . concat
-      _ -> checkError (text "record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
+      _ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
   PT t p' -> do
     checkEqLType env g typ t (patt2term p')
     pattContext env g typ p'
@@ -605,9 +605,9 @@ pattContext env g typ p = case p of
     g2 <- pattContext env g typ q
     let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])
     checkCond 
-      (text "incompatible bindings of" <+>
-       fsep (map ppIdent pts) <+> 
-       text "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts) 
+      ("incompatible bindings of" <+>
+       fsep pts <+> 
+       "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts) 
     return g1 -- must be g1 == g2
   PSeq p q -> do
     g1 <- pattContext env g typ p
@@ -621,7 +621,7 @@ pattContext env g typ p = case p of
    noBind typ p' = do
     co <- pattContext env g typ p'
     if not (null co)
-      then checkWarn (text "no variable bound inside pattern" <+> ppPatt Unqualified 0 p) 
+      then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p) 
            >> return []
       else return []
 
@@ -630,9 +630,9 @@ checkEqLType gr g t u trm = do
   (b,t',u',s) <- checkIfEqLType gr g t u trm
   case b of
     True  -> return t'
-    False -> checkError $ text s <+> text "type of" <+> ppTerm Unqualified 0 trm $$
-                          text "expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$
-                          text "inferred:" <+> ppTerm Qualified 0 u -- ppqType u t
+    False -> checkError $ s <+> "type of" <+> ppTerm Unqualified 0 trm $$
+                          "expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$
+                          "inferred:" <+> ppTerm Qualified 0 u -- ppqType u t
 
 checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
 checkIfEqLType gr g t u trm = do
@@ -644,7 +644,7 @@ checkIfEqLType gr g t u trm = do
     --- better: use a flag to forgive? (AR 31/1/2006)
     _ -> case missingLock [] t' u' of
       Ok lo -> do
-        checkWarn $ text "missing lock field" <+> fsep (map ppLabel lo)
+        checkWarn $ "missing lock field" <+> fsep lo
         return (True,t',u',[])
       Bad s -> return (False,t',u',s)
 
@@ -699,7 +699,7 @@ checkIfEqLType gr g t u trm = do
                    not (any (\ (k,b) -> alpha g a b && l == k) ts)]
          (locks,others) = partition isLockLabel ls
        in case others of
-         _:_ -> Bad $ render (text "missing record fields:" <+> fsep (punctuate comma (map ppLabel others)))
+         _:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))
          _ -> return locks
      -- contravariance
      (Prod _ x a b, Prod _ y c d) -> do
@@ -737,9 +737,9 @@ ppType :: Type -> Doc
 ppType ty =
   case ty of
     RecType fs   -> case filter isLockLabel $ map fst fs of
-                      [lock] -> text (drop 5 (showIdent (label2ident lock)))
+                      [lock] -> pp (drop 5 (showIdent (label2ident lock)))
                       _      -> ppTerm Unqualified 0 ty
-    Prod _ x a b -> ppType a <+> text "->" <+> ppType b
+    Prod _ x a b -> ppType a <+> "->" <+> ppType b
     _            -> ppTerm Unqualified 0 ty
 
 ppqType :: Type -> Type -> Doc
@@ -750,5 +750,5 @@ ppqType t u = case (ppType t, ppType u) of
 checkLookup :: Ident -> Context -> Check Type
 checkLookup x g =
   case [ty | (b,y,ty) <- g, x == y] of
-    []     -> checkError (text "unknown variable" <+> ppIdent x)
+    []     -> checkError ("unknown variable" <+> x)
     (ty:_) -> return ty
diff --git a/src/compiler/GF/Compile/TypeCheck/TC.hs b/src/compiler/GF/Compile/TypeCheck/TC.hs
index 5dd276303..0b90d6f6c 100644
--- a/src/compiler/GF/Compile/TypeCheck/TC.hs
+++ b/src/compiler/GF/Compile/TypeCheck/TC.hs
@@ -28,7 +28,7 @@ import GF.Grammar.Predef
 import Control.Monad
 --import Data.List (sortBy)
 import Data.Maybe
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 data AExp =
      AVr   Ident Val 
@@ -57,7 +57,7 @@ lookupConst :: Theory -> QIdent -> Err Val
 lookupConst th f = th f
 
 lookupVar :: Env -> Ident -> Err Val
-lookupVar g x = maybe (Bad (render (text "unknown variable" <+> ppIdent x))) return $ lookup x ((identW,uVal):g)
+lookupVar g x = maybe (Bad (render ("unknown variable" <+> x))) return $ lookup x ((identW,uVal):g)
 -- wild card IW: no error produced, ?0 instead.
 
 type TCEnv = (Int,Env,Env)
@@ -129,7 +129,7 @@ checkExp th tenv@(k,rho,gamma) e ty = do
 	(t',cs) <- checkExp th 
                            (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
 	return (AAbs x a' t', cs)
-      _ -> Bad (render (text "function type expected for" <+> ppTerm Unqualified 0 e <+> text "instead of" <+> ppValue Unqualified 0 typ))
+      _ -> Bad (render ("function type expected for" <+> ppTerm Unqualified 0 e <+> "instead of" <+> ppValue Unqualified 0 typ))
 
     Prod _ x a b -> do
       testErr (typ == vType) "expected Type"
@@ -141,11 +141,11 @@ checkExp th tenv@(k,rho,gamma) e ty = do
       case typ of
         VRecType ys -> do case [l | (l,_) <- ys, isNothing (lookup l xs)] of
                             [] -> return ()
-                            ls -> fail (render (text "no value given for label:" <+> fsep (punctuate comma (map ppLabel ls))))
+                            ls -> fail (render ("no value given for label:" <+> fsep (punctuate ',' ls)))
                           r <- mapM (checkAssign th tenv ys) xs
                           let (xs,css) = unzip r
                           return (AR xs, concat css)
-        _           -> Bad (render (text "record type expected for" <+> ppTerm Unqualified 0 e <+> text "instead of" <+> ppValue Unqualified 0 typ))
+        _           -> Bad (render ("record type expected for" <+> ppTerm Unqualified 0 e <+> "instead of" <+> ppValue Unqualified 0 typ))
 
     P r l -> do (r',cs) <- checkExp th tenv r (VRecType [(l,typ)])
                 return (AP r' l typ,cs)
@@ -180,8 +180,8 @@ inferExp th tenv@(k,rho,gamma) e = case e of
         (a',csa) <- checkExp th tenv t (VClos env a)
 	b' <- whnf $ VClos ((x,VClos rho t):env) b
 	return $ (AApp f' a' b', b', csf ++ csa)
-      _ -> Bad (render (text "Prod expected for function" <+> ppTerm Unqualified 0 f <+> text "instead of" <+> ppValue Unqualified 0 typ))
-   _ -> Bad (render (text "cannot infer type of expression" <+> ppTerm Unqualified 0 e))
+      _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))
+   _ -> Bad (render ("cannot infer type of expression" <+> ppTerm Unqualified 0 e))
 
 checkLabelling :: Theory -> TCEnv -> Labelling -> Err (ALabelling, [(Val,Val)])
 checkLabelling th tenv (lbl,typ) = do
@@ -223,7 +223,7 @@ checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $
           let tenv' = (length binds, sigma ++ rho, binds ++ gamma)
           ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b)
 	  return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
-        _ -> Bad (render (text "Product expected for definiens" <+> ppTerm Unqualified 0 t <+> text "instead of" <+> ppValue Unqualified 0 typ))
+        _ -> Bad (render ("Product expected for definiens" <+> ppTerm Unqualified 0 t <+> "instead of" <+> ppValue Unqualified 0 typ))
     [] -> do
       (e,cs) <- checkExp th tenv t ty
       return (([],e),cs)
@@ -244,7 +244,7 @@ checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $
                     where (xss,j,g',k') = foldr p2t ([],i,g,k) xs
      PImplArg p -> p2t p (ps,i,g,k)
      PTilde t -> (t : ps, i, g, k)
-     _ -> error $ render (text "undefined p2t case" <+> ppPatt Unqualified 0 p <+> text "in checkBranch")
+     _ -> error $ render ("undefined p2t case" <+> ppPatt Unqualified 0 p <+> "in checkBranch")
 
   upd x k g = (x, VGen k x) : g --- hack to recognize pattern variables
 
@@ -282,8 +282,8 @@ checkPatt th tenv exp val = do
            (a',_,csa) <- checkExpP tenv t (VClos env a)
 	   b' <- whnf $ VClos ((x,VClos rho t):env) b
 	   return $ (AApp f' a' b', b', csf ++ csa)
-         _ -> Bad (render (text "Prod expected for function" <+> ppTerm Unqualified 0 f <+> text "instead of" <+> ppValue Unqualified 0 typ))
-     _ -> Bad (render (text "cannot typecheck pattern" <+> ppTerm Unqualified 0 exp))
+         _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))
+     _ -> Bad (render ("cannot typecheck pattern" <+> ppTerm Unqualified 0 exp))
 
 -- auxiliaries
 
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index 88f44a631..6a7b0e8d1 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -26,7 +26,7 @@ import GF.Data.Operations
 import Data.List
 import qualified Data.Map as Map
 import Control.Monad
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 -- | combine a list of definitions into a balanced binary search tree
 buildAnyTree :: Monad m => Ident -> [(Ident,Info)] -> m (BinTree Ident Info)
@@ -37,9 +37,9 @@ buildAnyTree m = go Map.empty
       case Map.lookup c map of
         Just i  -> case unifyAnyInfo m i j of
 		     Ok k  -> go (Map.insert c k map) is
-		     Bad _ -> fail $ render (text "conflicting information in module"<+>ppIdent m $$
+		     Bad _ -> fail $ render ("conflicting information in module"<+>m $$
 		                             nest 4 (ppJudgement Qualified (c,i)) $$
-		                             text "and" $+$
+		                             "and" $+$
 		                             nest 4 (ppJudgement Qualified (c,j)))
         Nothing -> go (Map.insert c j map) is
 
@@ -58,7 +58,7 @@ extendModule cwd gr (name,m)
 
      -- test that the module types match, and find out if the old is complete
      unless (sameMType (mtype m) (mtype mo)) 
-            (checkError (text "illegal extension type to module" <+> ppIdent name))
+            (checkError ("illegal extension type to module" <+> name))
 
      let isCompl = isCompleteModule m0
 
@@ -88,13 +88,13 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
     -- add the information given in interface into an instance module
     Nothing -> do
       unless (null is || mstatus mi == MSIncomplete) 
-             (checkError (text "module" <+> ppIdent i <+> 
-                          text "has open interfaces and must therefore be declared incomplete"))
+             (checkError ("module" <+> i <+> 
+                          "has open interfaces and must therefore be declared incomplete"))
       case mt of
         MTInstance (i0,mincl) -> do
           m1 <- lookupModule gr i0
           unless (isModRes m1)
-                 (checkError (text "interface expected instead of" <+> ppIdent i0))
+                 (checkError ("interface expected instead of" <+> i0))
           js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi)
           --- to avoid double inclusions, in instance I of I0 = J0 ** ...
           case extends mi of
@@ -112,7 +112,7 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
       let stat' = ifNull MSComplete (const MSIncomplete)
                     [i | i <- is, notElem i infs]
       unless (stat' == MSComplete || stat == MSIncomplete) 
-             (checkError (text "module" <+> ppIdent i <+> text "remains incomplete"))
+             (checkError ("module" <+> i <+> "remains incomplete"))
       ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext
       let ops1 = nub $
                    ops_ ++ -- N.B. js has been name-resolved already
@@ -149,11 +149,11 @@ extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jme
 		                                 (name,i) <- case i of 
                                                                AnyInd _ m -> lookupOrigInfo gr (m,c)
                                                                _          -> return (name,i)
-		                                 checkError (text "cannot unify the information" $$ 
+		                                 checkError ("cannot unify the information" $$ 
 		                                             nest 4 (ppJudgement Qualified (c,i)) $$
-		                                             text "in module" <+> ppIdent name <+> text "with" $$
+		                                             "in module" <+> name <+> "with" $$
 		                                             nest 4 (ppJudgement Qualified (c,j)) $$
-		                                             text "in module" <+> ppIdent base)
+		                                             "in module" <+> base)
                          Nothing-> if isCompl
                                      then return $ updateTree (c,indirInfo name i) new
                                      else return $ updateTree (c,i) new
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index df60c7c54..816a9f438 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -36,7 +36,7 @@ module GF.Grammar.Grammar (
         PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence,
         
         Info(..),
-        Location(..), L(..), unLoc, noLoc,
+        Location(..), L(..), unLoc, noLoc, ppLocation, ppL,
         Type,
         Cat,
         Fun,
@@ -63,6 +63,7 @@ module GF.Grammar.Grammar (
 
 import GF.Infra.Ident
 import GF.Infra.Option ---
+import GF.Infra.Location
 
 import GF.Data.Operations
 
@@ -74,7 +75,7 @@ import Data.Array.Unboxed
 import qualified Data.Map as Map
 --import qualified Data.Set as Set
 --import qualified Data.IntMap as IntMap
-import Text.PrettyPrint
+import GF.Text.Pretty
 --import System.FilePath
 --import Control.Monad.Identity
 
@@ -98,6 +99,8 @@ data SourceModInfo = ModInfo {
     jments  :: Map.Map Ident Info
   }
 
+instance HasSourcePath SourceModInfo where sourcePath = msrc
+
 type SourceModule = (Ident, SourceModInfo)
 
 -- | encoding the type of the module
@@ -200,12 +203,12 @@ abstractOfConcrete gr c = do
   n <- lookupModule gr c
   case mtype n of
     MTConcrete a -> return a
-    _ -> raise $ render (text "expected concrete" <+> ppIdent c)
+    _ -> raise $ render ("expected concrete" <+> c)
 
 lookupModule :: ErrorMonad m => SourceGrammar -> Ident -> m SourceModInfo
 lookupModule gr m = case Map.lookup m (moduleMap gr) of
   Just i  -> return i
-  Nothing -> raise $ render (text "unknown module" <+> ppIdent m <+> text "among" <+> hsep (map (ppIdent . fst) (modules gr)))
+  Nothing -> raise $ render ("unknown module" <+> m <+> "among" <+> hsep (map fst (modules gr)))
 
 isModAbs :: SourceModInfo -> Bool
 isModAbs m =
@@ -263,7 +266,7 @@ allAbstracts :: SourceGrammar -> [Ident]
 allAbstracts gr = 
  case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
    Left  is     -> is
-   Right cycles -> error $ render (text "Cyclic abstract modules:" <+> vcat (map (hsep . map ppIdent) cycles))
+   Right cycles -> error $ render ("Cyclic abstract modules:" <+> vcat (map hsep cycles))
 
 -- | the last abstract in dependency order (head of list)
 greatestAbstract :: SourceGrammar -> Maybe Ident
@@ -332,23 +335,6 @@ data Info =
  | AnyInd Bool Ident                         -- ^ (/INDIR/) the 'Bool' says if canonical
   deriving Show
 
-data Location 
-  = NoLoc
-  | Local Int Int
-  | External FilePath Location
-  deriving (Show,Eq,Ord)
-
-data L a = L Location a  -- location information
-  deriving Show
-
-instance Functor L where
-  fmap f (L loc x) = L loc (f x)
-
-unLoc :: L a -> a
-unLoc (L _ x) = x
-
-noLoc = L NoLoc
-
 type Type = Term
 type Cat  = QIdent
 type Fun  = QIdent
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index 6bdf87a5c..da75267de 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -42,7 +42,7 @@ import GF.Grammar.Lockfield
 import Data.List (sortBy)
 --import Data.Maybe (maybe)
 --import Control.Monad
-import Text.PrettyPrint
+import GF.Text.Pretty
 import qualified Data.Map as Map
 
 -- whether lock fields are added in reuse
@@ -83,7 +83,7 @@ lookupResDefLoc gr (m,c)
         AnyInd _ n        -> look n c
         ResParam _ _      -> return (noLoc (QC (m,c)))
         ResValue _        -> return (noLoc (QC (m,c)))
-        _   -> raise $ render (ppIdent c <+> text "is not defined in resource" <+> ppIdent m)
+        _   -> raise $ render (c <+> "is not defined in resource" <+> m)
 
 lookupResType :: ErrorMonad m => SourceGrammar -> QIdent -> m Type
 lookupResType gr (m,c) = do
@@ -99,7 +99,7 @@ lookupResType gr (m,c) = do
     AnyInd _ n        -> lookupResType gr (n,c)
     ResParam _ _      -> return typePType
     ResValue (L _ t)  -> return t
-    _   -> raise $ render (ppIdent c <+> text "has no type defined in resource" <+> ppIdent m)
+    _   -> raise $ render (c <+> "has no type defined in resource" <+> m)
 
 lookupOverload :: ErrorMonad m => SourceGrammar -> QIdent -> m [([Type],(Type,Term))]
 lookupOverload gr (m,c) = do
@@ -112,7 +112,7 @@ lookupOverload gr (m,c) = do
                      concat tss
 
       AnyInd _ n  -> lookupOverload gr (n,c)
-      _   -> raise $ render (ppIdent c <+> text "is not an overloaded operation")
+      _   -> raise $ render (c <+> "is not an overloaded operation")
 
 -- | returns the original 'Info' and the module where it was found
 lookupOrigInfo :: ErrorMonad m => SourceGrammar -> QIdent -> m (Ident,Info)
@@ -132,7 +132,7 @@ lookupParamValues gr c = do
   (_,info) <- lookupOrigInfo gr c
   case info of
     ResParam _ (Just pvs) -> return pvs
-    _                     -> raise $ render (ppQIdent Qualified c <+> text "has no parameter values defined")
+    _                     -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")
 
 allParamValues :: ErrorMonad m => SourceGrammar -> Type -> m [Term]
 allParamValues cnc ptyp =
@@ -148,13 +148,13 @@ allParamValues cnc ptyp =
        pvs <- allParamValues cnc pt
        vvs <- allParamValues cnc vt
        return [V pt ts | ts <- combinations (replicate (length pvs) vvs)]
-    _ -> raise (render (text "cannot find parameter values for" <+> ppTerm Unqualified 0 ptyp))
+    _ -> raise (render ("cannot find parameter values for" <+> ptyp))
   where
     -- to normalize records and record types
     sortByFst = sortBy (\ x y -> compare (fst x) (fst y))
 
 lookupAbsDef :: ErrorMonad m => SourceGrammar -> Ident -> Ident -> m (Maybe Int,Maybe [Equation])
-lookupAbsDef gr m c = errIn (render (text "looking up absdef of" <+> ppIdent c)) $ do
+lookupAbsDef gr m c = errIn (render ("looking up absdef of" <+> c)) $ do
   info <- lookupQIdentInfo gr (m,c)
   case info of
     AbsFun _ a d _ -> return (a,fmap (map unLoc) d)
@@ -168,7 +168,7 @@ lookupLincat gr m c = do
   case info of
     CncCat (Just (L _ t)) _ _ _ _ -> return t
     AnyInd _ n                    -> lookupLincat gr n c
-    _                             -> raise (render (ppIdent c <+> text "has no linearization type in" <+> ppIdent m))
+    _                             -> raise (render (c <+> "has no linearization type in" <+> m))
 
 -- | this is needed at compile time
 lookupFunType :: ErrorMonad m => SourceGrammar -> Ident -> Ident -> m Type
@@ -177,7 +177,7 @@ lookupFunType gr m c = do
   case info of
     AbsFun (Just (L _ t)) _ _ _ -> return t
     AnyInd _ n                  -> lookupFunType gr n c
-    _                           -> raise (render (text "cannot find type of" <+> ppIdent c))
+    _                           -> raise (render ("cannot find type of" <+> c))
 
 -- | this is needed at compile time
 lookupCatContext :: ErrorMonad m => SourceGrammar -> Ident -> Ident -> m Context
@@ -186,7 +186,7 @@ lookupCatContext gr m c = do
   case info of
     AbsCat (Just (L _ co)) -> return co
     AnyInd _ n             -> lookupCatContext gr n c
-    _                      -> raise (render (text "unknown category" <+> ppIdent c))
+    _                      -> raise (render ("unknown category" <+> c))
 
 
 -- this gives all opers and param constructors, also overloaded opers and funs, and the types, and locations
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index e516f0e47..b623aaa2b 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -31,7 +31,7 @@ import qualified Data.Traversable as T(mapM)
 import Control.Monad (liftM, liftM2, liftM3)
 --import Data.Char (isDigit)
 import Data.List (sortBy,nub)
-import Text.PrettyPrint
+import GF.Text.Pretty
 
 typeForm :: Type -> (Context, Cat, [Term])
 typeForm t =
@@ -45,7 +45,7 @@ typeForm t =
     Q  c -> ([],c,[])
     QC c -> ([],c,[])
     Sort c -> ([],(identW, c),[])
-    _      -> error (render (text "no normal form of type" <+> ppTerm Unqualified 0 t))
+    _      -> error (render ("no normal form of type" <+> ppTerm Unqualified 0 t))
 
 typeFormCnc :: Type -> (Context, Type)
 typeFormCnc t = 
@@ -170,7 +170,7 @@ projectRec :: Label -> [Assign] -> Term
 projectRec l rs =
   case lookup l rs of
     Just (_,t) -> t
-    Nothing    -> error (render (text "no value for label" <+> ppLabel l))
+    Nothing    -> error (render ("no value for label" <+> l))
 
 zipAssign :: [Label] -> [Term] -> [Assign]
 zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]
@@ -194,7 +194,7 @@ mkRecType = mkRecTypeN 0
 record2subst :: Term -> Err Substitution
 record2subst t = case t of
   R fs -> return [(identC x, t) | (LIdent x,(_,t)) <- fs]
-  _    -> Bad (render (text "record expected, found" <+> ppTerm Unqualified 0 t))
+  _    -> Bad (render ("record expected, found" <+> ppTerm Unqualified 0 t))
 
 typeType, typePType, typeStr, typeTok, typeStrs :: Term
 
@@ -273,8 +273,8 @@ plusRecType t1 t2 = case (t1, t2) of
   (RecType r1, RecType r2) -> case
     filter (`elem` (map fst r1)) (map fst r2) of
       [] -> return (RecType (r1 ++ r2))
-      ls -> raise $ render (text "clashing labels" <+> hsep (map ppLabel ls))
-  _ -> raise $ render (text "cannot add record types" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2) 
+      ls -> raise $ render ("clashing labels" <+> hsep ls)
+  _ -> raise $ render ("cannot add record types" <+> ppTerm Unqualified 0 t1 <+> "and" <+> ppTerm Unqualified 0 t2) 
 
 --plusRecord :: Term -> Term -> Err Term
 plusRecord t1 t2 =
@@ -283,7 +283,7 @@ plusRecord t1 t2 =
                               (l,v) <- r1, not (elem l (map fst r2)) ] ++ r2))
    (_,    FV rs) -> mapM (plusRecord t1) rs >>= return . FV
    (FV rs,_    ) -> mapM (`plusRecord` t2) rs >>= return . FV
-   _ -> raise $ render (text "cannot add records" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2)
+   _ -> raise $ render ("cannot add records" <+> ppTerm Unqualified 0 t1 <+> "and" <+> ppTerm Unqualified 0 t2)
 
 -- | default linearization type
 defLinType :: Type
@@ -386,7 +386,7 @@ term2patt trm = case termForm trm of
   Ok ([], Cn c, []) -> do
     return (PMacro c)
 
-  _ -> Bad $ render (text "no pattern corresponds to term" <+> ppTerm Unqualified 0 trm)
+  _ -> Bad $ render ("no pattern corresponds to term" <+> ppTerm Unqualified 0 trm)
 
 patt2term :: Patt -> Term
 patt2term pt = case pt of
@@ -450,7 +450,7 @@ strsFromTerm t = case t of
            ]
   FV ts -> mapM strsFromTerm ts >>= return . concat
   Strs ts -> mapM strsFromTerm ts >>= return . concat  
-  _ -> raise (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t))
+  _ -> raise (render ("cannot get Str from term" <+> ppTerm Unqualified 0 t))
 
 -- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg
 stringFromTerm :: Term -> String
@@ -609,7 +609,7 @@ topoSortJments :: ErrorMonad m => SourceModule -> m [(Ident,Info)]
 topoSortJments (m,mi) = do
   is <- either
           return
-          (\cyc -> raise (render (text "circular definitions:" <+> fsep (map ppIdent (head cyc)))))
+          (\cyc -> raise (render ("circular definitions:" <+> fsep (head cyc))))
           (topoTest (allDependencies (==m) (jments mi)))
   return (reverse [(i,info) | i <- is, Ok info <- [lookupTree showIdent i (jments mi)]])
 
@@ -617,8 +617,8 @@ topoSortJments2 :: ErrorMonad m => SourceModule -> m [[(Ident,Info)]]
 topoSortJments2 (m,mi) = do
   iss <- either
            return
-           (\cyc -> raise (render (text "circular definitions:"
-                                   <+> fsep (map ppIdent (head cyc)))))
+           (\cyc -> raise (render ("circular definitions:"
+                                   <+> fsep (head cyc))))
            (topoTest2 (allDependencies (==m) (jments mi)))
   return
     [[(i,info) | i<-is,Ok info<-[lookupTree showIdent i (jments mi)]] | is<-iss]
diff --git a/src/compiler/GF/Grammar/PatternMatch.hs b/src/compiler/GF/Grammar/PatternMatch.hs
index 81541b2a3..48cb9bd3f 100644
--- a/src/compiler/GF/Grammar/PatternMatch.hs
+++ b/src/compiler/GF/Grammar/PatternMatch.hs
@@ -22,20 +22,20 @@ import GF.Data.Operations
 import GF.Grammar.Grammar
 import GF.Infra.Ident
 import GF.Grammar.Macros
-import GF.Grammar.Printer
+--import GF.Grammar.Printer
 
 --import Data.List
 import Control.Monad
-import Text.PrettyPrint
+import GF.Text.Pretty
 --import Debug.Trace
 
 matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution)
 matchPattern pts term = 
   if not (isInConstantForm term)
-    then raise (render (text "variables occur in" <+> ppTerm Unqualified 0 term))
+    then raise (render ("variables occur in" <+> pp term))
   else do
     term' <- mkK term
-    errIn (render (text "trying patterns" <+> hsep (punctuate comma (map (ppPatt Unqualified 0 . fst) pts)))) $
+    errIn (render ("trying patterns" <+> hsep (punctuate ',' (map fst pts)))) $
       findMatch [([p],t) | (p,t) <- pts] [term']
  where
   -- to capture all Str with string pattern matching
@@ -49,7 +49,7 @@ matchPattern pts term =
     K w -> return [w]
     C v w -> liftM2 (++) (getS v) (getS w)
     Empty -> return []
-    _ -> raise (render (text "cannot get string from" <+> ppTerm Unqualified 0 s))
+    _ -> raise (render ("cannot get string from" <+> s))
 
 testOvershadow :: ErrorMonad m => [Patt] -> [Term] -> m [Patt]
 testOvershadow pts vs = do
@@ -60,10 +60,10 @@ testOvershadow pts vs = do
 
 findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution)
 findMatch cases terms = case cases of
-   [] -> raise (render (text "no applicable case for" <+> hsep (punctuate comma (map (ppTerm Unqualified 0) terms))))
+   [] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms)))
    (patts,_):_ | length patts /= length terms -> 
-       raise (render (text "wrong number of args for patterns :" <+> hsep (map (ppPatt Unqualified 0) patts) <+> 
-                    text "cannot take" <+> hsep (map (ppTerm Unqualified 0) terms)))
+       raise (render ("wrong number of args for patterns :" <+> hsep patts <+> 
+                    "cannot take" <+> hsep terms))
    (patts,val):cc -> case mapM tryMatch (zip patts terms) of
        Ok substs -> return (val, concat substs)
        _         -> findMatch cc terms
@@ -116,7 +116,7 @@ tryMatch (p,t) = do
 
       (PNeg p',_) -> case tryMatch (p',t) of
         Bad _ -> return []
-        _ -> raise (render (text "no match with negative pattern" <+> ppPatt Unqualified 0 p))
+        _ -> raise (render ("no match with negative pattern" <+> p))
 
       (PSeq p1 p2, ([],K s, [])) -> matchPSeq p1 p2 s
       (PMSeq mp1 mp2, ([],K s, [])) -> matchPMSeq mp1 mp2 s
@@ -130,7 +130,7 @@ tryMatch (p,t) = do
       (PChar,  ([],K [_], [])) -> return []
       (PChars cs, ([],K [c], [])) | elem c cs -> return []
 
-      _ -> raise (render (text "no match in case expr for" <+> ppTerm Unqualified 0 t))
+      _ -> raise (render ("no match in case expr for" <+> t))
 
 matchPMSeq (m1,p1) (m2,p2) s = matchPSeq' m1 p1 m2 p2 s
 --matchPSeq p1 p2 s = matchPSeq' (0,maxBound::Int) p1 (0,maxBound::Int) p2 s
diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs
index 6138f2ab9..da29e3ebd 100644
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -9,8 +9,6 @@
 
 module GF.Grammar.Printer
            ( TermPrintQual(..)
-           , ppLabel
-           , ppGrammar
            , ppModule
            , ppJudgement
            , ppParams
@@ -18,7 +16,6 @@ module GF.Grammar.Printer
            , ppPatt
            , ppValue
            , ppConstrs
-           , ppLocation
            , ppQIdent
            , ppMeta
            , getAbs
@@ -31,7 +28,7 @@ import GF.Grammar.Grammar
 
 import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq)
 
-import Text.PrettyPrint
+import GF.Text.Pretty
 import Data.Maybe (isNothing)
 import Data.List  (intersperse)
 import qualified Data.Map as Map
@@ -43,8 +40,8 @@ data TermPrintQual
   = Unqualified | Qualified | Internal
   deriving Eq                 
 
-ppGrammar :: SourceGrammar -> Doc
-ppGrammar sgr = vcat $ map (ppModule Qualified) $ modules sgr
+instance Pretty SourceGrammar where
+  pp = vcat . map (ppModule Qualified) . modules
 
 ppModule :: TermPrintQual -> SourceModule -> Doc
 ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ mseqs jments) =
@@ -54,288 +51,286 @@ ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ mseqs jments) =
             maybe empty (ppSequences q) mseqs) $$
     ftr
     where
-      hdr = complModDoc <+> modTypeDoc <+> equals <+> 
-            hsep (intersperse (text "**") $
+      hdr = complModDoc <+> modTypeDoc <+> '=' <+> 
+            hsep (intersperse (pp "**") $
                   filter (not . isEmpty)  $ [ commaPunct ppExtends exts
                                             , maybe empty ppWith with
                                             , if null opens
-                                                then lbrace
-                                                else text "open" <+> commaPunct ppOpenSpec opens <+> text "in" <+> lbrace
+                                                then pp '{'
+                                                else "open" <+> commaPunct ppOpenSpec opens <+> "in" <+> '{'
                                             ])
 
-      ftr = rbrace
+      ftr = '}'
 
       complModDoc =
         case mstat of
           MSComplete   -> empty
-          MSIncomplete -> text "incomplete"
+          MSIncomplete -> pp "incomplete"
 
       modTypeDoc =
         case mtype of
-          MTAbstract         -> text "abstract"  <+> ppIdent mn
-          MTResource         -> text "resource"  <+> ppIdent mn
-          MTConcrete abs     -> text "concrete"  <+> ppIdent mn <+> text "of" <+> ppIdent abs
-          MTInterface        -> text "interface" <+> ppIdent mn
-          MTInstance ie      -> text "instance"  <+> ppIdent mn <+> text "of" <+> ppExtends ie
+          MTAbstract         -> "abstract"  <+> mn
+          MTResource         -> "resource"  <+> mn
+          MTConcrete abs     -> "concrete"  <+> mn <+> "of" <+> abs
+          MTInterface        -> "interface" <+> mn
+          MTInstance ie      -> "instance"  <+> mn <+> "of" <+> ppExtends ie
 
-      ppExtends (id,MIAll        ) = ppIdent id
-      ppExtends (id,MIOnly   incs) = ppIdent id              <+> brackets (commaPunct ppIdent incs)
-      ppExtends (id,MIExcept incs) = ppIdent id <+> char '-' <+> brackets (commaPunct ppIdent incs)
+      ppExtends (id,MIAll        ) = pp id
+      ppExtends (id,MIOnly   incs) = id         <+> brackets (commaPunct pp incs)
+      ppExtends (id,MIExcept incs) = id <+> '-' <+> brackets (commaPunct pp incs)
       
-      ppWith (id,ext,opens) = ppExtends (id,ext) <+> text "with" <+> commaPunct ppInstSpec opens
+      ppWith (id,ext,opens) = ppExtends (id,ext) <+> "with" <+> commaPunct ppInstSpec opens
 
 ppOptions opts = 
-  text "flags" $$
-  nest 2 (vcat [text option <+> equals <+> ppLit value <+> semi | (option,value) <- optionsGFO opts])
+  "flags" $$
+  nest 2 (vcat [option <+> '=' <+> ppLit value <+> ';' | (option,value) <- optionsGFO opts])
 
 ppJudgement q (id, AbsCat pcont ) =
-  text "cat" <+> ppIdent id <+>
+  "cat" <+> id <+>
   (case pcont of
      Just (L _ cont) -> hsep (map (ppDecl q) cont)
-     Nothing         -> empty) <+> semi
+     Nothing         -> empty) <+> ';'
 ppJudgement q (id, AbsFun ptype _ pexp poper) =
   let kind | isNothing pexp      = "data"
            | poper == Just False = "oper"
            | otherwise           = "fun"
   in
   (case ptype of
-     Just (L _ typ) -> text kind <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi
+     Just (L _ typ) -> kind <+> id <+> ':' <+> ppTerm q 0 typ <+> ';'
      Nothing        -> empty) $$
   (case pexp of
      Just []  -> empty
-     Just eqs -> text "def" <+> vcat [ppIdent id <+> hsep (map (ppPatt q 2) ps) <+> equals <+> ppTerm q 0 e <+> semi | L _ (ps,e) <- eqs]
+     Just eqs -> "def" <+> vcat [id <+> hsep (map (ppPatt q 2) ps) <+> '=' <+> ppTerm q 0 e <+> ';' | L _ (ps,e) <- eqs]
      Nothing  -> empty)
 ppJudgement q (id, ResParam pparams _) = 
-  text "param" <+> ppIdent id <+>
+  "param" <+> id <+>
   (case pparams of
-     Just (L _ ps) -> equals <+> ppParams q ps
-     _             -> empty) <+> semi
+     Just (L _ ps) -> '=' <+> ppParams q ps
+     _             -> empty) <+> ';'
 ppJudgement q (id, ResValue pvalue) = 
-  text "-- param constructor" <+> ppIdent id <+> colon <+> 
+  "-- param constructor" <+> id <+> ':' <+> 
   (case pvalue of
-     (L _ ty) -> ppTerm q 0 ty) <+> semi
+     (L _ ty) -> ppTerm q 0 ty) <+> ';'
 ppJudgement q (id, ResOper  ptype pexp) =
-  text "oper" <+> ppIdent id <+>
-  (case ptype of {Just (L _ t) -> colon  <+> ppTerm q 0 t; Nothing -> empty} $$
-   case pexp  of {Just (L _ e) -> equals <+> ppTerm q 0 e; Nothing -> empty}) <+> semi
+  "oper" <+> id <+>
+  (case ptype of {Just (L _ t) -> ':'  <+> ppTerm q 0 t; Nothing -> empty} $$
+   case pexp  of {Just (L _ e) -> '=' <+> ppTerm q 0 e; Nothing -> empty}) <+> ';'
 ppJudgement q (id, ResOverload ids defs) =
-  text "oper" <+> ppIdent id <+> equals <+> 
-  (text "overload" <+> lbrace $$
-   nest 2 (vcat [ppIdent id <+> (colon <+> ppTerm q 0 ty $$ equals <+> ppTerm q 0 e <+> semi) | (L _ ty,L _ e) <- defs]) $$
-   rbrace) <+> semi
+  "oper" <+> id <+> '=' <+> 
+  ("overload" <+> '{' $$
+   nest 2 (vcat [id <+> (':' <+> ppTerm q 0 ty $$ '=' <+> ppTerm q 0 e <+> ';') | (L _ ty,L _ e) <- defs]) $$
+   '}') <+> ';'
 ppJudgement q (id, CncCat pcat pdef pref pprn mpmcfg) =
   (case pcat of
-     Just (L _ typ) -> text "lincat" <+> ppIdent id <+> equals <+> ppTerm q 0 typ <+> semi
+     Just (L _ typ) -> "lincat" <+> id <+> '=' <+> ppTerm q 0 typ <+> ';'
      Nothing        -> empty) $$
   (case pdef of
-     Just (L _ exp) -> text "lindef" <+> ppIdent id <+> equals <+> ppTerm q 0 exp <+> semi
+     Just (L _ exp) -> "lindef" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';'
      Nothing        -> empty) $$
   (case pref of
-     Just (L _ exp) -> text "linref" <+> ppIdent id <+> equals <+> ppTerm q 0 exp <+> semi
+     Just (L _ exp) -> "linref" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';'
      Nothing        -> empty) $$
   (case pprn of
-     Just (L _ prn) -> text "printname" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi
+     Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
      Nothing        -> empty) $$
   (case (mpmcfg,q) of
      (Just (PMCFG prods funs),Internal)
-                    -> text "pmcfg" <+> ppIdent id <+> equals <+> char '{' $$
+                    -> "pmcfg" <+> id <+> '=' <+> '{' $$
                        nest 2 (vcat (map ppProduction prods) $$
-                               space $$
-                               vcat (map (\(funid,arr) -> ppFunId funid <+> text ":=" <+> 
-                                                          parens (hcat (punctuate comma (map ppSeqId (Array.elems arr)))))
+                               ' ' $$
+                               vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+> 
+                                                          parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr)))))
                                          (Array.assocs funs))) $$
-                       char '}'
+                       '}'
      _              -> empty)
 ppJudgement q (id, CncFun  ptype pdef pprn mpmcfg) =
   (case pdef of
      Just (L _ e) -> let (xs,e') = getAbs e
-                     in text "lin" <+> ppIdent id <+> hsep (map ppBind xs) <+> equals <+> ppTerm q 0 e' <+> semi
+                     in "lin" <+> id <+> hsep (map ppBind xs) <+> '=' <+> ppTerm q 0 e' <+> ';'
      Nothing      -> empty) $$
   (case pprn of
-     Just (L _ prn) -> text "printname" <+> ppIdent id <+> equals <+> ppTerm q 0 prn <+> semi
+     Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
      Nothing        -> empty) $$
   (case (mpmcfg,q) of
      (Just (PMCFG prods funs),Internal)
-                    -> text "pmcfg" <+> ppIdent id <+> equals <+> char '{' $$
+                    -> "pmcfg" <+> id <+> '=' <+> '{' $$
                        nest 2 (vcat (map ppProduction prods) $$
-                               space $$
-                               vcat (map (\(funid,arr) -> ppFunId funid <+> text ":=" <+> 
-                                                          parens (hcat (punctuate comma (map ppSeqId (Array.elems arr)))))
+                               ' ' $$
+                               vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+> 
+                                                          parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr)))))
                                          (Array.assocs funs))) $$
-                       char '}'
+                       '}'
      _              -> empty)
 ppJudgement q (id, AnyInd cann mid) =
   case q of
-    Internal -> text "ind" <+> ppIdent id <+> equals <+> (if cann then text "canonical" else empty) <+> ppIdent mid <+> semi
+    Internal -> "ind" <+> id <+> '=' <+> (if cann then pp "canonical" else empty) <+> mid <+> ';'
     _        -> empty
 
+instance Pretty Term where pp = ppTerm Unqualified 0
+
 ppTerm q d (Abs b v e)   = let (xs,e') = getAbs (Abs b v e)
-                           in prec d 0 (char '\\' <> commaPunct ppBind xs <+> text "->" <+> ppTerm q 0 e')
+                           in prec d 0 ('\\' <> commaPunct ppBind xs <+> "->" <+> ppTerm q 0 e')
 ppTerm q d (T TRaw xs) = case getCTable (T TRaw xs) of
-                           ([],_) -> text "table" <+> lbrace $$
-	  		             nest 2 (vcat (punctuate semi (map (ppCase q) xs))) $$
-			             rbrace
-                           (vs,e) -> prec d 0 (text "\\\\" <> commaPunct ppIdent vs <+> text "=>" <+> ppTerm q 0 e)
-ppTerm q d (T (TTyped t) xs) = text "table" <+> ppTerm q 0 t <+> lbrace $$
-			       nest 2 (vcat (punctuate semi (map (ppCase q) xs))) $$
-			       rbrace
-ppTerm q d (T (TComp  t) xs) = text "table" <+> ppTerm q 0 t <+> lbrace $$
-		 	       nest 2 (vcat (punctuate semi (map (ppCase q) xs))) $$
-			       rbrace
-ppTerm q d (T (TWild  t) xs) = text "table" <+> ppTerm q 0 t <+> lbrace $$
-			       nest 2 (vcat (punctuate semi (map (ppCase q) xs))) $$
-			       rbrace
+                           ([],_) -> "table" <+> '{' $$
+	  		             nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			             '}'
+                           (vs,e) -> prec d 0 ("\\\\" <> commaPunct pp vs <+> "=>" <+> ppTerm q 0 e)
+ppTerm q d (T (TTyped t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
+			       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			       '}'
+ppTerm q d (T (TComp  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
+		 	       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			       '}'
+ppTerm q d (T (TWild  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
+			       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			       '}'
 ppTerm q d (Prod bt x a b)= if x == identW && bt == Explicit
-                              then prec d 0 (ppTerm q 4 a <+> text "->" <+> ppTerm q 0 b)
-                              else prec d 0 (parens (ppBind (bt,x) <+> colon <+> ppTerm q 0 a) <+> text "->" <+> ppTerm q 0 b)
-ppTerm q d (Table kt vt)=prec d 0 (ppTerm q 3 kt <+> text "=>" <+> ppTerm q 0 vt)
+                              then prec d 0 (ppTerm q 4 a <+> "->" <+> ppTerm q 0 b)
+                              else prec d 0 (parens (ppBind (bt,x) <+> ':' <+> ppTerm q 0 a) <+> "->" <+> ppTerm q 0 b)
+ppTerm q d (Table kt vt)=prec d 0 (ppTerm q 3 kt <+> "=>" <+> ppTerm q 0 vt)
 ppTerm q d (Let l e)    = let (ls,e') = getLet e
-                          in prec d 0 (text "let" <+> vcat (map (ppLocDef q) (l:ls)) $$ text "in" <+> ppTerm q 0 e')
-ppTerm q d (Example e s)=prec d 0 (text "in" <+> ppTerm q 5 e <+> str s)
-ppTerm q d (C e1 e2)    =prec d 1 (hang (ppTerm q 2 e1) 2 (text "++" <+> ppTerm q 1 e2))
-ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> char '+'  <+> ppTerm q 2 e2)
+                          in prec d 0 ("let" <+> vcat (map (ppLocDef q) (l:ls)) $$ "in" <+> ppTerm q 0 e')
+ppTerm q d (Example e s)=prec d 0 ("in" <+> ppTerm q 5 e <+> str s)
+ppTerm q d (C e1 e2)    =prec d 1 (hang (ppTerm q 2 e1) 2 ("++" <+> ppTerm q 1 e2))
+ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> '+'  <+> ppTerm q 2 e2)
 ppTerm q d (S x y)     = case x of
                            T annot xs -> let e = case annot of
 			                           TRaw     -> y
 			                           TTyped t -> Typed y t
 			                           TComp  t -> Typed y t
 			                           TWild  t -> Typed y t
-			                 in text "case" <+> ppTerm q 0 e <+> text "of" <+> lbrace $$
-			                    nest 2 (vcat (punctuate semi (map (ppCase q) xs))) $$
-			                   rbrace
-			   _          -> prec d 3 (hang (ppTerm q 3 x) 2 (text "!" <+> ppTerm q 4 y))
-ppTerm q d (ExtR x y)  = prec d 3 (ppTerm q 3 x <+> text "**" <+> ppTerm q 4 y)
+			                 in "case" <+> ppTerm q 0 e <+>"of" <+> '{' $$
+			                    nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			                   '}'
+			   _          -> prec d 3 (hang (ppTerm q 3 x) 2 ("!" <+> ppTerm q 4 y))
+ppTerm q d (ExtR x y)  = prec d 3 (ppTerm q 3 x <+> "**" <+> ppTerm q 4 y)
 ppTerm q d (App x y)   = prec d 4 (ppTerm q 4 x <+> ppTerm q 5 y)
-ppTerm q d (V e es)    = hang (text "table") 2 (sep [ppTerm q 6 e,brackets (fsep (punctuate semi (map (ppTerm q 0) es)))])
-ppTerm q d (FV es)     = text "variants" <+> braces (fsep (punctuate semi (map (ppTerm q 0) es)))
-ppTerm q d (AdHocOverload es)     = text "overload" <+> braces (fsep (punctuate semi (map (ppTerm q 0) es)))
-ppTerm q d (Alts e xs) = prec d 4 (text "pre" <+> braces (ppTerm q 0 e <> semi <+> fsep (punctuate semi (map (ppAltern q) xs))))
-ppTerm q d (Strs es)   = text "strs" <+> braces (fsep (punctuate semi (map (ppTerm q 0) es)))
-ppTerm q d (EPatt p)   = prec d 4 (char '#' <+> ppPatt q 2 p)
-ppTerm q d (EPattType t)=prec d 4 (text "pattern" <+> ppTerm q 0 t)
-ppTerm q d (P t l)     = prec d 5 (ppTerm q 5 t <> char '.' <> ppLabel l)
-ppTerm q d (Cn id)     = ppIdent id
-ppTerm q d (Vr id)     = ppIdent id
+ppTerm q d (V e es)    = hang "table" 2 (sep [ppTerm q 6 e,brackets (fsep (punctuate ';' (map (ppTerm q 0) es)))])
+ppTerm q d (FV es)     = "variants" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
+ppTerm q d (AdHocOverload es)     = "overload" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
+ppTerm q d (Alts e xs) = prec d 4 ("pre" <+> braces (ppTerm q 0 e <> ';' <+> fsep (punctuate ';' (map (ppAltern q) xs))))
+ppTerm q d (Strs es)   = "strs" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
+ppTerm q d (EPatt p)   = prec d 4 ('#' <+> ppPatt q 2 p)
+ppTerm q d (EPattType t)=prec d 4 ("pattern" <+> ppTerm q 0 t)
+ppTerm q d (P t l)     = prec d 5 (ppTerm q 5 t <> '.' <> l)
+ppTerm q d (Cn id)     = pp id
+ppTerm q d (Vr id)     = pp id
 ppTerm q d (Q  id)     = ppQIdent q id
 ppTerm q d (QC id)     = ppQIdent q id
-ppTerm q d (Sort id)   = ppIdent id
+ppTerm q d (Sort id)   = pp id
 ppTerm q d (K s)       = str s
-ppTerm q d (EInt n)    = int n
-ppTerm q d (EFloat f)  = double f
+ppTerm q d (EInt n)    = pp n
+ppTerm q d (EFloat f)  = pp f
 ppTerm q d (Meta i)    = ppMeta i
-ppTerm q d (Empty)     = text "[]"
-ppTerm q d (R [])      = text "<>" -- to distinguish from {} empty RecType
-ppTerm q d (R xs)      = braces (fsep (punctuate semi [ppLabel l <+> 
-                                                       fsep [case mb_t of {Just t -> colon <+> ppTerm q 0 t; Nothing -> empty},
-                                                             equals <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs]))
-ppTerm q d (RecType xs)= braces (fsep (punctuate semi [ppLabel l <+> colon <+> ppTerm q 0 t | (l,t) <- xs]))
-ppTerm q d (Typed e t) = char '<' <> ppTerm q 0 e <+> colon <+> ppTerm q 0 t <> char '>'
+ppTerm q d (Empty)     = pp "[]"
+ppTerm q d (R [])      = pp "<>" -- to distinguish from {} empty RecType
+ppTerm q d (R xs)      = braces (fsep (punctuate ';' [l <+> 
+                                                       fsep [case mb_t of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty},
+                                                             '=' <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs]))
+ppTerm q d (RecType xs)= braces (fsep (punctuate ';' [l <+> ':' <+> ppTerm q 0 t | (l,t) <- xs]))
+ppTerm q d (Typed e t) = '<' <> ppTerm q 0 e <+> ':' <+> ppTerm q 0 t <> '>'
 ppTerm q d (ImplArg e) = braces (ppTerm q 0 e)
-ppTerm q d (ELincat cat t) = prec d 4 (text "lincat" <+> ppIdent cat <+> ppTerm q 5 t)
-ppTerm q d (ELin cat t) = prec d 4 (text "lin" <+> ppIdent cat <+> ppTerm q 5 t)
-ppTerm q d (Error s)   = prec d 4 (text "Predef.error" <+> str s)
+ppTerm q d (ELincat cat t) = prec d 4 ("lincat" <+> cat <+> ppTerm q 5 t)
+ppTerm q d (ELin cat t) = prec d 4 ("lin" <+> cat <+> ppTerm q 5 t)
+ppTerm q d (Error s)   = prec d 4 ("Predef.error" <+> str s)
 
-ppEquation q (ps,e) = hcat (map (ppPatt q 2) ps) <+> text "->" <+> ppTerm q 0 e
+ppEquation q (ps,e) = hcat (map (ppPatt q 2) ps) <+> "->" <+> ppTerm q 0 e
 
-ppCase q (p,e) = ppPatt q 0 p <+> text "=>" <+> ppTerm q 0 e
+ppCase q (p,e) = ppPatt q 0 p <+> "=>" <+> ppTerm q 0 e
 
-ppPatt q d (PAlt p1 p2) = prec d 0 (ppPatt q 0 p1 <+> char '|' <+> ppPatt q 1 p2)
-ppPatt q d (PSeq p1 p2) = prec d 0 (ppPatt q 0 p1 <+> char '+' <+> ppPatt q 1 p2)
-ppPatt q d (PMSeq (_,p1) (_,p2)) = prec d 0 (ppPatt q 0 p1 <+> char '+' <+> ppPatt q 1 p2)
+instance Pretty Patt where pp = ppPatt Unqualified 0
+
+ppPatt q d (PAlt p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '|' <+> ppPatt q 1 p2)
+ppPatt q d (PSeq p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2)
+ppPatt q d (PMSeq (_,p1) (_,p2)) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2)
 ppPatt q d (PC f ps)    = if null ps
-                            then ppIdent f
-                            else prec d 1 (ppIdent f <+> hsep (map (ppPatt q 3) ps))
+                            then pp f
+                            else prec d 1 (f <+> hsep (map (ppPatt q 3) ps))
 ppPatt q d (PP f ps)    = if null ps
                             then ppQIdent q f
                             else prec d 1 (ppQIdent q f <+> hsep (map (ppPatt q 3) ps))
-ppPatt q d (PRep p)     = prec d 1 (ppPatt q 3 p <> char '*')
-ppPatt q d (PAs f p)    = prec d 2 (ppIdent f <> char '@' <> ppPatt q 3 p)
-ppPatt q d (PNeg p)     = prec d 2 (char '-' <> ppPatt q 3 p)
-ppPatt q d (PChar)      = char '?'
+ppPatt q d (PRep p)     = prec d 1 (ppPatt q 3 p <> '*')
+ppPatt q d (PAs f p)    = prec d 2 (f <> '@' <> ppPatt q 3 p)
+ppPatt q d (PNeg p)     = prec d 2 ('-' <> ppPatt q 3 p)
+ppPatt q d (PChar)      = pp '?'
 ppPatt q d (PChars s)   = brackets (str s)
-ppPatt q d (PMacro id)  = char '#' <> ppIdent id
-ppPatt q d (PM id)      = char '#' <> ppQIdent q id
-ppPatt q d PW           = char '_'
-ppPatt q d (PV id)      = ppIdent id
-ppPatt q d (PInt n)     = int n
-ppPatt q d (PFloat f)   = double f
+ppPatt q d (PMacro id)  = '#' <> id
+ppPatt q d (PM id)      = '#' <> ppQIdent q id
+ppPatt q d PW           = pp '_'
+ppPatt q d (PV id)      = pp id
+ppPatt q d (PInt n)     = pp n
+ppPatt q d (PFloat f)   = pp f
 ppPatt q d (PString s)  = str s
-ppPatt q d (PR xs)      = braces (hsep (punctuate semi [ppLabel l <+> equals <+> ppPatt q 0 e | (l,e) <- xs]))
+ppPatt q d (PR xs)      = braces (hsep (punctuate ';' [l <+> '=' <+> ppPatt q 0 e | (l,e) <- xs]))
 ppPatt q d (PImplArg p) = braces (ppPatt q 0 p)
-ppPatt q d (PTilde t)   = prec d 2 (char '~' <> ppTerm q 6 t)
+ppPatt q d (PTilde t)   = prec d 2 ('~' <> ppTerm q 6 t)
 
 ppValue :: TermPrintQual -> Int -> Val -> Doc
-ppValue q d (VGen i x)    = ppIdent x <> text "{-" <> int i <> text "-}" ---- latter part for debugging
+ppValue q d (VGen i x)    = x <> "{-" <> i <> "-}" ---- latter part for debugging
 ppValue q d (VApp u v)    = prec d 4 (ppValue q 4 u <+> ppValue q 5 v)
-ppValue q d (VCn (_,c))   = ppIdent c
+ppValue q d (VCn (_,c))   = pp c
 ppValue q d (VClos env e) = case e of
                               Meta _ -> ppTerm q d e <> ppEnv env
                               _      -> ppTerm q d e ---- ++ prEnv env ---- for debugging
-ppValue q d (VRecType xs) = braces (hsep (punctuate comma [ppLabel l <> char '=' <> ppValue q 0 v | (l,v) <- xs]))
-ppValue q d VType         = text "Type"
+ppValue q d (VRecType xs) = braces (hsep (punctuate ',' [l <> '=' <> ppValue q 0 v | (l,v) <- xs]))
+ppValue q d VType         = pp "Type"
 
 ppConstrs :: Constraints -> [Doc]
-ppConstrs = map (\(v,w) -> braces (ppValue Unqualified 0 v <+> text "<>" <+> ppValue Unqualified 0 w))
+ppConstrs = map (\(v,w) -> braces (ppValue Unqualified 0 v <+> "<>" <+> ppValue Unqualified 0 w))
 
 ppEnv :: Env -> Doc
-ppEnv e = hcat (map (\(x,t) -> braces (ppIdent x <> text ":=" <> ppValue Unqualified 0 t)) e)
+ppEnv e = hcat (map (\(x,t) -> braces (x <> ":=" <> ppValue Unqualified 0 t)) e)
 
-str s = doubleQuotes (text s)
+str s = doubleQuotes s
 
 ppDecl q (_,id,typ)
   | id == identW = ppTerm q 3 typ
-  | otherwise    = parens (ppIdent id <+> colon <+> ppTerm q 0 typ)
+  | otherwise    = parens (id <+> ':' <+> ppTerm q 0 typ)
 
 ppDDecl q (_,id,typ)
   | id == identW = ppTerm q 6 typ
-  | otherwise    = parens (ppIdent id <+> colon <+> ppTerm q 0 typ)
+  | otherwise    = parens (id <+> ':' <+> ppTerm q 0 typ)
 
+ppQIdent :: TermPrintQual -> QIdent -> Doc
 ppQIdent q (m,id) =
   case q of
-    Unqualified ->                          ppIdent id
-    Qualified   -> ppIdent m <> char '.' <> ppIdent id
-    Internal    -> ppIdent m <> char '.' <> ppIdent id
+    Unqualified ->          pp id
+    Qualified   -> m <> '.' <> id
+    Internal    -> m <> '.' <> id
     
 
-ppLabel = ppIdent . label2ident
+instance Pretty Label where pp = pp . label2ident
 
-ppOpenSpec (OSimple id)   = ppIdent id
-ppOpenSpec (OQualif id n) = parens (ppIdent id <+> equals <+> ppIdent n)
+ppOpenSpec (OSimple id)   = pp id
+ppOpenSpec (OQualif id n) = parens (id <+> '=' <+> n)
 
-ppInstSpec (id,n) = parens (ppIdent id <+> equals <+> ppIdent n)
+ppInstSpec (id,n) = parens (id <+> '=' <+> n)
 
 ppLocDef q (id, (mbt, e)) =
-  ppIdent id <+>
-  (case mbt of {Just t -> colon  <+> ppTerm q 0 t; Nothing -> empty} <+> equals <+> ppTerm q 0 e) <+> semi
+  id <+>
+  (case mbt of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty} <+> '=' <+> ppTerm q 0 e) <+> ';'
 
-ppBind (Explicit,v) = ppIdent v
-ppBind (Implicit,v) = braces (ppIdent v)
+ppBind (Explicit,v) = pp v
+ppBind (Implicit,v) = braces v
 
-ppAltern q (x,y) = ppTerm q 0 x <+> char '/' <+> ppTerm q 0 y
+ppAltern q (x,y) = ppTerm q 0 x <+> '/' <+> ppTerm q 0 y
 
-ppParams q ps = fsep (intersperse (char '|') (map (ppParam q) ps))
-ppParam q (id,cxt) = ppIdent id <+> hsep (map (ppDDecl q) cxt)
-
-ppLocation :: FilePath -> Location -> Doc
-ppLocation fpath NoLoc          = text fpath
-ppLocation fpath (External p l) = ppLocation p l
-ppLocation fpath (Local b e)
-  | b == e    = text fpath <> colon <> int b
-  | otherwise = text fpath <> colon <> int b <> text "-" <> int e
+ppParams q ps = fsep (intersperse (pp '|') (map (ppParam q) ps))
+ppParam q (id,cxt) = id <+> hsep (map (ppDDecl q) cxt)
 
 ppProduction (Production fid funid args) =
-  ppFId fid <+> text "->" <+> ppFunId funid <> 
-  brackets (hcat (punctuate comma (map (hsep . intersperse (char '|') . map ppFId) args)))
+  ppFId fid <+> "->" <+> ppFunId funid <> 
+  brackets (hcat (punctuate "," (map (hsep . intersperse (pp '|') . map ppFId) args)))
 
 ppSequences q seqsArr
   | null seqs || q /= Internal = empty
-  | otherwise                  = text "sequences" <+> char '{' $$
+  | otherwise                  = "sequences" <+> '{' $$
                                  nest 2 (vcat (map ppSeq seqs)) $$
-                                 char '}'
+                                 '}'
   where
     seqs = Array.assocs seqsArr
 
-commaPunct f ds = (hcat (punctuate comma (map f ds)))
+commaPunct f ds = (hcat (punctuate "," (map f ds)))
 
 prec d1 d2 doc
   | d1 > d2   = parens doc
diff --git a/src/compiler/GF/Grammar/ShowTerm.hs b/src/compiler/GF/Grammar/ShowTerm.hs
index 8f64fbc5a..d97ad9fe3 100644
--- a/src/compiler/GF/Grammar/ShowTerm.hs
+++ b/src/compiler/GF/Grammar/ShowTerm.hs
@@ -5,7 +5,7 @@ import GF.Grammar.Printer
 import GF.Grammar.Lookup
 import GF.Data.Operations
 
-import Text.PrettyPrint
+import GF.Text.Pretty
 import Data.List  (intersperse)
 
 showTerm :: SourceGrammar -> TermPrintStyle -> TermPrintQual -> Term -> String
@@ -13,7 +13,7 @@ showTerm gr sty q t = case sty of
     TermPrintTable -> render $ vcat [p <+> s | (p,s) <- ppTermTabular gr q t]
     TermPrintAll   -> render $ vcat [      s | (p,s) <- ppTermTabular gr q t]
     TermPrintList  -> renderStyle (style{mode = OneLineMode}) $ 
-      vcat (punctuate comma [s | (p,s) <- ppTermTabular gr q t])
+      vcat (punctuate ',' [s | (p,s) <- ppTermTabular gr q t])
     TermPrintOne   -> render $ vcat [      s | (p,s) <- take 1 (ppTermTabular gr q t)]
     TermPrintDefault -> render $ ppTerm q 0 t
 
@@ -21,19 +21,19 @@ ppTermTabular :: SourceGrammar -> TermPrintQual -> Term -> [(Doc,Doc)]
 ppTermTabular gr q = pr where
   pr t = case t of
     R rs   -> 
-      [(ppLabel lab       <+> char '.'  <+> path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val]
+      [(lab       <+> '.' <+> path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val]
     T _ cs -> 
-      [(ppPatt q 0 patt     <+> text "=>" <+> path, str) | (patt,  val ) <- cs, (path,str) <- pr val]
+      [(ppPatt q 0 patt     <+> "=>" <+> path, str) | (patt,  val ) <- cs, (path,str) <- pr val]
     V ty cs -> 
       let pvals = case allParamValues gr ty of
                     Ok pvals -> pvals
                     Bad _    -> map Meta [1..]
-      in [(ppTerm q 0 pval <+> text "=>" <+> path, str) | (pval, val) <- zip pvals cs, (path,str) <- pr val]
+      in [(ppTerm q 0 pval <+> "=>" <+> path, str) | (pval, val) <- zip pvals cs, (path,str) <- pr val]
     _      -> [(empty,ps t)]
   ps t = case t of
-    K s   -> text s
+    K s   -> pp s
     C s u -> ps s <+> ps u
-    FV ts -> hsep (intersperse (char '/') (map ps ts))
+    FV ts -> hsep (intersperse (pp '/') (map ps ts))
     _     -> ppTerm q 0 t
 
 data TermPrintStyle
diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs
index 045ba4852..24fbc3644 100644
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -21,11 +21,11 @@ module GF.Infra.CheckM
 
 import GF.Data.Operations
 --import GF.Infra.Ident
-import GF.Grammar.Grammar(msrc) -- ,Context
-import GF.Grammar.Printer(ppLocation)
+--import GF.Grammar.Grammar(msrc) -- ,Context
+import GF.Infra.Location(ppLocation,sourcePath)
 
 import qualified Data.Map as Map
-import Text.PrettyPrint
+import GF.Text.Pretty
 import System.FilePath(makeRelative)
 import Control.Parallel.Strategies(parList,rseq,using)
 import Control.Monad(liftM)
@@ -51,7 +51,7 @@ instance Monad Check where
                  (ws,Fail msg)  -> (ws,Fail msg)
 
 instance ErrorMonad Check where
-  raise s = checkError (text s)
+  raise s = checkError (pp s)
   handle f h = handle' f (h . render)
 
 handle' f h = Check (\{-ctxt-} msgs -> case unCheck f {-ctxt-} msgs of
@@ -67,7 +67,7 @@ checkCond s b = if b then return () else checkError s
 
 -- | warnings should be reversed in the end
 checkWarn :: Message -> Check ()
-checkWarn msg = Check $ \{-ctxt-} (es,ws) -> ((es,(text "Warning:" <+> msg) : ws),Success ())
+checkWarn msg = Check $ \{-ctxt-} (es,ws) -> ((es,("Warning:" <+> msg) : ws),Success ())
 
 checkWarnings = mapM_ checkWarn
 
@@ -151,6 +151,6 @@ checkIn msg c = Check $ \{-ctxt-} msgs0 ->
 -- | Augment error messages with a relative path to the source module and
 -- an contextual hint (which can be left 'empty')
 checkInModule cwd mi loc context =
-    checkIn (ppLocation relpath loc <> colon $$ nest 2 context)
+    checkIn (ppLocation relpath loc <> ':' $$ nest 2 context)
   where
-    relpath = makeRelative cwd (msrc mi)
+    relpath = makeRelative cwd (sourcePath mi)
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs
index 390c5ba84..272efca03 100644
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -13,7 +13,7 @@
 -----------------------------------------------------------------------------
 
 module GF.Infra.Ident (-- * Identifiers
-	      Ident, ident2utf8, showIdent, ppIdent, prefixIdent,
+	      Ident, ident2utf8, showIdent, prefixIdent,
 	      identS, identC, identV, identA, identAV, identW,
 	      argIdent, isArgIdent, getArgIndex,
               varStr, varX, isWildIdent, varIndex,
@@ -31,7 +31,7 @@ import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
                  -- UTF-8-encoded bytestrings!
 import Data.Char(isDigit)
 import PGF.Internal(Binary(..))
-import Text.PrettyPrint(Doc,text)
+import GF.Text.Pretty
 
 
 -- | the constructors labelled /INTERNAL/ are
@@ -81,8 +81,7 @@ ident2raw = Id . ident2utf8
 showIdent :: Ident -> String
 showIdent i = unpack $! ident2utf8 i
 
-ppIdent :: Ident -> Doc
-ppIdent = text . showIdent
+instance Pretty Ident where pp = pp . showIdent
 
 identS :: String -> Ident
 identS = identC . rawIdentS
diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs
index fe1d01423..aa0c7d7ff 100644
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -54,7 +54,7 @@ errOptIO os e m = case m of
     return e
 -}
 type FileName = String
-type InitPath = String
+type InitPath = String -- ^ the directory portion of a pathname
 type FullPath = String
 
 gfLibraryPath    = "GF_LIB_PATH"
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index 4d7e65870..44f978cb3 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -42,7 +42,7 @@ import qualified Text.ParserCombinators.ReadP as RP
 import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import Control.Exception(SomeException,fromException,evaluate,try)
 import Control.Monad
-import Text.PrettyPrint (render)
+import GF.Text.Pretty (render)
 import qualified GF.System.Signal as IO(runInterruptibly)
 #ifdef SERVER_MODE
 import GFServer(server)
@@ -247,7 +247,7 @@ execute1 opts gfenv0 s0 =
                  (\ m@(i,_) -> let file = (showIdent i ++ ".gfh") in 
                     restricted $ writeFile file (render (ppModule Qualified m)) >> P.putStrLn ("wrote " ++ file))
                  (modules mygr)  
-        _ -> putStrLn $ render $ ppGrammar mygr
+        _ -> putStrLn $ render mygr
       continue gfenv
 
     dependency_graph ws =
diff --git a/src/compiler/SimpleEditor/Convert.hs b/src/compiler/SimpleEditor/Convert.hs
index 0f07bc8bf..c0f7e3946 100644
--- a/src/compiler/SimpleEditor/Convert.hs
+++ b/src/compiler/SimpleEditor/Convert.hs
@@ -6,7 +6,7 @@ import Data.List(sortBy)
 import Data.Function(on)
 import qualified Data.Map as Map
 import Text.JSON(makeObj) --encode
-import Text.PrettyPrint(render,text,(<+>))
+import GF.Text.Pretty(render,(<+>))
 
 import qualified Data.ByteString.UTF8 as UTF8(fromString)
 
@@ -124,11 +124,11 @@ convCncJment (name,jment) =
     ResOper oltyp (Just lterm) -> return $ Op $ Oper lhs rhs
       where
         lhs = i++maybe "" ((" : "++) . render . ppTerm q 0 . unLoc) oltyp
-        rhs = render (text " ="<+>ppTerm q 0 (unLoc lterm))
+        rhs = render (" ="<+>ppTerm q 0 (unLoc lterm))
     ResOverload [] defs -> return $ Op $ Oper lhs rhs
       where
         lhs = i
-        rhs = render $ text " = overload"<+>ppTerm q 0 r
+        rhs = render $ " = overload"<+>ppTerm q 0 r
         r =  R [(lab,(Just ty,fu)) | (L _ ty,L _ fu) <-defs]
         lab = ident2label name
     CncFun _ (Just ldef) pprn _ -> -- ignores printname !!