Merge pull request #55 from inariksit/error-messages

Improvements in common  error messages

doc/errors/gluing.md

@@ -0,0 +1,27 @@
+## unsupported token gluing `foo + bar`
+
+There was a problem in an expression using +, e.g. `foo + bar`.
+This can be due to two causes, check which one applies in your case.
+
+1. You are trying to use + on runtime arguments. Even if you are using
+`foo + bar` in an oper, make sure that the oper isn't called in a
+linearization that takes arguments. Both of the following are illegal:
+
+    lin Test foo bar = foo.s + bar.s          -- explicit + in a lin
+    lin Test foo bar = opWithPlus foo bar     -- the oper uses +
+
+2. One of the arguments in `foo + bar` is a bound variable
+from pattern matching a string, but the cases are non-exhaustive.
+Example:
+    case "test" of {
+      x + "a" => x + "b"   -- no applicable case for "test", so x = ???
+    } ;
+
+You can fix this by adding a catch-all case in the end:
+    { x + "a" => x + "b" ;
+      _       => "default case" } ;
+
+3. If neither applies to your problem, submit a bug report and we
+will update the error message and this documentation.
+
+    https://github.com/GrammaticalFramework/gf-core/issues

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 $
+                                originalMsg = render $ ppL loc (hang "unsupported token gluing" 4
-                                         ppL loc (hang "unsupported token gluing:" 4
+                                                               (Glue (vt v1) (vt v2)))
-                                                        (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

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

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

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) 
+             return (App f' a',ty)
-           _ -> checkError ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty)
+           _ ->
+             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 $$
+    False ->
-                          "expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$
+      let inferredType = ppTerm Qualified 0 u
-                          "inferred:" <+> ppTerm Qualified 0 u -- ppqType u t
+          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