diff options
Diffstat (limited to 'src/compiler/GF/Compile')
| -rw-r--r-- | src/compiler/GF/Compile/Compute/ConcreteNew.hs | 16 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/GeneratePMCFG.hs | 16 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/Rename.hs | 2 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/TypeCheck/RConcrete.hs | 40 |
4 files changed, 62 insertions, 12 deletions
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs index a9ae63960..ea55e77cb 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs +++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs @@ -291,9 +291,17 @@ glue env (v1,v2) = glu v1 v2 vt v = case value2term loc (local env) v of Left i -> Error ('#':show i) Right t -> t - in error . render $ - ppL loc (hang "unsupported token gluing:" 4 - (Glue (vt v1) (vt v2))) + originalMsg = render $ ppL loc (hang "unsupported token gluing" 4 + (Glue (vt v1) (vt v2))) + term = render $ pp $ Glue (vt v1) (vt v2) + in error $ unlines + [originalMsg + ,"" + ,"There was a problem in the expression `"++term++"`, either:" + ,"1) You are trying to use + on runtime arguments, possibly via an oper." + ,"2) One of the arguments in `"++term++"` is a bound variable from pattern matching a string, but the cases are non-exhaustive." + ,"For more help see https://github.com/GrammaticalFramework/gf-core/tree/master/doc/errors/gluing.md" + ] -- | to get a string from a value that represents a sequence of terminals @@ -546,7 +554,7 @@ value2term' stop loc xs v0 = linPattVars p = if null dups then return pvs - else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p) + else fail.render $ hang "Pattern is not linear. All variable names on the left-hand side must be distinct." 4 (ppPatt Unqualified 0 p) where allpvs = allPattVars p pvs = nub allpvs diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index f0c256775..0558715c6 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -614,6 +614,20 @@ mkArray lst = listArray (0,length lst-1) lst mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map] bug msg = ppbug msg -ppbug msg = error . render $ hang "Internal error in GeneratePMCFG:" 4 msg +ppbug msg = error completeMsg + where + originalMsg = render $ hang "Internal error in GeneratePMCFG:" 4 msg + completeMsg = + unlines [originalMsg + ,"" + ,"1) Check that you are not trying to pattern match a /runtime string/." + ," These are illegal:" + ," lin Test foo = case foo.s of {" + ," \"str\" => … } ; <- explicit matching argument of a lin" + ," lin Test foo = opThatMatches foo <- calling an oper that pattern matches" + ,"" + ,"2) Not about pattern matching? Submit a bug report and we update the error message." + ," https://github.com/GrammaticalFramework/gf-core/issues" + ] ppU = ppTerm Unqualified diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs index 5eb83cd4b..aacf24c5b 100644 --- a/src/compiler/GF/Compile/Rename.hs +++ b/src/compiler/GF/Compile/Rename.hs @@ -236,7 +236,7 @@ renamePattern :: Status -> Patt -> Check (Patt,[Ident]) renamePattern env patt = do r@(p',vs) <- renp patt let dupl = vs \\ nub vs - unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4 + unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear. All variable names on the left-hand side must be distinct.") 4 patt) return r where diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs index 134e71559..4d194e38b 100644 --- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs +++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs @@ -127,8 +127,12 @@ inferLType gr g trm = case trm of ty <- if isWildIdent z then return val else substituteLType [(bt,z,a')] val - return (App f' a',ty) - _ -> checkError ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty) + return (App f' a',ty) + _ -> + let term = ppTerm Unqualified 0 f + funName = pp . head . words .render $ term + in checkError ("A function type is expected for" <+> term <+> "instead of type" <+> ppType fty $$ + "\n ** Maybe you gave too many arguments to" <+> funName <+> "\n") S f x -> do (f', fty) <- inferLType gr g f @@ -428,7 +432,9 @@ checkLType gr g trm typ0 = do 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' z a b') - _ -> checkError $ "function type expected instead of" <+> ppType typ + _ -> checkError $ "function type expected instead of" <+> ppType typ $$ + "\n ** Double-check that the type signature of the operation" $$ + "matches the number of arguments given to it.\n" App f a -> do over <- getOverload gr g (Just typ) trm @@ -638,9 +644,31 @@ checkEqLType gr g t u trm = do (b,t',u',s) <- checkIfEqLType gr g t u trm case b of True -> return t' - False -> checkError $ s <+> "type of" <+> ppTerm Unqualified 0 trm $$ - "expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$ - "inferred:" <+> ppTerm Qualified 0 u -- ppqType u t + False -> + let inferredType = ppTerm Qualified 0 u + expectedType = ppTerm Qualified 0 t + term = ppTerm Unqualified 0 trm + funName = pp . head . words .render $ term + helpfulMsg = + case (arrows inferredType, arrows expectedType) of + (0,0) -> pp "" -- None of the types is a function + _ -> "\n **" <+> + if expectedType `isLessApplied` inferredType + then "Maybe you gave too few arguments to" <+> funName + else pp "Double-check that type signature and number of arguments match." + in checkError $ s <+> "type of" <+> term $$ + "expected:" <+> expectedType $$ -- ppqType t u $$ + "inferred:" <+> inferredType $$ -- ppqType u t + helpfulMsg + where + -- count the number of arrows in the prettyprinted term + arrows :: Doc -> Int + arrows = length . filter (=="->") . words . render + + -- If prettyprinted type t has fewer arrows then prettyprinted type u, + -- then t is "less applied", and we can print out more helpful error msg. + isLessApplied :: Doc -> Doc -> Bool + isLessApplied t u = arrows t < arrows u checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String) checkIfEqLType gr g t u trm = do |