Pass the current module name into handleContextReduction for better error message

Author: krame505

src/comp/ContextErrors.hs

@@ -21,7 +21,7 @@ import TCMisc
 import Unify
 
 import FStringCompat (FString, mkFString, getFString)
-import Id(mkId)
+import Id(Id, mkId)
 import PreIds
 import CSyntax
 import Util(separate, concatMapM, quote, headOrErr, toMaybe, boolCompress)
@@ -39,8 +39,8 @@ import CType(typeclassId, isTNum, getTNum)
 -- a list of the contexts which failed to reduce, this function
 -- returns the list of error messages which should be reported
 --
-handleContextReduction :: Position -> [VPred] -> TI a
-handleContextReduction pos vps =
+handleContextReduction :: Maybe Id -> Position -> [VPred] -> TI a
+handleContextReduction mid pos vps =
     do
        -- We used to remove duplicates:
        --   let vps' = nubVPred vps
@@ -80,15 +80,15 @@ handleContextReduction pos vps =
                      then vps_reduced_nicenames
                      else is_mod_arrow_vps
 
-       emsgs <- mapM (handleContextReduction' pos) err_vps
+       emsgs <- mapM (handleContextReduction' mid pos) err_vps
 
        errs "handleContextReduction" emsgs
 
 -- --------------------
 
 -- This helper function takes one predicate at a time
-handleContextReduction' :: Position -> (VPred, [VPred]) -> TI EMsg
-handleContextReduction' pos
+handleContextReduction' :: Maybe Id -> Position -> (VPred, [VPred]) -> TI EMsg
+handleContextReduction' mid pos
     p@((VPred vpi (PredWithPositions (IsIn c@(Class { name=(CTypeclass cid) }) ts) _)), _)
     | cid == idBitwise =
         case ts of
@@ -167,15 +167,15 @@ handleContextReduction' pos
                              "SizedLiteral instance contains wrong number of types")
     | cid == idWrapField =
         case ts of
-          [TCon (TyStr name _), t, _] -> return $ handleCtxRedWrapField pos p name t
+          [TCon (TyStr name _), t, _] -> return $ handleCtxRedWrapField mid pos p name t
           _ -> internalError("handleContextReduction': " ++
                              "WrapField instance contains wrong number of types")
 
 --  | cid == idLiteral =
 --  | cid == idRealLiteral =
 --  | cid == idStringLiteral =
 
-handleContextReduction' pos p =
+handleContextReduction' mid pos p =
     return (defaultContextReductionErr pos p)
 
 -- --------------------
@@ -461,9 +461,9 @@ handleCtxRedPrimPort pos (vp, reduced_ps) userty =
 
 -- --------------------
 
-handleCtxRedWrapField:: Position -> (VPred, [VPred]) -> FString -> Type -> EMsg
-handleCtxRedWrapField pos (vp, reduced_ps) name userty = 
-    (pos, EBadIfcType Nothing $
+handleCtxRedWrapField:: Maybe Id -> Position -> (VPred, [VPred]) -> FString -> Type -> EMsg
+handleCtxRedWrapField mid pos (vp, reduced_ps) name userty =
+    (pos, EBadIfcType (fmap pfpString mid) $
      "The interface method `" ++ getFString name ++
      "' uses type(s) that are not in the Bits or SplitPorts typeclasses: " ++
      intercalate ", " (concatMap bitsPredType reduced_ps)
@@ -1036,7 +1036,7 @@ earlyContextReduction pos ps =
     rs <- mapM try_pred ps
     let err_preds = map fst (filter (not . snd) rs)
     when (not (null err_preds)) $
-        handleContextReduction pos err_preds
+        handleContextReduction Nothing pos err_preds
 
 -- ========================================================================
 

src/comp/TCheck.hs

@@ -2639,7 +2639,7 @@ tiExpl''' as0 i sc alts me (oqt@(oqs :=> ot), vts) = do
      -- Were any contexts without variables left unsatisfied?
      if not (null uds) then
         -- Report reduction errors
-        handleContextReduction (getPosition i) uds
+        handleContextReduction (Just i) (getPosition i) uds
      else
         -- No ambiguous variables, so...
         -- Produce the return values (deferred preds, CDefl)

src/comp/TypeCheck.hs

@@ -72,7 +72,7 @@ tiOneDef :: CDefn -> TI CDefn
 tiOneDef d@(CValueSign (CDef i t s)) = do
         --trace ("TC " ++ ppReadable i) $ return ()
         (rs, ~(CLValueSign d' _)) <- tiExpl nullAssump (i, t, s, [])
-        checkTopPreds d rs
+        checkTopPreds (Just i) d rs
         s <- getSubst'
         clearSubst
         return (CValueSign (apSub s d'))
@@ -91,7 +91,7 @@ tiOneDef d@(Cclass incoh cps ik is fd fs) = do
               fqt' = CQType fps' fty
           (rs, ~(CLValueSign (CDefT _ _ _ fcs') _))
                <- tiExpl nullAssump (fid, fqt', fcs, [])
-          checkTopPreds fid rs
+          checkTopPreds (Just fid) fid rs
           clearSubst
           return (f { cf_default = fcs' })
     fs' <- mapM tiF fs
@@ -113,17 +113,17 @@ getSubst' = do
         if s == s then return s else internalError "TypeCheck.getSubst': s /= s (WTF!?)"
 
 -- Any predicates at the top level should be reported as an error
-checkTopPreds :: (HasPosition a, PPrint a) => a -> [VPred] -> TI ()
-checkTopPreds _ [] = return ()
-checkTopPreds a ps = do
+checkTopPreds :: (HasPosition a, PPrint a) => Maybe Id -> a -> [VPred] -> TI ()
+checkTopPreds _ _ [] = return ()
+checkTopPreds mid a ps = do
     -- reduce the predicates as much as possible
     (ps', ls) <- satisfy [] ps
     if null ps' then
         -- they shouldn't reduce away completely
         internalError ("checkTopPreds " ++ ppReadable (a, ps))
      else do
         addExplPreds []  -- add en empty context
-        handleContextReduction (getPosition a) ps'
+        handleContextReduction mid (getPosition a) ps'
 
 -- typecheck an expression as a top-level object
 -- returning any unsatisfied preds

testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected

@@ -7,6 +7,6 @@ Error: Unknown position: (T0031)
   The proviso was implied by expressions at the following positions:
     "NoInline_ArgNotInBits.bsv", line 4, column 15
 Error: "NoInline_ArgNotInBits.bsv", line 4, column 15: (T0043)
-  Cannot synthesize this module or function: The interface method
+  Cannot synthesize `module_fnNoInline_ArgNotInBits­': The interface method
   `fnNoInline_ArgNotInBits' uses type(s) that are not in the Bits or
   SplitPorts typeclasses: NoInline_ArgNotInBits::L

testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected

@@ -7,7 +7,7 @@ Error: Unknown position: (T0031)
   The proviso was implied by expressions at the following positions:
     "NoInline_ResNotInBits.bsv", line 4, column 12
 Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0043)
-  Cannot synthesize this module or function: The interface method
+  Cannot synthesize `module_fnNoInline_ResNotInBits­': The interface method
   `fnNoInline_ResNotInBits' uses type(s) that are not in the Bits or
   SplitPorts typeclasses: NoInline_ResNotInBits::L
 Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0029)