1
0
forked from GitHub/gf-core

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.
This commit is contained in:
hallgren
2014-07-27 22:06:23 +00:00
parent 7eaea44386
commit 30cda51516
22 changed files with 422 additions and 451 deletions

View File

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