diff options
Diffstat (limited to 'src/compiler/GF/Compile')
| -rw-r--r-- | src/compiler/GF/Compile/TypeCheck/Concrete.hs | 12 |
1 files 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 |