diff options
| author | krangelov <kr.angelov@gmail.com> | 2019-05-27 09:06:11 +0200 |
|---|---|---|
| committer | krangelov <kr.angelov@gmail.com> | 2019-05-27 09:06:11 +0200 |
| commit | 8df212165028242458795b1f943c7975eb434e2a (patch) | |
| tree | 49d0d8b3b195daa74cd61ec0988bbf06f58cbad2 /src/compiler/GF/Compile | |
| parent | 8b9719bd2d85ee16f89453c79c40d9e00f5057ad (diff) | |
| parent | b7249adf63acf717210af2fa2e552bd50473b960 (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.hs | 16 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/TypeCheck/RConcrete.hs | 11 |
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 |
