From 30cda5151651e712803527b6ab4e5abc07536f2c Mon Sep 17 00:00:00 2001 From: hallgren Date: Sun, 27 Jul 2014 22:06:23 +0000 Subject: Introducing GF.Text.Pretty for more concise pretty printers and GF.Infra.Location for modularity GF.Text.Pretty provides the class Pretty and overloaded versions of the pretty printing combinators in Text.PrettyPrint, allowing pretty printable values to be used directly instead of first having to convert them to Doc with functions like text, int, char and ppIdent. Some modules have been converted to use GF.Text.Pretty, but not all. Precedences could be added to simplify the pretty printers for terms and patterns. GF.Infra.Location contains the types Location and L, factored out from GF.Grammar.Grammar, and the class HasSourcePath. This allowed the import of GF.Grammar.Grammar to be removed from GF.Infra.CheckM, making it more like a pure library module. --- src/compiler/GF/Compile/Update.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'src/compiler/GF/Compile/Update.hs') 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 -- cgit v1.2.3