Use GF.Grammar.Printer everywhere instead of PrGrammar

9 files changed, 93 insertions, 66 deletions

diff --git a/src/GF/Grammar/Abstract.hs b/src/GF/Grammar/Abstract.hs
index c03783a52..8777c1287 100644
--- a/src/GF/Grammar/Abstract.hs
+++ b/src/GF/Grammar/Abstract.hs
@@ -19,7 +19,7 @@ module GF.Grammar.Values,
 module GF.Grammar.Macros,
 module GF.Infra.Ident,
 module GF.Grammar.MMacros,
-module GF.Grammar.PrGrammar,
+module GF.Grammar.Printer,
 
 Grammar
 
@@ -30,7 +30,7 @@ import GF.Grammar.Values
 import GF.Grammar.Macros
 import GF.Infra.Ident
 import GF.Grammar.MMacros
-import GF.Grammar.PrGrammar
+import GF.Grammar.Printer
 
 type Grammar = SourceGrammar ---
 
diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
index cfb6baf1d..248445c0c 100644
--- a/src/GF/Grammar/AppPredefined.hs
+++ b/src/GF/Grammar/AppPredefined.hs
@@ -20,8 +20,9 @@ import GF.Data.Operations
 import GF.Grammar.Predef
 import GF.Grammar.Grammar
 import GF.Grammar.Macros
-import GF.Grammar.PrGrammar (prt,prt_,prtBad)
+import GF.Grammar.Printer
 import qualified Data.ByteString.Char8 as BS
+import Text.PrettyPrint
 
 -- predefined function type signatures and definitions. AR 12/3/2003.
 
@@ -56,7 +57,7 @@ typPredefined f
     ([(varL,typeType),(identW,mkFunType [typeStr] typeStr),(identW,Vr varL)],Vr varL,[])
   | f == cTake      = return $ mkFunType [typeInt,typeTok] typeTok
   | f == cTk        = return $ mkFunType [typeInt,typeTok] typeTok
-  | otherwise       = prtBad "unknown in Predef:" f
+  | otherwise       = Bad (render (text "unknown in Predef:" <+> ppIdent f))
 
 varL :: Ident
 varL = identC (BS.pack "L")
@@ -89,7 +90,7 @@ appPredefined t = case t of
       (EInt i, EInt j) | f == cEqInt   -> retb $ if i==j then predefTrue else predefFalse
       (EInt i, EInt j) | f == cLessInt -> retb $ if i<j  then predefTrue else predefFalse
       (EInt i, EInt j) | f == cPlus    -> retb $ EInt $ i+j
-      (_,      t)      | f == cShow    -> retb $ foldr C Empty $ map K $ words $ prt t
+      (_,      t)      | f == cShow    -> retb $ foldr C Empty $ map K $ words $ render (ppTerm Unqualified 0 t)
       (_,      K s)    | f == cRead    -> retb $ Cn (identC (BS.pack s)) --- because of K, only works for atomic tags
       (_,      t)      | f == cToStr   -> trm2str t >>= retb
       _ -> retb t ---- prtBad "cannot compute predefined" t
@@ -137,11 +138,11 @@ trm2str t = case t of
   T _ ((_,s):_)   -> trm2str s
   TSh _ ((_,s):_) -> trm2str s
   V _ (s:_)       -> trm2str s
-  C _ _         -> return $ t
-  K _           -> return $ t
-  S c _         -> trm2str c
-  Empty         -> return $ t
-  _ -> prtBad "cannot get Str from term" t
+  C _ _           -> return $ t
+  K _             -> return $ t
+  S c _           -> trm2str c
+  Empty           -> return $ t
+  _               -> Bad (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t))
 
 -- simultaneous recursion on type and term: type arg is essential!
 -- But simplify the task by assuming records are type-annotated
diff --git a/src/GF/Grammar/Lockfield.hs b/src/GF/Grammar/Lockfield.hs
index 66a978770..3e78a48b6 100644
--- a/src/GF/Grammar/Lockfield.hs
+++ b/src/GF/Grammar/Lockfield.hs
@@ -21,14 +21,13 @@ import qualified Data.ByteString.Char8 as BS
 import GF.Infra.Ident
 import GF.Grammar.Grammar
 import GF.Grammar.Macros
-import GF.Grammar.PrGrammar
 
 import GF.Data.Operations
 
 lockRecType :: Ident -> Type -> Err Type
 lockRecType c t@(RecType rs) = 
   let lab = lockLabel c in
-  return $ if elem lab (map fst rs) || elem (prt c) ["String","Int"]
+  return $ if elem lab (map fst rs) || elem (showIdent c) ["String","Int"]
     then t --- don't add an extra copy of lock field, nor predef cats
     else RecType (rs ++ [(lockLabel c,  RecType [])])
 lockRecType c t = plusRecType t $ RecType [(lockLabel c,  RecType [])]
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index f6cf60873..c0cbbe962 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -16,20 +16,20 @@
 -----------------------------------------------------------------------------
 
 module GF.Grammar.Lookup (
-               lookupIdent,
-               lookupIdentInfo,
-               lookupIdentInfoIn,
-               lookupOrigInfo,
-               lookupResDef,
-               lookupResDefKind,
+           lookupIdent,
+           lookupIdentInfo,
+           lookupIdentInfoIn,
+           lookupOrigInfo,
+           lookupResDef,
+           lookupResDefKind,
 	       lookupResType, 
-               lookupOverload,
+           lookupOverload,
 	       lookupParams, 
 	       lookupParamValues, 
 	       lookupFirstTag, 
-               lookupValueIndex,
-               lookupIndexValue,
-               allOrigInfos,
+           lookupValueIndex,
+           lookupIndexValue,
+           allOrigInfos,
 	       allParamValues, 
 	       lookupAbsDef, 
 	       lookupLincat, 
@@ -39,13 +39,17 @@ module GF.Grammar.Lookup (
 	      ) where
 
 import GF.Data.Operations
-import GF.Grammar.Abstract
+import GF.Infra.Ident
 import GF.Infra.Modules
+import GF.Grammar.Macros
+import GF.Grammar.Grammar
+import GF.Grammar.Printer
 import GF.Grammar.Predef
 import GF.Grammar.Lockfield
 
 import Data.List (nub,sortBy)
 import Control.Monad
+import Text.PrettyPrint
 
 -- whether lock fields are added in reuse
 lock c = lockRecType c -- return
@@ -92,7 +96,7 @@ lookupResDefKind gr m c
       AnyInd _ n        -> look False n c
       ResParam _        -> return (QC m c,2)
       ResValue _        -> return (QC m c,2)
-      _   -> Bad $ prt c +++ "is not defined in resource" +++ prt m
+      _   -> Bad $ render (ppIdent c <+> text "is not defined in resource" <+> ppIdent m)
   lookExt m c =
     checks ([look False n c | n <- allExtensions gr m] ++ [return (Q m c,3)])
 
@@ -112,7 +116,7 @@ lookupResType gr m c = do
     AnyInd _ n        -> lookupResType gr n c
     ResParam _        -> return $ typePType
     ResValue (Just (t,_))  -> return $ qualifAnnotPar m t
-    _   -> Bad $ prt c +++ "has no type defined in resource" +++ prt m
+    _   -> Bad $ render (ppIdent c <+> text "has no type defined in resource" <+> ppIdent m)
   where
     lookFunType e m c = do
           a  <- abstractOfConcrete gr m
@@ -124,7 +128,7 @@ lookupResType gr m c = do
             AbsFun (Just ty) _ _ -> return $ redirectTerm e ty 
             AbsCat _ _ -> return typeType
             AnyInd _ n -> lookFun e m c n
-            _ -> prtBad "cannot find type of reused function" c
+            _ -> Bad (render (text "cannot find type of reused function" <+> ppIdent c))
 
 lookupOverload :: SourceGrammar -> Ident -> Ident -> Err [([Type],(Type,Term))]
 lookupOverload gr m c = do
@@ -138,7 +142,7 @@ lookupOverload gr m c = do
                      concat tss
 
       AnyInd _ n  -> lookupOverload gr n c
-      _   -> Bad $ prt c +++ "is not an overloaded operation"
+      _   -> Bad $ render (ppIdent c <+> text "is not an overloaded operation")
 
 -- | returns the original 'Info' and the module where it was found
 lookupOrigInfo :: SourceGrammar -> Ident -> Ident -> Err (Ident,Info)
@@ -157,7 +161,7 @@ lookupParams gr = look True where
     case info of
       ResParam (Just psm) -> return psm
       AnyInd _ n          -> look False n c
-      _                   -> Bad $ prt c +++ "has no parameters defined in resource" +++ prt m
+      _                   -> Bad $ render (ppIdent c <+> text "has no parameters defined in resource" <+> ppIdent m)
   lookExt m c =
     checks [look False n c | n <- allExtensions gr m]
 
@@ -177,21 +181,21 @@ lookupFirstTag gr m c = do
   vs <- lookupParamValues gr m c
   case vs of
     v:_ -> return v
-    _ -> prtBad "no parameter values given to type" c
+    _ -> Bad (render (text "no parameter values given to type" <+> ppIdent c))
 
 lookupValueIndex :: SourceGrammar -> Type -> Term -> Err Term
 lookupValueIndex gr ty tr = do
   ts <- allParamValues gr ty
   case lookup tr $ zip ts [0..] of
     Just i -> return $ Val tr ty i
-    _ -> Bad $ "no index for" +++ prt tr +++ "in" +++ prt ty
+    _ -> Bad $ render (text "no index for" <+> ppTerm Unqualified 0 tr <+> text "in" <+> ppTerm Unqualified 0 ty)
 
 lookupIndexValue :: SourceGrammar -> Type -> Int -> Err Term
 lookupIndexValue gr ty i = do
   ts <- allParamValues gr ty
   if i < length ts
     then return $ ts !! i
-    else Bad $ "no value for index" +++ show i +++ "in" +++ prt ty
+    else Bad $ render (text "no value for index" <+> int i <+> text "in" <+> ppTerm Unqualified 0 ty)
 
 allOrigInfos :: SourceGrammar -> Ident -> [(Ident,Info)]
 allOrigInfos gr m = errVal [] $ do
@@ -209,7 +213,7 @@ allParamValues cnc ptyp = case ptyp of
        let (ls,tys) = unzip $ sortByFst r
        tss <- mapM allPV tys
        return [R (zipAssign ls ts) | ts <- combinations tss]
-     _ -> prtBad "cannot find parameter values for" ptyp
+     _ -> Bad (render (text "cannot find parameter values for" <+> ppTerm Unqualified 0 ptyp))
   where
     allPV = allParamValues cnc
     -- to normalize records and record types
@@ -228,7 +232,7 @@ qualifAnnotPar m t = case t of
   _ -> composSafeOp (qualifAnnotPar m) t
 
 lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Int,Maybe [Equation])
-lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
+lookupAbsDef gr m c = errIn (render (text "looking up absdef of" <+> ppIdent c)) $ do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
@@ -244,7 +248,7 @@ lookupLincat gr m c = do
   case info of
     CncCat (Just t) _ _ -> return t
     AnyInd _ n          -> lookupLincat gr n c
-    _                   -> Bad $ prt c +++ "has no linearization type in" +++ prt m
+    _                   -> Bad (render (ppIdent c <+> text "has no linearization type in" <+> ppIdent m))
 
 -- | this is needed at compile time
 lookupFunType :: SourceGrammar -> Ident -> Ident -> Err Type
@@ -254,7 +258,7 @@ lookupFunType gr m c = do
   case info of
     AbsFun (Just t) _ _  -> return t
     AnyInd _ n           -> lookupFunType gr n c
-    _                    -> prtBad "cannot find type of" c
+    _                    -> Bad (render (text "cannot find type of" <+> ppIdent c))
 
 -- | this is needed at compile time
 lookupCatContext :: SourceGrammar -> Ident -> Ident -> Err Context
@@ -264,7 +268,7 @@ lookupCatContext gr m c = do
   case info of
     AbsCat (Just co) _ -> return co
     AnyInd _ n         -> lookupCatContext gr n c
-    _                  -> prtBad "unknown category" c
+    _                  -> Bad (render (text "unknown category" <+> ppIdent c))
 
 -- The first type argument is uncomputed, usually a category symbol.
 -- This is a hack to find implicit (= reused) opers.
diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs
index 84b365225..15e18231e 100644
--- a/src/GF/Grammar/MMacros.hs
+++ b/src/GF/Grammar/MMacros.hs
@@ -18,7 +18,7 @@ import GF.Data.Operations
 --import GF.Data.Zipper
 
 import GF.Grammar.Grammar
-import GF.Grammar.PrGrammar
+import GF.Grammar.Printer
 import GF.Infra.Ident
 import GF.Compile.Refresh
 import GF.Grammar.Values
@@ -27,6 +27,8 @@ import GF.Grammar.Macros
 
 import Control.Monad
 import qualified Data.ByteString.Char8 as BS
+import Text.PrettyPrint
+
 {-
 nodeTree :: Tree -> TrNode
 argsTree :: Tree -> [Tree]
@@ -178,13 +180,13 @@ val2expP :: Bool -> Val -> Err Exp
 val2expP safe v = case v of
 
   VClos g@(_:_) e@(Meta _) -> if safe 
-                              then prtBad "unsafe value substitution" v
+                              then Bad (render (text "unsafe value substitution" <+> ppValue Unqualified 0 v))
                               else substVal g e
   VClos g e -> substVal g e
   VApp f c  -> liftM2 App (val2expP safe f) (val2expP safe c)
   VCn c     -> return $ qq c
   VGen i x  -> if safe 
-               then prtBad "unsafe val2exp" v
+               then Bad (render (text "unsafe val2exp" <+> ppValue Unqualified 0 v))
                else return $ Vr $ x  --- in editing, no alpha conversions presentv
   VRecType xs->do xs <- mapM (\(l,v) -> val2expP safe v >>= \e -> return (l,e)) xs
                   return (RecType xs)
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index b195292eb..6749f1bc9 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -24,11 +24,12 @@ import GF.Infra.Ident
 import GF.Grammar.Grammar
 import GF.Grammar.Values
 import GF.Grammar.Predef
-import GF.Grammar.PrGrammar
+import GF.Grammar.Printer
 
 import Control.Monad (liftM, liftM2)
 import Data.Char (isDigit)
 import Data.List (sortBy)
+import Text.PrettyPrint
 
 firstTypeForm :: Type -> Err (Context, Type)
 firstTypeForm t = case t of
@@ -50,7 +51,7 @@ qTypeForm t = case t of
   QC m c ->
     return ([],(m,c),[]) 
   _       -> 
-    prtBad "no normal form of type" t
+    Bad (render (text "no normal form of type" <+> ppTerm Unqualified 0 t))
 
 qq :: QIdent -> Term
 qq (m,c) = Q m c
@@ -94,7 +95,7 @@ getMCat t = case t of
   QC m c -> return (m,c)
   Sort c -> return (identW, c)
   App f _ -> getMCat f
-  _ -> prtBad "no qualified constant" t
+  _ -> Bad (render (text "no qualified constant" <+> ppTerm Unqualified 0 t))
 
 typeSkeleton :: Type -> Err ([(Int,MCat)],MCat)
 typeSkeleton typ = do
@@ -231,7 +232,7 @@ mkRecType = mkRecTypeN 0
 record2subst :: Term -> Err Substitution
 record2subst t = case t of
   R fs -> return [(identC x, t) | (LIdent x,(_,t)) <- fs]
-  _ -> prtBad "record expected, found" t
+  _    -> Bad (render (text "record expected, found" <+> ppTerm Unqualified 0 t))
 
 typeType, typePType, typeStr, typeTok, typeStrs :: Term
 
@@ -304,8 +305,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 -> Bad $ "clashing labels" +++ unwords (map prt ls)
-  _ -> Bad ("cannot add record types" +++ prt t1 +++ "and" +++ prt t2) 
+      ls -> Bad $ render (text "clashing labels" <+> hsep (map ppLabel ls))
+  _ -> Bad $ render (text "cannot add record types" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2) 
 
 plusRecord :: Term -> Term -> Err Term
 plusRecord t1 t2 =
@@ -314,7 +315,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
-   _ -> Bad ("cannot add records" +++ prt t1 +++ "and" +++ prt t2)
+   _ -> Bad $ render (text "cannot add records" <+> ppTerm Unqualified 0 t1 <+> text "and" <+> ppTerm Unqualified 0 t2)
 
 -- | default linearization type
 defLinType :: Type
@@ -463,7 +464,7 @@ term2patt trm = case termForm trm of
   Ok ([], Cn c, []) -> do
     return (PMacro c)
 
-  _ -> prtBad "no pattern corresponds to term" trm
+  _ -> Bad $ render (text "no pattern corresponds to term" <+> ppTerm Unqualified 0 trm)
 
 patt2term :: Patt -> Term
 patt2term pt = case pt of
@@ -529,7 +530,7 @@ strsFromTerm t = case t of
   FV ts -> mapM strsFromTerm ts >>= return . concat
   Strs ts -> mapM strsFromTerm ts >>= return . concat  
   Alias _ _ d -> strsFromTerm d --- should not be needed...
-  _ -> prtBad "cannot get Str from term" t
+  _ -> Bad (render (text "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
@@ -708,10 +709,11 @@ isInOneType t = case t of
 
 sortRec :: [(Label,a)] -> [(Label,a)]
 sortRec = sortBy ordLabel where
-  ordLabel (r1,_) (r2,_) = case (prt r1, prt r2) of
-    ("s",_) -> LT
-    (_,"s") -> GT
-    (s1,s2) -> compare s1 s2
+  ordLabel (r1,_) (r2,_) = 
+    case (showIdent (label2ident r1), showIdent (label2ident r2)) of
+      ("s",_) -> LT
+      (_,"s") -> GT
+      (s1,s2) -> compare s1 s2
 
 
 
diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
index a14b405f3..0fb23f531 100644
--- a/src/GF/Grammar/PatternMatch.hs
+++ b/src/GF/Grammar/PatternMatch.hs
@@ -21,20 +21,20 @@ import GF.Data.Operations
 import GF.Grammar.Grammar
 import GF.Infra.Ident
 import GF.Grammar.Macros
-import GF.Grammar.PrGrammar
+import GF.Grammar.Printer
 
 import Data.List
 import Control.Monad
-
+import Text.PrettyPrint
 import Debug.Trace
 
 matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution)
 matchPattern pts term = 
   if not (isInConstantForm term)
-    then prtBad "variables occur in" term
+    then Bad (render (text "variables occur in" <+> ppTerm Unqualified 0 term))
   else do
     term' <- mkK term
-    errIn ("trying patterns" +++ unwords (intersperse "," (map (prt . fst) pts))) $
+    errIn (render (text "trying patterns" <+> hsep (punctuate comma (map (ppPatt Unqualified 0 . fst) pts)))) $
       findMatch [([p],t) | (p,t) <- pts] [term']
  where
   -- to capture all Str with string pattern matching
@@ -48,7 +48,7 @@ matchPattern pts term =
     K w -> return [w]
     C v w -> liftM2 (++) (getS v) (getS w)
     Empty -> return []
-    _ -> prtBad "cannot get string from" s
+    _ -> Bad (render (text "cannot get string from" <+> ppTerm Unqualified 0 s))
 
 testOvershadow :: [Patt] -> [Term] -> Err [Patt]
 testOvershadow pts vs = do
@@ -59,10 +59,10 @@ testOvershadow pts vs = do
 
 findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution)
 findMatch cases terms = case cases of
-   [] -> Bad $"no applicable case for" +++ unwords (intersperse "," (map prt terms))
+   [] -> Bad (render (text "no applicable case for" <+> hsep (punctuate comma (map (ppTerm Unqualified 0) terms))))
    (patts,_):_ | length patts /= length terms -> 
-       Bad ("wrong number of args for patterns :" +++ 
-            unwords (map prt patts) +++ "cannot take" +++ unwords (map prt terms))
+       Bad (render (text "wrong number of args for patterns :" <+> hsep (map (ppPatt Unqualified 0) patts) <+> 
+                    text "cannot take" <+> hsep (map (ppTerm Unqualified 0) terms)))
    (patts,val):cc -> case mapM tryMatch (zip patts terms) of
        Ok substs -> return (val, concat substs)
        _         -> findMatch cc terms
@@ -122,7 +122,7 @@ tryMatch (p,t) = do
 
       (PNeg p',_) -> case tryMatch (p',t) of
         Bad _ -> return []
-        _ -> prtBad "no match with negative pattern" p
+        _ -> Bad (render (text "no match with negative pattern" <+> ppPatt Unqualified 0 p))
 
       (PSeq p1 p2, ([],K s, [])) -> do
          let cuts = [splitAt n s | n <- [0 .. length s]] 
@@ -138,7 +138,7 @@ tryMatch (p,t) = do
       (PChar,  ([],K [_], [])) -> return []
       (PChars cs, ([],K [c], [])) | elem c cs -> return []
 
-      _ -> prtBad "no match in case expr for" t
+      _ -> Bad (render (text "no match in case expr for" <+> ppTerm Unqualified 0 t))
   
 isInConstantForm :: Term -> Bool
 isInConstantForm trm = case trm of
diff --git a/src/GF/Grammar/Printer.hs b/src/GF/Grammar/Printer.hs
index e366f45d5..a5beec99a 100644
--- a/src/GF/Grammar/Printer.hs
+++ b/src/GF/Grammar/Printer.hs
@@ -16,11 +16,14 @@ module GF.Grammar.Printer
            , ppTerm

            , ppTermTabular

            , ppPatt

+           , ppValue

+           , ppConstrs

            ) where

 

 import GF.Infra.Ident

 import GF.Infra.Modules

 import GF.Infra.Option

+import GF.Grammar.Values

 import GF.Grammar.Grammar

 import GF.Data.Operations

 import Text.PrettyPrint

@@ -225,6 +228,22 @@ ppPatt q d (PFloat f)   = double 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]))

 

+ppValue :: TermPrintQual -> Int -> Val -> Doc

+ppValue q d (VGen i x)    = ppIdent x <> text "{-" <> int i <> text "-}" ---- 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 (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"

+

+ppConstrs :: Constraints -> [Doc]

+ppConstrs = map (\(v,w) -> braces (ppValue Unqualified 0 v <+> text "<>" <+> ppValue Unqualified 0 w))

+

+ppEnv :: Env -> Doc

+ppEnv e = hcat (map (\(x,t) -> braces (ppIdent x <> text ":=" <> ppValue Unqualified 0 t)) e)

+

 str s = doubleQuotes (text s)

 

 ppDecl q (id,typ)

diff --git a/src/GF/Grammar/Unify.hs b/src/GF/Grammar/Unify.hs
index 68f8b3352..f367dc891 100644
--- a/src/GF/Grammar/Unify.hs
+++ b/src/GF/Grammar/Unify.hs
@@ -18,9 +18,9 @@
 module GF.Grammar.Unify (unifyVal) where
 
 import GF.Grammar.Abstract
-
 import GF.Data.Operations
 
+import Text.PrettyPrint
 import Data.List (partition)
 
 unifyVal :: Constraints -> Err (Constraints,MetaSubst)
@@ -64,13 +64,13 @@ unify e1 e2 g =
                                          unify b c' g
   (App c a, App d b)            -> case unify c d g of 
                                      Ok g1 -> unify a b g1 
-                                     _       -> prtBad "fail unify" e1
+                                     _     -> Bad (render (text "fail unify" <+> ppTerm Unqualified 0 e1))
   (RecType xs,RecType ys) | xs == ys -> return g
-  _                             -> prtBad "fail unify" e1
+  _                             -> Bad (render (text "fail unify" <+> ppTerm Unqualified 0 e1))
 
 extend :: Unifier -> MetaSymb -> Term -> Err Unifier
 extend g s t | (t == Meta s) = return g  
-             | occCheck s t  = prtBad "occurs check" t
+             | occCheck s t  = Bad (render (text "occurs check" <+> ppTerm Unqualified 0 t))
              | True          = return ((s, t) : g) 
 
 subst_all :: Unifier -> Term -> Err Term