summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
authorkrangelov <kr.angelov@gmail.com>2019-05-27 09:06:11 +0200
committerkrangelov <kr.angelov@gmail.com>2019-05-27 09:06:11 +0200
commit8df212165028242458795b1f943c7975eb434e2a (patch)
tree49d0d8b3b195daa74cd61ec0988bbf06f58cbad2 /src/compiler/GF/Compile
parent8b9719bd2d85ee16f89453c79c40d9e00f5057ad (diff)
parentb7249adf63acf717210af2fa2e552bd50473b960 (diff)
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/CheckGrammar.hs16
-rw-r--r--src/compiler/GF/Compile/TypeCheck/RConcrete.hs11
2 files changed, 17 insertions, 10 deletions
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 1348d8e41..5d6922704 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -147,11 +147,17 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
return $ updateTree (c,CncFun (Just linty) d mn mf) js
_ -> do checkWarn ("function" <+> c <+> "is not in abstract")
return js
- CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
- Ok _ -> return $ updateTree i js
- _ -> do checkWarn ("category" <+> c <+> "is not in abstract")
- return js
- _ -> return $ updateTree i js
+ CncCat {} ->
+ case lookupOrigInfo gr (am,c) of
+ Ok (_,AbsCat _) -> return $ updateTree i js
+ {- -- This might be too pedantic:
+ Ok (_,AbsFun {}) ->
+ checkError ("lincat:"<+>c<+>"is a fun, not a cat")
+ -}
+ _ -> do checkWarn ("category" <+> c <+> "is not in abstract")
+ return js
+
+ _ -> return $ updateTree i js
-- | General Principle: only Just-values are checked.
diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
index 88e324ff3..134e71559 100644
--- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
@@ -360,12 +360,13 @@ getOverload gr g mt ot = case appForm ot of
nest 2 (showTypes pre)
return (mkApp fun tts, val)
([],[]) -> do
- checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$
- "for" $$
+ checkError $ "no overload instance of" <+> ppTerm Qualified 0 f $$
+ maybe empty (\x -> "with value type" <+> ppType x) mt $$
+ "for argument list" $$
nest 2 stysError $$
- "among" $$
- nest 2 (vcat stypsError) $$
- maybe empty (\x -> "with value type" <+> ppType x) mt
+ "among alternatives" $$
+ nest 2 (vcat stypsError)
+
(vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
([(val,fun)],_) -> do