diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs | 4 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/TypeCheck/RConcrete.hs | 2 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Printer.hs | 11 |
3 files changed, 12 insertions, 5 deletions
diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index f1c6aab80..badf8bd30 100644 --- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs @@ -288,8 +288,8 @@ tcApp ge scope t = tcOverloadFailed t ttys = tcError ("Overload resolution failed" $$ - "term " <+> pp t $$ - "types" <+> vcat [pp ty | (_,ty) <- ttys]) + "of term " <+> pp t $$ + "with types" <+> vcat [ppTerm Terse 0 ty | (_,ty) <- ttys]) tcPatt ge scope PW ty0 = diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs index 8913f7c5d..2fe08b256 100644 --- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs +++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs @@ -425,7 +425,7 @@ checkLType gr g trm typ0 = do then checkLType gr ((bt,x,a):g) c 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') + return $ (Abs bt x c', Prod bt' z a b') _ -> checkError $ "function type expected instead of" <+> ppType typ App f a -> do diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs index 341ff3863..dcd419c42 100644 --- a/src/compiler/GF/Grammar/Printer.hs +++ b/src/compiler/GF/Grammar/Printer.hs @@ -39,7 +39,7 @@ import qualified Data.Map as Map import qualified Data.Array.IArray as Array
data TermPrintQual
- = Unqualified | Qualified | Internal
+ = Terse | Unqualified | Qualified | Internal
deriving Eq
instance Pretty Grammar where
@@ -229,7 +229,13 @@ 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 (RecType xs)
+ | q == Terse = case [cat | (l,_) <- xs, let (p,cat) = splitAt 5 (showIdent (label2ident l)), p == "lock_"] of
+ [cat] -> pp cat
+ _ -> doc
+ | otherwise = doc
+ where
+ doc = 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 ("lincat" <+> cat <+> ppTerm q 5 t)
@@ -296,6 +302,7 @@ ppDDecl q (_,id,typ) ppQIdent :: TermPrintQual -> QIdent -> Doc
ppQIdent q (m,id) =
case q of
+ Terse -> pp id
Unqualified -> pp id
Qualified -> m <> '.' <> id
Internal -> m <> '.' <> id
|