From 6af9575a68cc6c35c8eec83a77d877adfaec97b1 Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 28 Jan 2013 14:00:23 +0000 Subject: [PATCH] improved error message for overloading in case the given signature looks the same as one of the expected ones: it shows full records rather than just lock fields. --- src/compiler/GF/Compile/TypeCheck/Concrete.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/compiler/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/GF/Compile/TypeCheck/Concrete.hs index ef98fe449..b58e9f5a2 100644 --- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs +++ b/src/compiler/GF/Compile/TypeCheck/Concrete.hs @@ -317,6 +317,14 @@ getOverload gr g mt ot = case appForm ot of let matches = [vf | vf@((_,v,_),_) <- vfs, matchVal mt v] let showTypes ty = hsep (map ppType ty) + + let (stys,styps) = (showTypes tys, [showTypes ty | (ty,_) <- typs]) + + -- to avoid strange error msg e.g. in case of unmatch record extension, show whole types if needed AR 28/1/2013 + let (stysError,stypsError) = if elem (render stys) (map render styps) + then (hsep (map (ppTerm Unqualified 0) tys), [hsep (map (ppTerm Unqualified 0) ty) | (ty,_) <- typs]) + else (stys,styps) + case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of ([(_,val,fun)],_) -> return (mkApp fun tts, val) ([],[(pre,val,fun)]) -> do @@ -329,9 +337,9 @@ getOverload gr g mt ot = case appForm ot of ([],[]) -> do checkError $ text "no overload instance of" <+> ppTerm Unqualified 0 f $$ text "for" $$ - nest 2 (showTypes tys) $$ + nest 2 stysError $$ text "among" $$ - nest 2 (vcat [showTypes ty | (ty,_) <- typs]) $$ + nest 2 (vcat stypsError) $$ maybe empty (\x -> text "with value type" <+> ppType x) mt (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of