Report S0015 split-port errors at the interface field's declaration

src/Libraries/Base1/Prelude.bs

@@ -4651,16 +4651,21 @@ class (WrapField :: $ -> * -> * -> *) name f w | name f -> w where
   saveFieldPortTypes :: StrArg name -> f -> Maybe Name__ -> String -> List String -> String -> Module ()
 
 instance (WrapMethod m w) => (WrapField name m w) where
-  toWrapField _ prefix argNames resultName =
-    let argBaseNames = methodArgBaseNames (_ :: m) prefix argNames 1
+  -- The name proxy is generated (GenWrap) with the interface field's
+  -- decl-side position, so port-name checking errors point at the
+  -- field in the user's interface declaration.
+  toWrapField np prefix argNames resultName =
+    let pos = getEvalPosition np
+        argBaseNames = methodArgBaseNames (_ :: m) pos prefix argNames 1
     in primMethod
-      (inputPortNames (_ :: m) argBaseNames)
-      (outputPortNames (_ :: m) resultName)
+      (inputPortNames (_ :: m) pos argBaseNames)
+      (outputPortNames (_ :: m) pos resultName)
       ∘ toWrapMethod
   fromWrapField _ = fromWrapMethod
-  saveFieldPortTypes _ _ modName prefix argNames resultName =
-    let baseNames = methodArgBaseNames (_ :: m) prefix argNames 1
-    in saveMethodPortTypes (_ :: m) modName baseNames resultName
+  saveFieldPortTypes np _ modName prefix argNames resultName =
+    let pos = getEvalPosition np
+        baseNames = methodArgBaseNames (_ :: m) pos prefix argNames 1
+    in saveMethodPortTypes (_ :: m) pos modName baseNames resultName
 
 -- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface,
 -- but this case was being handled in GenWrap.
@@ -4693,10 +4698,11 @@ instance (Bits a n) => WrapField name (Inout a) (Inout_ n) where
 -- and output ports; only the arg names are supplied separately.
 fromWrapNoInline :: (WrapMethod m w) => String -> List String -> w -> m
 fromWrapNoInline name argNames x =
-  let argBaseNames = methodArgBaseNames (_ :: m) name argNames 1
+  let pos = getStringPosition name  -- the noinline function's position
+      argBaseNames = methodArgBaseNames (_ :: m) pos name argNames 1
   in fromWrapMethod (primNoInline
-                       (inputPortNames (_ :: m) argBaseNames)
-                       (outputPortNames (_ :: m) name)
+                       (inputPortNames (_ :: m) pos argBaseNames)
+                       (outputPortNames (_ :: m) pos name)
                        x)
 
 class WrapMethod m w | m -> w where
@@ -4706,17 +4712,20 @@ class WrapMethod m w | m -> w where
   -- Convert a wrapper interface method to its synthesized interface method.
   fromWrapMethod :: w -> m
 
+  -- The Position__ argument is a term-side error position: the interface
+  -- field (or noinline function) whose ports are being checked.
+
   -- Compute the actual argument base names for a method, given the prefix and arg_names pragmas.
-  methodArgBaseNames :: m -> String -> List String -> Integer -> List String
+  methodArgBaseNames :: m -> Position__ -> String -> List String -> Integer -> List String
 
   -- Compute the list of input port names for each method argument, given the per-argument base names.
-  inputPortNames :: m -> List String -> List (List String)
+  inputPortNames :: m -> Position__ -> List String -> List (List String)
 
   -- Compute the list of output port names for a method, from the result base name.
-  outputPortNames :: m -> String -> List String
+  outputPortNames :: m -> Position__ -> String -> List String
 
   -- Save the port types for a method, given the module name, argument base names and result name.
-  saveMethodPortTypes :: m -> Maybe Name__ -> List String -> String -> Module ()
+  saveMethodPortTypes :: m -> Position__ -> Maybe Name__ -> List String -> String -> Module ()
 
 instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n,
           PrimSeqTupleBits pb, WrapMethod b v) =>
@@ -4726,57 +4735,57 @@ instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n,
   toWrapMethod f = toWrapMethod ∘ f ∘ unsplitPorts ∘ unpackPorts ∘ primDeepSeqTupleBits
   fromWrapMethod g = fromWrapMethod ∘ g ∘ primDeepSeqTupleBits ∘ packPorts ∘ splitPorts
 
-  methodArgBaseNames _ prefix (Cons h t) i = Cons
+  methodArgBaseNames _ pos prefix (Cons h t) i = Cons
     -- arg_names can start with a digit
     (if prefix == "" && (h == "" || not (isDigit $ stringHead h))
      then h
      else prefix +++ "_" +++ h)
-    (methodArgBaseNames (_ :: b) prefix t $ i + 1)
-  methodArgBaseNames _ prefix Nil i = Cons
+    (methodArgBaseNames (_ :: b) pos prefix t $ i + 1)
+  methodArgBaseNames _ pos prefix Nil i = Cons
     (prefix +++ "_" +++ integerToString i)
-    (methodArgBaseNames (_ :: b) prefix Nil $ i + 1)
+    (methodArgBaseNames (_ :: b) pos prefix Nil $ i + 1)
 
-  inputPortNames _ (Cons h t) =
-    Cons (filterZeroWidthPorts (_ :: PortsOf a) (checkPortNames (_ :: a) h))
-         (inputPortNames (_ :: b) t)
-  inputPortNames _ Nil = error "inputPortNames: empty arg names list"
+  inputPortNames _ pos (Cons h t) =
+    Cons (filterZeroWidthPorts (_ :: PortsOf a) (checkPortNames pos (_ :: a) h))
+         (inputPortNames (_ :: b) pos t)
+  inputPortNames _ _ Nil = error "inputPortNames: empty arg names list"
 
-  outputPortNames _ = outputPortNames (_ :: b)
+  outputPortNames _ pos = outputPortNames (_ :: b) pos
 
-  saveMethodPortTypes _ modName (Cons h t) result = do
-    savePortTypes (_ :: PortsOf a) modName $ checkPortNames (_ :: a) h
-    saveMethodPortTypes (_ :: b) modName t result
-  saveMethodPortTypes _ _ Nil _ = error "saveMethodPortTypes: empty arg names list"
+  saveMethodPortTypes _ pos modName (Cons h t) result = do
+    savePortTypes (_ :: PortsOf a) modName $ checkPortNames pos (_ :: a) h
+    saveMethodPortTypes (_ :: b) pos modName t result
+  saveMethodPortTypes _ _ _ Nil _ = error "saveMethodPortTypes: empty arg names list"
 
 instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n,
           PrimSeqTupleBits pb) =>
     WrapMethod (ActionValue a) (ActionValue_ pb) where
   toWrapMethod = bitsToActionValue_ ∘ fmap (primDeepSeqTupleBits ∘ packPorts ∘ splitPorts)
   fromWrapMethod = fmap (unsplitPorts ∘ unpackPorts) ∘ bitsFromActionValue_
-  methodArgBaseNames _ _ Nil _ = Nil
-  methodArgBaseNames prx prefix argNames _ =
-    primError (getEvalPosition prx) $ integerToString (listLength argNames) +++
+  methodArgBaseNames _ _ _ Nil _ = Nil
+  methodArgBaseNames _ pos prefix argNames _ =
+    primError pos $ integerToString (listLength argNames) +++
     " excess arg_names provided for method " +++ prefix
-  inputPortNames _ Nil = Nil
-  inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names"
-  outputPortNames _ base = filterZeroWidthPorts (_ :: PortsOf a) $ checkPortNames (_ :: a) base
-  saveMethodPortTypes _ modName _ result =
-    savePortTypes (_ :: PortsOf a) modName $ checkPortNames (_ :: a) result
+  inputPortNames _ _ Nil = Nil
+  inputPortNames _ _ (Cons _ _) = error "inputPortNames: uncaught excess arg names"
+  outputPortNames _ pos base = filterZeroWidthPorts (_ :: PortsOf a) $ checkPortNames pos (_ :: a) base
+  saveMethodPortTypes _ pos modName _ result =
+    savePortTypes (_ :: PortsOf a) modName $ checkPortNames pos (_ :: a) result
 
 instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n,
           PrimSeqTupleBits pb) =>
     WrapMethod a pb where
   toWrapMethod = primDeepSeqTupleBits ∘ packPorts ∘ splitPorts
   fromWrapMethod = unsplitPorts ∘ unpackPorts
-  methodArgBaseNames _ _ Nil _ = Nil
-  methodArgBaseNames prx prefix argNames _ =
-    primError (getEvalPosition prx) $ integerToString (listLength argNames) +++
+  methodArgBaseNames _ _ _ Nil _ = Nil
+  methodArgBaseNames _ pos prefix argNames _ =
+    primError pos $ integerToString (listLength argNames) +++
     " excess arg_names provided for method " +++ prefix
-  inputPortNames _ Nil = Nil
-  inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names"
-  outputPortNames _ base = filterZeroWidthPorts (_ :: PortsOf a) $ checkPortNames (_ :: a) base
-  saveMethodPortTypes _ modName _ result =
-    savePortTypes (_ :: PortsOf a) modName $ checkPortNames (_ :: a) result
+  inputPortNames _ _ Nil = Nil
+  inputPortNames _ _ (Cons _ _) = error "inputPortNames: uncaught excess arg names"
+  outputPortNames _ pos base = filterZeroWidthPorts (_ :: PortsOf a) $ checkPortNames pos (_ :: a) base
+  saveMethodPortTypes _ pos modName _ result =
+    savePortTypes (_ :: PortsOf a) modName $ checkPortNames pos (_ :: a) result
 
 class WrapPorts p pb | p -> pb where
   -- Convert from a tuple of Port values to a tuple of bits.
@@ -4854,12 +4863,13 @@ instance PrimSeqTupleBits () where
 -- Compute the list port names for type 'a' given a base name.
 -- Check that the number of port names matches the number of ports.
 -- This error should only occur if there is an error in a SplitPorts instance.
-checkPortNames :: (SplitPorts a p, TupleSize p n) => a -> String -> List String
-checkPortNames proxy base =
+-- The position is the interface field (or noinline function) under check.
+checkPortNames :: (SplitPorts a p, TupleSize p n) => Position__ -> a -> String -> List String
+checkPortNames pos proxy base =
   let pn = portNames proxy base
   in
     if listLength pn /= valueOf n
-    then primError (getEvalPosition proxy) $
+    then primError pos $
       "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++
       " ports, but " +++ integerToString (listLength pn) +++ " port names were given"
     else pn

src/comp/GenWrap.hs

@@ -1115,7 +1115,7 @@ genTo pps ty mk =
                    localResult1 = fromMaybe (getIdBaseString f) (lookupResultIfcPragma ciPrags)
                    localResult = joinStrings_ currentPre localResult1
                    result = stringLiteralAt noPosition localResult
-                   fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
+                   fnp = mkStrArgProxyExpr (getIdPosition f) $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes 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 idToWrapField) [fnp, prefix, arg_names, result, ec]
@@ -1211,7 +1211,7 @@ genFrom pps ty var =
 
               -- Call fromWrapField with a proxy for the field name as a type level string,
               -- and the field selection from the unwrapped module.
-              let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
+              let fnp = mkStrArgProxyExpr (getIdPosition f) $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
               let e = CApply (CVar idFromWrapField) [fnp, sel binf]
               return (f, e, qs)
 
@@ -1627,7 +1627,7 @@ mkFromBind true_ifc_ids var ft =
 
               -- Call fromWrapField with a proxy for the field name as a type level string,
               -- and the field selection from the unwrapped module.
-              let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
+              let fnp = mkStrArgProxyExpr (getIdPosition f) $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
               let e = CApply (CVar idFromWrapField) [fnp, sel binf]
               return (f, e, qs)
 
@@ -2212,7 +2212,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId
 
               -- Arguments to saveFieldPortTypes: proxies for the field name as a type level string and the field type,
               -- and the values for the prefix, arg_names, and result pragmas.
-              let fproxy = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
+              let fproxy = mkStrArgProxyExpr (getIdPosition f) $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f)
                   proxy = mkTypeProxyExpr $ foldr arrow r as
                   prefix = stringLiteralAt noPosition localPrefix
                   arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds]

src/comp/GenWrapUtils.hs

@@ -4,10 +4,12 @@ module GenWrapUtils where
 import FStringCompat
 import Util(rTake, rDrop)
 import ErrorUtil
+import Position
 import Id
 import Pragma
 import PreIds
 import CSyntax
+import CSyntaxUtil(posLiteral, numLiteralAt)
 import CType
 import Undefined (UndefKind(..))
 
@@ -91,4 +93,16 @@ getDefArgs dcls t =
 mkTypeProxyExpr :: CType -> CExpr
 mkTypeProxyExpr ty = CHasType (CAny (getPosition ty) UNotUsed) $ CQType [] ty
 
+-- A proxy for the WrapField field-name type argument, evaluating to a
+-- raw undefined stamped with the interface field's decl-side position.
+-- The Prelude's port-name checks report their errors at getEvalPosition
+-- of this proxy, i.e. at the user's interface field.  A plain don't-care
+-- (mkTypeProxyExpr) would not do: class-dispatched undefined
+-- construction rebuilds the nullary StrArg constructor and the position
+-- is lost.
+mkStrArgProxyExpr :: Position -> CType -> CExpr
+mkStrArgProxyExpr pos ty =
+    let e = cVApply idRawUndef [posLiteral pos, numLiteralAt pos (0 :: Integer)]
+    in  CHasType e (CQType [] ty)
+
 

testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected

@@ -1,7 +1,7 @@
 checking package dependencies
 compiling BadSplitInst_TooManyPortNames.bs
 code generation for sysBadSplitInst_TooManyPortNames starts
-Error: "BadSplitInst_TooManyPortNames.bs", line 17, column 12: (S0015)
+Error: "BadSplitInst_TooManyPortNames.bs", line 17, column 2: (S0015)
   Bluespec evaluation-time error: SplitPorts: fooIn_1 has 2 ports, but 3 port
   names were given
   During elaboration of `sysBadSplitInst_TooManyPortNames' at

testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected

@@ -1,7 +1,7 @@
 checking package dependencies
 compiling TooManyArgNames.bs
 code generation for mkTooManyArgNamesSplitTest starts
-Error: "TooManyArgNames.bs", line 27, column 29: (S0015)
+Error: "TooManyArgNames.bs", line 27, column 2: (S0015)
   Bluespec evaluation-time error: 2 excess arg_names provided for method
   putFooBar
   During elaboration of the interface method `putFooBar' at