From 0ea992e85ae2852a9e204e5bae907c8bfbb3e07d Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 19:50:39 -0700 Subject: [PATCH] Stuff the field name in the WrapField type class as a type parameter for better error messages. --- src/Libraries/Base1/Prelude.bs | 62 ++++++++++--------- src/comp/ContextErrors.hs | 10 +-- src/comp/GenFuncWrap.hs | 7 ++- src/comp/GenWrap.hs | 22 ++++--- src/comp/GenWrapUtils.hs | 4 ++ ...ne_ArgNotInBits.bsv.bsc-vcomp-out.expected | 4 +- ...ne_ResNotInBits.bsv.bsc-vcomp-out.expected | 4 +- 7 files changed, 62 insertions(+), 51 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 464bde00a..349a60cd4 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/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. diff --git a/src/comp/ContextErrors.hs b/src/comp/ContextErrors.hs index 63e5cc555..0519ee94c 100644 --- a/src/comp/ContextErrors.hs +++ b/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.") diff --git a/src/comp/GenFuncWrap.hs b/src/comp/GenFuncWrap.hs index ef173c822..6a94d95fe 100644 --- a/src/comp/GenFuncWrap.hs +++ b/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 diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 374acd5bc..f2a842ad4 100644 --- a/src/comp/GenWrap.hs +++ b/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,7 +2174,8 @@ 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 @@ -2178,7 +2183,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId 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 diff --git a/src/comp/GenWrapUtils.hs b/src/comp/GenWrapUtils.hs index eef8e628b..d8c6fe8f7 100644 --- a/src/comp/GenWrapUtils.hs +++ b/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 + diff --git a/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected b/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected index 6e1dd0aba..8cb78a0bb 100644 --- a/testsuite/bsc.verilog/noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected +++ b/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. diff --git a/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected b/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected index be21fcb36..f00649d96 100644 --- a/testsuite/bsc.verilog/noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected +++ b/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: