Stuff the field name in the WrapField type class as a type parameter …

…for better error messages.

src/Libraries/Base1/Prelude.bs

@@ -4435,46 +4435,50 @@ data (MetaField :: $ -> # -> *) name idx = MetaField
 -- Should eventually include the output port names, when we support multiple output ports.
 primitive primMethod :: List String -> a -> a
 
-class WrapField f w | f -> w where
-  -- Given the prefix and arg_names pragmas, converts a synthesized interface field value to
-  -- its wrapper interface field.
-  toWrapField :: String -> List String -> f -> w
-
-  -- Converts a wrapper interface field value to its synthesized interface field.
-  fromWrapField :: w -> f
+-- Convert bewtween a field in an interface that is being synthesized,
+-- and a field in the corresponding field in the generated wrapper interface.
+-- Also takes the name of the field for error reporting purposes.
+class (WrapField :: $ -> * -> * -> *) name f w | name f -> w where
+  -- Given a proxy value for the field name, and the values of the prefix and arg_names pragmas,
+  -- converts a synthesized interface field value to its wrapper interface field.
+  toWrapField :: StrArg name -> String -> List String -> f -> w
+
+  -- Given a proxy value for the field name, converts a wrapper interface field value
+  -- to its synthesized interface field.
+  fromWrapField :: StrArg name -> w -> f
 
   -- Save the port types for a field in the wrapped interface, given the module name
   -- and the prefix, arg_names and result pragmas.
-  saveFieldPortTypes :: f -> Maybe Name__ -> String -> List String -> String -> Module ()
-  saveFieldPortTypes _ _ _ _ _ = return ()
+  saveFieldPortTypes :: StrArg name -> f -> Maybe Name__ -> String -> List String -> String -> Module ()
+  saveFieldPortTypes _ _ _ _ _ _ = return ()
 
-instance (WrapMethod m w) => (WrapField m w) where
-  toWrapField prefix names =
+instance (WrapMethod m w) => (WrapField name m w) where
+  toWrapField _ prefix names =
     let baseNames = methodArgBaseNames (_ :: m) prefix names 1
     in primMethod (inputPortNames (_ :: m) baseNames) ∘ toWrapMethod
-  fromWrapField = fromWrapMethod
-  saveFieldPortTypes _ modName prefix names =
+  fromWrapField _ = fromWrapMethod
+  saveFieldPortTypes _ _ modName prefix names =
     let baseNames = methodArgBaseNames (_ :: m) prefix names 1
     in saveMethodPortTypes (_ :: m) modName baseNames
 
 -- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface,
 -- but this case was being handled in GenWrap.
-instance WrapField PrimAction PrimAction where
-  toWrapField _ _ = id
-  fromWrapField = id
-
-instance WrapField Clock Clock where
-  toWrapField _ _ = id
-  fromWrapField = id
-
-instance WrapField Reset Reset where
-  toWrapField _ _ = id
-  fromWrapField = id
-
-instance (Bits a n) => WrapField (Inout a) (Inout_ n) where
-  toWrapField _ _ = primInoutCast0
-  fromWrapField = primInoutUncast0
-  saveFieldPortTypes _ modName _ _ result = primSavePortType modName result $ typeOf (_ :: (Inout a))
+instance WrapField name PrimAction PrimAction where
+  toWrapField _ _ _ = id
+  fromWrapField _ = id
+
+instance WrapField name Clock Clock where
+  toWrapField _ _ _ = id
+  fromWrapField _ = id
+
+instance WrapField name Reset Reset where
+  toWrapField _ _ _ = id
+  fromWrapField _ = id
+
+instance (Bits a n) => WrapField name (Inout a) (Inout_ n) where
+  toWrapField _ _ _ = primInoutCast0
+  fromWrapField _ = primInoutUncast0
+  saveFieldPortTypes _ _ modName _ _ result = primSavePortType modName result $ typeOf (_ :: (Inout a))
 
 class WrapMethod m w | m -> w where
   -- Convert a synthesized interface method to its wrapper interface method.

src/comp/ContextErrors.hs

@@ -20,7 +20,7 @@ import TIMonad
 import TCMisc
 import Unify
 
-import FStringCompat (mkFString)
+import FStringCompat (FString, mkFString, getFString)
 import Id(mkId)
 import PreIds
 import CSyntax
@@ -167,7 +167,7 @@ handleContextReduction' pos
                              "SizedLiteral instance contains wrong number of types")
     | cid == idWrapField =
         case ts of
-          [t, _] -> return $ handleCtxRedWrapField pos p t
+          [TCon (TyStr name _), t, _] -> return $ handleCtxRedWrapField pos p name t
           _ -> internalError("handleContextReduction': " ++
                              "WrapField instance contains wrong number of types")
 
@@ -461,9 +461,9 @@ handleCtxRedPrimPort pos (vp, reduced_ps) userty =
 
 -- --------------------
 
-handleCtxRedWrapField:: Position -> (VPred, [VPred]) -> Type -> EMsg
-handleCtxRedWrapField pos (vp, reduced_ps) userty =
-    (pos, EBadIfcType (pfpString userty)  -- XXX reporting the type, no easy way to get the method name here.
+handleCtxRedWrapField:: Position -> (VPred, [VPred]) -> FString -> Type -> EMsg
+handleCtxRedWrapField pos (vp, reduced_ps) name userty =
+    (pos, EBadIfcType (getFString name)
      "This method uses types that are not in the Bits or SplitPorts typeclass.")
 
 

src/comp/GenFuncWrap.hs

@@ -9,13 +9,13 @@ import Error(internalError, ErrMsg(..), ErrorHandle, bsError)
 import Flags(Flags)
 import PPrint
 import Id
-import PreIds(id_fromWrapField, idActionValue)
+import PreIds(id_fromWrapField, idActionValue, idStrArg)
 import CSyntax
 import SymTab
 import Scheme
 import Assump
 import Type(tModule, fn)
-import CType(getArrows, getRes)
+import CType(getArrows, getRes, cTStr)
 import Pred(expandSyn)
 import TypeCheck(cCtxReduceDef)
 import Subst(tv)
@@ -246,7 +246,8 @@ funcDef errh symt i oqt@(CQType _ ot) i_ n (CQType _ t) =
         -- the result is either an actionvalue or a value
         isAV = isActionValue symt r
 
-        expr = cVApply id_fromWrapField [CVar i_]
+        fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString i) (getIdPosition i)
+        expr = cVApply id_fromWrapField [fnp, CVar i_]
     in
         -- XXX this code works for Action/ActionValue foreign funcs,
         -- XXX but they are not handled by astate yet

src/comp/GenWrap.hs

@@ -25,7 +25,6 @@ import IdPrint
 import PreIds
 import CSyntax
 import CSyntaxUtil
-import Undefined (UndefKind(..))
 import SymTab(SymTab, TypeInfo(..), FieldInfo(..), findType, addTypesUQ,
               findField, findFieldInfo, getMethodArgNames)
 import MakeSymTab(convCQType)
@@ -901,8 +900,9 @@ genIfcField trec ifcIdIn prefixes (FInf fieldIdQ argtypes rettype _) =
                        let (fields,props) = unzip fieldsprops
                        return (concat fields, concat props)
                 _ -> do  -- ELSE NOT a Vec
+                      let fnt = cTStr (getIdFString fieldIdQ) (getIdPosition fieldIdQ)
                       let v = cTVar $ head tmpTyVarIds
-                      let ctx = CPred (CTypeclass idWrapField) [foldr arrow rettype argtypes, v]
+                      let ctx = CPred (CTypeclass idWrapField) [fnt, foldr arrow rettype argtypes, v]
 
                       let fi = binId prefixes fieldId
                       --
@@ -1107,9 +1107,10 @@ genTo pps ty mk =
                    localPrefix = joinStrings_  currentPre localPrefix1
                    prefix = stringLiteralAt noPosition localPrefix
                    arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds]
+                   fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f)
                -- XXX idEmpty is a horrible way to know no more selection is required
                let ec = if f == idEmpty then sel else CSelect sel (setInternal f)
-               let e = CApply (CVar id_toWrapField) [prefix, arg_names, ec]
+               let e = CApply (CVar id_toWrapField) [fnp, prefix, arg_names, ec]
                return [CLValue (binId prefixes f) [CClause [] [] e] []]
 
 -- --------------------
@@ -1199,7 +1200,9 @@ genFrom pps ty var =
               let meth_guard = CApply eUnpack [sel wbinf]
               let qs = if (hasNoRdy || isClock || isReset || isIot)
                        then [] else [CQFilter meth_guard]
-              let e = CApply (CVar id_fromWrapField) [sel binf]
+
+              let fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f)
+              let e = CApply (CVar id_fromWrapField) [fnp, sel binf]
               return (f, e, qs)
 
 
@@ -1611,7 +1614,8 @@ mkFromBind true_ifc_ids var ft =
               let meth_guard = CApply eUnpack [sel wbinf]
               let qs = if (wbinf `elem` true_ifc_ids || isClock || isReset || isIot)
                        then [] else [CQFilter meth_guard]
-              let e = CApply (CVar id_fromWrapField) [sel binf]
+              let fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f)
+              let e = CApply (CVar id_fromWrapField) [fnp, sel binf]
               return (f, e, qs)
 
 
@@ -2170,15 +2174,16 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId
                         Just str -> joinStrings_ currentPre str
                         Nothing  -> joinStrings_ currentPre methodStr
 
-              let proxy = mkProxy $ foldr arrow r as
+              let fproxy = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f)
+                  proxy = mkProxy $ foldr arrow r as
                   prefix = stringLiteralAt noPosition localPrefix
                   arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds]
                   result = stringLiteralAt noPosition resultName
               return [
                 CSExpr Nothing $
                   cVApply idLiftModule $
                     [cVApply id_saveFieldPortTypes
-                      [proxy, mkMaybe v, prefix, arg_names, result]]]
+                      [fproxy, proxy, mkMaybe v, prefix, arg_names, result]]]
 
 
 saveNameStmt :: Id -> Id -> CMStmt
@@ -2220,9 +2225,6 @@ tmod t = TAp (cTCon idModule) t
 id_t :: Position -> Id
 id_t pos = mkId pos fs_t
 
-mkProxy :: CType -> CExpr
-mkProxy ty = CHasType (CAny (getPosition ty) UNotUsed) $ CQType [] ty
-
 -- ====================
 -- Ready method utilities
 

src/comp/GenWrapUtils.hs

@@ -9,6 +9,7 @@ import Pragma
 import PreIds
 import CSyntax
 import CType
+import Undefined (UndefKind(..))
 
 -- ====================
 
@@ -87,4 +88,7 @@ getDefArgs dcls t =
 
 -- ====================
 
+mkProxy :: CType -> CExpr
+mkProxy ty = CHasType (CAny (getPosition ty) UNotUsed) $ CQType [] ty
+
 

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

@@ -7,5 +7,5 @@ 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 `function Bool f(NoInline_ArgNotInBits::L x1)': This
-  method uses types that are not in the Bits or SplitPorts typeclass.
+  Cannot synthesize `fnNoInline_ArgNotInBits': This method uses types that are
+  not in the Bits or SplitPorts typeclass.

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

@@ -7,8 +7,8 @@ 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 `function NoInline_ResNotInBits::L f(Bool x1)': This
-  method uses types that are not in the Bits or SplitPorts typeclass.
+  Cannot synthesize `fnNoInline_ResNotInBits': This method uses types that are
+  not in the Bits or SplitPorts typeclass.
 Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0029)
   Signature mismatch (given too general):
   given: