From 2c27a5d284abfc879312824b4841318487f2f26c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Wed, 31 Jul 2024 17:34:54 -0700 Subject: [PATCH 01/89] Initial, hacky work on computing wrapper interface method types using type classes --- src/Libraries/Base1/Prelude.bs | 112 ++++++++++++++++++++++- src/comp/GenWrap.hs | 160 ++++++++++----------------------- src/comp/PreIds.hs | 5 ++ src/comp/PreStrings.hs | 3 + 4 files changed, 167 insertions(+), 113 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index a21a278cf..70120fa9a 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -255,7 +255,10 @@ package Prelude( Generic(..), Conc(..), ConcPrim(..), ConcPoly(..), Meta(..), MetaData(..), StarArg(..), NumArg(..), StrArg(..), NumConArg(..), StarConArg(..), OtherConArg(..), - MetaConsNamed(..), MetaConsAnon(..), MetaField(..) + MetaConsNamed(..), MetaConsAnon(..), MetaField(..), + + Curry(..), AppendTuple(..), AppendTuple'(..), + WrapPorts(..), WrapMethod(..) ) where infixr 0 $ @@ -4386,3 +4389,110 @@ data (MetaConsAnon :: $ -> # -> # -> *) name idx nfields = MetaConsAnon -- field) and index in the constructor's fields data (MetaField :: $ -> # -> *) name idx = MetaField deriving (FShow) + + +class Curry f g | f -> g where + curryN :: f -> g + uncurryN :: g -> f + +instance (Curry (b -> c) d) => Curry ((a, b) -> c) (a -> d) where + curryN f x = curryN $ \y -> f (x, y) + uncurryN f (x, y) = uncurryN (f x) y + +instance Curry (() -> a) a where + curryN f = f () + uncurryN f _ = f + +instance Curry (a -> b) (a -> b) where + curryN = id + uncurryN = id + +class AppendTuple a b c | a b -> c where + appendTuple :: a -> b -> c + +instance AppendTuple a () a where + appendTuple x _ = x + +-- The above instance should take precedence over the other cases that assume +-- b is non-unit. To avoid overlapping instances, the below are factored out as +-- a seperate type class: +instance (AppendTuple' a b c) => AppendTuple a b c where + appendTuple = appendTuple' + +class AppendTuple' a b c | a b -> c where + appendTuple' :: a -> b -> c + +instance AppendTuple' () a a where + appendTuple' _ = id + +instance AppendTuple' a b (a, b) where + appendTuple' a b = (a, b) + +instance (AppendTuple' a b c) => AppendTuple' (h, a) b (h, c) where + appendTuple' (x, y) z = (x, appendTuple' y z) + + +data (WrapPort :: $ -> # -> *) name n = WrapPort (Bit n) + +class WrapPorts a p | a -> p where + toPorts :: a -> p + fromPorts :: p -> a + +{- +instance (Bits a n) => WrapPorts a (WrapPort "foo" n) where + toPorts = WrapPort ∘ pack + fromPorts (WrapPort x) = unpack x +-} + +instance (Bits a n) => WrapPorts a (Bit n) where + toPorts = pack + fromPorts = unpack + +{- +instance WrapPorts (Vector 0 a) () where + toPorts _ = () + fromPorts _ = nil + +instance (Add n1 1 n, WrapPorts a p1, WrapPorts (Vector n1 a) p2, AppendTuple p1 p2 p) => + WrapPorts (Vector n a) p where + toPorts v = appendTuple (toPorts $ head v) (toPorts $ tail v) +-} + +-- TODO: If there is only one instance for WrapPorts, the first WrapMethod instance below fails to typecheck. +instance WrapPorts () () where + toPorts = id + fromPorts = id + +class WrapMethod m w | m -> w where + toWrapMethod :: m -> w + fromWrapMethod :: w -> m + +instance (WrapPorts a p, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where + toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ fromPorts + fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ toPorts + +instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where + toWrapMethod = toActionValue_ + fromWrapMethod = fromActionValue_ + +instance (Bits a n) => WrapMethod a (Bit n) where + toWrapMethod = pack + fromWrapMethod = unpack + +-- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface, +-- but this case was being handled in GenWrap. +instance WrapMethod PrimAction PrimAction where + toWrapMethod = id + fromWrapMethod = id + +instance WrapMethod Clock Clock where + toWrapMethod = id + fromWrapMethod = id + +instance WrapMethod Reset Reset where + toWrapMethod = id + fromWrapMethod = id + +instance (Bits a n) => WrapMethod (Inout a) (Inout_ n) where + toWrapMethod = primInoutCast0 + fromWrapMethod = primInoutUncast0 diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index d54c0a6d9..1c0651ebb 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -828,17 +828,11 @@ genTDef trec@(IfcTRec newId rootId _ sty _ k fts args _) = (ifc',newprops) <- genIfc trec args k --traceM( "genTDef: ifc " ++ ppReadable ifc' ) --traceM( "genTDef:: new prop are: " ++ ppReadable newprops ) - flgs <- getFlags - symt <- getSymTab - let res = cCtxReduceDef flgs symt ifc' - --traceM( "genTDef: res " ++ ppReadable res ) - case res of -- type checking for the interface - Left msgs -> bads msgs - Right ifc'' -> return GeneratedIfc { - genifc_id = newId, - genifc_kind = k, - genifc_cdefn = ifc'', - genifc_pprops = newprops } + return GeneratedIfc { + genifc_id = newId, + genifc_kind = k, + genifc_cdefn = ifc', + genifc_pprops = newprops } -- Generate a new interface definition for the CPackage -- Basically, this consists of a Cstruct of sub-type Sintrface. @@ -892,18 +886,11 @@ genIfcField trec ifcIdIn prefixes (FInf fieldIdQ argtypes rettype _) = return ((concat fields), (concat props)) _ -> -- leaf function do - let (v, vs) = unconsOrErr "GenWrap.genIfcField: v:vs" $ - map cTVarNum (take (length argtypes + 1) tmpTyVarIds) - let bitsCtx a s = CPred (CTypeclass idBits) [a, s] - let ctx = zipWith bitsCtx argtypes vs - let ss = map (TAp tBit) vs - isClock <- isClockType rettype isReset <- isResetType rettype isInout <- isInoutType rettype let isIot = isInout/=Nothing isPA <- isPrimAction rettype - isAV <- isActionValue rettype isVec <- isVectorInterfaces rettype case (isVec, argtypes) of (Just (n, tVec, isListN), []) -> @@ -916,37 +903,30 @@ genIfcField trec ifcIdIn prefixes (FInf fieldIdQ argtypes rettype _) = let (fields,props) = unzip fieldsprops return (concat fields, concat props) _ -> do -- ELSE NOT a Vec - (r', ctx') <- - if isAV then do - av_t <- getAVType "genIfcField" rettype - return (TAp tActionValue_ v, bitsCtx av_t v : ctx) - else return $ - case isInout of - Just t -> (TAp tInout_ v, - bitsCtx t v : ctx) - _ -> if (isPA || isClock || isReset) then (rettype, ctx) - else (TAp tBit v, bitsCtx rettype v : ctx) - let fi = binId prefixes fieldId - -- - let (mprops, ifcPragmas) = gen prefixes ciPrags fieldId fi - gen | isClock = genNewClockIfcPragmas - | isReset = genNewResetIfcPragmas - | isIot = genNewInoutIfcPragmas - | otherwise = genNewMethodIfcPragmas - - let ifc_field = CField { cf_name = fi, - cf_pragmas = Just ifcPragmas, - cf_type = CQType ctx' (foldr arrow r' ss), - cf_orig_type = Just (foldr arrow rettype argtypes), - cf_default = [] - } - -- - -- the ready field - let rdy_field = if (isClock || isReset || isIot) then [] - else mkReadyField trec ifcPragmas ifcIdIn fieldId fi - -- - --traceM( "ifc_fields is: " ++ ppReadable ifc_field) - return ((ifc_field : rdy_field), mprops ) + let v = cTVar $ head tmpTyVarIds + let ctx = CPred (CTypeclass idWrapMethod) [foldr arrow rettype argtypes, v] + + let fi = binId prefixes fieldId + -- + let (mprops, ifcPragmas) = gen prefixes ciPrags fieldId fi + gen | isClock = genNewClockIfcPragmas + | isReset = genNewResetIfcPragmas + | isIot = genNewInoutIfcPragmas + | otherwise = genNewMethodIfcPragmas + + let ifc_field = CField { cf_name = fi, + cf_pragmas = Just ifcPragmas, + cf_type = CQType [ctx] v, + cf_orig_type = Just (foldr arrow rettype argtypes), + cf_default = [] + } + -- + -- the ready field + let rdy_field = if (isClock || isReset || isIot) then [] + else mkReadyField trec ifcPragmas ifcIdIn fieldId fi + -- + --traceM( "ifc_fields is: " ++ ppReadable ifc_field) + return ((ifc_field : rdy_field), mprops ) -- create a RDY field, if requested @@ -1123,25 +1103,10 @@ genTo pps ty mk = fields <- mapM recurse nums return (concat fields) _ -> do - isClock <- isClockType r - isReset <- isResetType r - isInout <- isInoutType r - isPA <- isPrimAction r - isAV <- isActionValue r - let vs = take (length as) (aIds ++ tmpVarXIds) -- XXX idEmpty is a horrible way to know no more selection is required - let ec = if f == idEmpty then sel else - cApply 11 (CSelect sel (setInternal f)) - (map (\ v -> CApply eUnpack [CVar v]) vs) - let e = - case isInout of - Just _ -> CApply ePrimInoutCast0 [ec] - _ -> if isClock || isReset || isPA - then ec - else if isAV - then cVApply idToActionValue_ [ec] - else CApply ePack [ec] - return [CLValue (binId prefixes f) [CClause (map CPVar vs) [] e] []] + let ec = if f == idEmpty then sel else CSelect sel (setInternal f) + let e = CApply (CVar id_toWrapMethod) [ec] + return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- -- genWrapE toplevel: mkFrom_ @@ -1156,15 +1121,15 @@ mkFrom_ trec@(IfcTRec { rec_numargs = [], rec_typemap = [] }) = tyId <- flatTypeId pps t let arg = id_t (getPosition t) let ty = cTCon tyId `fn` t - (expr, ctxs) <- genFrom pps t (CVar arg) + expr <- genFrom pps t (CVar arg) let cls = CClause [CPVar arg] [] expr - return (CValueSign (CDef (from_Id tyId) (CQType ctxs ty) [cls])) + return (CValueSign (CDef (from_Id tyId) (CQType [] ty) [cls])) mkFrom_ x = internalError "GenWrap::mkFrom_ " from_Id :: Id -> Id from_Id i = addInternalProp (mkIdPre fsFrom i) -genFrom :: [PProp] -> CType -> CExpr -> GWMonad (CExpr, [CPred]) +genFrom :: [PProp] -> CType -> CExpr -> GWMonad CExpr genFrom pps ty var = do --traceM ("genFrom type: " ++ (pfpAll ty)) @@ -1179,27 +1144,19 @@ genFrom pps ty var = ifcPrags <- getInterfacePrags ti let prefixes = noPrefixes { ifcp_pragmas = ifcPrags } fieldBlobs <- mapM (meth prefixes ti) fts - let expr = blobsToIfc ti fts fieldBlobs - let bits_types = unions (map fifth fieldBlobs) - ctxs = [ CPred (CTypeclass idBits) [t, cTVarNum v] - | (t, v) <- zip bits_types tmpTyVarIds ] - return (expr, ctxs) + return $ blobsToIfc ti fts fieldBlobs where blobsToIfc ti fts fieldBlobs = - let meths = [ CLValue (setInternal f) [CClause (map CPVar vs) [] e] gs - | (f, vs, e, gs, _) <- fieldBlobs ] + let meths = [ CLValue (setInternal f) [CClause [] [] e] gs + | (f, e, gs) <- fieldBlobs ] in Cinterface (getPosition fts) (Just ti) meths - fifth (_, _, _, _, x) = x - - -- This returns a 5-tuple of a field Id (method or subifc), - -- its argument Ids, its result expression, and its implicit - -- condition (only for methods), and a list of types which need - -- Bits provisos. + -- This returns a 3-tuple of a field Id (method or subifc), + -- its defining expression, and its implicit condition (only for methods). -- Note: The Id is qualified, because it could be something not -- imported by the user (and this not available unqualified). meth :: IfcPrefixes -> Id -> FInf -> - GWMonad (Id, [Id], CExpr, [CQual], [CType]) + GWMonad (Id, CExpr, [CQual]) meth prefixes ifcId (FInf f as r aIds) = do ciPrags <- getInterfaceFieldPrags ifcId f {- f should be qualifed -} @@ -1210,8 +1167,7 @@ genFrom pps ty var = newprefixes <- extendPrefixes prefixes ciPrags r f fieldBlobs <- mapM (meth newprefixes ti) fts let expr = blobsToIfc ti fts fieldBlobs - ctxs = unions (map fifth fieldBlobs) - return (f, [], expr, [], ctxs) + return (f, expr, []) _ -> do isVec <- isVectorInterfaces r case (isVec, as) of @@ -1222,14 +1178,9 @@ genFrom pps ty var = do newprefixes <- extendPrefixes prefixes ciPrags r f meth newprefixes idVector (FInf (mkNumId num) [] tVec []) fieldBlobs <- mapM recurse nums - let (es, gs) = unzip [(e, g) | (_, _, e, g, _) <- fieldBlobs] + let (es, gs) = unzip [(e, g) | (_, e, g) <- fieldBlobs] let vec = cToVector isListN es - let ctxs = case fieldBlobs of - -- each element will have the same ctxs - -- so just take from the first one - (blob:_) -> fifth blob - _ -> [] - return (f, [], vec, concat gs, ctxs) + return (f, vec, concat gs) _ -> do isPA <- isPrimAction r isClock <- isClockType r @@ -1243,26 +1194,10 @@ genFrom pps ty var = let hasNoRdy = isAlwaysRdy pps wbinf || isAlwaysReadyIfc (ifcp_pragmas prefixes ++ ciPrags) let meth_guard = CApply eUnpack [sel wbinf] - let vs = take (length as) (aIds ++ tmpVarXIds) let qs = if (hasNoRdy || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let ec = cApply 13 (sel binf) - (map (\ v -> CApply ePack [CVar v]) vs) - (e, res_ctxs) <- - case isInout of - Just iot -> return (CApply ePrimInoutUncast0 [ec], [iot]) - _ -> if (isPA || isClock || isReset) - then return (ec, []) - else - if isAV - then do - retType <- getAVType "genFrom" r - return - (cApply 12 (CVar idFromActionValue_) [ec], - [retType]) - else return (CApply eUnpack [ec], [r]) - let ctxs = nub (res_ctxs ++ as) - return (f, vs, e, qs, ctxs) + let e = CApply (CVar id_fromWrapMethod) [sel binf] + return (f, e, qs) -- -------------------- @@ -1380,7 +1315,8 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = ftps <- mapM collectIfcInfo (reverse cfields) -- get back the arg port to type mapping, for recording flgs <- getFlags - arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps + -- arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps + let arg_pts = [] let arg_infos = thd $ unzip3 vtis (vs, ts) = unzip $ concatMap extractVTPairs arg_infos diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index a12f46f17..0a55c10f7 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -236,6 +236,11 @@ idPolyWrapField = mk_no fsPolyWrapField idLiftModule :: Id idLiftModule = prelude_id_no fsLiftModule +idWrapMethod, id_fromWrapMethod, id_toWrapMethod :: Id +idWrapMethod = prelude_id_no fsWrapMethod +id_fromWrapMethod = prelude_id_no fsFromWrapMethod +id_toWrapMethod = prelude_id_no fsToWrapMethod + -- Used by desugaring id_lam, id_if, id_read, id_write :: Position -> Id id_lam pos = mkId pos fs_lam diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index 987b9c500..a139003c4 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -346,6 +346,9 @@ fsMetaConsNamed = mkFString "MetaConsNamed" fsMetaConsAnon = mkFString "MetaConsAnon" fsMetaField = mkFString "MetaField" fsPolyWrapField = mkFString "val" +fsWrapMethod = mkFString "WrapMethod" +fsFromWrapMethod = mkFString "fromWrapMethod" +fsToWrapMethod = mkFString "toWrapMethod" -- XXX low ASCII only, please... sAcute = "__" From 5dd5a7f21afab3963e8173edac6819ddaff1ab62 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Wed, 7 Aug 2024 17:19:25 -0700 Subject: [PATCH 02/89] Attempt at attachting port names with a primative on every input. Doesn't work b/c lambda bodies aren't partially evaluated before iExpandMethod. --- src/Libraries/Base1/Prelude.bs | 37 +++++++++++++++++----------------- src/comp/CSyntaxUtil.hs | 4 ++++ src/comp/GenWrap.hs | 7 +++++-- src/comp/IExpand.hs | 30 ++++++++++++++++++--------- src/comp/IfcBetterInfo.hs | 19 +---------------- src/comp/Prim.hs | 3 +++ 6 files changed, 51 insertions(+), 49 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 70120fa9a..c24fd02eb 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -258,7 +258,8 @@ package Prelude( MetaConsNamed(..), MetaConsAnon(..), MetaField(..), Curry(..), AppendTuple(..), AppendTuple'(..), - WrapPorts(..), WrapMethod(..) + WrapPorts(..), WrapMethod(..), + primPortName ) where infixr 0 $ @@ -4432,20 +4433,17 @@ instance (AppendTuple' a b c) => AppendTuple' (h, a) b (h, c) where appendTuple' (x, y) z = (x, appendTuple' y z) -data (WrapPort :: $ -> # -> *) name n = WrapPort (Bit n) +primitive primPortName :: String -> Bit n -> Bit n class WrapPorts a p | a -> p where - toPorts :: a -> p + -- Takes a port name and a value to wrap, returns a (tuple of) bits + -- cooresponding to port(s), each tagged with primPortName. + toPorts :: String -> a -> p + -- Takes a (tuple of) bits cooresponding to ports, returns the unwrapped value. fromPorts :: p -> a -{- -instance (Bits a n) => WrapPorts a (WrapPort "foo" n) where - toPorts = WrapPort ∘ pack - fromPorts (WrapPort x) = unpack x --} - instance (Bits a n) => WrapPorts a (Bit n) where - toPorts = pack + toPorts name = primPortName name ∘ pack fromPorts = unpack {- @@ -4460,39 +4458,40 @@ instance (Add n1 1 n, WrapPorts a p1, WrapPorts (Vector n1 a) p2, AppendTuple p1 -- TODO: If there is only one instance for WrapPorts, the first WrapMethod instance below fails to typecheck. instance WrapPorts () () where - toPorts = id + toPorts _ = id fromPorts = id class WrapMethod m w | m -> w where toWrapMethod :: m -> w - fromWrapMethod :: w -> m + fromWrapMethod :: List String -> w -> m instance (WrapPorts a p, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ fromPorts - fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ toPorts + fromWrapMethod (Cons h t) f = fromWrapMethod t ∘ uncurryN f ∘ toPorts h + fromWrapMethod Nil _ = error "toWrapMethod: empty arg names list" instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where toWrapMethod = toActionValue_ - fromWrapMethod = fromActionValue_ + fromWrapMethod _ = fromActionValue_ instance (Bits a n) => WrapMethod a (Bit n) where toWrapMethod = pack - fromWrapMethod = unpack + fromWrapMethod _ = unpack -- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface, -- but this case was being handled in GenWrap. instance WrapMethod PrimAction PrimAction where toWrapMethod = id - fromWrapMethod = id + fromWrapMethod _ = id instance WrapMethod Clock Clock where toWrapMethod = id - fromWrapMethod = id + fromWrapMethod _ = id instance WrapMethod Reset Reset where toWrapMethod = id - fromWrapMethod = id + fromWrapMethod _ = id instance (Bits a n) => WrapMethod (Inout a) (Inout_ n) where toWrapMethod = primInoutCast0 - fromWrapMethod = primInoutUncast0 + fromWrapMethod _ = primInoutUncast0 diff --git a/src/comp/CSyntaxUtil.hs b/src/comp/CSyntaxUtil.hs index 8abbf355f..284339e6d 100644 --- a/src/comp/CSyntaxUtil.hs +++ b/src/comp/CSyntaxUtil.hs @@ -63,6 +63,10 @@ mkMaybe :: (Maybe CExpr) -> CExpr mkMaybe Nothing = CCon idInvalid [] mkMaybe (Just e) = CCon idValid [e] +mkList :: [CExpr] -> CExpr +mkList [] = CCon (idNil noPosition) [] +mkList (e:es) = CCon (idCons $ getPosition e) [e, mkList es] + num_to_cliteral_at :: Integral n => Position -> n -> CLiteral num_to_cliteral_at pos num = CLiteral pos $ LInt $ ilDec (toInteger num) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 1c0651ebb..bc8afb404 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -9,7 +9,7 @@ module GenWrap( import Prelude hiding ((<>)) #endif -import Data.List(nub, (\\), find) +import Data.List(nub, (\\), find, genericLength) import Control.Monad(when, foldM, filterM, zipWithM, mapAndUnzipM) import Control.Monad.Except(ExceptT, runExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, gets, get, put) @@ -1196,7 +1196,10 @@ 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_fromWrapMethod) [sel binf] + let arg_names = mkList + [stringLiteralAt (getPosition i) (getIdString i) + | i <- aIds ++ map mkNumId [genericLength aIds + 1..genericLength as]] + let e = CApply (CVar id_fromWrapMethod) [arg_names, sel binf] return (f, e, qs) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 677768cb2..a847f045a 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -21,7 +21,7 @@ import Data.List import Data.Maybe import Data.Foldable(foldrM) import Numeric(showIntAtBase) -import Data.Char(intToDigit, ord, chr) +import Data.Char(intToDigit, ord, chr, isDigit) import Control.Monad(when, foldM, zipWithM, mapAndUnzipM) import Control.Monad.Fix(mfix) --import Control.Monad.Fix @@ -1064,15 +1064,19 @@ iExpandMethodLam :: Id -> Integer -> [Id] -> HPred -> Id -> IType -> Pred HeapData -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p = do - -- substitute argument with a modvar and replace with body - let i_n :: Id - i_n = mkIdPost (BetterInfo.mi_prefix bi) (concatFString [fsUnderscore, mkNumFString n]) +iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p = + case eb of + IAps (ICon _ (ICPrim _ PrimPortName)) _ [ename, ebody] -> do + (name, _) <- evalString ename + let pfx :: Id + pfx = BetterInfo.mi_prefix bi i' :: Id - i' = if null (BetterInfo.mi_args bi) then i_n else (BetterInfo.mi_args bi) !! fromInteger (n-1) + i' = if isEmptyId pfx && not (isDigit $ head name) + then mkIdPost pfx $ mkFString name + else mkIdPost pfx (concatFString [fsUnderscore, mkFString name]) + -- substitute argument with a modvar and replace with body eb' :: HExpr - eb' = eSubst li (ICon i' (ICMethArg ty)) eb - -- bi' = if null bi then [] else tail bi + eb' = eSubst li (ICon i' (ICMethArg ty)) ebody let m_orig_type :: Maybe IType m_orig_type = fmap ((flip (!!) (fromInteger (n-1))) . fst . itGetArrows) (BetterInfo.mi_orig_type bi) @@ -1083,9 +1087,11 @@ iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p = do inps = vf_inputs wf1 let wf1' :: VFieldInfo wf1' = case wf1 of - (Method {}) -> wf1 { vf_inputs = ((id_to_vPort i'):inps) } - _ -> internalError "iExpandMethodLam: unexpected wf1" + (Method {}) -> wf1 { vf_inputs = ((id_to_vPort i'):inps) } + _ -> internalError "iExpandMethodLam: unexpected wf1" return ((i', ty) : its, (d, ws1, wf1'), (wd, ws2, wf2)) + -- XXX should be a user error, since someone can write their own WrapPorts instance + _ -> internalError $ "iExpandMethodLam: expected PrimPortName, got " ++ ppReadable eb iExpandMethod' :: HPred -> HClock -> (Id, BetterInfo.BetterInfo, HExpr) -> Pred HeapData -> @@ -2537,6 +2543,10 @@ walkNF e = _ <- internalError ("PrimWhenPred" ++ ppReadable e) (P p' e', ws) <- walkNF e upd (pConjs [p0, p, p']) e' ws + + IAps f@(ICon i (ICPrim _ PrimPortName)) _ [n, e] -> do + (P p e', ws) <- walkNF e + upd (pConj p0 p) (IAps f [] [n, e']) ws -- Any other application is not in NF (which is unexpected?) IAps f ts es -> do diff --git a/src/comp/IfcBetterInfo.hs b/src/comp/IfcBetterInfo.hs index d7a37c96a..555d7840d 100644 --- a/src/comp/IfcBetterInfo.hs +++ b/src/comp/IfcBetterInfo.hs @@ -32,7 +32,6 @@ data BetterInfo = BetterMethodInfo mi_ready :: VPort, -- for ready signal mi_enable :: VPort, -- for enable signal mi_prefix :: Id, -- default prefix for arguments (which are not found in classic) - mi_args :: [Id], -- for arguments mi_orig_type :: Maybe IType -- original (unwrapped) field type } -- XXX Note that the following are unused @@ -58,7 +57,6 @@ noMethodInfo fieldId = BetterMethodInfo {mi_id = fieldId, mi_ready = id_to_vPort $ mkRdyId fieldId, mi_enable = id_to_vPort $ mkEnableId fieldId, mi_prefix = fieldId, - mi_args = [], mi_orig_type = Nothing } @@ -69,7 +67,6 @@ instance PPrint BetterInfo where printMaybe d i "Ready:" (mi_ready info) <> printMaybe d i "Enable:" (mi_enable info) <> text "Prefix:" <> pPrint d i (mi_prefix info) <> - text "Args:" <> pPrint d i (mi_args info) <> printMaybe d i "Original type:" (mi_orig_type info) ) @@ -106,21 +103,7 @@ fieldInfoToBetterInfo flags symTab (fieldId, Just fi) = mi_ready = maybe (id_to_vPort $ mkRdyId fieldId) str_to_vPort mrdy, mi_enable = maybe (id_to_vPort $ mkEnableId fieldId) str_to_vPort men, mi_prefix = maybe fieldId (setIdBaseString fieldId) mprefix, - mi_args = args, mi_orig_type = fmap (iConvT flags symTab) (fi_orig_type fi) } where prags = fi_pragmas fi - (mprefix,mres,mrdy,men,rawargs,_,_) = getMethodPragmaInfo prags - args = genArgNames mprefix fieldId rawargs - - --- Create a list of Ids for method argument names --- Used by IExpand thru IfcbetterNames maybe move it here --- Note that this only uses IPrefixStr and iArgNames, which must be --- kept on the FieldInfo in the SymTab -genArgNames :: Maybe String -> Id -> [Id] -> [Id] -genArgNames mprefix fieldId ids = map (addPrefix mprefix fieldId) ids - where addPrefix :: Maybe String -> Id -> Id -> Id - addPrefix Nothing fid aid = mkUSId fid aid - addPrefix (Just "") _ aid = aid - addPrefix (Just pstr) _ aid = mkIdPre (mkFString $ pstr ++ "_" ) aid + (mprefix,mres,mrdy,men,_,_,_) = getMethodPragmaInfo prags diff --git a/src/comp/Prim.hs b/src/comp/Prim.hs index dbfc1d331..c3df58b25 100644 --- a/src/comp/Prim.hs +++ b/src/comp/Prim.hs @@ -64,6 +64,8 @@ data PrimOp = | PrimInoutCast | PrimInoutUncast + | PrimPortName + | PrimIf | PrimMux | PrimPriMux @@ -354,6 +356,7 @@ toPrim i = tp (getIdBaseString i) -- XXXXX tp "primBOr" = PrimBOr tp "primInoutCast" = PrimInoutCast tp "primInoutUncast" = PrimInoutUncast + tp "primPortName" = PrimPortName tp "primIntegerToBit" = PrimIntegerToBit tp "primIntegerToUIntBits" = PrimIntegerToUIntBits tp "primIntegerToIntBits" = PrimIntegerToIntBits From dc8fa7fd8b2e0409f44ae8b7b3df568bad390539 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 9 Aug 2024 17:28:46 -0700 Subject: [PATCH 03/89] Pass the input port names by tagging methods with a new primative --- src/Libraries/Base1/Prelude.bs | 86 ++++++++++++++++++++---------- src/comp/Error.hs | 4 ++ src/comp/GenBin.hs | 2 + src/comp/GenWrap.hs | 10 ++-- src/comp/IExpand.hs | 96 +++++++++++++++++++++------------- src/comp/ISyntax.hs | 7 +++ src/comp/Prim.hs | 4 +- 7 files changed, 138 insertions(+), 71 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index c24fd02eb..74934397c 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -257,9 +257,9 @@ package Prelude( NumConArg(..), StarConArg(..), OtherConArg(..), MetaConsNamed(..), MetaConsAnon(..), MetaField(..), - Curry(..), AppendTuple(..), AppendTuple'(..), - WrapPorts(..), WrapMethod(..), - primPortName + Curry(..), AppendTuple(..), AppendTuple'(..), TupleSize(..), + WrapPorts(..), WrapMethod(..), toWrapMethod, + primPortNames ) where infixr 0 $ @@ -4432,19 +4432,26 @@ instance AppendTuple' a b (a, b) where instance (AppendTuple' a b c) => AppendTuple' (h, a) b (h, c) where appendTuple' (x, y) z = (x, appendTuple' y z) +class TupleSize a n | a -> n where {} +instance TupleSize () 0 where {} +instance TupleSize a 1 where {} +instance (TupleSize b n) => TupleSize (a, b) (TAdd n 1) where {} -primitive primPortName :: String -> Bit n -> Bit n +-- Tag a method with a list of port names. +primitive primPortNames :: List String -> a -> a class WrapPorts a p | a -> p where - -- Takes a port name and a value to wrap, returns a (tuple of) bits - -- cooresponding to port(s), each tagged with primPortName. - toPorts :: String -> a -> p + -- Takes an unwrapped value and returns a (tuple of) bits cooresponding to port(s). + toPorts :: a -> p -- Takes a (tuple of) bits cooresponding to ports, returns the unwrapped value. fromPorts :: p -> a + -- Takes a proxy value and a base name, returns a list of port names for the type. + portNames :: a -> String -> List String instance (Bits a n) => WrapPorts a (Bit n) where - toPorts name = primPortName name ∘ pack + toPorts = pack fromPorts = unpack + portNames _ base = Cons base nil {- instance WrapPorts (Vector 0 a) () where @@ -4458,40 +4465,65 @@ instance (Add n1 1 n, WrapPorts a p1, WrapPorts (Vector n1 a) p2, AppendTuple p1 -- TODO: If there is only one instance for WrapPorts, the first WrapMethod instance below fails to typecheck. instance WrapPorts () () where - toPorts _ = id + toPorts = id fromPorts = id + portNames _ _ = nil + +checkPortNames :: (WrapPorts a p, TupleSize p n) => a -> String -> List String +checkPortNames _ base = + let pn = portNames ((error "proxy value") :: a) base + in + if listLength pn /= valueOf n + then error $ "WrapPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ + " ports, but " +++ integerToString (listLength pn) +++ " port names were given" + else pn class WrapMethod m w | m -> w where - toWrapMethod :: m -> w - fromWrapMethod :: List String -> w -> m + toWrapMethod :: List String -> m -> w + + toWrapMethod' :: m -> w + fromWrapMethod :: w -> m + + inputPortNames :: m -> List String -> List String + inputPortNames _ _ = Nil -instance (WrapPorts a p, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where - toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ fromPorts - fromWrapMethod (Cons h t) f = fromWrapMethod t ∘ uncurryN f ∘ toPorts h - fromWrapMethod Nil _ = error "toWrapMethod: empty arg names list" +instance (WrapPorts a p, TupleSize p n, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where + toWrapMethod names = primPortNames (inputPortNames ((error "proxy value") :: (a -> b)) names) ∘ toWrapMethod' + toWrapMethod' f = curryN $ toWrapMethod' ∘ f ∘ fromPorts + fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ toPorts + inputPortNames _ (Cons h t) = + checkPortNames ((error "proxy value") :: a) h `listPrimAppend` + inputPortNames ((error "proxy value") :: b) t + inputPortNames _ Nil = error "toWrapMethod: empty arg names list" instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where - toWrapMethod = toActionValue_ - fromWrapMethod _ = fromActionValue_ + toWrapMethod _ = primPortNames Nil ∘ toActionValue_ + toWrapMethod' = toActionValue_ + fromWrapMethod = fromActionValue_ instance (Bits a n) => WrapMethod a (Bit n) where - toWrapMethod = pack - fromWrapMethod _ = unpack + toWrapMethod _ = primPortNames Nil ∘ pack + toWrapMethod' = pack + fromWrapMethod = unpack -- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface, -- but this case was being handled in GenWrap. instance WrapMethod PrimAction PrimAction where - toWrapMethod = id - fromWrapMethod _ = id + toWrapMethod _ = id + toWrapMethod' = id + fromWrapMethod = id instance WrapMethod Clock Clock where - toWrapMethod = id - fromWrapMethod _ = id + toWrapMethod _ = id + toWrapMethod' = id + fromWrapMethod = id instance WrapMethod Reset Reset where - toWrapMethod = id - fromWrapMethod _ = id + toWrapMethod _ = id + toWrapMethod' = id + fromWrapMethod = id instance (Bits a n) => WrapMethod (Inout a) (Inout_ n) where - toWrapMethod = primInoutCast0 - fromWrapMethod _ = primInoutUncast0 + toWrapMethod _ = primInoutCast0 + toWrapMethod' = primInoutCast0 + fromWrapMethod = primInoutUncast0 diff --git a/src/comp/Error.hs b/src/comp/Error.hs index 11c48ee11..99fe44774 100644 --- a/src/comp/Error.hs +++ b/src/comp/Error.hs @@ -1004,6 +1004,7 @@ data ErrMsg = | EModuleUndet | EModuleUndetNoMatch | EStringNF String + | EStringListNF String | ENoNF String String | EHasImplicit String | EModPortHasImplicit String String @@ -3943,6 +3944,9 @@ getErrorText (WRuleUndetPred is_meth rule poss) = nest 4 (vcat (map (text . prPosition) poss)) ) +getErrorText (EStringListNF s) = + (Generate 129, empty, s2par ("Not a compile time string list: " ++ s)) + --------------------------------------------------------------------------- --------------------------------------------------------------------------- diff --git a/src/comp/GenBin.hs b/src/comp/GenBin.hs index cad48d9eb..e7dfe642d 100644 --- a/src/comp/GenBin.hs +++ b/src/comp/GenBin.hs @@ -642,6 +642,8 @@ instance Bin (IConInfo a) where internalError "GenBin.Bin(IConInfo).writeBytes: ICPred" writeBytes (ICHandle { }) = internalError "GenBin.Bin(IConInfo).writeBytes: ICHandle" + writeBytes (ICMethod { }) = + internalError "GenBin.Bin(IConInfo).writeBytes: ICMethod" readBytes = do tag <- getI t <- fromBin case tag of diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index bc8afb404..4291fa03b 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1104,8 +1104,11 @@ genTo pps ty mk = return (concat fields) _ -> do -- XXX idEmpty is a horrible way to know no more selection is required + let arg_names = mkList + [stringLiteralAt (getPosition i) (getIdString i) + | i <- aIds ++ map mkNumId [genericLength aIds + 1..genericLength as]] let ec = if f == idEmpty then sel else CSelect sel (setInternal f) - let e = CApply (CVar id_toWrapMethod) [ec] + let e = CApply (CVar id_toWrapMethod) [arg_names, ec] return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- @@ -1196,10 +1199,7 @@ genFrom pps ty var = let meth_guard = CApply eUnpack [sel wbinf] let qs = if (hasNoRdy || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let arg_names = mkList - [stringLiteralAt (getPosition i) (getIdString i) - | i <- aIds ++ map mkNumId [genericLength aIds + 1..genericLength as]] - let e = CApply (CVar id_fromWrapMethod) [arg_names, sel binf] + let e = CApply (CVar id_fromWrapMethod) [sel binf] return (f, e, qs) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index a847f045a..9c6c91d19 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -1033,8 +1033,12 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) | isRdyId i = iExpandField modId implicitCond clkRst (i, bi, e, t) = do showTopProgress ("Elaborating method " ++ quote (pfpString i)) setIfcSchedNameScopeProgress (Just (IEP_Method i False)) + (_, P p e') <- evalUH e + let (ins, eb) = case e' of + ICon _ (ICMethod _ ins eb) -> (ins, eb) + _ -> internalError ("iExpandField: expected ICMethod: " ++ ppReadable e') (its, ((IDef i1 t1 e1 _), ws1, fi1), ((IDef wi wt we _), ws2, fi2)) - <- iExpandMethod modId 1 [] implicitCond clkRst (i, bi, e) + <- iExpandMethod modId 1 [] implicitCond clkRst (i, bi, ins, eb) let wp1 = wsToProps ws1 -- default clock domain forced in by iExpandField let wp2 = wsToProps ws2 setIfcSchedNameScopeProgress Nothing @@ -1043,10 +1047,10 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) = do -- expand a method iExpandMethod :: Id -> Integer -> [Id] -> HPred -> - (HClock, HReset) -> (Id, BetterInfo.BetterInfo, HExpr) -> + (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, e) = do +iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, ins, e) = do when doDebug $ traceM ("iExpandMethod " ++ ppString i ++ " " ++ ppReadable e) (_, P p e') <- evalUH e case e' of @@ -1056,42 +1060,41 @@ iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, e) = do -- a GenWrap-added context that wasn't satisfied, and GenWrap -- should only be adding Bits) errG (reportNonSynthTypeInMethod modId i e') - ILam li ty eb -> iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p + ILam li ty eb -> iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p _ -> iExpandMethod' implicitCond curClk (i, bi, e') p iExpandMethodLam :: Id -> Integer -> [Id] -> HPred -> - (HClock, HReset) -> (Id, BetterInfo.BetterInfo, HExpr) -> + (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> Id -> IType -> Pred HeapData -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethodLam modId n args implicitCond clkRst (i, bi, eb) li ty p = - case eb of - IAps (ICon _ (ICPrim _ PrimPortName)) _ [ename, ebody] -> do - (name, _) <- evalString ename - let pfx :: Id - pfx = BetterInfo.mi_prefix bi - i' :: Id - i' = if isEmptyId pfx && not (isDigit $ head name) - then mkIdPost pfx $ mkFString name - else mkIdPost pfx (concatFString [fsUnderscore, mkFString name]) - -- substitute argument with a modvar and replace with body - eb' :: HExpr - eb' = eSubst li (ICon i' (ICMethArg ty)) ebody - let m_orig_type :: Maybe IType - m_orig_type = fmap ((flip (!!) (fromInteger (n-1))) . fst . itGetArrows) - (BetterInfo.mi_orig_type bi) - maybe (return ()) (saveTopModPortType (id_to_vName i')) m_orig_type - (its, (d, ws1, wf1), (wd, ws2, wf2)) <- - iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, eb') - let inps :: [VPort] - inps = vf_inputs wf1 - let wf1' :: VFieldInfo - wf1' = case wf1 of - (Method {}) -> wf1 { vf_inputs = ((id_to_vPort i'):inps) } - _ -> internalError "iExpandMethodLam: unexpected wf1" - return ((i', ty) : its, (d, ws1, wf1'), (wd, ws2, wf2)) - -- XXX should be a user error, since someone can write their own WrapPorts instance - _ -> internalError $ "iExpandMethodLam: expected PrimPortName, got " ++ ppReadable eb +iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do + traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show ins) + let pfx :: Id + pfx = BetterInfo.mi_prefix bi + name :: String + name = head ins + i' :: Id + i' = if isEmptyId pfx && not (isDigit $ head name) + then mkIdPost pfx $ mkFString name + else mkIdPost pfx (concatFString [fsUnderscore, mkFString name]) + -- substitute argument with a modvar and replace with body + eb' :: HExpr + eb' = eSubst li (ICon i' (ICMethArg ty)) eb + -- XXX we aren't indexing this list properly here! + -- let m_orig_type :: Maybe IType + -- m_orig_type = fmap ((flip (!!) (fromInteger (n-1))) . fst . itGetArrows) + -- (BetterInfo.mi_orig_type bi) + --maybe (return ()) (saveTopModPortType (id_to_vName i')) m_orig_type + (its, (d, ws1, wf1), (wd, ws2, wf2)) <- + iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, tail ins, eb') + let inps :: [VPort] + inps = vf_inputs wf1 + let wf1' :: VFieldInfo + wf1' = case wf1 of + (Method {}) -> wf1 { vf_inputs = ((id_to_vPort i'):inps) } + _ -> internalError "iExpandMethodLam: unexpected wf1" + return ((i', ty) : its, (d, ws1, wf1'), (wd, ws2, wf2)) iExpandMethod' :: HPred -> HClock -> (Id, BetterInfo.BetterInfo, HExpr) -> Pred HeapData -> @@ -2134,6 +2137,24 @@ evalString e = do _ -> do e'' <- unheapAll e' errG (getIExprPosition e'', EStringNF (ppString e'')) +evalStringList :: HExpr -> G ([String], Position) +evalStringList e = do + e' <- evaleUH e + case e' of + IAps (ICon _ c) _ [a] -> do + a' <- evaleUH a + -- XXX this is a horrible way of pulling apart a list, but I don't think there is a better way: + case a' of + IAps (ICon i' (ICTuple {})) _ [e_h, e_t] | getIdBaseString i' == "List_$Cons" -> do + (h, _) <- evalString e_h + (t, _) <- evalStringList e_t + return (h:t, getIExprPosition e') + ICon _ (ICInt _ (IntLit { ilValue = 0 })) -> + return ([], getIExprPosition e') + _ -> internalError ("evalStringList con: " ++ showTypeless a') + _ -> do e'' <- unheapAll e' + errG (getIExprPosition e', EStringListNF (ppString e')) + ----------------------------------------------------------------------------- evalHandle :: HExpr -> G Handle @@ -2543,10 +2564,6 @@ walkNF e = _ <- internalError ("PrimWhenPred" ++ ppReadable e) (P p' e', ws) <- walkNF e upd (pConjs [p0, p, p']) e' ws - - IAps f@(ICon i (ICPrim _ PrimPortName)) _ [n, e] -> do - (P p e', ws) <- walkNF e - upd (pConj p0 p) (IAps f [] [n, e']) ws -- Any other application is not in NF (which is unexpected?) IAps f ts es -> do @@ -3127,6 +3144,11 @@ conAp' i (ICPrim _ PrimIsRawUndefined) _ (T t : E e : as) = do _ -> -- do traceM ("IsRawUndefined: False") return (P p iFalse) +conAp' i (ICPrim _ PrimPortNames) _ [T t, E eInNames, E meth] = do + (inNames, _) <- evalStringList eInNames + P p meth' <- eval1 meth + return $ P p $ ICon (dummyId noPosition) $ ICMethod {iConType = t, iInputNames = inNames, iMethod = meth'} + -- XXX is this still needed? conAp' i (ICUndet { iConType = t }) e as | t == itClock = errG (getIdPosition i, EUndeterminedClock) diff --git a/src/comp/ISyntax.hs b/src/comp/ISyntax.hs index 6c823682f..4bb08b7f5 100644 --- a/src/comp/ISyntax.hs +++ b/src/comp/ISyntax.hs @@ -821,6 +821,8 @@ data IConInfo a = -- as an argument to PrimAddSchedPragmas (applied to rules). -- only exists before expansion | ICSchedPragmas { iConType :: IType, iPragmas :: [CSchedulePragma] } + + | ICMethod { iConType :: IType, iInputNames :: [String], iMethod :: IExpr a } | ICClock { iConType :: IType, iClock :: IClock a } | ICReset { iConType :: IType, iReset :: IReset a } -- iReset has effective type itBit1 | ICInout { iConType :: IType, iInout :: IInout a } @@ -870,6 +872,7 @@ ordC (ICAttrib { }) = 28 ordC (ICPosition { }) = 29 ordC (ICType { }) = 30 ordC (ICPred { }) = 31 +ordC (ICMethod { }) = 32 instance Eq (IConInfo a) where x == y = cmpC x y == EQ @@ -914,6 +917,8 @@ cmpC c1 c2 = ICIFace { ifcTyId = ti1, ifcIds = is1 } -> compare (ti1, is1) (ifcTyId c2, ifcIds c2) ICRuleAssert { iAsserts = asserts } -> compare asserts (iAsserts c2) ICSchedPragmas { iPragmas = pragmas } -> compare pragmas (iPragmas c2) + ICMethod { iInputNames = inames1, iMethod = meth1 } -> + compare (inames1, meth1) (iInputNames c2, iMethod c2) -- the ICon Id is not sufficient for equality comparison for Clk/Rst ICClock { iClock = clock1 } -> compare clock1 (iClock c2) ICReset { iReset = reset1 } -> compare reset1 (iReset c2) @@ -1238,6 +1243,7 @@ instance NFData (IConInfo a) where rnf (ICIFace x1 x2 x3) = rnf3 x1 x2 x3 rnf (ICRuleAssert x1 x2) = rnf2 x1 x2 rnf (ICSchedPragmas x1 x2) = rnf2 x1 x2 + rnf (ICMethod x1 x2 x3) = rnf3 x1 x2 x3 rnf (ICClock x1 x2) = rnf2 x1 x2 rnf (ICReset x1 x2) = rnf2 x1 x2 rnf (ICInout x1 x2) = rnf2 x1 x2 @@ -1459,6 +1465,7 @@ showTypelessCI (ICValue {iConType = t, iValDef = e}) = "(ICValue)" showTypelessCI (ICIFace {iConType = t, ifcTyId = i, ifcIds = ids}) = "(ICIFace _ " ++ (show i) ++ " " ++ (show ids) ++ ")" showTypelessCI (ICRuleAssert {iConType = t, iAsserts = rps}) = "(ICRuleAssert _ " ++ (show rps) ++ ")" showTypelessCI (ICSchedPragmas {iConType = t, iPragmas = sps}) = "(ICSchedPragmas _ " ++ (show sps) ++ ")" +showTypelessCI (ICMethod {iConType = t, iInputNames = ins, iMethod = m }) = "(ICMethod " ++ (show ins) ++ " " ++ (ppReadable m) ++ ")" showTypelessCI (ICClock {iConType = t, iClock = clock}) = "(ICClock)" showTypelessCI (ICReset {iConType = t, iReset = reset}) = "(ICReset)" showTypelessCI (ICInout {iConType = t, iInout = inout}) = "(ICInout)" diff --git a/src/comp/Prim.hs b/src/comp/Prim.hs index c3df58b25..7054f1cc3 100644 --- a/src/comp/Prim.hs +++ b/src/comp/Prim.hs @@ -64,7 +64,7 @@ data PrimOp = | PrimInoutCast | PrimInoutUncast - | PrimPortName + | PrimPortNames | PrimIf | PrimMux @@ -356,7 +356,7 @@ toPrim i = tp (getIdBaseString i) -- XXXXX tp "primBOr" = PrimBOr tp "primInoutCast" = PrimInoutCast tp "primInoutUncast" = PrimInoutUncast - tp "primPortName" = PrimPortName + tp "primPortNames" = PrimPortNames tp "primIntegerToBit" = PrimIntegerToBit tp "primIntegerToUIntBits" = PrimIntegerToUIntBits tp "primIntegerToIntBits" = PrimIntegerToIntBits From 4130371c2f4fd48cef8346ecc113b4e063833b34 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 9 Aug 2024 17:50:36 -0700 Subject: [PATCH 04/89] Refactor WrapMethod type class --- src/Libraries/Base1/Prelude.bs | 113 +++++++++++++++++---------------- src/comp/GenWrap.hs | 6 +- src/comp/IExpand.hs | 2 +- src/comp/PreIds.hs | 8 +-- src/comp/PreStrings.hs | 6 +- src/comp/Prim.hs | 4 +- 6 files changed, 72 insertions(+), 67 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 74934397c..62ec84c3c 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -258,8 +258,8 @@ package Prelude( MetaConsNamed(..), MetaConsAnon(..), MetaField(..), Curry(..), AppendTuple(..), AppendTuple'(..), TupleSize(..), - WrapPorts(..), WrapMethod(..), toWrapMethod, - primPortNames + WrapPorts(..), WrapMethod(..), WrapField(..), + primMethod ) where infixr 0 $ @@ -4437,8 +4437,63 @@ instance TupleSize () 0 where {} instance TupleSize a 1 where {} instance (TupleSize b n) => TupleSize (a, b) (TAdd n 1) where {} --- Tag a method with a list of port names. -primitive primPortNames :: List String -> a -> a +-- Tag a method with metadata. +-- Currently just the list of input port names. +primitive primMethod :: List String -> a -> a + +class WrapField f w | f -> w where + -- Takes a list of argument names, converts a synthesized interface field value to + -- its wrapper interface field. + toWrapField :: List String -> f -> w + -- Converts a wrapper interface field value to its synthesized interface field. + fromWrapField :: w -> f + +instance (WrapMethod m w) => (WrapField m w) where + toWrapField names = primMethod (inputPortNames ((error "proxy value") :: m) names) ∘ toWrapMethod + fromWrapField = fromWrapMethod + +-- 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 + +class WrapMethod m w | m -> w where + -- Convert a synthesized interface method to its wrapper interface method. + toWrapMethod :: m -> w + -- Convert a wrapper interface method to its synthesized interface method. + fromWrapMethod :: w -> m + -- Comput the list of input port names for a method. + inputPortNames :: m -> List String -> List String + inputPortNames _ _ = Nil + +instance (WrapPorts a p, TupleSize p n, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where + toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ fromPorts + fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ toPorts + inputPortNames _ (Cons h t) = + checkPortNames ((error "proxy value") :: a) h `listPrimAppend` + inputPortNames ((error "proxy value") :: b) t + inputPortNames _ Nil = error "toWrapMethod: empty arg names list" + +instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where + toWrapMethod = toActionValue_ + fromWrapMethod = fromActionValue_ + +instance (Bits a n) => WrapMethod a (Bit n) where + toWrapMethod = pack + fromWrapMethod = unpack class WrapPorts a p | a -> p where -- Takes an unwrapped value and returns a (tuple of) bits cooresponding to port(s). @@ -4477,53 +4532,3 @@ checkPortNames _ base = then error $ "WrapPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ " ports, but " +++ integerToString (listLength pn) +++ " port names were given" else pn - -class WrapMethod m w | m -> w where - toWrapMethod :: List String -> m -> w - - toWrapMethod' :: m -> w - fromWrapMethod :: w -> m - - inputPortNames :: m -> List String -> List String - inputPortNames _ _ = Nil - -instance (WrapPorts a p, TupleSize p n, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where - toWrapMethod names = primPortNames (inputPortNames ((error "proxy value") :: (a -> b)) names) ∘ toWrapMethod' - toWrapMethod' f = curryN $ toWrapMethod' ∘ f ∘ fromPorts - fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ toPorts - inputPortNames _ (Cons h t) = - checkPortNames ((error "proxy value") :: a) h `listPrimAppend` - inputPortNames ((error "proxy value") :: b) t - inputPortNames _ Nil = error "toWrapMethod: empty arg names list" - -instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where - toWrapMethod _ = primPortNames Nil ∘ toActionValue_ - toWrapMethod' = toActionValue_ - fromWrapMethod = fromActionValue_ - -instance (Bits a n) => WrapMethod a (Bit n) where - toWrapMethod _ = primPortNames Nil ∘ pack - toWrapMethod' = pack - fromWrapMethod = unpack - --- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface, --- but this case was being handled in GenWrap. -instance WrapMethod PrimAction PrimAction where - toWrapMethod _ = id - toWrapMethod' = id - fromWrapMethod = id - -instance WrapMethod Clock Clock where - toWrapMethod _ = id - toWrapMethod' = id - fromWrapMethod = id - -instance WrapMethod Reset Reset where - toWrapMethod _ = id - toWrapMethod' = id - fromWrapMethod = id - -instance (Bits a n) => WrapMethod (Inout a) (Inout_ n) where - toWrapMethod _ = primInoutCast0 - toWrapMethod' = primInoutCast0 - fromWrapMethod = primInoutUncast0 diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 4291fa03b..254b2a982 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -904,7 +904,7 @@ genIfcField trec ifcIdIn prefixes (FInf fieldIdQ argtypes rettype _) = return (concat fields, concat props) _ -> do -- ELSE NOT a Vec let v = cTVar $ head tmpTyVarIds - let ctx = CPred (CTypeclass idWrapMethod) [foldr arrow rettype argtypes, v] + let ctx = CPred (CTypeclass idWrapField) [foldr arrow rettype argtypes, v] let fi = binId prefixes fieldId -- @@ -1108,7 +1108,7 @@ genTo pps ty mk = [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds ++ map mkNumId [genericLength aIds + 1..genericLength as]] let ec = if f == idEmpty then sel else CSelect sel (setInternal f) - let e = CApply (CVar id_toWrapMethod) [arg_names, ec] + let e = CApply (CVar id_toWrapField) [arg_names, ec] return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- @@ -1199,7 +1199,7 @@ 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_fromWrapMethod) [sel binf] + let e = CApply (CVar id_fromWrapField) [sel binf] return (f, e, qs) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 9c6c91d19..07a082b72 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -3144,7 +3144,7 @@ conAp' i (ICPrim _ PrimIsRawUndefined) _ (T t : E e : as) = do _ -> -- do traceM ("IsRawUndefined: False") return (P p iFalse) -conAp' i (ICPrim _ PrimPortNames) _ [T t, E eInNames, E meth] = do +conAp' i (ICPrim _ PrimMethod) _ [T t, E eInNames, E meth] = do (inNames, _) <- evalStringList eInNames P p meth' <- eval1 meth return $ P p $ ICon (dummyId noPosition) $ ICMethod {iConType = t, iInputNames = inNames, iMethod = meth'} diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index 0a55c10f7..7d723ab6e 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -236,10 +236,10 @@ idPolyWrapField = mk_no fsPolyWrapField idLiftModule :: Id idLiftModule = prelude_id_no fsLiftModule -idWrapMethod, id_fromWrapMethod, id_toWrapMethod :: Id -idWrapMethod = prelude_id_no fsWrapMethod -id_fromWrapMethod = prelude_id_no fsFromWrapMethod -id_toWrapMethod = prelude_id_no fsToWrapMethod +idWrapField, id_fromWrapField, id_toWrapField :: Id +idWrapField = prelude_id_no fsWrapField +id_fromWrapField = prelude_id_no fsFromWrapField +id_toWrapField = prelude_id_no fsToWrapField -- Used by desugaring id_lam, id_if, id_read, id_write :: Position -> Id diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index a139003c4..9551162bd 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -346,9 +346,9 @@ fsMetaConsNamed = mkFString "MetaConsNamed" fsMetaConsAnon = mkFString "MetaConsAnon" fsMetaField = mkFString "MetaField" fsPolyWrapField = mkFString "val" -fsWrapMethod = mkFString "WrapMethod" -fsFromWrapMethod = mkFString "fromWrapMethod" -fsToWrapMethod = mkFString "toWrapMethod" +fsWrapField = mkFString "WrapField" +fsFromWrapField = mkFString "fromWrapField" +fsToWrapField = mkFString "toWrapField" -- XXX low ASCII only, please... sAcute = "__" diff --git a/src/comp/Prim.hs b/src/comp/Prim.hs index 7054f1cc3..2af390c89 100644 --- a/src/comp/Prim.hs +++ b/src/comp/Prim.hs @@ -64,7 +64,7 @@ data PrimOp = | PrimInoutCast | PrimInoutUncast - | PrimPortNames + | PrimMethod | PrimIf | PrimMux @@ -356,7 +356,7 @@ toPrim i = tp (getIdBaseString i) -- XXXXX tp "primBOr" = PrimBOr tp "primInoutCast" = PrimInoutCast tp "primInoutUncast" = PrimInoutUncast - tp "primPortNames" = PrimPortNames + tp "primMethod" = PrimMethod tp "primIntegerToBit" = PrimIntegerToBit tp "primIntegerToUIntBits" = PrimIntegerToUIntBits tp "primIntegerToIntBits" = PrimIntegerToIntBits From fbee672452fd5964e89f448981161c6769f20785 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Aug 2024 19:47:53 -0700 Subject: [PATCH 05/89] Input port splitting works end-to-end, modulo sanity checks and saving port types --- src/Libraries/Base1/Prelude.bs | 131 ++++++++++++++++++++++++--------- src/comp/GenWrap.hs | 37 +++------- src/comp/IExpand.hs | 24 ++---- src/comp/IExpandUtils.hs | 5 +- src/comp/IfcBetterInfo.hs | 12 +-- 5 files changed, 116 insertions(+), 93 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 62ec84c3c..aa6bf85d6 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -258,7 +258,7 @@ package Prelude( MetaConsNamed(..), MetaConsAnon(..), MetaField(..), Curry(..), AppendTuple(..), AppendTuple'(..), TupleSize(..), - WrapPorts(..), WrapMethod(..), WrapField(..), + WrapField(..), WrapMethod(..), WrapPorts(..), SplitPorts(..), primMethod ) where @@ -4445,12 +4445,18 @@ class WrapField f w | f -> w where -- Takes a list of argument names, converts a synthesized interface field value to -- its wrapper interface field. toWrapField :: List String -> f -> w + -- Converts a wrapper interface field value to its synthesized interface field. fromWrapField :: w -> f + -- Save the port types for a field in the wrapped interface. + saveFieldPortTypes :: f -> Maybe Name__ -> List String -> String -> Module () + saveFieldPortTypes _ _ _ _ = return () + instance (WrapMethod m w) => (WrapField m w) where - toWrapField names = primMethod (inputPortNames ((error "proxy value") :: m) names) ∘ toWrapMethod + toWrapField names = primMethod (inputPortNames (_:: m) names) ∘ toWrapMethod fromWrapField = fromWrapMethod + saveFieldPortTypes = saveMethodPortTypes -- TODO: It doesn't seem possible to have a PrimAction field in a synthesized interface, -- but this case was being handled in GenWrap. @@ -4469,44 +4475,114 @@ instance WrapField Reset Reset where instance (Bits a n) => WrapField (Inout a) (Inout_ n) where toWrapField _ = primInoutCast0 fromWrapField = primInoutUncast0 + saveFieldPortTypes _ name _ result = primSavePortType name result $ typeOf (_ :: a) class WrapMethod m w | m -> w where -- Convert a synthesized interface method to its wrapper interface method. toWrapMethod :: m -> w + -- Convert a wrapper interface method to its synthesized interface method. fromWrapMethod :: w -> m - -- Comput the list of input port names for a method. + + -- Compute the list of input port names for a method, from its argument names. inputPortNames :: m -> List String -> List String inputPortNames _ _ = Nil -instance (WrapPorts a p, TupleSize p n, WrapMethod b v, Curry (p -> v) w) => WrapMethod (a -> b) w where - toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ fromPorts - fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ toPorts + -- Save the port types for a method. + saveMethodPortTypes :: m -> Maybe Name__ -> List String -> String -> Module () + +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry (pb -> v) w) => + WrapMethod (a -> b) w where + toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ unsplitPorts ∘ unpackPorts + fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ packPorts ∘ splitPorts inputPortNames _ (Cons h t) = - checkPortNames ((error "proxy value") :: a) h `listPrimAppend` - inputPortNames ((error "proxy value") :: b) t - inputPortNames _ Nil = error "toWrapMethod: empty arg names list" + checkPortNames (_ :: a) h `listPrimAppend` + inputPortNames (_ :: b) t + inputPortNames _ Nil = error "inputPortNames: empty arg names list" + saveMethodPortTypes _ name (Cons h t) result = do + savePortTypes (_ :: p) name $ checkPortNames (_ :: a) h + saveMethodPortTypes (_ :: b) name t result + saveMethodPortTypes _ _ Nil _ = error "saveMethodPortTypes: empty arg names list" instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where toWrapMethod = toActionValue_ fromWrapMethod = fromActionValue_ + saveMethodPortTypes _ name _ result = primSavePortType name result $ typeOf (_ :: a) instance (Bits a n) => WrapMethod a (Bit n) where toWrapMethod = pack fromWrapMethod = unpack + saveMethodPortTypes _ name _ result = primSavePortType name result $ typeOf (_ :: a) -class WrapPorts a p | a -> p where - -- Takes an unwrapped value and returns a (tuple of) bits cooresponding to port(s). - toPorts :: a -> p - -- Takes a (tuple of) bits cooresponding to ports, returns the unwrapped value. - fromPorts :: p -> a - -- Takes a proxy value and a base name, returns a list of port names for the type. - portNames :: a -> String -> List String +{- +Eventually, we should support splitting multiple output ports. +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod (ActionValue a) (ActionValue pb) where + toWrapMethod = fmap packPorts + fromWrapMethod = fmap unpackPorts + outputPortNames _ base = checkPortNames (_ :: a) base + saveMethodPortTypes _ name _ result = + savePortTypes (_ :: p) name $ checkPortNames (_ :: a) result + +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod a pb where + toWrapMethod a = packPorts a + fromWrapMethod a = unpackPorts a + outputPortNames _ base = checkPortNames (_ :: a) base + saveMethodPortTypes _ name _ result = + savePortTypes (_ :: p) name $ checkPortNames (_ :: a) result +-} + +class WrapPorts p pb | p -> pb where + -- Convert from a tuple of values to a tuple of bits. + packPorts :: p -> pb + -- Convert from a tuple of bits to a tuple of values. + unpackPorts :: pb -> p + -- Save the port types, given their names. + savePortTypes :: p -> Maybe Name__ -> List String -> Module () + +instance (Bits a n, WrapPorts b bb) => WrapPorts (a, b) (Bit n, bb) where + packPorts (a, b) = (pack a, packPorts b) + unpackPorts (a, b) = (unpack a, unpackPorts b) + savePortTypes _ name (Cons h t) = do + primSavePortType name h $ typeOf (_ :: a) + savePortTypes (_ :: b) name t + savePortTypes _ _ Nil = error "savePortTypes: empty port names list" instance (Bits a n) => WrapPorts a (Bit n) where - toPorts = pack - fromPorts = unpack - portNames _ base = Cons base nil + packPorts = pack + unpackPorts = unpack + savePortTypes _ name (Cons h _) = primSavePortType name h $ typeOf (_ :: a) + savePortTypes _ _ Nil = error "savePortTypes: empty port names list" + +instance WrapPorts () () where + packPorts _ = () + unpackPorts _ = () + savePortTypes _ _ _ = return () + +checkPortNames :: (SplitPorts a p, TupleSize p n) => a -> String -> List String +checkPortNames proxy base = + let pn = portNames proxy base + in + if listLength pn /= valueOf n + then error $ "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ + " ports, but " +++ integerToString (listLength pn) +++ " port names were given" + else pn + +class SplitPorts a p | a -> p where + splitPorts :: a -> p + unsplitPorts :: p -> a + portNames :: a -> String -> List String + +-- XXX if the default instance is the only one, then it gets inlined in CtxReduce +-- and other instances for this class are ignored. +instance SplitPorts () () where + splitPorts = id + unsplitPorts = id + portNames _ _ = Nil + +instance SplitPorts a a where + splitPorts = id + unsplitPorts = id + portNames _ base = Cons base Nil {- instance WrapPorts (Vector 0 a) () where @@ -4516,19 +4592,4 @@ instance WrapPorts (Vector 0 a) () where instance (Add n1 1 n, WrapPorts a p1, WrapPorts (Vector n1 a) p2, AppendTuple p1 p2 p) => WrapPorts (Vector n a) p where toPorts v = appendTuple (toPorts $ head v) (toPorts $ tail v) --} - --- TODO: If there is only one instance for WrapPorts, the first WrapMethod instance below fails to typecheck. -instance WrapPorts () () where - toPorts = id - fromPorts = id - portNames _ _ = nil - -checkPortNames :: (WrapPorts a p, TupleSize p n) => a -> String -> List String -checkPortNames _ base = - let pn = portNames ((error "proxy value") :: a) base - in - if listLength pn /= valueOf n - then error $ "WrapPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ - " ports, but " +++ integerToString (listLength pn) +++ " port names were given" - else pn +-} \ No newline at end of file diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 254b2a982..4a222629b 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1190,7 +1190,6 @@ genFrom pps ty var = isReset <- isResetType r isInout <- isInoutType r let isIot = isInout /= Nothing - isAV <- isActionValue r let binf = binId prefixes f let wbinf = mkRdyId binf let sel = CSelect var @@ -1318,6 +1317,8 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = ftps <- mapM collectIfcInfo (reverse cfields) -- get back the arg port to type mapping, for recording flgs <- getFlags + -- XXX Need to handle module arguments here. + -- XXX Need to sanity check port names after elaboration. -- arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps let arg_pts = [] @@ -1542,7 +1543,9 @@ genFromBody arg_pts vfield_map mk true_ifc_ids si fts = let pos = getIdPosition si let mkMethod = mkFromBind vfield_map true_ifc_ids (CVar (id_t pos)) (meths, ifc_ptss) <- mapAndUnzipM mkMethod fts + -- TODO: Save "port types" for clocks, resets, inouts here. let -- interface save-port-type statements + -- XXX need to use the type class here ifc_sptStmts = map (uncurry (savePortTypeStmt (CVar id_x))) (concat ifc_ptss) -- argument save-port-type statements @@ -1560,6 +1563,8 @@ genFromBody arg_pts vfield_map mk true_ifc_ids si fts = -- Creates a method for the module body -- also returns the raw port-type information for correlation -- XXX some of this can be replaced with a call to "mkFrom_" +-- Currently there is an optimization preventing this - we avoid adding guards for +-- ready signals that are known to be constant True, which isn't known when mkFrom_ is generated. mkFromBind :: M.Map Id VFieldInfo -> [Id] -> CExpr -> FInf -> GWMonad (CDefl, [(VPort, CType)]) mkFromBind vfield_map true_ifc_ids var ft = do @@ -1600,39 +1605,14 @@ mkFromBind vfield_map true_ifc_ids var ft = isReset <- isResetType r isInout <- isInoutType r let isIot = isInout/=Nothing - isAV <- isActionValue r let binf = binId prefixes f let wbinf = mkRdyId binf let sel = CSelect var let meth_guard = CApply eUnpack [sel wbinf] - let vs = take (length as) (aIds ++ tmpVarXIds) let qs = if (wbinf `elem` true_ifc_ids || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let ec = cApply 13 (sel binf) (map (\ v -> CApply ePack [CVar v]) vs) - let e = - case isInout of - Just _ -> (CApply ePrimInoutUncast0 [ec]) - _ -> if (isPA || isClock || isReset) - then ec - else - if isAV - then cApply 12 (CVar idFromActionValue_) [ec] - else CApply eUnpack [ec] - pts <- case (M.lookup binf vfield_map) of - Just (Method { vf_inputs = inps, - vf_output = mo }) -> do - output_type <- if isAV then - getAVType "mkFromBind" r - else return r - return ((maybeToList (fmap (\p -> (p, output_type)) mo)) ++ - zip inps as) - Just (Inout { vf_inout = vn }) -> do - let ty = r - vp = (vn, []) - return [(vp,ty)] - _ -> do --traceM ("no field info: " ++ ppReadable (f, binf, vfield_map)) - return [] - return (f, cLams vs e, qs, pts) + let e = CApply (CVar id_fromWrapField) [sel binf] + return (f, e, qs, []) @@ -2134,6 +2114,7 @@ chkUserPragmas pps ifc = do -- ==================== -- Saving name/type information +-- XXX is liftModule really needed for these? -- liftModule $ primSavePortType (Valid v) s t savePortTypeStmt :: CExpr -> (VName, b) -> CType -> CMStmt diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 07a082b72..78629cf35 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -1021,9 +1021,6 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) | isitInout_ t = do (iinout, e') <- evalInout e let modPos = getPosition modId (ws, fi) <- makeIfcInout modPos i (BetterInfo.mi_prefix bi) iinout - let mType = fmap (snd . itGetArrows) (BetterInfo.mi_orig_type bi) - vname = vf_inout fi - maybe (return ()) (saveTopModPortType vname) mType setIfcSchedNameScopeProgress Nothing return [(IEFace i [] (Just (e',t)) Nothing ws fi)] @@ -1038,7 +1035,7 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) = do ICon _ (ICMethod _ ins eb) -> (ins, eb) _ -> internalError ("iExpandField: expected ICMethod: " ++ ppReadable e') (its, ((IDef i1 t1 e1 _), ws1, fi1), ((IDef wi wt we _), ws2, fi2)) - <- iExpandMethod modId 1 [] implicitCond clkRst (i, bi, ins, eb) + <- iExpandMethod modId 1 [] (pConj implicitCond p) clkRst (i, bi, ins, eb) let wp1 = wsToProps ws1 -- default clock domain forced in by iExpandField let wp2 = wsToProps ws2 setIfcSchedNameScopeProgress Nothing @@ -1081,11 +1078,6 @@ iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do -- substitute argument with a modvar and replace with body eb' :: HExpr eb' = eSubst li (ICon i' (ICMethArg ty)) eb - -- XXX we aren't indexing this list properly here! - -- let m_orig_type :: Maybe IType - -- m_orig_type = fmap ((flip (!!) (fromInteger (n-1))) . fst . itGetArrows) - -- (BetterInfo.mi_orig_type bi) - --maybe (return ()) (saveTopModPortType (id_to_vName i')) m_orig_type (its, (d, ws1, wf1), (wd, ws2, wf2)) <- iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, tail ins, eb') let inps :: [VPort] @@ -1164,14 +1156,6 @@ iExpandMethod' implicitCond curClk (i, bi, e0) p0 = do let rdyPort :: VPort rdyPort = BetterInfo.mi_ready bi - let mType :: Maybe IType - mType = fmap (snd . itGetArrows) (BetterInfo.mi_orig_type bi) - maybe (return ()) (\t -> do - maybe (return ()) (\(n,_) -> do - if (isActionType methType) then - maybe (return ()) (saveTopModPortType n) (getAVType t) - else saveTopModPortType n t) outputPort) mType - -- split wire sets for more accurate tracking return ([], ((IDef i (iGetType final_e) final_e []), final_ws, @@ -4146,7 +4130,7 @@ getBuriedPreds (IAps a@(ICon _ (ICPrim _ PrimBOr)) b [e1, e2]) = do -- the following are followed because they are strict, -- and we want to unheap the references in their arguments getBuriedPreds (IAps a@(ICon _ p@(ICPrim _ _)) b es) = do - --traceM("getBuriedPreds: prim") + -- traceM("getBuriedPreds: prim") ps <- mapM getBuriedPreds es return (foldr1 pConj ps) getBuriedPreds (IAps a@(ICon _ (ICForeign { })) b es) = do @@ -4167,6 +4151,10 @@ getBuriedPreds (IAps ic@(ICon i_sel (ICSel { })) ts1 [e]) | (i_sel == idAVValue_ || i_sel == idAVAction_) = do --traceM("getBuriedPreds: AV sel") getBuriedPreds e +getBuriedPreds (ICon _ (ICMethod _ _ eb)) = do + -- traceM("getBuriedPreds: method") + p <- getBuriedPreds eb + return p getBuriedPreds e@(ICon _ _) = do --traceM("getBuriedPreds: con: e = " ++ ppReadable e ++ show e) return pTrue diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index f61573ecd..0cf4ea057 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -16,7 +16,7 @@ module IExpandUtils( pushIfcSchedNameScope, popIfcSchedNameScope, setIfcSchedNameScopeProgress, IfcElabProgress(..), addSubmodComments, {-getSubmodComments,-} - addPort, getPortWires, savePortType, saveTopModPortType, + addPort, getPortWires, savePortType, saveRules, getSavedRules, clearSavedRules, replaceSavedRules, setBackendSpecific, cacheDef, addStateVar, step, updHeap, getHeap, {- filterHeapPtrs, -} @@ -1234,9 +1234,6 @@ savePortType minst port t = do old_map put s { portTypeMap = new_map } -saveTopModPortType :: VName -> IType -> G () -saveTopModPortType port t = savePortType Nothing port t - -- --------------- saveRules :: (HClock, HReset) -> IStateLoc -> HPred -> HExpr -> G () diff --git a/src/comp/IfcBetterInfo.hs b/src/comp/IfcBetterInfo.hs index 555d7840d..103bf4082 100644 --- a/src/comp/IfcBetterInfo.hs +++ b/src/comp/IfcBetterInfo.hs @@ -31,8 +31,7 @@ data BetterInfo = BetterMethodInfo mi_result :: VPort, -- possible rename for method result mi_ready :: VPort, -- for ready signal mi_enable :: VPort, -- for enable signal - mi_prefix :: Id, -- default prefix for arguments (which are not found in classic) - mi_orig_type :: Maybe IType -- original (unwrapped) field type + mi_prefix :: Id -- default prefix for arguments (which are not found in classic) } -- XXX Note that the following are unused -- XXX (this package needs re-thinking) @@ -56,8 +55,7 @@ noMethodInfo fieldId = BetterMethodInfo {mi_id = fieldId, mi_result = id_to_vPort fieldId, mi_ready = id_to_vPort $ mkRdyId fieldId, mi_enable = id_to_vPort $ mkEnableId fieldId, - mi_prefix = fieldId, - mi_orig_type = Nothing + mi_prefix = fieldId } @@ -66,8 +64,7 @@ instance PPrint BetterInfo where ( printMaybe d i "Result:" (mi_result info) <> printMaybe d i "Ready:" (mi_ready info) <> printMaybe d i "Enable:" (mi_enable info) <> - text "Prefix:" <> pPrint d i (mi_prefix info) <> - printMaybe d i "Original type:" (mi_orig_type info) + text "Prefix:" <> pPrint d i (mi_prefix info) ) printMaybe :: PPrint a => PDetail -> Int -> String -> a -> Doc @@ -102,8 +99,7 @@ fieldInfoToBetterInfo flags symTab (fieldId, Just fi) = mi_result = maybe (id_to_vPort fieldId) (str_to_vPort) mres, mi_ready = maybe (id_to_vPort $ mkRdyId fieldId) str_to_vPort mrdy, mi_enable = maybe (id_to_vPort $ mkEnableId fieldId) str_to_vPort men, - mi_prefix = maybe fieldId (setIdBaseString fieldId) mprefix, - mi_orig_type = fmap (iConvT flags symTab) (fi_orig_type fi) + mi_prefix = maybe fieldId (setIdBaseString fieldId) mprefix } where prags = fi_pragmas fi (mprefix,mres,mrdy,men,_,_,_) = getMethodPragmaInfo prags From 4615c554d12c75ec5546f906fccaf30863a3e414 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Aug 2024 10:24:35 -0700 Subject: [PATCH 06/89] Handle prefix for input port names via wrap typeclasses --- src/Libraries/Base1/Prelude.bs | 86 ++++++++++++++++++++++------------ src/comp/GenWrap.hs | 28 +++++------ src/comp/IExpand.hs | 10 +--- 3 files changed, 72 insertions(+), 52 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index aa6bf85d6..b70041128 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4439,43 +4439,49 @@ instance (TupleSize b n) => TupleSize (a, b) (TAdd n 1) where {} -- Tag a method with metadata. -- Currently just the list of input port names. +-- 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 - -- Takes a list of argument names, converts a synthesized interface field value to + -- Given the prefix and arg_names pragmas, converts a synthesized interface field value to -- its wrapper interface field. - toWrapField :: List String -> f -> w + toWrapField :: String -> List String -> f -> w -- Converts a wrapper interface field value to its synthesized interface field. fromWrapField :: w -> f - -- Save the port types for a field in the wrapped interface. - saveFieldPortTypes :: f -> Maybe Name__ -> List String -> String -> Module () - saveFieldPortTypes _ _ _ _ = return () + -- 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 () instance (WrapMethod m w) => (WrapField m w) where - toWrapField names = primMethod (inputPortNames (_:: m) names) ∘ toWrapMethod + toWrapField prefix names = + let baseNames = methodArgBaseNames (_ :: m) prefix names 1 + in primMethod (inputPortNames (_ :: m) baseNames) ∘ toWrapMethod fromWrapField = fromWrapMethod - saveFieldPortTypes = saveMethodPortTypes + 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 + toWrapField _ _ = id fromWrapField = id instance WrapField Clock Clock where - toWrapField _ = id + toWrapField _ _ = id fromWrapField = id instance WrapField Reset Reset where - toWrapField _ = id + toWrapField _ _ = id fromWrapField = id instance (Bits a n) => WrapField (Inout a) (Inout_ n) where - toWrapField _ = primInoutCast0 + toWrapField _ _ = primInoutCast0 fromWrapField = primInoutUncast0 - saveFieldPortTypes _ name _ result = primSavePortType name result $ typeOf (_ :: a) + saveFieldPortTypes _ modName _ _ result = primSavePortType modName result $ typeOf (_ :: a) class WrapMethod m w | m -> w where -- Convert a synthesized interface method to its wrapper interface method. @@ -4484,35 +4490,46 @@ class WrapMethod m w | m -> w where -- Convert a wrapper interface method to its synthesized interface method. fromWrapMethod :: w -> m - -- Compute the list of input port names for a method, from its argument names. + -- 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 _ _ _ _ = Nil + + -- Compute the list of input port names for a method, from the argument base names. inputPortNames :: m -> List String -> List String inputPortNames _ _ = Nil - -- Save the port types for a method. + -- 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 () instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry (pb -> v) w) => WrapMethod (a -> b) w where toWrapMethod f = curryN $ toWrapMethod ∘ f ∘ unsplitPorts ∘ unpackPorts fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ packPorts ∘ splitPorts - inputPortNames _ (Cons h t) = - checkPortNames (_ :: a) h `listPrimAppend` - inputPortNames (_ :: b) t + + methodArgBaseNames _ prefix (Cons h t) i = Cons + (if prefix == "" && not (isDigit $ stringHead h) then h else prefix +++ "_" +++ h) + (methodArgBaseNames (_ :: b) prefix t $ i + 1) + methodArgBaseNames _ prefix Nil i = Cons + (prefix +++ "_" +++ integerToString i) + (methodArgBaseNames (_ :: b) prefix Nil $ i + 1) + + inputPortNames _ (Cons h t) = checkPortNames (_ :: a) h `listPrimAppend` inputPortNames (_ :: b) t inputPortNames _ Nil = error "inputPortNames: empty arg names list" - saveMethodPortTypes _ name (Cons h t) result = do - savePortTypes (_ :: p) name $ checkPortNames (_ :: a) h - saveMethodPortTypes (_ :: b) name t result + + saveMethodPortTypes _ modName (Cons h t) result = do + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) h + saveMethodPortTypes (_ :: b) modName t result saveMethodPortTypes _ _ Nil _ = error "saveMethodPortTypes: empty arg names list" instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where toWrapMethod = toActionValue_ fromWrapMethod = fromActionValue_ - saveMethodPortTypes _ name _ result = primSavePortType name result $ typeOf (_ :: a) + saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) instance (Bits a n) => WrapMethod a (Bit n) where toWrapMethod = pack fromWrapMethod = unpack - saveMethodPortTypes _ name _ result = primSavePortType name result $ typeOf (_ :: a) + saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) {- Eventually, we should support splitting multiple output ports. @@ -4520,15 +4537,15 @@ instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod (ActionVa toWrapMethod = fmap packPorts fromWrapMethod = fmap unpackPorts outputPortNames _ base = checkPortNames (_ :: a) base - saveMethodPortTypes _ name _ result = - savePortTypes (_ :: p) name $ checkPortNames (_ :: a) result + saveMethodPortTypes _ modName _ result = + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod a pb where toWrapMethod a = packPorts a fromWrapMethod a = unpackPorts a outputPortNames _ base = checkPortNames (_ :: a) base - saveMethodPortTypes _ name _ result = - savePortTypes (_ :: p) name $ checkPortNames (_ :: a) result + saveMethodPortTypes _ modName _ result = + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result -} class WrapPorts p pb | p -> pb where @@ -4542,15 +4559,15 @@ class WrapPorts p pb | p -> pb where instance (Bits a n, WrapPorts b bb) => WrapPorts (a, b) (Bit n, bb) where packPorts (a, b) = (pack a, packPorts b) unpackPorts (a, b) = (unpack a, unpackPorts b) - savePortTypes _ name (Cons h t) = do - primSavePortType name h $ typeOf (_ :: a) - savePortTypes (_ :: b) name t + savePortTypes _ modName (Cons h t) = do + primSavePortType modName h $ typeOf (_ :: a) + savePortTypes (_ :: b) modName t savePortTypes _ _ Nil = error "savePortTypes: empty port names list" instance (Bits a n) => WrapPorts a (Bit n) where packPorts = pack unpackPorts = unpack - savePortTypes _ name (Cons h _) = primSavePortType name h $ typeOf (_ :: a) + savePortTypes _ modName (Cons h _) = primSavePortType modName h $ typeOf (_ :: a) savePortTypes _ _ Nil = error "savePortTypes: empty port names list" instance WrapPorts () () where @@ -4558,6 +4575,9 @@ instance WrapPorts () () where unpackPorts _ = () savePortTypes _ _ _ = return () +-- 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 WrapPorts instance. checkPortNames :: (SplitPorts a p, TupleSize p n) => a -> String -> List String checkPortNames proxy base = let pn = portNames proxy base @@ -4568,8 +4588,14 @@ checkPortNames proxy base = else pn class SplitPorts a p | a -> p where + -- Convert a value to a tuple of values corresponding to ports. splitPorts :: a -> p + -- Combine a tuple of values corresponding to ports into a value. unsplitPorts :: p -> a + -- Compute the list of port names for a type, given a base name. + -- This must be the same length as the tuple of values. + -- XXX it would be nice to use ListN here to enforce this, but it's not + -- available in the Prelude. portNames :: a -> String -> List String -- XXX if the default instance is the only one, then it gets inlined in CtxReduce diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 4a222629b..25aab14fa 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -9,7 +9,7 @@ module GenWrap( import Prelude hiding ((<>)) #endif -import Data.List(nub, (\\), find, genericLength) +import Data.List(nub, (\\), find) import Control.Monad(when, foldM, filterM, zipWithM, mapAndUnzipM) import Control.Monad.Except(ExceptT, runExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, gets, get, put) @@ -1067,14 +1067,14 @@ genTo pps ty mk = cint <- chkInterface ty case cint of Nothing -> internalError ("genTo: " ++ pfpReadable (ty, mk)) - Just (_, _, fts) -> do - meths <- mapM (meth mk noPrefixes) fts + Just (ifcId, _, fts) -> do + meths <- mapM (meth mk noPrefixes ifcId) fts fty <- flatTypeId pps ty let tmpl = Cinterface (getPosition fts) (Just fty) (concat meths) return tmpl where - meth :: CExpr -> IfcPrefixes -> FInf -> GWMonad [CDefl] - meth sel prefixes (FInf f as r aIds) = + meth :: CExpr -> IfcPrefixes -> Id -> FInf -> GWMonad [CDefl] + meth sel prefixes ifcId (FInf f as r aIds) = do mi <- chkInterface r case (mi, as) of @@ -1085,7 +1085,7 @@ genTo pps ty mk = else do --traceM ("selector: " ++ show sel) newPrefixes <- extendPrefixes prefixes [] r f - meths <- mapM (meth (extSel sel f) newPrefixes) fts + meths <- mapM (meth (extSel sel f) newPrefixes ifcId) fts return (concat meths) _ -> do -- Generate the Verilog template for X isVec <- isVectorInterfaces r @@ -1099,16 +1099,19 @@ genTo pps ty mk = elemPrefix <- extendPrefixes prefixes [] r f let recurse num = do numPrefix <- extendPrefixes elemPrefix [] r (mkNumId num) - meth (selector num) numPrefix (FInf idEmpty [] tVec []) + meth (selector num) numPrefix ifcId (FInf idEmpty [] tVec []) fields <- mapM recurse nums return (concat fields) _ -> do + ciPrags <- getInterfaceFieldPrags ifcId f + let currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix + localPrefix1 = fromMaybe (getIdString f) (lookupPrefixIfcPragma ciPrags) + localPrefix = joinStrings_ currentPre localPrefix1 + prefix = stringLiteralAt noPosition localPrefix + arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] -- XXX idEmpty is a horrible way to know no more selection is required - let arg_names = mkList - [stringLiteralAt (getPosition i) (getIdString i) - | i <- aIds ++ map mkNumId [genericLength aIds + 1..genericLength as]] let ec = if f == idEmpty then sel else CSelect sel (setInternal f) - let e = CApply (CVar id_toWrapField) [arg_names, ec] + let e = CApply (CVar id_toWrapField) [prefix, arg_names, ec] return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- @@ -2152,9 +2155,6 @@ extSel :: CExpr -> Id -> CExpr extSel sel xid | xid == idEmpty = sel extSel sel xid = CSelect sel xid -cLams :: [Id] -> CExpr -> CExpr -cLams is e = foldr (CLam . Right) e is - unLams :: CExpr -> ([CPat], CExpr) unLams (CLam (Right i) e) = ((CPVar i):is, e') where (is, e') = unLams e unLams (CLam (Left p) e) = ((CPAny p):is, e') where (is, e') = unLams e diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 78629cf35..196156f67 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -1067,14 +1067,8 @@ iExpandMethodLam :: Id -> Integer -> [Id] -> HPred -> (HDef, HWireSet, VFieldInfo)) iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show ins) - let pfx :: Id - pfx = BetterInfo.mi_prefix bi - name :: String - name = head ins - i' :: Id - i' = if isEmptyId pfx && not (isDigit $ head name) - then mkIdPost pfx $ mkFString name - else mkIdPost pfx (concatFString [fsUnderscore, mkFString name]) + let i' :: Id + i' = mkId (getPosition i) $ mkFString $ head ins -- substitute argument with a modvar and replace with body eb' :: HExpr eb' = eSubst li (ICon i' (ICMethArg ty)) eb From aaf9e9a21d24fb556f459c3e85b8868a5999880a Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Aug 2024 14:09:37 -0700 Subject: [PATCH 07/89] Saving port types using WrapField type class method --- src/comp/GenWrap.hs | 115 +++++++++++++++++++++++++++++------------ src/comp/IExpand.hs | 4 +- src/comp/PreIds.hs | 3 +- src/comp/PreStrings.hs | 1 + 4 files changed, 86 insertions(+), 37 deletions(-) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 25aab14fa..9c2e271b5 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -10,7 +10,7 @@ import Prelude hiding ((<>)) #endif import Data.List(nub, (\\), find) -import Control.Monad(when, foldM, filterM, zipWithM, mapAndUnzipM) +import Control.Monad(when, foldM, filterM, zipWithM) import Control.Monad.Except(ExceptT, runExceptT, throwError) import Control.Monad.State(StateT, runStateT, lift, gets, get, put) import PFPrint @@ -25,6 +25,7 @@ import IdPrint import PreIds import CSyntax import CSyntaxUtil +import Undefined (UndefKind(..)) import SymTab(SymTab, TypeInfo(..), FieldInfo(..), findType, addTypesUQ, findField, findFieldInfo, getMethodArgNames) import MakeSymTab(convCQType) @@ -1299,11 +1300,17 @@ mkCtxs ty = mkNewModDef :: M.Map Id GeneratedIfc -> ModDefInfo -> GWMonad CDefn mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = do + --traceM ("mkNewModDef: " ++ ppReadable def) -- XXX This could have been stored in the moduledef info -- XXX (note that the first half is the "ts" in "vtis") let tr = case getArrows t of (_, TAp _ r) -> r _ -> internalError "GenWrap.mkNewModDef: tr" + cint <- chkInterface tr + (ifcId, _, fts) <- case cint of + Just res -> return res + Nothing -> internalError "GenWrap.mkNewModDef: cint" + tyId <- flatTypeId vps tr -- id of the Ifc_ let ty = tmod (cTCon tyId) -- type of new module @@ -1340,10 +1347,15 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = -- statements to record the port-types of module arguments -- (for the current module) arg_sptStmts = map (uncurry saveTopModPortTypeStmt) arg_pts + + -- interface save-port-type statements + ifc_sptStmts <- mkFieldSavePortTypeStmts Nothing ifcId fts + + let sptStmts = arg_sptStmts ++ ifc_sptStmts -- a do-block around the module body, so that we can include the -- save-port-type statements - lexp = if not (null arg_sptStmts) - then Cdo False (arg_sptStmts ++ [CSExpr Nothing mexp]) + lexp = if not (null sptStmts) + then Cdo False (sptStmts ++ [CSExpr Nothing mexp]) else mexp -- liftM of the do-block to = cVApply idLiftM [CVar (to_Id tyId), lexp] @@ -1436,7 +1448,7 @@ mkNewModDef _ (def,_,_,_) = -- This is the part of "genWrapInfo" which makes the DefFun, -- a continuation function which does the final wrapper computation. --- type DefFun = VWireInfo -> VSchedInfo -> VPathInfo -> [VPort] -> SymTab -> [VFieldInfo] -> [Id] -> [Id] -> IO CDefn +-- type DefFun = Bool -> VWireInfo -> VSchedInfo -> VPathInfo -> [VPort] -> SymTab -> [VFieldInfo] -> [Id] -> IO CDefn -- XXX: alwaysEnabled is dropped and broken (not propagated to {inhigh}) mkDef :: [PProp] -> [PProp] -> CDef -> CQType -> GWMonad DefFun mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do @@ -1450,7 +1462,7 @@ mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do -- do not use ifc prags here (st2, ti_) <- runGWMonadGetNoFail (flatTypeId pps tr) st1 let vs = take (length ts) tmpVarIds - (st3, Just (_, _, finfs)) <- runGWMonadGetNoFail (chkInterface tr) st2 + (st3, Just (ifcId, _, finfs)) <- runGWMonadGetNoFail (chkInterface tr) st2 let -- return an expression for creating the arg (from the wrapper's args) -- and the type of the internal module's arg (for port-type saving) @@ -1495,10 +1507,6 @@ mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do -- make the arg port-types, for saving in the module arg_pts = mkArgPortTypes wire_info arg_ts let - -- don't use the "fixed up" veriFields below because we don't need - -- port property information (makes the flow a little simpler, I think) - vfield_map = M.fromList [(vf_name vf, vf) | vf <- fields] - fields' = filter (not . (isRdyToRemoveField (iprags ++ pps))) fields veriFields = (map (fixupVeriField (iprags ++ pps) ips) fields') vexp = xWrapperModuleVerilog @@ -1512,7 +1520,7 @@ mkDef iprags pps (CDef i (CQType _ qt) _) cqt = do pathinfo vlift = (cVApply idLiftModule [vexp]) body <- runGWMonadNoFail - (genFromBody arg_pts vfield_map vlift true_ifc_ids ti_ finfs) + (genFromBody arg_pts vlift true_ifc_ids ti_ ifcId finfs) st4 let cls = CClause (map CPVar vs) [] body return $ CValueSign (CDef i cqt [cls])) @@ -1537,24 +1545,21 @@ mkArgPortTypes wire_info arg_ts = -- used in wrapper generate to wrap the module given by mk -- to the result. -genFromBody :: [(VPort, CType)] -> M.Map Id VFieldInfo -> - CExpr -> [Id] -> Id -> [FInf] -> GWMonad CExpr -genFromBody arg_pts vfield_map mk true_ifc_ids si fts = +genFromBody :: [(VPort, CType)] -> + CExpr -> [Id] -> Id -> Id -> [FInf] -> GWMonad CExpr +genFromBody arg_pts mk true_ifc_ids si ifcId fts = do -- traceM( "genFromBody: " ++ ppReadable fts ) let sty = cTCon si let pos = getIdPosition si - let mkMethod = mkFromBind vfield_map true_ifc_ids (CVar (id_t pos)) - (meths, ifc_ptss) <- mapAndUnzipM mkMethod fts - -- TODO: Save "port types" for clocks, resets, inouts here. - let -- interface save-port-type statements - -- XXX need to use the type class here - ifc_sptStmts = - map (uncurry (savePortTypeStmt (CVar id_x))) (concat ifc_ptss) - -- argument save-port-type statements - arg_sptStmts = + let mkMethod = mkFromBind true_ifc_ids (CVar (id_t pos)) + meths <- mapM mkMethod fts + -- interface save-port-type statements + ifc_sptStmts <- mkFieldSavePortTypeStmts (Just $ CVar id_x) ifcId fts + -- argument save-port-type statements + let arg_sptStmts = map (uncurry (savePortTypeStmt (CVar id_x))) arg_pts - sptStmts = arg_sptStmts ++ ifc_sptStmts + sptStmts = arg_sptStmts ++ map CMStmt ifc_sptStmts let tmpl = Cmodule pos $ [CMStmt $ CSBindT (CPVar (id_t pos)) Nothing [] (CQType [] sty) mk] ++ ((saveNameStmt (id_t pos) id_x):sptStmts) ++ @@ -1563,25 +1568,24 @@ genFromBody arg_pts vfield_map mk true_ifc_ids si fts = return tmpl --- Creates a method for the module body --- also returns the raw port-type information for correlation +-- Creates a method for the module body. -- XXX some of this can be replaced with a call to "mkFrom_" -- Currently there is an optimization preventing this - we avoid adding guards for -- ready signals that are known to be constant True, which isn't known when mkFrom_ is generated. -mkFromBind :: M.Map Id VFieldInfo -> [Id] -> CExpr -> FInf -> GWMonad (CDefl, [(VPort, CType)]) -mkFromBind vfield_map true_ifc_ids var ft = +mkFromBind :: [Id] -> CExpr -> FInf -> GWMonad CDefl +mkFromBind true_ifc_ids var ft = do ms <- meth noPrefixes ft - return (mkv ms, fth4 ms) + return $ mkv ms where - mkv (f, e, g, _) = CLValue (setInternal f) [CClause vps [] e'] g + mkv (f, e, g) = CLValue (setInternal f) [CClause vps [] e'] g where (vps, e') = unLams e -- This returns a triple of a field Id (method or subifc), -- its definition, and its implicit condition (only for methods). -- Note: The Id is qualified, because it could be something not -- imported by the user (and this not available unqualified). - meth :: IfcPrefixes -> FInf -> GWMonad (Id, CExpr, [CQual], [(VPort, CType)]) + meth :: IfcPrefixes -> FInf -> GWMonad (Id, CExpr, [CQual]) meth prefixes (FInf f as r aIds) = do mi <- chkInterface r @@ -1589,7 +1593,7 @@ mkFromBind vfield_map true_ifc_ids var ft = (Just (ti, _, fts), []) -> do newprefixes <- extendPrefixes prefixes [] r f fieldBlobs <- mapM (meth newprefixes) fts - return (f, cInterface ti (map fst3of4 fieldBlobs), [], concatMap fth4 fieldBlobs) + return (f, cInterface ti fieldBlobs, []) _ -> do isVec <- isVectorInterfaces r case (isVec, as) of @@ -1599,9 +1603,9 @@ mkFromBind vfield_map true_ifc_ids var ft = let recurse num = do newprefixes <- extendPrefixes prefixes [] r f meth newprefixes (FInf (mkNumId num) [] tVec []) fieldBlobs <- mapM recurse nums - let (es, gs) = unzip [(e,g) | (_, e, g, _) <- fieldBlobs] + let (es, gs) = unzip [(e,g) | (_, e, g) <- fieldBlobs] let vec = cToVector isListN es - return (f, vec, concat gs, concatMap fth4 fieldBlobs) + return (f, vec, concat gs) _ -> do isPA <- isPrimAction r isClock <- isClockType r @@ -1615,7 +1619,7 @@ mkFromBind vfield_map true_ifc_ids var ft = let qs = if (wbinf `elem` true_ifc_ids || isClock || isReset || isIot) then [] else [CQFilter meth_guard] let e = CApply (CVar id_fromWrapField) [sel binf] - return (f, e, qs, []) + return (f, e, qs) @@ -2143,6 +2147,47 @@ saveTopModPortTypeStmt i t = cVApply idSavePortType [mkMaybe Nothing, stringLiteralAt noPosition s, typeLiteral t] +-- saveFieldPortTypes v "prefix" ["arg1", "arg2"] "result" +mkFieldSavePortTypeStmts :: Maybe CExpr -> Id -> [FInf] -> GWMonad [CStmt] +mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes + where + meth :: IfcPrefixes -> FInf -> GWMonad [CStmt] + meth prefixes (FInf f as r aIds) = + do + mi <- chkInterface r + case (mi, as) of + (Just (ti, _, fts), []) -> do + newprefixes <- extendPrefixes prefixes [] r f + concatMapM (meth newprefixes) fts + _ -> do + isVec <- isVectorInterfaces r + case (isVec, as) of + (Just (n, tVec, isListN), []) -> do + let nums = [0..(n-1)] :: [Integer] + let recurse num = do newprefixes <- extendPrefixes prefixes [] r f + meth newprefixes (FInf (mkNumId num) [] tVec []) + concatMapM recurse nums + _ -> do + ciPrags <- getInterfaceFieldPrags ifcId f + let methodStr = getIdString f + currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix + localPrefix1 = fromMaybe (getIdString f) (lookupPrefixIfcPragma ciPrags) + localPrefix = joinStrings_ currentPre localPrefix1 + mResName = lookupResultIfcPragma ciPrags + resultName = case mResName of + Just str -> joinStrings_ currentPre str + Nothing -> joinStrings_ currentPre methodStr + + 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 id_saveFieldPortTypes + [proxy, mkMaybe v, prefix, arg_names, result]] + + saveNameStmt :: Id -> Id -> CMStmt saveNameStmt svName resultVar = CMStmt (CSletseq [(CLValue resultVar [CClause [] [] nameExpr]) []]) where nameExpr = cVApply idGetModuleName [cVApply idAsIfc [CVar svName]] @@ -2182,6 +2227,8 @@ 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/IExpand.hs b/src/comp/IExpand.hs index 196156f67..f6b98b8ed 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -21,7 +21,7 @@ import Data.List import Data.Maybe import Data.Foldable(foldrM) import Numeric(showIntAtBase) -import Data.Char(intToDigit, ord, chr, isDigit) +import Data.Char(intToDigit, ord, chr) import Control.Monad(when, foldM, zipWithM, mapAndUnzipM) import Control.Monad.Fix(mfix) --import Control.Monad.Fix @@ -1066,7 +1066,7 @@ iExpandMethodLam :: Id -> Integer -> [Id] -> HPred -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do - traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show ins) + -- traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show ins) let i' :: Id i' = mkId (getPosition i) $ mkFString $ head ins -- substitute argument with a modvar and replace with body diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index 7d723ab6e..e48c1cf66 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -236,10 +236,11 @@ idPolyWrapField = mk_no fsPolyWrapField idLiftModule :: Id idLiftModule = prelude_id_no fsLiftModule -idWrapField, id_fromWrapField, id_toWrapField :: Id +idWrapField, id_fromWrapField, id_toWrapField, id_saveFieldPortTypes :: Id idWrapField = prelude_id_no fsWrapField id_fromWrapField = prelude_id_no fsFromWrapField id_toWrapField = prelude_id_no fsToWrapField +id_saveFieldPortTypes = prelude_id_no fsSaveFieldPortTypes -- Used by desugaring id_lam, id_if, id_read, id_write :: Position -> Id diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index 9551162bd..41a8d1ba9 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -349,6 +349,7 @@ fsPolyWrapField = mkFString "val" fsWrapField = mkFString "WrapField" fsFromWrapField = mkFString "fromWrapField" fsToWrapField = mkFString "toWrapField" +fsSaveFieldPortTypes = mkFString "saveFieldPortTypes" -- XXX low ASCII only, please... sAcute = "__" From 0cad6463aa68b057e27cc645c7b5a55235d07531 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Aug 2024 15:38:11 -0700 Subject: [PATCH 08/89] Bug fixes --- src/Libraries/Base1/Prelude.bs | 24 ++++++++++++++---------- src/comp/GenWrap.hs | 12 ++++++------ 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index b70041128..cc417bd12 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -258,7 +258,8 @@ package Prelude( MetaConsNamed(..), MetaConsAnon(..), MetaField(..), Curry(..), AppendTuple(..), AppendTuple'(..), TupleSize(..), - WrapField(..), WrapMethod(..), WrapPorts(..), SplitPorts(..), + WrapField(..), WrapMethod(..), WrapPorts(..), + Port(..), SplitPorts(..), primMethod ) where @@ -4556,17 +4557,17 @@ class WrapPorts p pb | p -> pb where -- Save the port types, given their names. savePortTypes :: p -> Maybe Name__ -> List String -> Module () -instance (Bits a n, WrapPorts b bb) => WrapPorts (a, b) (Bit n, bb) where - packPorts (a, b) = (pack a, packPorts b) - unpackPorts (a, b) = (unpack a, unpackPorts b) +instance (Bits a n, WrapPorts b bb) => WrapPorts (Port a, b) (Bit n, bb) where + packPorts (Port a, b) = (pack a, packPorts b) + unpackPorts (a, b) = (Port $ unpack a, unpackPorts b) savePortTypes _ modName (Cons h t) = do primSavePortType modName h $ typeOf (_ :: a) savePortTypes (_ :: b) modName t savePortTypes _ _ Nil = error "savePortTypes: empty port names list" -instance (Bits a n) => WrapPorts a (Bit n) where - packPorts = pack - unpackPorts = unpack +instance (Bits a n) => WrapPorts (Port a) (Bit n) where + packPorts (Port a) = pack a + unpackPorts = Port ∘ unpack savePortTypes _ modName (Cons h _) = primSavePortType modName h $ typeOf (_ :: a) savePortTypes _ _ Nil = error "savePortTypes: empty port names list" @@ -4598,6 +4599,9 @@ class SplitPorts a p | a -> p where -- available in the Prelude. portNames :: a -> String -> List String +data Port a = Port a + deriving (FShow) + -- XXX if the default instance is the only one, then it gets inlined in CtxReduce -- and other instances for this class are ignored. instance SplitPorts () () where @@ -4605,9 +4609,9 @@ instance SplitPorts () () where unsplitPorts = id portNames _ _ = Nil -instance SplitPorts a a where - splitPorts = id - unsplitPorts = id +instance SplitPorts a (Port a) where + splitPorts = Port + unsplitPorts (Port a) = a portNames _ base = Cons base Nil {- diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 9c2e271b5..a0abee807 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1106,7 +1106,7 @@ genTo pps ty mk = _ -> do ciPrags <- getInterfaceFieldPrags ifcId f let currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix - localPrefix1 = fromMaybe (getIdString f) (lookupPrefixIfcPragma ciPrags) + localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) localPrefix = joinStrings_ currentPre localPrefix1 prefix = stringLiteralAt noPosition localPrefix arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] @@ -2121,7 +2121,6 @@ chkUserPragmas pps ifc = do -- ==================== -- Saving name/type information --- XXX is liftModule really needed for these? -- liftModule $ primSavePortType (Valid v) s t savePortTypeStmt :: CExpr -> (VName, b) -> CType -> CMStmt @@ -2169,9 +2168,9 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes concatMapM recurse nums _ -> do ciPrags <- getInterfaceFieldPrags ifcId f - let methodStr = getIdString f + let methodStr = getIdBaseString f currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix - localPrefix1 = fromMaybe (getIdString f) (lookupPrefixIfcPragma ciPrags) + localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) localPrefix = joinStrings_ currentPre localPrefix1 mResName = lookupResultIfcPragma ciPrags resultName = case mResName of @@ -2184,8 +2183,9 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes result = stringLiteralAt noPosition resultName return [ CSExpr Nothing $ - cVApply id_saveFieldPortTypes - [proxy, mkMaybe v, prefix, arg_names, result]] + cVApply idLiftModule $ + [cVApply id_saveFieldPortTypes + [proxy, mkMaybe v, prefix, arg_names, result]]] saveNameStmt :: Id -> Id -> CMStmt From ded14c256da9ff33621279f514bb491238672ccf Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Wed, 14 Aug 2024 14:00:42 -0700 Subject: [PATCH 09/89] Use WrapField to determine noinline foreign function types --- src/comp/CSyntax.hs | 9 ++-- src/comp/CVPrint.hs | 2 +- src/comp/GenBin.hs | 9 ++-- src/comp/GenFuncWrap.hs | 47 ++++--------------- src/comp/GenSign.hs | 4 +- src/comp/MakeSymTab.hs | 6 ++- src/comp/Parser/Classic/CParser.hs | 2 +- src/comp/Parser/Classic/Warnings.hs | 2 +- src/comp/bluetcl.hs | 2 +- ...ne_ArgNotInBits.bsv.bsc-vcomp-out.expected | 22 +++++---- ...ne_ResNotInBits.bsv.bsc-vcomp-out.expected | 27 +++++++---- testsuite/bsc.verilog/noinline/noinline.exp | 7 ++- 12 files changed, 64 insertions(+), 75 deletions(-) diff --git a/src/comp/CSyntax.hs b/src/comp/CSyntax.hs index 64d26342a..aec23f599 100644 --- a/src/comp/CSyntax.hs +++ b/src/comp/CSyntax.hs @@ -175,7 +175,8 @@ data CDefn | Cforeign { cforg_name :: Id, cforg_type :: CQType, cforg_foreign_name :: Maybe String, - cforg_ports :: Maybe ([String], [String]) } + cforg_ports :: Maybe ([String], [String]), + cforg_is_noinline :: Bool } | Cprimitive Id CQType | CprimType IdK | CPragma Pragma @@ -1131,8 +1132,10 @@ instance PPrint CDefn where (IdK i) -> ppConId d i (IdKind i k) -> ppConId d i <+> t "::" <+> pp d k (IdPKind i pk) -> ppConId d i <+> t "::" <+> pp d pk - pPrint d p (Cforeign i ty oname opnames) = - text "foreign" <+> ppVarId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> text ""; Just s -> text (" = " ++ show s)) <> (case opnames of Nothing -> text ""; Just (is, os) -> t"," <> pparen True (sep (map (text . show) is ++ po os))) + pPrint d p (Cforeign i ty oname opnames _) = + text "foreign" <+> ppVarId d i <+> t "::" <+> pp d ty <> + (case oname of Nothing -> text ""; Just s -> text (" = " ++ show s)) <> + (case opnames of Nothing -> text ""; Just (is, os) -> t"," <> pparen True (sep (map (text . show) is ++ po os))) where po [o] = [text ",", text (show o)] po os = [t"(" <> sepList (map (text . show) os) (t",") <> t ")"] pPrint d p (CIinstance i qt) = diff --git a/src/comp/CVPrint.hs b/src/comp/CVPrint.hs index 8f97ace07..100b93685 100644 --- a/src/comp/CVPrint.hs +++ b/src/comp/CVPrint.hs @@ -287,7 +287,7 @@ instance PVPrint CDefn where pvPrint d p (CprimType (IdKind i k)) = t"primitive type" <+> pp d i <+> t "::" <+> pp d k - pvPrint d p (Cforeign i ty oname opnames) = + pvPrint d p (Cforeign i ty oname opnames _) = text "foreign" <+> pvpId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> empty; Just s -> text (" = " ++ show s)) diff --git a/src/comp/GenBin.hs b/src/comp/GenBin.hs index e7dfe642d..1e9ca1162 100644 --- a/src/comp/GenBin.hs +++ b/src/comp/GenBin.hs @@ -27,7 +27,7 @@ doTrace = elem "-trace-genbin" progArgs -- .bo file tag -- change this whenever the .bo format changes -- See also GenABin.header header :: [Byte] -header = B.unpack $ TE.encodeUtf8 $ T.pack "bsc-bo-20230831-1" +header = B.unpack $ TE.encodeUtf8 $ T.pack "bsc-bo-20240814-1" genBinFile :: ErrorHandle -> String -> CSignature -> CSignature -> IPackage a -> IO () @@ -84,8 +84,8 @@ instance Bin CDefn where do putI 2; toBin vis; toBin st; toBin ik; toBin is; toBin fs writeBytes (Cclass incoh ps ik is deps fs) = do putI 3; toBin incoh; toBin ps; toBin ik; toBin is; toBin deps; toBin fs - writeBytes (Cforeign n cqt fn ports) = - do putI 4; toBin n; toBin cqt; toBin fn; toBin ports + writeBytes (Cforeign n cqt fn ports ni) = + do putI 4; toBin n; toBin cqt; toBin fn; toBin ports; toBin ni writeBytes (Cprimitive i cqt) = do putI 5; toBin i; toBin cqt writeBytes (CprimType ik) = do putI 6; toBin ik writeBytes (CIinstance i cqt) = do putI 7; toBin i; toBin cqt @@ -128,7 +128,8 @@ instance Bin CDefn where cqt <- fromBin fn <- fromBin ports <- fromBin - return (Cforeign n cqt fn ports) + ni <- fromBin + return (Cforeign n cqt fn ports ni) 5 -> do when doTrace $ traceM ("Cprimitive") i <- fromBin; cqt <- fromBin return (Cprimitive i cqt) diff --git a/src/comp/GenFuncWrap.hs b/src/comp/GenFuncWrap.hs index 1a33d6f27..ef173c822 100644 --- a/src/comp/GenFuncWrap.hs +++ b/src/comp/GenFuncWrap.hs @@ -9,14 +9,13 @@ import Error(internalError, ErrMsg(..), ErrorHandle, bsError) import Flags(Flags) import PPrint import Id -import PreIds(idBits, idUnpack, idPack, tmpVarIds, - idActionValue, idFromActionValue_) +import PreIds(id_fromWrapField, idActionValue) import CSyntax import SymTab import Scheme import Assump import Type(tModule, fn) -import CType(getArrows, cTVarNum) +import CType(getArrows, getRes) import Pred(expandSyn) import TypeCheck(cCtxReduceDef) import Subst(tv) @@ -241,48 +240,20 @@ addFuncWrap errh symt is (CPackage modid exps imps fixs ds includes) = do -- n = the number of arguments to the foreign function -- t = the base type of the foreign function funcDef :: ErrorHandle -> SymTab -> Id -> CQType -> Id -> Int -> CQType -> IO CDefn -funcDef errh symt i oqt@(CQType octxs ot) i_ n (CQType _ t) = - let - -- unfortunately, we have to duplicate the work that genwrap did - -- in creating the interface interface type and interface - -- conversion functions - - pos = getPosition i - (as, r) = getArrows ot - - -- the arguments are always bitifiable - bitsCtx a s = CPred (CTypeclass idBits) [a, s] - size_vars = map (cTVarNum . enumId "sn" pos) [0..] - as_ctxs = zipWith bitsCtx as size_vars - - vs = map (setIdPosition pos) $ take n tmpVarIds - epack e = cVApply idPack [e] - es = map (epack . CVar) vs - - f_expr = cVApply i_ es - +funcDef errh symt i oqt@(CQType _ ot) i_ n (CQType _ t) = + let pos = getPosition i + r = getRes ot -- the result is either an actionvalue or a value isAV = isActionValue symt r - r_size_var = cTVarNum $ enumId "sn" pos n - r_ctxs = case (isAV) of - Just av_t -> [bitsCtx av_t r_size_var] - Nothing -> [bitsCtx r r_size_var] - - expr = if (isJust isAV) - then cVApply idFromActionValue_ [f_expr] - else cVApply idUnpack [f_expr] - - -- put the ctxs together - ctxs' = as_ctxs ++ r_ctxs ++ octxs - qt' = CQType ctxs' ot + expr = cVApply id_fromWrapField [CVar i_] in -- XXX this code works for Action/ActionValue foreign funcs, -- XXX but they are not handled by astate yet if (isJust isAV) - then bsError errh [(getPosition i, ENoInlineAction (getIdBaseString i))] + then bsError errh [(pos, ENoInlineAction (getIdBaseString i))] else return $ - CValueSign (CDef i qt' [CClause (map CPVar vs) [] expr]) + CValueSign (CDef i oqt [CClause [] [] expr]) -- --------------- @@ -304,7 +275,7 @@ funcDef_ mi i i_ qt_ args = -- output port: oport = getIdString i in - Cforeign i_ qt_ (Just mstr) (Just (iports, [oport])) + Cforeign i_ qt_ (Just mstr) (Just (iports, [oport])) True -- --------------- diff --git a/src/comp/GenSign.hs b/src/comp/GenSign.hs index cf4c54b9a..0161e839f 100644 --- a/src/comp/GenSign.hs +++ b/src/comp/GenSign.hs @@ -407,11 +407,11 @@ genDefSign s look currentPkg (CValueSign (CDef i qt _)) = in case look qi of Nothing -> [] Just _ -> [(CIValueSign qi (qualCQType s qt), [])] -genDefSign s look currentPkg (Cforeign i qt ms mps) = +genDefSign s look currentPkg (Cforeign i qt ms mps ni) = let qi = qualId currentPkg i in case look qi of Nothing -> [] - Just _ -> [(Cforeign qi (qualCQType s qt) ms mps, [])] + Just _ -> [(Cforeign qi (qualCQType s qt) ms mps ni, [])] genDefSign s look currentPkg (Cprimitive i qt) = let qi = qualId currentPkg i in case look qi of diff --git a/src/comp/MakeSymTab.hs b/src/comp/MakeSymTab.hs index 51d9d21c3..39ef7bc4f 100644 --- a/src/comp/MakeSymTab.hs +++ b/src/comp/MakeSymTab.hs @@ -602,7 +602,7 @@ chkTopDef r mi isDep (Cprimitive i ct) = do chkTopDef r mi isDep (CIValueSign i ct) = do sc <- mkSchemeWithSymTab r ct return [(i, VarInfo VarDefn (i :>: sc) (isDep i))] -chkTopDef r mi isDep (Cforeign i qt on ops) = do +chkTopDef r mi isDep (Cforeign i qt on ops ni) = do sc@(Forall _ (_ :=> t)) <- mkSchemeWithSymTab r qt let name = case on of Just s -> s @@ -622,7 +622,9 @@ chkTopDef r mi isDep (Cforeign i qt on ops) = do in (all isGoodArg args) && (isGoodResult res) let i' = qual mi i - if isGoodType (expandSyn t) then + -- This check is skipped for noinline-created foreign functions, since their type is + -- determined by the WrapField type class, and a bad foreign type will raise an error in typecheck. + if ni || isGoodType (expandSyn t) then return [(i', VarInfo (VarForg name ops) (i' :>: sc) (isDep i))] else throwError (getPosition i, EForeignNotBit (pfpString i) (pfpString t)) diff --git a/src/comp/Parser/Classic/CParser.hs b/src/comp/Parser/Classic/CParser.hs index 6b2173425..98f0dccac 100644 --- a/src/comp/Parser/Classic/CParser.hs +++ b/src/comp/Parser/Classic/CParser.hs @@ -406,7 +406,7 @@ pVarDefn = (pVarId +.+ dc ..+ pQType +.. dsm `into` \(var, typ) -> pClauses1 v pTyDefn :: Bool -> CParser CDefn pTyDefn b = l L_foreign ..+ pVarId +.+ dc ..+ pQType +.+ opt (eq ..+ pString) +.+ opt (cm ..+ lp ..+ many pString +.+ pForeignRes +.. rp) - >>>>> Cforeign + >>>>> (\ i qt on ops -> Cforeign i qt on ops True) ||! l L_primitive ..+ pVarId +.+ dc ..+ pQType >>> Cprimitive -- ||! l L_primitive ..+ l L_class ..+ pPreds +.+ pTyConIdK +.+ many pTyVarId +.+ pFunDeps >>>>> CprimClass ||! l L_primitive ..+ l L_type ..+ pTyConId +.+ dc ..+ pKind >>- (\ (i, k) -> CprimType (IdKind i k)) diff --git a/src/comp/Parser/Classic/Warnings.hs b/src/comp/Parser/Classic/Warnings.hs index 7f68511da..ea0b447d5 100644 --- a/src/comp/Parser/Classic/Warnings.hs +++ b/src/comp/Parser/Classic/Warnings.hs @@ -32,7 +32,7 @@ classicWarnings (CPackage _ _ _ _ ds _) = concatMap getWarnings ds getBound (CValue i _) = [i] getBound (CValueSign (CDef i _ _)) = [i] getBound (CValueSign (CDefT i _ _ _)) = [i] - getBound (Cforeign i _ _ _) = [i] + getBound (Cforeign i _ _ _ _) = [i] getBound (Cprimitive i _) = [i] getBound (CprimType {}) = [] getBound (CPragma {}) = [] diff --git a/src/comp/bluetcl.hs b/src/comp/bluetcl.hs index 185545a3d..3edca23b7 100644 --- a/src/comp/bluetcl.hs +++ b/src/comp/bluetcl.hs @@ -826,7 +826,7 @@ tclDefs xs = internalError $ "tclDefs: grammar mismatch: " ++ (show xs) -- XXX the argument names and we could display them. displayCDefn :: CDefn -> [HTclObj] displayCDefn (CIValueSign i cqt) = [displayTypeSignature i cqt] -displayCDefn (Cforeign i cqt _ _) = [displayTypeSignature i cqt] +displayCDefn (Cforeign i cqt _ _ _) = [displayTypeSignature i cqt] displayCDefn (Cprimitive i cqt) = [displayTypeSignature i cqt] displayCDefn (CValue i _) = internalError ("displayCDefn: unexpected CValue: " ++ ppReadable i) 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 06ba4d213..727783b2d 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 @@ -1,11 +1,15 @@ checking package dependencies compiling NoInline_ArgNotInBits.bsv -code generation for module_fnNoInline_ArgNotInBits starts -Error: "NoInline_ArgNotInBits.bsv", line 4, column 15: (T0043) - Cannot synthesize `module_fnNoInline_ArgNotInBits': The interface method - `fnNoInline_ArgNotInBits' uses type `NoInline_ArgNotInBits::L' which is not - in the Bits class. - During elaboration of the interface method `fnNoInline_ArgNotInBits' at - "NoInline_ArgNotInBits.bsv", line 4, column 15. - During elaboration of `module_fnNoInline_ArgNotInBits' at - "NoInline_ArgNotInBits.bsv", line 4, column 15. +Error: Unknown position: (T0031) + The provisos for this expression could not be resolved because there are no + instances of the form: + Bits#(NoInline_ArgNotInBits::L, a__) + 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: (T0032) + This expression requires the following proviso which could not be resolved: + WrapField#(function Bool f(NoInline_ArgNotInBits::L x1), a__) + An instance for this proviso exists, but it depends on the following + provisos for which there are no instances: + Curry#(function Bit#(1) f(Bit#(b__) x1), a__), + Bits#(NoInline_ArgNotInBits::L, b__) 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 02d3fb3c6..75030a887 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 @@ -1,11 +1,20 @@ checking package dependencies compiling NoInline_ResNotInBits.bsv -code generation for module_fnNoInline_ResNotInBits starts -Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0043) - Cannot synthesize `module_fnNoInline_ResNotInBits': The interface method - `fnNoInline_ResNotInBits' uses type `NoInline_ResNotInBits::L' which is not - in the Bits class. - During elaboration of the interface method `fnNoInline_ResNotInBits' at - "NoInline_ResNotInBits.bsv", line 4, column 12. - During elaboration of `module_fnNoInline_ResNotInBits' at - "NoInline_ResNotInBits.bsv", line 4, column 12. +Error: Unknown position: (T0031) + The provisos for this expression could not be resolved because there are no + instances of the form: + Bits#(NoInline_ResNotInBits::L, a__) + 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: (T0032) + This expression requires the following proviso which could not be resolved: + WrapField#(function NoInline_ResNotInBits::L f(Bool x1), a__) + An instance for this proviso exists, but it depends on the following proviso + for which there is no instance: + Bits#(NoInline_ResNotInBits::L, b__) +Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0029) + Signature mismatch (given too general): + given: + function b__ f(Bit#(1) x1) provisos (Bits#(NoInline_ResNotInBits::L, a__)) + deduced: + function Bit#(c__) f(Bit#(1) x1) provisos (Bits#(NoInline_ResNotInBits::L, c__)) diff --git a/testsuite/bsc.verilog/noinline/noinline.exp b/testsuite/bsc.verilog/noinline/noinline.exp index 78b24f4a2..598f7c411 100644 --- a/testsuite/bsc.verilog/noinline/noinline.exp +++ b/testsuite/bsc.verilog/noinline/noinline.exp @@ -44,8 +44,7 @@ test_c_veri_bsv_modules \ # The typedef fails because BSC doesn't expand the synonym before checking # to see if the result type is in Bits, so the user gets a proviso error # (bug 1466) -compile_verilog_pass_bug_error \ - NoInline_LessPatternsThanArgs_BSV_TypeDef.bsv T0031 +compile_verilog_pass NoInline_LessPatternsThanArgs_BSV_TypeDef.bsv # ----- @@ -60,11 +59,11 @@ test_c_veri_bsv_modules NoInlineInSched {module_inv} if { $vtest == 1 } { -compile_verilog_fail_error NoInline_ArgNotInBits.bsv T0043 +compile_verilog_fail_error NoInline_ArgNotInBits.bsv T0031 # compare for good measure, since the error has a configurable string compare_file NoInline_ArgNotInBits.bsv.bsc-vcomp-out -compile_verilog_fail_error NoInline_ResNotInBits.bsv T0043 +compile_verilog_fail_error NoInline_ResNotInBits.bsv T0031 # compare for good measure, since the error has a configurable string compare_file NoInline_ResNotInBits.bsv.bsc-vcomp-out From 3fbc8f2c54ba897cef2eb50378d732efc51ef7d4 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Wed, 14 Aug 2024 16:23:06 -0700 Subject: [PATCH 10/89] Cleanup, add DeepSplitPorts type class --- src/Libraries/Base1/Prelude.bs | 186 +++++++++++++++++++++++---------- src/Libraries/Base1/Vector.bs | 14 +++ 2 files changed, 142 insertions(+), 58 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index cc417bd12..782b345bb 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -95,7 +95,7 @@ package Prelude( primCharToString, primUIntBitsToInteger, primIntBitsToInteger, - ($), (∘), id, const, constFn, flip, while, curry, uncurry, asTypeOf, + ($), (∘), id, const, constFn, flip, while, curry, uncurry, Curry(..), asTypeOf, liftM, liftM2, bindM, (<+>), rJoin, @@ -172,6 +172,7 @@ package Prelude( Tuple6, tuple6, Has_tpl_6(..), Tuple7, tuple7, Has_tpl_7(..), Tuple8, tuple8, Has_tpl_8(..), + AppendTuple(..), AppendTuple'(..), TupleSize(..), -- lists required for desugaring List(..), @@ -257,10 +258,9 @@ package Prelude( NumConArg(..), StarConArg(..), OtherConArg(..), MetaConsNamed(..), MetaConsAnon(..), MetaField(..), - Curry(..), AppendTuple(..), AppendTuple'(..), TupleSize(..), - WrapField(..), WrapMethod(..), WrapPorts(..), + primMethod, WrapField(..), WrapMethod(..), WrapPorts(..), Port(..), SplitPorts(..), - primMethod + DeepSplit(..), DeepSplitPorts(..), DeepSplitPorts'(..), DeepSplitPorts''(..) ) where infixr 0 $ @@ -2600,6 +2600,23 @@ curry f x y = f (x, y) uncurry :: (a -> b -> c) -> ((a, b) -> c) uncurry f (x, y) = f x y +-- Polymorphic, N-argument version of curry/uncurry +class Curry f g | f -> g where + curryN :: f -> g + uncurryN :: g -> f + +instance (Curry (b -> c) d) => Curry ((a, b) -> c) (a -> d) where + curryN f x = curryN $ \y -> f (x, y) + uncurryN f (x, y) = uncurryN (f x) y + +instance Curry (() -> a) a where + curryN f = f () + uncurryN f _ = f + +instance Curry (a -> b) (a -> b) where + curryN = id + uncurryN = id + --@ Constant function --@ \index{const@\te{const} (Prelude function)} --@ \begin{libverbatim} @@ -3389,6 +3406,43 @@ tuple7 a b c d e f g = (a,b,c,d,e,f,g) tuple8 :: a -> b -> c -> d -> e -> f -> g -> h -> Tuple8 a b c d e f g h tuple8 a b c d e f g h = (a,b,c,d,e,f,g,h) +class AppendTuple a b c | a b -> c where + appendTuple :: a -> b -> c + splitTuple :: c -> (a, b) + +instance AppendTuple a () a where + appendTuple x _ = x + splitTuple x = (x, ()) + +-- The above instance should take precedence over the other cases that assume +-- b is non-unit. To avoid overlapping instances, the below are factored out as +-- a seperate type class: +instance (AppendTuple' a b c) => AppendTuple a b c where + appendTuple = appendTuple' + splitTuple = splitTuple' + +class AppendTuple' a b c | a b -> c where + appendTuple' :: a -> b -> c + splitTuple' :: c -> (a, b) + +instance AppendTuple' () a a where + appendTuple' _ = id + splitTuple' x = ((), x) + +instance AppendTuple' a b (a, b) where + appendTuple' a b = (a, b) + splitTuple' = id + +instance (AppendTuple' a b c) => AppendTuple' (h, a) b (h, c) where + appendTuple' (x, y) z = (x, appendTuple' y z) + splitTuple' (x, y) = case splitTuple' y of + (w, z) -> ((x, w), z) + +class TupleSize a n | a -> n where {} +instance TupleSize () 0 where {} +instance TupleSize a 1 where {} +instance (TupleSize b n) => TupleSize (a, b) (TAdd n 1) where {} + -- FUNCTIONS TO REPLACE UNAVAILABLE INFIXES compose :: (b -> c) -> (a -> b) -> (a -> c) @@ -4393,51 +4447,6 @@ data (MetaField :: $ -> # -> *) name idx = MetaField deriving (FShow) -class Curry f g | f -> g where - curryN :: f -> g - uncurryN :: g -> f - -instance (Curry (b -> c) d) => Curry ((a, b) -> c) (a -> d) where - curryN f x = curryN $ \y -> f (x, y) - uncurryN f (x, y) = uncurryN (f x) y - -instance Curry (() -> a) a where - curryN f = f () - uncurryN f _ = f - -instance Curry (a -> b) (a -> b) where - curryN = id - uncurryN = id - -class AppendTuple a b c | a b -> c where - appendTuple :: a -> b -> c - -instance AppendTuple a () a where - appendTuple x _ = x - --- The above instance should take precedence over the other cases that assume --- b is non-unit. To avoid overlapping instances, the below are factored out as --- a seperate type class: -instance (AppendTuple' a b c) => AppendTuple a b c where - appendTuple = appendTuple' - -class AppendTuple' a b c | a b -> c where - appendTuple' :: a -> b -> c - -instance AppendTuple' () a a where - appendTuple' _ = id - -instance AppendTuple' a b (a, b) where - appendTuple' a b = (a, b) - -instance (AppendTuple' a b c) => AppendTuple' (h, a) b (h, c) where - appendTuple' (x, y) z = (x, appendTuple' y z) - -class TupleSize a n | a -> n where {} -instance TupleSize () 0 where {} -instance TupleSize a 1 where {} -instance (TupleSize b n) => TupleSize (a, b) (TAdd n 1) where {} - -- Tag a method with metadata. -- Currently just the list of input port names. -- Should eventually include the output port names, when we support multiple output ports. @@ -4614,12 +4623,73 @@ instance SplitPorts a (Port a) where unsplitPorts (Port a) = a portNames _ base = Cons base Nil -{- -instance WrapPorts (Vector 0 a) () where - toPorts _ = () - fromPorts _ = nil - -instance (Add n1 1 n, WrapPorts a p1, WrapPorts (Vector n1 a) p2, AppendTuple p1 p2 p) => - WrapPorts (Vector n a) p where - toPorts v = appendTuple (toPorts $ head v) (toPorts $ tail v) --} \ No newline at end of file +-- Newtype tag to indicate that a type should be recursively split into ports +data DeepSplit a = DeepSplit a + +instance (DeepSplitPorts a p) => SplitPorts (DeepSplit a) p where + splitPorts (DeepSplit x) = deepSplitPorts x + unsplitPorts = DeepSplit ∘ deepUnsplitPorts + portNames _ = deepSplitPortNames (_ :: a) + + +-- Helper class using generics, to recursively split structs and vectors into a tuple of ports. +class DeepSplitPorts a p | a -> p where + deepSplitPorts :: a -> p + deepUnsplitPorts :: p -> a + deepSplitPortNames :: a -> String -> List String + +instance (Generic a r, DeepSplitPorts' r a p) => + DeepSplitPorts a p where + deepSplitPorts = deepSplitPorts' (_ :: r) + deepUnsplitPorts = deepUnsplitPorts' (_ :: r) + deepSplitPortNames = deepSplitPortNames' (_ :: r) + +class DeepSplitPorts' r a p | r a -> p where + deepSplitPorts' :: r -> a -> p + deepUnsplitPorts' :: r -> p -> a + deepSplitPortNames' :: r -> a -> String -> List String + +instance (SplitPorts a p) => DeepSplitPorts' r a p where + deepSplitPorts' _ = splitPorts + deepUnsplitPorts' _ = unsplitPorts + deepSplitPortNames' _ = portNames + +instance (Generic a r, DeepSplitPorts'' r p) => DeepSplitPorts' (Meta (MetaData name pkg args 1) r') a p where + deepSplitPorts' _ = deepSplitPorts'' ∘ from + deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' + deepSplitPortNames' _ _ = deepSplitPortNames'' (_ :: r) + +class DeepSplitPorts'' r p | r -> p where + deepSplitPorts'' :: r -> p + deepUnsplitPorts'' :: p -> r + deepSplitPortNames'' :: r -> String -> List String + +instance (DeepSplitPorts'' a p, DeepSplitPorts'' b q, AppendTuple p q r) => DeepSplitPorts'' (a, b) r where + deepSplitPorts'' (a, b) = deepSplitPorts'' a `appendTuple` deepSplitPorts'' b + deepUnsplitPorts'' x = case splitTuple x of + (a, b) -> (deepUnsplitPorts'' a, deepUnsplitPorts'' b) + deepSplitPortNames'' _ base = + deepSplitPortNames'' (_ :: a) base `listPrimAppend` deepSplitPortNames'' (_ :: b) base + +instance DeepSplitPorts'' () () where + deepSplitPorts'' _ = () + deepUnsplitPorts'' _ = () + deepSplitPortNames'' _ _ = Nil + +instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r) p where + deepSplitPorts'' (Meta x) = deepSplitPorts'' x + deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' + deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ + if stringHead (stringOf name) == '_' + then base +++ stringOf name + else base +++ "_" +++ stringOf name + +instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta m r) p where + deepSplitPorts'' (Meta x) = deepSplitPorts'' x + deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' + deepSplitPortNames'' _ = deepSplitPortNames'' (_ :: r) + +instance (DeepSplitPorts a p) => DeepSplitPorts'' (Conc a) p where + deepSplitPorts'' (Conc x) = deepSplitPorts x + deepUnsplitPorts'' = Conc ∘ deepUnsplitPorts + deepSplitPortNames'' _ = deepSplitPortNames (_ :: a) diff --git a/src/Libraries/Base1/Vector.bs b/src/Libraries/Base1/Vector.bs index 70d410993..6006abd41 100644 --- a/src/Libraries/Base1/Vector.bs +++ b/src/Libraries/Base1/Vector.bs @@ -1362,3 +1362,17 @@ instance (PrimMakeUninitialized'' r) => PrimMakeUninitialized'' (Vector n r) whe instance (PrimDeepSeqCond' r) => PrimDeepSeqCond' (Vector n r) where primDeepSeqCond' = flip $ foldr primDeepSeqCond' + +instance DeepSplitPorts'' (Vector 0 r) () where + deepSplitPorts'' _ = () + deepUnsplitPorts'' _ = nil + deepSplitPortNames'' _ _ = Nil + +instance (DeepSplitPorts'' r p1, Add n1 1 n, DeepSplitPorts'' (Vector n1 r) p2, AppendTuple p1 p2 p) => + DeepSplitPorts'' (Vector n r) p where + deepSplitPorts'' v = deepSplitPorts'' (head v) `appendTuple` deepSplitPorts'' (tail v) + deepUnsplitPorts'' x = case splitTuple x of + (y, z) -> deepUnsplitPorts'' y :> deepUnsplitPorts'' z + deepSplitPortNames'' _ base = + let genElem i = deepSplitPortNames'' (_ :: r) (base +++ "_" +++ integerToString i) + in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) From 8cb4473015d31a4b617747ed596eed2e3695dfdd Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 11:18:50 -0700 Subject: [PATCH 11/89] Add primMethod wrapper prim calls in vMkRWire1 --- src/Libraries/Base1/PreludeBSV.bsv | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Libraries/Base1/PreludeBSV.bsv b/src/Libraries/Base1/PreludeBSV.bsv index ccbc4dd53..5f1e5e73b 100644 --- a/src/Libraries/Base1/PreludeBSV.bsv +++ b/src/Libraries/Base1/PreludeBSV.bsv @@ -89,15 +89,17 @@ interface VRWireN#(numeric type n); endinterface // for addCFWire desugaring +// This uses prim types like something coming from genwrap. module vMkRWire1(VRWireN#(1)); (* hide *) VRWire#(Bit#(1)) _rw <- vMkRWire; - method wset(v); - return(toPrimAction(_rw.wset(v))); - endmethod - method wget = _rw.wget; - method whas = pack(_rw.whas); + function rw_wset(v); + return toPrimAction(_rw.wset(v)); + endfunction + method wset = primMethod(Cons("v", Nil), rw_wset); + method wget = primMethod(Nil, _rw.wget); + method whas = primMethod(Nil, pack(_rw.whas)); endmodule From 7f2e12e36a7929d7b6f58be30401882a9b5e2ee9 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 11:59:07 -0700 Subject: [PATCH 12/89] Update expected test output --- .../urgency/IfcIfcWarning.bsv.bsc-sched-out.expected | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected b/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected index 27c0fa197..9644c77f8 100644 --- a/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected +++ b/testsuite/bsc.scheduler/urgency/IfcIfcWarning.bsv.bsc-sched-out.expected @@ -8,7 +8,8 @@ order: [bar, baz] ----- === resources: -[(the_r.read, [(the_r.read, 1)]), (the_r.write, [(the_r.write x__h69, 1), (the_r.write x__h85, 1)])] +[(the_r.read, [(the_r.read, 1)]), + (the_r.write, [(the_r.write x__h108, 1), (the_r.write x__h134, 1)])] ----- From d095b930e9e1806d0b9843df616ff04798b820a9 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 14:18:13 -0700 Subject: [PATCH 13/89] Re-add module arg port type saving, still need to do port name conflict checking --- src/comp/GenWrap.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index a0abee807..48bdb61c5 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1327,11 +1327,11 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = ftps <- mapM collectIfcInfo (reverse cfields) -- get back the arg port to type mapping, for recording flgs <- getFlags - -- XXX Need to handle module arguments here. -- XXX Need to sanity check port names after elaboration. -- arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps - let arg_pts = [] - + let arg_pts = + [ (pid,pt) | (pid,pt,Simple {}) <- vtis, not $ isParamModArg vps pid || pt == tClock && pt == tReset ] ++ + [ (pid,pt) | (_,_,Vector _ _ _ ais) <- vtis, (pid,pt) <- concatMap extractVTPairs ais ] let arg_infos = thd $ unzip3 vtis (vs, ts) = unzip $ concatMap extractVTPairs arg_infos From 3b8b9b563d91778c33affd5df31feaf6c5c1e957 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 14:23:10 -0700 Subject: [PATCH 14/89] Fix saving Inout port types --- src/Libraries/Base1/Prelude.bs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 782b345bb..b3e4342cc 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4491,7 +4491,7 @@ instance WrapField Reset Reset where instance (Bits a n) => WrapField (Inout a) (Inout_ n) where toWrapField _ _ = primInoutCast0 fromWrapField = primInoutUncast0 - saveFieldPortTypes _ modName _ _ result = primSavePortType modName result $ typeOf (_ :: a) + 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. From 2c263393f5cd1fcce664d6023d4dbca759ac7ebb Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 14:26:05 -0700 Subject: [PATCH 15/89] Update test expected output --- .../bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected index 576752ed7..d8b638257 100644 --- a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected @@ -55,9 +55,9 @@ PreludeBSV vMkCRegA5 PreludeBSV mkCReg PreludeBSV mkCRegU PreludeBSV mkCRegA -PreludeBSV _PreludeBSV.CReg5713 -PreludeBSV _PreludeBSV.CReg5809 -PreludeBSV _PreludeBSV.CReg5904 +PreludeBSV _PreludeBSV.CReg5714 +PreludeBSV _PreludeBSV.CReg5810 +PreludeBSV _PreludeBSV.CReg5905 Prelude Reg Prelude VReg Prelude vMkReg From 7fc11e998f5a00692dac6e3c45985fffcfc82348 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 15:14:06 -0700 Subject: [PATCH 16/89] Update expected test output --- .../bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected | 4 ++-- .../bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected b/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected index 07eff2906..0ed61ea89 100644 --- a/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected @@ -1,9 +1,9 @@ checking package dependencies compiling TestCReg_TooBig.bsv code generation for sysTestCReg_TooBig starts -Error: "PreludeBSV.bsv", line 1002, column 37: (S0015) +Error: "PreludeBSV.bsv", line 1003, column 37: (S0015) Bluespec evaluation-time error: `mkCReg' cannot have more than five ports - During elaboration of `error' at "PreludeBSV.bsv", line 1002, column 13. + During elaboration of `error' at "PreludeBSV.bsv", line 1003, column 13. During elaboration of `rg' at "TestCReg_TooBig.bsv", line 5, column 19. During elaboration of `sysTestCReg_TooBig' at "TestCReg_TooBig.bsv", line 3, column 8. diff --git a/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected b/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected index 3cdcc1c3f..c846601a5 100644 --- a/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected @@ -1,10 +1,10 @@ checking package dependencies compiling TestCReg_TooSmall.bsv code generation for sysTestCReg_TooSmall starts -Error: "PreludeBSV.bsv", line 1003, column 37: (S0015) +Error: "PreludeBSV.bsv", line 1004, column 37: (S0015) Bluespec evaluation-time error: `mkCReg' cannot have a negative number of ports - During elaboration of `error' at "PreludeBSV.bsv", line 1003, column 13. + During elaboration of `error' at "PreludeBSV.bsv", line 1004, column 13. During elaboration of `rg' at "TestCReg_TooSmall.bsv", line 5, column 19. During elaboration of `sysTestCReg_TooSmall' at "TestCReg_TooSmall.bsv", line 3, column 8. From 46fd375dfc41fe1b8e4a07e9c03e0d295698d50b Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 19:36:41 -0700 Subject: [PATCH 17/89] Fix prefix computation in genwrap 'to' function and port saving statement construction --- src/comp/GenWrap.hs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 48bdb61c5..6a3bd6e52 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1075,17 +1075,18 @@ genTo pps ty mk = return tmpl where meth :: CExpr -> IfcPrefixes -> Id -> FInf -> GWMonad [CDefl] - meth sel prefixes ifcId (FInf f as r aIds) = + meth sel prefixes ifcIdIn (FInf f as r aIds) = do + ciPrags <- getInterfaceFieldPrags ifcIdIn f {- f should be qualifed -} mi <- chkInterface r case (mi, as) of - (Just (_, _, fts), []) -> do + (Just (ifcId, _, fts), []) -> do isAV <- isActionValue r if isAV then internalError "genTo 2: unexpected AV" else do --traceM ("selector: " ++ show sel) - newPrefixes <- extendPrefixes prefixes [] r f + newPrefixes <- extendPrefixes prefixes ciPrags r f meths <- mapM (meth (extSel sel f) newPrefixes ifcId) fts return (concat meths) _ -> do -- Generate the Verilog template for X @@ -1097,14 +1098,13 @@ genTo pps ty mk = let primselect = idPrimSelectFn noPosition let lit k = CLit $ num_to_cliteral_at noPosition k let selector n = cVApply primselect [posLiteral noPosition, extSel sel f, lit n] - elemPrefix <- extendPrefixes prefixes [] r f + elemPrefix <- extendPrefixes prefixes ciPrags r f let recurse num = do - numPrefix <- extendPrefixes elemPrefix [] r (mkNumId num) - meth (selector num) numPrefix ifcId (FInf idEmpty [] tVec []) + numPrefix <- extendPrefixes elemPrefix ciPrags r (mkNumId num) + meth (selector num) numPrefix ifcIdIn (FInf idEmpty [] tVec []) fields <- mapM recurse nums return (concat fields) _ -> do - ciPrags <- getInterfaceFieldPrags ifcId f let currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) localPrefix = joinStrings_ currentPre localPrefix1 @@ -2148,26 +2148,26 @@ saveTopModPortTypeStmt i t = -- saveFieldPortTypes v "prefix" ["arg1", "arg2"] "result" mkFieldSavePortTypeStmts :: Maybe CExpr -> Id -> [FInf] -> GWMonad [CStmt] -mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes +mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId where - meth :: IfcPrefixes -> FInf -> GWMonad [CStmt] - meth prefixes (FInf f as r aIds) = + meth :: IfcPrefixes -> Id -> FInf -> GWMonad [CStmt] + meth prefixes ifcIdIn (FInf f as r aIds) = do + ciPrags <- getInterfaceFieldPrags ifcIdIn f mi <- chkInterface r case (mi, as) of (Just (ti, _, fts), []) -> do - newprefixes <- extendPrefixes prefixes [] r f - concatMapM (meth newprefixes) fts + newprefixes <- extendPrefixes prefixes ciPrags r f + concatMapM (meth newprefixes ti) fts _ -> do isVec <- isVectorInterfaces r case (isVec, as) of (Just (n, tVec, isListN), []) -> do let nums = [0..(n-1)] :: [Integer] - let recurse num = do newprefixes <- extendPrefixes prefixes [] r f - meth newprefixes (FInf (mkNumId num) [] tVec []) + let recurse num = do newprefixes <- extendPrefixes prefixes ciPrags r f + meth newprefixes ifcIdIn (FInf (mkNumId num) [] tVec []) concatMapM recurse nums _ -> do - ciPrags <- getInterfaceFieldPrags ifcId f let methodStr = getIdBaseString f currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) @@ -2177,7 +2177,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes Just str -> joinStrings_ currentPre str Nothing -> joinStrings_ currentPre methodStr - proxy = mkProxy $ foldr arrow r as + let proxy = mkProxy $ foldr arrow r as prefix = stringLiteralAt noPosition localPrefix arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] result = stringLiteralAt noPosition resultName From 9ad861d8b2d6945996512e54476bb7254658a89c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Aug 2024 19:36:58 -0700 Subject: [PATCH 18/89] Fix inadvertantly disabled type check for foreign functions --- src/comp/Parser/Classic/CParser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/comp/Parser/Classic/CParser.hs b/src/comp/Parser/Classic/CParser.hs index 98f0dccac..6e37b20b6 100644 --- a/src/comp/Parser/Classic/CParser.hs +++ b/src/comp/Parser/Classic/CParser.hs @@ -406,7 +406,7 @@ pVarDefn = (pVarId +.+ dc ..+ pQType +.. dsm `into` \(var, typ) -> pClauses1 v pTyDefn :: Bool -> CParser CDefn pTyDefn b = l L_foreign ..+ pVarId +.+ dc ..+ pQType +.+ opt (eq ..+ pString) +.+ opt (cm ..+ lp ..+ many pString +.+ pForeignRes +.. rp) - >>>>> (\ i qt on ops -> Cforeign i qt on ops True) + >>>>> (\ i qt on ops -> Cforeign i qt on ops False) ||! l L_primitive ..+ pVarId +.+ dc ..+ pQType >>> Cprimitive -- ||! l L_primitive ..+ l L_class ..+ pPreds +.+ pTyConIdK +.+ many pTyVarId +.+ pFunDeps >>>>> CprimClass ||! l L_primitive ..+ l L_type ..+ pTyConId +.+ dc ..+ pKind >>- (\ (i, k) -> CprimType (IdKind i k)) From 46bfafe0097a06bb23f8d858b099e102669b8480 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 18:45:21 -0700 Subject: [PATCH 19/89] Add interface port name sanity checking after elaboration --- src/comp/GenWrap.hs | 6 +- src/comp/IExpand.hs | 4 + src/comp/IExpandUtils.hs | 86 +++++++++- src/comp/IfcBetterInfo.hs | 3 - src/comp/PragmaCheck.hs | 148 +----------------- src/comp/VModInfo.hs | 2 +- .../conflicts/clock/ClockEnable.bsv | 2 + .../conflicts/clock/ClockResult.bsv | 2 + .../conflicts/clock/GateEnable.bsv | 2 + .../conflicts/modarg/ModargClock.bsv | 1 + .../conflicts/modarg/ModargGate.bsv | 1 + .../conflicts/modarg/ModargReset.bsv | 1 + .../conflicts/modparam/ModparamClock.bsv | 1 + .../conflicts/modparam/ModparamGate.bsv | 1 + .../conflicts/modparam/ModparamReset.bsv | 1 + 15 files changed, 110 insertions(+), 151 deletions(-) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 6a3bd6e52..befae7e8e 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1327,11 +1327,7 @@ mkNewModDef genIfcMap (def@(CDef i (CQType _ t) dcls), cqt, vtis, vps) = ftps <- mapM collectIfcInfo (reverse cfields) -- get back the arg port to type mapping, for recording flgs <- getFlags - -- XXX Need to sanity check port names after elaboration. - -- arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps - let arg_pts = - [ (pid,pt) | (pid,pt,Simple {}) <- vtis, not $ isParamModArg vps pid || pt == tClock && pt == tReset ] ++ - [ (pid,pt) | (_,_,Vector _ _ _ ais) <- vtis, (pid,pt) <- concatMap extractVTPairs ais ] + arg_pts <- convEM $ checkModulePortNames flgs (getPosition i) vps vtis ftps let arg_infos = thd $ unzip3 vtis (vs, ts) = unzip $ concatMap extractVTPairs arg_infos diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index f6b98b8ed..e02855e69 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -253,6 +253,10 @@ iExpand errh flags symt alldefs is_noinlined_func pps def@(IDef mi _ _ _) = do let (iks, args, varginfo, ifc) = goutput go let rules = go_rules go let insts = go_state_vars go + let vclockinfo = go_vclockinfo go + let vresetinfo = go_vresetinfo go + + chkIfcPortNames errh args ifc vclockinfo vresetinfo -- turn heap into IDef definitions let diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index 0cf4ea057..437974224 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -35,7 +35,7 @@ module IExpandUtils( addGateUsesToInhigh, addGateInhighAttributes, chkClkArgGateWires, chkClkAncestry, chkClkSiblings, getInputResetClockDomain, setInputResetClockDomain, - chkInputClockPragmas, + chkInputClockPragmas, chkIfcPortNames, getBoundaryClock, getBoundaryClocks, boundaryClockToName, getBoundaryReset, getBoundaryResets, boundaryResetToName, getInputResets, makeInputClk, makeInputRstn, makeOutputClk, makeOutputRstn, @@ -102,6 +102,7 @@ import IWireSet import Pragma(PProp(..), SPIdMap, substSchedPragmaIds, extractSchedPragmaIds, removeSchedPragmaIds) import Util +import Verilog(vKeywords, vIsValidIdent) import IOUtil(progArgs) import ISyntaxXRef(mapIExprPosition, mapIExprPosition2) @@ -2020,6 +2021,89 @@ chkClkAncestry modName instName pos ancestors clockargnum_map = when (not (null err_pairs)) $ errG (pos, EClockArgAncestors modName instName err_pairs) +chkIfcPortNames :: ErrorHandle -> [IAbstractInput] -> [HEFace] -> VClockInfo -> VResetInfo -> IO () +chkIfcPortNames errh args ifcs (ClockInfo ci co _ _) (ResetInfo ri ro) = + when (not (null emsgs)) $ bsError errh emsgs + where + input_clock_ports i = + case lookup i ci of + Just (Just (VName o, Right (VName g))) -> [o, g] + Just (Just (VName o, Left _)) -> [o] + _ -> [] + output_clock_ports i = + case lookup i co of + Just (Just (VName o, Just (VName g, _))) -> [o, g] + Just (Just (VName o, Nothing)) -> [o] + _ -> [] + input_reset_ports i = + case lookup i ri of + Just (Just (VName r), _) -> [r] + _ -> [] + output_reset_ports i = + case lookup i ro of + Just (Just (VName r), _) -> [r] + _ -> [] + + arg_port_names = [ (getIdBaseString i, i) | IAI_Port (i, _) <- args ] + arg_inout_names = [ (getIdBaseString i, i) | IAI_Inout i _ <- args ] + arg_clock_names = [ (n, i) | IAI_Clock i _ <- args, n <- input_clock_ports i ] + arg_reset_names = [ (n, i) | IAI_Reset i <- args, n <- input_reset_ports i ] + arg_names = sort $ arg_port_names ++ arg_inout_names ++ arg_clock_names ++ arg_reset_names + + ifc_port_names = + [ (n, i) + | IEFace {ief_fieldinfo = Method i _ _ _ ins out en} <- ifcs, + (VName n, _) <- ins ++ maybeToList out ++ maybeToList en ] + ifc_inout_names = + [ (n, i) | IEFace {ief_fieldinfo = Inout i (VName n) _ _} <- ifcs ] + ifc_clock_names = + [ (n, i) | IEFace {ief_fieldinfo = Clock i} <- ifcs, n <- output_clock_ports i ] + ifc_reset_names = + [ (n, i) | IEFace {ief_fieldinfo = Reset i} <- ifcs, n <- output_reset_ports i ] + ifc_names = sort $ ifc_port_names ++ ifc_inout_names ++ ifc_clock_names ++ ifc_reset_names + + -- --------------- + -- check that no ifc port name clashes with another port name and + -- check that no ifc port name clashes with a Verilog keyword and + -- check that each ifc port name is a valid Verilog identifier + ifc_same_name = filter (\xs -> (length xs) > 1) $ + groupBy (\(n1,_) (n2,_) -> n1 == n2) ifc_names + ifc_kw_clash = filter (\(n,_) -> n `elem` vKeywords) ifc_names + ifc_bad_ident = filter (\(n,_) -> not (vIsValidIdent n)) ifc_names + emsgs0 = let mkErr xs = + let ns = [(n, getPosition i, getIdBaseString i) + | (n,i) <- xs ] + in case ns of + ((v,p1,m1):(_,p2,m2):_) -> + (p1, EPortNamesClashFromMethod m1 m2 v p2) + _ -> internalError ("emsg0: impossible") + in map mkErr ifc_same_name + emsgs1 = let mkErr (n,i) = (getPosition i, + EPortKeywordClashFromMethod + (getIdBaseString i) n) + in map mkErr ifc_kw_clash + emsgs2 = let mkErr (n,i) = (getPosition i, + EPortNotValidIdentFromMethod + (getIdBaseString i) n) + in map mkErr ifc_bad_ident + + -- --------------- + -- check that no arg port clashes with an ifc port + ifc_ports_map = M.fromList ifc_names + + findIfcPortName (p, a) = + case M.lookup p ifc_ports_map of + Nothing -> Nothing + Just m -> Just (p, m, a) + + arg_ifc_dups = catMaybes $ map findIfcPortName arg_names + emsgs3 = let mkErr (p,m,a) = (getPosition a, + EPortNamesClashArgAndIfc + p (getIdBaseString a) (getIdBaseString m) (getPosition m)) + in map mkErr arg_ifc_dups + + emsgs = emsgs0 ++ emsgs1 ++ emsgs2 ++ emsgs3 + -- --------------- {-# INLINE newStateNo #-} diff --git a/src/comp/IfcBetterInfo.hs b/src/comp/IfcBetterInfo.hs index 103bf4082..8baded88b 100644 --- a/src/comp/IfcBetterInfo.hs +++ b/src/comp/IfcBetterInfo.hs @@ -17,9 +17,6 @@ import Pragma import PPrint import IdPrint import VModInfo -import FStringCompat(mkFString) -import ISyntax -import IConv(iConvT) -- import Util(traces) diff --git a/src/comp/PragmaCheck.hs b/src/comp/PragmaCheck.hs index 56fdeff33..d8c5a30c3 100644 --- a/src/comp/PragmaCheck.hs +++ b/src/comp/PragmaCheck.hs @@ -11,17 +11,15 @@ import Control.Monad(msum) import Data.List(groupBy, sort, partition, nub, intersect) import Data.Maybe(listToMaybe, mapMaybe, catMaybes, fromMaybe) -import Util(thd, fst3, headOrErr, fromJustOrErr) +import Util(thd, fst3, headOrErr) import Verilog(vKeywords, vIsValidIdent) -import Error(internalError, EMsg, ErrMsg(..)) +import Error(EMsg, ErrMsg(..)) import ErrorMonad(ErrorMonad(..)) -import PFPrint import Position import Id -import PreIds(idDefaultClock, idDefaultReset, idCLK, idCLK_GATE, - idPrimAction, idActionValue_, mk_no) +import PreIds(idDefaultClock, idDefaultReset, idCLK, idCLK_GATE, mk_no) import FStringCompat import PreStrings(fsUnderscore) @@ -29,7 +27,7 @@ import Flags(Flags(..)) import Pragma import CType -import Type(tClock, tReset, tInout_) +import Type(tClock, tReset) -- ============================== @@ -559,85 +557,9 @@ checkModulePortNames flgs pos pps vtis ftps = isClkField (_,t,_) = t == tClock isRstField (_,t,_) = t == tReset - isInoutField (_,t,_) = case t of - (TAp tt _) | (tt == tInout_) -> True - _ -> False - - getMString :: Maybe String -> String - getMString (Just str) = str - getMString Nothing = internalError ("getMString: empty field") - + (clk_fs, other_fs) = partition isClkField ftps - (rst_fs, other_fs') = partition isRstField other_fs - (iot_fs, method_fs) = partition isInoutField other_fs' - - ifc_clock_ports = - let mkClockPorts (i,_,ps) = - let mpref = getClockPragmaInfo ps - -- convert to Id and back, to reuse "mkPortName" - pref_id = mk_homeless_id $ getMString $ mpref - osc = mkPortName idCLK osc_prefix Nothing pref_id - gate = mkPortName idCLK_GATE gate_prefix Nothing pref_id - in [(getIdBaseString osc, i), - (getIdBaseString gate, i)] - in concatMap mkClockPorts clk_fs - - ifc_reset_ports = - let mkResetPort (i,_,ps) = - let mpref = getResetPragmaInfo ps - -- convert to Id and back, to reuse "mkPortName" - pref_id = mk_homeless_id $ getMString $ mpref - p = mkPortName idrstn rst_prefix Nothing pref_id - in (getIdBaseString p, i) - in map mkResetPort rst_fs - - ifc_inout_ports = - let mkInoutPort (i,t,ps) = - let pref = getMString $ getInoutPragmaInfo ps - in (pref, i) - in map mkInoutPort iot_fs - - ifc_method_ports = - let mkMethodPorts (i,t,ps) = - let resType = getRes t - resTypeId = fromJustOrErr - ("ifc_method_ports: " ++ ppReadable t) - (leftCon resType) - -- XXX can PrimAction ever occur? - -- XXX (Maybe if explicitly written?) - -- The types Action and ActionValue (which should be the - -- only types written by the user) become ActionValue_ - -- in the flattened interface (with Action being size 0). - -- So ActionValue_ should be only type seen. - isPA = (qualEq resTypeId idPrimAction) - isAV = (qualEq resTypeId idActionValue_) - -- If the user wrote "Action" the flattened ifc is - -- ActionValue_#(0). If the user wrote ActionValue#(t) - -- then the flattened ifc is ActionValue#(sz), where - -- "sz" is a variable reference in context Bits#(t,sz). - -- If GenWrap did ctxReduce, then these variables would - -- go away (if not, then we'd error, as iExpand does - -- now). In the meantime, just look for explicit 0. - isAV0 = case resType of - (TAp (TCon (TyCon av _ _)) (TCon (TyNum n _))) - | qualEq av idActionValue_ -> (n == 0) - _ -> False - (mpref, mres, mrdy, men, argids, ar, ae) = - getMethodPragmaInfo ps - res = if (isPA || isAV0) then [] else [getMString mres] - rdy = if (ar) then [] else [getMString mrdy] - en = if (not ae) && (isAV || isPA) - then [getMString men] else [] - argToName :: String -> Id -> String - argToName pstr aid = joinStrings_ pstr (getIdString aid) - args = map (argToName (getMString mpref)) argids - in - if (isRdyId i) then [] - else zip (res ++ rdy ++ en ++ args) (repeat i) - in concatMap mkMethodPorts method_fs - - all_ifc_info = ifc_clock_ports ++ ifc_reset_ports ++ - ifc_inout_ports ++ ifc_method_ports + (rst_fs, _) = partition isRstField other_fs -- --------------- -- check that no arg port name clashes with another port name and @@ -663,52 +585,6 @@ checkModulePortNames flgs pos pps vtis ftps = emsgs2 = let mkErr (n,i) = (getPosition i, EPortNotValidIdent n) in map mkErr arg_bad_ident - -- --------------- - -- check that no ifc port name clashes with another port name and - -- check that no ifc port name clashes with a Verilog keyword and - -- check that each ifc port name is a valid Verilog identifier - - ifc_names = sort all_ifc_info - ifc_same_name = filter (\xs -> (length xs) > 1) $ - groupBy (\(n1,_) (n2,_) -> n1 == n2) ifc_names - ifc_kw_clash = filter (\(n,_) -> n `elem` vKeywords) ifc_names - ifc_bad_ident = filter (\(n,_) -> not (vIsValidIdent n)) ifc_names - emsgs3 = let mkErr xs = - let ns = [(n, getPosition i, getIdBaseString i) - | (n,i) <- xs ] - in case ns of - ((v,p1,m1):(_,p2,m2):_) -> - (p1, EPortNamesClashFromMethod m1 m2 v p2) - _ -> internalError ("emsg3: impossible") - in map mkErr ifc_same_name - emsgs4 = let mkErr (n,i) = (getPosition i, - EPortKeywordClashFromMethod - (getIdBaseString i) n) - in map mkErr ifc_kw_clash - emsgs5 = let mkErr (n,i) = (getPosition i, - EPortNotValidIdentFromMethod - (getIdBaseString i) n) - in map mkErr ifc_bad_ident - - -- --------------- - -- check that no arg port clashes with an ifc port - - - ifc_ports_map = M.fromList ifc_names - - findIfcPortName api@(API { api_port = Just p }) = - case (M.lookup (getIdBaseString p) ifc_ports_map) of - Nothing -> Nothing - Just m -> Just (p, m, getAPIArgName api) - findIfcPortName (API { api_port = Nothing }) = Nothing - - arg_ifc_dups = catMaybes $ map findIfcPortName all_arg_info - emsgs6 = let mkErr (p,m,a) = (pos, - EPortNamesClashArgAndIfc - (pfpString p) (pfpString a) - (pfpString m) (getPosition m)) - in map mkErr arg_ifc_dups - -- --------------- -- warn if a prefix is supplied but never used @@ -755,8 +631,7 @@ checkModulePortNames flgs pos pps vtis ftps = -- report any errors or warnings -- report all errors, since none trump any others - emsgs = emsgs0 ++ emsgs1 ++ emsgs2 ++ emsgs3 ++ - emsgs4 ++ emsgs5 ++ emsgs6 + emsgs = emsgs0 ++ emsgs1 ++ emsgs2 wmsgs = wmsgs0 ++ wmsgs1 @@ -768,12 +643,3 @@ checkModulePortNames flgs pos pps vtis ftps = -- ============================== - --- XXX copied from GenWrap --- Join string together with an underscore if either is not empty. -joinStrings_ :: String -> String -> String -joinStrings_ "" s2 = s2 -joinStrings_ s1 "" = s1 -joinStrings_ s1 s2 = s1 ++ "_" ++ s2 - --- ============================== diff --git a/src/comp/VModInfo.hs b/src/comp/VModInfo.hs index 6964602a1..66ca50458 100644 --- a/src/comp/VModInfo.hs +++ b/src/comp/VModInfo.hs @@ -67,7 +67,7 @@ getVNameString (VName string) = string -- convert Bluespec identifier to Verilog names id_to_vName :: Id -> VName -id_to_vName i = VName (getIdString i) +id_to_vName i = VName (getIdBaseString i) vName_to_id :: VName -> Id vName_to_id (VName s) = mk_homeless_id s diff --git a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv index dfc572448..6c5abb46d 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockEnable.bsv @@ -6,4 +6,6 @@ endinterface (* synthesize *) module mkClockEnable(Ifc); + method m = noAction; + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv index 937f80ea5..177411a5f 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/clock/ClockResult.bsv @@ -6,4 +6,6 @@ endinterface (* synthesize *) module mkClockResult(Ifc); + method m = False; + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv b/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv index 37fcea71c..65ec4ea47 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/clock/GateEnable.bsv @@ -6,4 +6,6 @@ endinterface (* synthesize *) module mkGateEnable(Ifc); + method m = noAction; + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv index f397463f6..4e4d628c2 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargClock.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModargClock ((*port="CLK_c"*)int c, Ifc i); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv index 0ba6c94c3..01d9aecd3 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargGate.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModargGate ((*port="CLK_GATE_c"*)int c, Ifc i); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv index f3bc6d5d5..4677891de 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modarg/ModargReset.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModargReset ((*port="RST_N_r"*)int r, Ifc i); + method r = noReset; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv index c8e73a159..505b46068 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamClock.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModparamClock #((*parameter="CLK_c"*)parameter int c) (Ifc); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv index 561a4829e..18ae8dc52 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamGate.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModparamGate #((*parameter="CLK_GATE_c"*)parameter int c) (Ifc); + method c = noClock; endmodule diff --git a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv index 5585103c3..7a4e7938c 100644 --- a/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv +++ b/testsuite/bsc.names/portRenaming/conflicts/modparam/ModparamReset.bsv @@ -4,5 +4,6 @@ endinterface (* synthesize *) module mkModparamReset #((*parameter="RST_N_r"*)parameter int r) (Ifc); + method r = noReset; endmodule From 6b93528922ea0b65e3b1ef461900eab8c8f5033e Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 19:05:04 -0700 Subject: [PATCH 20/89] Fix bug introduced in computing split vector interface prefixes --- src/comp/GenWrap.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index befae7e8e..fe13d0ffd 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1100,7 +1100,7 @@ genTo pps ty mk = let selector n = cVApply primselect [posLiteral noPosition, extSel sel f, lit n] elemPrefix <- extendPrefixes prefixes ciPrags r f let recurse num = do - numPrefix <- extendPrefixes elemPrefix ciPrags r (mkNumId num) + numPrefix <- extendPrefixes elemPrefix [] r (mkNumId num) meth (selector num) numPrefix ifcIdIn (FInf idEmpty [] tVec []) fields <- mapM recurse nums return (concat fields) From 8dd9823807c3d27923e4b4390be3a152ff747157 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 19:34:25 -0700 Subject: [PATCH 21/89] Add sketch of splitting tuples --- src/Libraries/Base1/Prelude.bs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index b3e4342cc..f69848e8a 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4618,11 +4618,40 @@ instance SplitPorts () () where unsplitPorts = id portNames _ _ = Nil +-- Default instance: don't split anything we don't know how to split. instance SplitPorts a (Port a) where splitPorts = Port unsplitPorts (Port a) = a portNames _ base = Cons base Nil +{- +XXX Consider if we want to split tuples by default. This would change the current behavior, +but might be a sensible one, especially if we support methods with multiple output ports. + +instance (SplitTuplePorts (a, b) r) => SplitPorts (a, b) r where + splitPorts = splitTuplePorts + unsplitPorts = unsplitTuplePorts + portNames = splitTuplePortNames 1 + +class SplitTuplePorts a p | a -> p where + splitTuplePorts :: a -> p + unsplitTuplePorts :: p -> a + splitTuplePortNames :: Integer -> a -> String -> List String + +instance (SplitPorts a p, SplitTuplePorts b q, AppendTuple p q r) => SplitTuplePorts (a, b) r where + splitTuplePorts (a, b) = splitPorts a `appendTuple` splitTuplePorts b + unsplitTuplePorts x = case splitTuple x of + (a, b) -> (unsplitPorts a, unsplitTuplePorts b) + splitTuplePortNames i _ base = + portNames (_ :: a) (base +++ "_" +++ integerToString i) `listPrimAppend` + splitTuplePortNames (i + 1) (_ :: b) base + +instance (SplitPorts a p) => SplitTuplePorts a p where + splitTuplePorts = splitPorts + unsplitTuplePorts x = unsplitPorts x + splitTuplePortNames i _ base = portNames (_ :: a) $ base +++ "_" +++ integerToString i +-} + -- Newtype tag to indicate that a type should be recursively split into ports data DeepSplit a = DeepSplit a From cb79bd6b0fa1f89762f9e76ede3ef549f1d1ee52 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 19:49:00 -0700 Subject: [PATCH 22/89] Check for clash with default clock/reset ports --- src/comp/IExpandUtils.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index 437974224..09b925792 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -2048,7 +2048,13 @@ chkIfcPortNames errh args ifcs (ClockInfo ci co _ _) (ResetInfo ri ro) = arg_inout_names = [ (getIdBaseString i, i) | IAI_Inout i _ <- args ] arg_clock_names = [ (n, i) | IAI_Clock i _ <- args, n <- input_clock_ports i ] arg_reset_names = [ (n, i) | IAI_Reset i <- args, n <- input_reset_ports i ] - arg_names = sort $ arg_port_names ++ arg_inout_names ++ arg_clock_names ++ arg_reset_names + + default_clock_names = [ (n, idDefaultClock) | n <- input_clock_ports idDefaultClock ] + default_reset_names = [ (n, idDefaultReset) | n <- input_reset_ports idDefaultReset ] + + arg_names = sort $ + arg_port_names ++ arg_inout_names ++ arg_clock_names ++ arg_reset_names ++ + default_clock_names ++ default_reset_names ifc_port_names = [ (n, i) From d1c5c5833b82da38689181cbeab0cf56a37e2c1c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 20:15:15 -0700 Subject: [PATCH 23/89] Better error message for synthesizing an interface with a non-Bits method --- src/comp/ContextErrors.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/comp/ContextErrors.hs b/src/comp/ContextErrors.hs index 93fad5883..63e5cc555 100644 --- a/src/comp/ContextErrors.hs +++ b/src/comp/ContextErrors.hs @@ -165,6 +165,11 @@ handleContextReduction' pos _ -> return $ defaultContextReductionErr pos p _ -> internalError("handleContextReduction': " ++ "SizedLiteral instance contains wrong number of types") + | cid == idWrapField = + case ts of + [t, _] -> return $ handleCtxRedWrapField pos p t + _ -> internalError("handleContextReduction': " ++ + "WrapField instance contains wrong number of types") -- | cid == idLiteral = -- | cid == idRealLiteral = @@ -454,6 +459,13 @@ handleCtxRedPrimPort pos (vp, reduced_ps) userty = in (pos, ECtxErrPrimPort (pfpString userty) poss hasVar) +-- -------------------- + +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. + "This method uses types that are not in the Bits or SplitPorts typeclass.") + -- ======================================================================== -- Weak Context From 230e32f5e71dc87a6a07d43bc23871503348587f Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 20:17:48 -0700 Subject: [PATCH 24/89] Cleanup trailing whitespace --- src/Libraries/Base1/Prelude.bs | 6 +++--- src/comp/GenWrap.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index f69848e8a..03d471f10 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4470,7 +4470,7 @@ instance (WrapMethod m w) => (WrapField m w) where let baseNames = methodArgBaseNames (_ :: m) prefix names 1 in primMethod (inputPortNames (_ :: m) baseNames) ∘ toWrapMethod fromWrapField = fromWrapMethod - saveFieldPortTypes _ modName prefix names = + saveFieldPortTypes _ modName prefix names = let baseNames = methodArgBaseNames (_ :: m) prefix names 1 in saveMethodPortTypes (_ :: m) modName baseNames @@ -4591,7 +4591,7 @@ instance WrapPorts () () where checkPortNames :: (SplitPorts a p, TupleSize p n) => a -> String -> List String checkPortNames proxy base = let pn = portNames proxy base - in + in if listLength pn /= valueOf n then error $ "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ " ports, but " +++ integerToString (listLength pn) +++ " port names were given" @@ -4685,7 +4685,7 @@ instance (SplitPorts a p) => DeepSplitPorts' r a p where instance (Generic a r, DeepSplitPorts'' r p) => DeepSplitPorts' (Meta (MetaData name pkg args 1) r') a p where deepSplitPorts' _ = deepSplitPorts'' ∘ from - deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' + deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' deepSplitPortNames' _ _ = deepSplitPortNames'' (_ :: r) class DeepSplitPorts'' r p | r -> p where diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index fe13d0ffd..d08f38512 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -2145,7 +2145,7 @@ saveTopModPortTypeStmt i t = -- saveFieldPortTypes v "prefix" ["arg1", "arg2"] "result" mkFieldSavePortTypeStmts :: Maybe CExpr -> Id -> [FInf] -> GWMonad [CStmt] mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId - where + where meth :: IfcPrefixes -> Id -> FInf -> GWMonad [CStmt] meth prefixes ifcIdIn (FInf f as r aIds) = do From 7f75867c4fd135b866a91db16709d54b77feb7bf Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 20:31:05 -0700 Subject: [PATCH 25/89] Update expected results, testsuite passing --- .../NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected | 10 +++------- .../NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected | 9 +++------ 2 files changed, 6 insertions(+), 13 deletions(-) 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 727783b2d..6e1dd0aba 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 @@ -6,10 +6,6 @@ Error: Unknown position: (T0031) Bits#(NoInline_ArgNotInBits::L, a__) 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: (T0032) - This expression requires the following proviso which could not be resolved: - WrapField#(function Bool f(NoInline_ArgNotInBits::L x1), a__) - An instance for this proviso exists, but it depends on the following - provisos for which there are no instances: - Curry#(function Bit#(1) f(Bit#(b__) x1), a__), - Bits#(NoInline_ArgNotInBits::L, b__) +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. 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 75030a887..be21fcb36 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 @@ -6,12 +6,9 @@ Error: Unknown position: (T0031) Bits#(NoInline_ResNotInBits::L, a__) 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: (T0032) - This expression requires the following proviso which could not be resolved: - WrapField#(function NoInline_ResNotInBits::L f(Bool x1), a__) - An instance for this proviso exists, but it depends on the following proviso - for which there is no instance: - Bits#(NoInline_ResNotInBits::L, b__) +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. Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0029) Signature mismatch (given too general): given: From ec8d4b06dc623e688e6bf28baab360f294617ed8 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 16 Aug 2024 21:03:55 -0700 Subject: [PATCH 26/89] Reorganize port splitting utilites into a seperate library, add ShallowSplitPorts --- src/Libraries/Base1/Prelude.bs | 74 +----------- src/Libraries/Base1/SplitPorts.bs | 190 ++++++++++++++++++++++++++++++ src/Libraries/Base1/Vector.bs | 14 --- src/Libraries/Base1/depends.mk | 3 +- 4 files changed, 193 insertions(+), 88 deletions(-) create mode 100644 src/Libraries/Base1/SplitPorts.bs diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 03d471f10..6057eb576 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -259,8 +259,7 @@ package Prelude( MetaConsNamed(..), MetaConsAnon(..), MetaField(..), primMethod, WrapField(..), WrapMethod(..), WrapPorts(..), - Port(..), SplitPorts(..), - DeepSplit(..), DeepSplitPorts(..), DeepSplitPorts'(..), DeepSplitPorts''(..) + Port(..), SplitPorts(..) ) where infixr 0 $ @@ -4651,74 +4650,3 @@ instance (SplitPorts a p) => SplitTuplePorts a p where unsplitTuplePorts x = unsplitPorts x splitTuplePortNames i _ base = portNames (_ :: a) $ base +++ "_" +++ integerToString i -} - --- Newtype tag to indicate that a type should be recursively split into ports -data DeepSplit a = DeepSplit a - -instance (DeepSplitPorts a p) => SplitPorts (DeepSplit a) p where - splitPorts (DeepSplit x) = deepSplitPorts x - unsplitPorts = DeepSplit ∘ deepUnsplitPorts - portNames _ = deepSplitPortNames (_ :: a) - - --- Helper class using generics, to recursively split structs and vectors into a tuple of ports. -class DeepSplitPorts a p | a -> p where - deepSplitPorts :: a -> p - deepUnsplitPorts :: p -> a - deepSplitPortNames :: a -> String -> List String - -instance (Generic a r, DeepSplitPorts' r a p) => - DeepSplitPorts a p where - deepSplitPorts = deepSplitPorts' (_ :: r) - deepUnsplitPorts = deepUnsplitPorts' (_ :: r) - deepSplitPortNames = deepSplitPortNames' (_ :: r) - -class DeepSplitPorts' r a p | r a -> p where - deepSplitPorts' :: r -> a -> p - deepUnsplitPorts' :: r -> p -> a - deepSplitPortNames' :: r -> a -> String -> List String - -instance (SplitPorts a p) => DeepSplitPorts' r a p where - deepSplitPorts' _ = splitPorts - deepUnsplitPorts' _ = unsplitPorts - deepSplitPortNames' _ = portNames - -instance (Generic a r, DeepSplitPorts'' r p) => DeepSplitPorts' (Meta (MetaData name pkg args 1) r') a p where - deepSplitPorts' _ = deepSplitPorts'' ∘ from - deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' - deepSplitPortNames' _ _ = deepSplitPortNames'' (_ :: r) - -class DeepSplitPorts'' r p | r -> p where - deepSplitPorts'' :: r -> p - deepUnsplitPorts'' :: p -> r - deepSplitPortNames'' :: r -> String -> List String - -instance (DeepSplitPorts'' a p, DeepSplitPorts'' b q, AppendTuple p q r) => DeepSplitPorts'' (a, b) r where - deepSplitPorts'' (a, b) = deepSplitPorts'' a `appendTuple` deepSplitPorts'' b - deepUnsplitPorts'' x = case splitTuple x of - (a, b) -> (deepUnsplitPorts'' a, deepUnsplitPorts'' b) - deepSplitPortNames'' _ base = - deepSplitPortNames'' (_ :: a) base `listPrimAppend` deepSplitPortNames'' (_ :: b) base - -instance DeepSplitPorts'' () () where - deepSplitPorts'' _ = () - deepUnsplitPorts'' _ = () - deepSplitPortNames'' _ _ = Nil - -instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r) p where - deepSplitPorts'' (Meta x) = deepSplitPorts'' x - deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' - deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ - if stringHead (stringOf name) == '_' - then base +++ stringOf name - else base +++ "_" +++ stringOf name - -instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta m r) p where - deepSplitPorts'' (Meta x) = deepSplitPorts'' x - deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' - deepSplitPortNames'' _ = deepSplitPortNames'' (_ :: r) - -instance (DeepSplitPorts a p) => DeepSplitPorts'' (Conc a) p where - deepSplitPorts'' (Conc x) = deepSplitPorts x - deepUnsplitPorts'' = Conc ∘ deepUnsplitPorts - deepSplitPortNames'' _ = deepSplitPortNames (_ :: a) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs new file mode 100644 index 000000000..708c65b30 --- /dev/null +++ b/src/Libraries/Base1/SplitPorts.bs @@ -0,0 +1,190 @@ +package SplitPorts where + +-- Utilities for port splitting + +import qualified List +import Vector + + + +-- Newtype tags to indicate that a types should be split (recursively or not) into ports +data ShallowSplit a = ShallowSplit a +data DeepSplit a = DeepSplit a + +instance (ShallowSplitPorts a p) => SplitPorts (ShallowSplit a) p where + splitPorts (ShallowSplit x) = shallowSplitPorts x + unsplitPorts = ShallowSplit ∘ shallowUnsplitPorts + portNames _ = shallowSplitPortNames (_ :: a) + +instance (DeepSplitPorts a p) => SplitPorts (DeepSplit a) p where + splitPorts (DeepSplit x) = deepSplitPorts x + unsplitPorts = DeepSplit ∘ deepUnsplitPorts + portNames _ = deepSplitPortNames (_ :: a) + + +-- Helper class using generics, to split a struct or vector into a tuple of ports. +class ShallowSplitPorts a p | a -> p where + shallowSplitPorts :: a -> p + shallowUnsplitPorts :: p -> a + shallowSplitPortNames :: a -> String -> List String + +instance (Generic a r, ShallowSplitPorts' r p) => + ShallowSplitPorts a p where + shallowSplitPorts = shallowSplitPorts' ∘ from + shallowUnsplitPorts = to ∘ shallowUnsplitPorts' + shallowSplitPortNames _ = shallowSplitPortNames' (_ :: r) + +class ShallowSplitPorts' r p | r -> p where + shallowSplitPorts' :: r -> p + shallowUnsplitPorts' :: p -> r + shallowSplitPortNames' :: r -> String -> List String + +instance (ShallowSplitPorts' a p, ShallowSplitPorts' b q, AppendTuple p q r) => ShallowSplitPorts' (a, b) r where + shallowSplitPorts' (a, b) = shallowSplitPorts' a `appendTuple` shallowSplitPorts' b + shallowUnsplitPorts' x = case splitTuple x of + (a, b) -> (shallowUnsplitPorts' a, shallowUnsplitPorts' b) + shallowSplitPortNames' _ base = + shallowSplitPortNames' (_ :: a) base `List.append` shallowSplitPortNames' (_ :: b) base + +instance ShallowSplitPorts' () () where + shallowSplitPorts' _ = () + shallowUnsplitPorts' _ = () + shallowSplitPortNames' _ _ = Nil + +instance ShallowSplitPorts' (Vector 0 r) () where + shallowSplitPorts' _ = () + shallowUnsplitPorts' _ = nil + shallowSplitPortNames' _ _ = Nil + +instance (ShallowSplitPorts' r p1, Add n1 1 n, ShallowSplitPorts' (Vector n1 r) p2, AppendTuple p1 p2 p) => + ShallowSplitPorts' (Vector n r) p where + shallowSplitPorts' v = shallowSplitPorts' (head v) `appendTuple` shallowSplitPorts' (tail v) + shallowUnsplitPorts' x = case splitTuple x of + (y, z) -> shallowUnsplitPorts' y :> shallowUnsplitPorts' z + shallowSplitPortNames' _ base = + let genElem i = shallowSplitPortNames' (_ :: r) (base +++ "_" +++ integerToString i) + in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) + +instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta (MetaField name idx) r) p where + shallowSplitPorts' (Meta x) = shallowSplitPorts' x + shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' + shallowSplitPortNames' _ base = shallowSplitPortNames' (_ :: r) $ + if stringHead (stringOf name) == '_' + then base +++ stringOf name + else base +++ "_" +++ stringOf name + +instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta m r) p where + shallowSplitPorts' (Meta x) = shallowSplitPorts' x + shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' + shallowSplitPortNames' _ = shallowSplitPortNames' (_ :: r) + +instance (SplitPorts a p) => ShallowSplitPorts' (Conc a) p where + shallowSplitPorts' (Conc x) = splitPorts x + shallowUnsplitPorts' = Conc ∘ unsplitPorts + shallowSplitPortNames' _ = portNames (_ :: a) + + +-- Helper class using generics, to recursively split structs and vectors into a tuple of ports. +class DeepSplitPorts a p | a -> p where + deepSplitPorts :: a -> p + deepUnsplitPorts :: p -> a + deepSplitPortNames :: a -> String -> List String + +instance DeepSplitPorts () () where + deepSplitPorts _ = () + deepUnsplitPorts _ = () + deepSplitPortNames _ _ = Nil + +instance (DeepSplitTuplePorts (a, b) r) => DeepSplitPorts (a, b) r where + deepSplitPorts = deepSplitTuplePorts + deepUnsplitPorts = deepUndeepSplitTuplePorts + deepSplitPortNames = deepSplitTuplePortNames 1 + +class DeepSplitTuplePorts a p | a -> p where + deepSplitTuplePorts :: a -> p + deepUndeepSplitTuplePorts :: p -> a + deepSplitTuplePortNames :: Integer -> a -> String -> List String + +instance (DeepSplitPorts a p, DeepSplitTuplePorts b q, AppendTuple p q r) => DeepSplitTuplePorts (a, b) r where + deepSplitTuplePorts (a, b) = deepSplitPorts a `appendTuple` deepSplitTuplePorts b + deepUndeepSplitTuplePorts x = case splitTuple x of + (a, b) -> (deepUnsplitPorts a, deepUndeepSplitTuplePorts b) + deepSplitTuplePortNames i _ base = + deepSplitPortNames (_ :: a) (base +++ "_" +++ integerToString i) `List.append` + deepSplitTuplePortNames (i + 1) (_ :: b) base + +instance (DeepSplitPorts a p) => DeepSplitTuplePorts a p where + deepSplitTuplePorts = deepSplitPorts + deepUndeepSplitTuplePorts x = deepUnsplitPorts x + deepSplitTuplePortNames i _ base = deepSplitPortNames (_ :: a) $ base +++ "_" +++ integerToString i + + +instance (Generic a r, DeepSplitPorts' r a p) => + DeepSplitPorts a p where + deepSplitPorts = deepSplitPorts' (_ :: r) + deepUnsplitPorts = deepUnsplitPorts' (_ :: r) + deepSplitPortNames = deepSplitPortNames' (_ :: r) + +class DeepSplitPorts' r a p | r a -> p where + deepSplitPorts' :: r -> a -> p + deepUnsplitPorts' :: r -> p -> a + deepSplitPortNames' :: r -> a -> String -> List String + +instance (SplitPorts a p) => DeepSplitPorts' r a p where + deepSplitPorts' _ = splitPorts + deepUnsplitPorts' _ = unsplitPorts + deepSplitPortNames' _ = portNames + +instance (Generic a r, DeepSplitPorts'' r p) => DeepSplitPorts' (Meta (MetaData name pkg args 1) r') a p where + deepSplitPorts' _ = deepSplitPorts'' ∘ from + deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' + deepSplitPortNames' _ _ = deepSplitPortNames'' (_ :: r) + +class DeepSplitPorts'' r p | r -> p where + deepSplitPorts'' :: r -> p + deepUnsplitPorts'' :: p -> r + deepSplitPortNames'' :: r -> String -> List String + +instance (DeepSplitPorts'' a p, DeepSplitPorts'' b q, AppendTuple p q r) => DeepSplitPorts'' (a, b) r where + deepSplitPorts'' (a, b) = deepSplitPorts'' a `appendTuple` deepSplitPorts'' b + deepUnsplitPorts'' x = case splitTuple x of + (a, b) -> (deepUnsplitPorts'' a, deepUnsplitPorts'' b) + deepSplitPortNames'' _ base = + deepSplitPortNames'' (_ :: a) base `List.append` deepSplitPortNames'' (_ :: b) base + +instance DeepSplitPorts'' () () where + deepSplitPorts'' _ = () + deepUnsplitPorts'' _ = () + deepSplitPortNames'' _ _ = Nil + +instance DeepSplitPorts'' (Vector 0 r) () where + deepSplitPorts'' _ = () + deepUnsplitPorts'' _ = nil + deepSplitPortNames'' _ _ = Nil + +instance (DeepSplitPorts'' r p1, Add n1 1 n, DeepSplitPorts'' (Vector n1 r) p2, AppendTuple p1 p2 p) => + DeepSplitPorts'' (Vector n r) p where + deepSplitPorts'' v = deepSplitPorts'' (head v) `appendTuple` deepSplitPorts'' (tail v) + deepUnsplitPorts'' x = case splitTuple x of + (y, z) -> deepUnsplitPorts'' y :> deepUnsplitPorts'' z + deepSplitPortNames'' _ base = + let genElem i = deepSplitPortNames'' (_ :: r) (base +++ "_" +++ integerToString i) + in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) + +instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r) p where + deepSplitPorts'' (Meta x) = deepSplitPorts'' x + deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' + deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ + if stringHead (stringOf name) == '_' + then base +++ stringOf name + else base +++ "_" +++ stringOf name + +instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta m r) p where + deepSplitPorts'' (Meta x) = deepSplitPorts'' x + deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' + deepSplitPortNames'' _ = deepSplitPortNames'' (_ :: r) + +instance (DeepSplitPorts a p) => DeepSplitPorts'' (Conc a) p where + deepSplitPorts'' (Conc x) = deepSplitPorts x + deepUnsplitPorts'' = Conc ∘ deepUnsplitPorts + deepSplitPortNames'' _ = deepSplitPortNames (_ :: a) diff --git a/src/Libraries/Base1/Vector.bs b/src/Libraries/Base1/Vector.bs index 6006abd41..70d410993 100644 --- a/src/Libraries/Base1/Vector.bs +++ b/src/Libraries/Base1/Vector.bs @@ -1362,17 +1362,3 @@ instance (PrimMakeUninitialized'' r) => PrimMakeUninitialized'' (Vector n r) whe instance (PrimDeepSeqCond' r) => PrimDeepSeqCond' (Vector n r) where primDeepSeqCond' = flip $ foldr primDeepSeqCond' - -instance DeepSplitPorts'' (Vector 0 r) () where - deepSplitPorts'' _ = () - deepUnsplitPorts'' _ = nil - deepSplitPortNames'' _ _ = Nil - -instance (DeepSplitPorts'' r p1, Add n1 1 n, DeepSplitPorts'' (Vector n1 r) p2, AppendTuple p1 p2 p) => - DeepSplitPorts'' (Vector n r) p where - deepSplitPorts'' v = deepSplitPorts'' (head v) `appendTuple` deepSplitPorts'' (tail v) - deepUnsplitPorts'' x = case splitTuple x of - (y, z) -> deepUnsplitPorts'' y :> deepUnsplitPorts'' z - deepSplitPortNames'' _ base = - let genElem i = deepSplitPortNames'' (_ :: r) (base +++ "_" +++ integerToString i) - in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) diff --git a/src/Libraries/Base1/depends.mk b/src/Libraries/Base1/depends.mk index 0446a6da7..52e8f5f75 100644 --- a/src/Libraries/Base1/depends.mk +++ b/src/Libraries/Base1/depends.mk @@ -1,5 +1,5 @@ ## Automatically generated by bluetcl -exec makedepend -- Do NOT EDIT -## Date: Tue Jul 23 10:01:18 AM PDT 2024 +## Date: Thu Dec 19 11:17:07 AM PST 2024 ## Command: bluetcl -exec makedepend -bdir $(BUILDDIR) *.bs* $(BUILDDIR)/ActionSeq.bo: ActionSeq.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo @@ -36,4 +36,5 @@ $(BUILDDIR)/RegFile.bo: RegFile.bs $(BUILDDIR)/ConfigReg.bo $(BUILDDIR)/List.bo $(BUILDDIR)/Reserved.bo: Reserved.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo $(BUILDDIR)/RevertingVirtualReg.bo: RevertingVirtualReg.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo $(BUILDDIR)/SShow.bo: SShow.bs $(BUILDDIR)/ListN.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo +$(BUILDDIR)/SplitPorts.bo: SplitPorts.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo $(BUILDDIR)/Vector.bo: Vector.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Array.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo From 200f6f7ea679b7498009ab854b9d9d95bbbc747a Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 15:23:59 -0700 Subject: [PATCH 27/89] More efficient implementation of splitting vectors --- src/Libraries/Base1/SplitPorts.bs | 28 +++++----------- src/Libraries/Base1/Vector.bs | 56 ++++++++++++++++++++++++++++++- 2 files changed, 63 insertions(+), 21 deletions(-) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index 708c65b30..3f4694b5b 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -51,16 +51,9 @@ instance ShallowSplitPorts' () () where shallowUnsplitPorts' _ = () shallowSplitPortNames' _ _ = Nil -instance ShallowSplitPorts' (Vector 0 r) () where - shallowSplitPorts' _ = () - shallowUnsplitPorts' _ = nil - shallowSplitPortNames' _ _ = Nil - -instance (ShallowSplitPorts' r p1, Add n1 1 n, ShallowSplitPorts' (Vector n1 r) p2, AppendTuple p1 p2 p) => - ShallowSplitPorts' (Vector n r) p where - shallowSplitPorts' v = shallowSplitPorts' (head v) `appendTuple` shallowSplitPorts' (tail v) - shallowUnsplitPorts' x = case splitTuple x of - (y, z) -> shallowUnsplitPorts' y :> shallowUnsplitPorts' z +instance (ShallowSplitPorts' r p1, ConcatTuple n p1 p) => ShallowSplitPorts' (Vector n r) p where + shallowSplitPorts' = concatTuple ∘ map shallowSplitPorts' + shallowUnsplitPorts' = map shallowUnsplitPorts' ∘ unconcatTuple shallowSplitPortNames' _ base = let genElem i = shallowSplitPortNames' (_ :: r) (base +++ "_" +++ integerToString i) in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) @@ -130,11 +123,13 @@ class DeepSplitPorts' r a p | r a -> p where deepUnsplitPorts' :: r -> p -> a deepSplitPortNames' :: r -> a -> String -> List String +-- Terminate recursion for n /= 1 constructors instance (SplitPorts a p) => DeepSplitPorts' r a p where deepSplitPorts' _ = splitPorts deepUnsplitPorts' _ = unsplitPorts deepSplitPortNames' _ = portNames +-- Recurse into the fields of a struct instance (Generic a r, DeepSplitPorts'' r p) => DeepSplitPorts' (Meta (MetaData name pkg args 1) r') a p where deepSplitPorts' _ = deepSplitPorts'' ∘ from deepUnsplitPorts' _ = to ∘ deepUnsplitPorts'' @@ -157,16 +152,9 @@ instance DeepSplitPorts'' () () where deepUnsplitPorts'' _ = () deepSplitPortNames'' _ _ = Nil -instance DeepSplitPorts'' (Vector 0 r) () where - deepSplitPorts'' _ = () - deepUnsplitPorts'' _ = nil - deepSplitPortNames'' _ _ = Nil - -instance (DeepSplitPorts'' r p1, Add n1 1 n, DeepSplitPorts'' (Vector n1 r) p2, AppendTuple p1 p2 p) => - DeepSplitPorts'' (Vector n r) p where - deepSplitPorts'' v = deepSplitPorts'' (head v) `appendTuple` deepSplitPorts'' (tail v) - deepUnsplitPorts'' x = case splitTuple x of - (y, z) -> deepUnsplitPorts'' y :> deepUnsplitPorts'' z +instance (DeepSplitPorts'' r p1, ConcatTuple n p1 p) => DeepSplitPorts'' (Vector n r) p where + deepSplitPorts'' = concatTuple ∘ map deepSplitPorts'' + deepUnsplitPorts'' = map deepUnsplitPorts'' ∘ unconcatTuple deepSplitPortNames'' _ base = let genElem i = deepSplitPortNames'' (_ :: r) (base +++ "_" +++ integerToString i) in List.concat $ List.map genElem $ List.upto 0 (valueOf n - 1) diff --git a/src/Libraries/Base1/Vector.bs b/src/Libraries/Base1/Vector.bs index 70d410993..82a37d9cb 100644 --- a/src/Libraries/Base1/Vector.bs +++ b/src/Libraries/Base1/Vector.bs @@ -19,7 +19,8 @@ package Vector( find, findElem, findIndex, countLeadingZeros, countElem, countIf, countOnes, countOnesAlt, rotateBy, rotateBitsBy, - readVReg, writeVReg, toChunks, drop, Ascii + readVReg, writeVReg, toChunks, drop, Ascii, + ConcatTuple(..), ConcatTuple'(..) ) where import List @@ -1255,6 +1256,59 @@ toChunks x = let padding = (0 :: Bit ch_sz) in unpack(tmp[v_sz-1:0]) + +class ConcatTuple n a b | n a -> b where + concatTuple :: Vector n a -> b + unconcatTuple :: b -> Vector n a + +instance ConcatTuple 0 a () where + concatTuple _ = () + unconcatTuple _ = nil + +instance ConcatTuple 1 a a where + concatTuple v = head v + unconcatTuple x = cons x nil + +-- Linear recursive implementation: O(n^2) +-- instance (Add n1 1 n, ConcatTuple n1 a b, AppendTuple a b c) => ConcatTuple n a c where +-- concatTuple v = appendTuple (head v) $ concatTuple (tail v) +-- unconcatTuple x = case splitTuple x of +-- (y, z) -> cons y $ unconcatTuple z + +-- O(n lg n) optimization: split into chunks that are powers of 2 +instance (Add lgn 1 (TLog (TAdd n 1)), Add (TExp lgn) n1 n, ConcatTuple n1 a b, ConcatTuple' lgn a c, AppendTuple b c d) => + ConcatTuple n a d where + concatTuple v = + let v1 :: Vector n1 a = take v + v2 :: Vector (TExp lgn) a = drop v + in concatTuple v1 `appendTuple` concatTuple' v2 + unconcatTuple x = + let res :: (b, c) = splitTuple x + v1 :: Vector n1 a = unconcatTuple res.fst + v2 :: Vector (TExp lgn) a = unconcatTuple' res.snd + in append v1 v2 + +-- Concatenate a vector of 2^n tuples +class ConcatTuple' n a b | n a -> b where + concatTuple' :: Vector (TExp n) a -> b + unconcatTuple' :: b -> Vector (TExp n) a + +instance ConcatTuple' 0 a a where + concatTuple' v = head v + unconcatTuple' x = cons x nil + +instance (Add n1 1 n, ConcatTuple' n1 a b, AppendTuple b b c) => ConcatTuple' n a c where + concatTuple' v = + let v1 :: Vector (TExp n1) a = take v + v2 :: Vector (TExp n1) a = drop v + in concatTuple' v1 `appendTuple` concatTuple' v2 + unconcatTuple' x = + let res :: (b, b) = splitTuple x + v1 :: Vector (TExp n1) a = unconcatTuple' res.fst + v2 :: Vector (TExp n1) a = unconcatTuple' res.snd + in append v1 v2 + + --@ \item{\bf Examples Using the Vector Type} --@ --@ The following example shows some common uses of the {\te{Vector}} From d78f6e4e53cce38c93675e18b01e2956cae92f56 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 16:33:30 -0700 Subject: [PATCH 28/89] Avoid extra _1 suffix for DeepSplitPorts on Int/UInt --- src/Libraries/Base1/SplitPorts.bs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index 3f4694b5b..dd792ffc3 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -83,12 +83,22 @@ class DeepSplitPorts a p | a -> p where deepUnsplitPorts :: p -> a deepSplitPortNames :: a -> String -> List String +instance DeepSplitPorts (UInt n) (Port (UInt n)) where + deepSplitPorts = Port + deepUnsplitPorts (Port x) = x + deepSplitPortNames _ base = Cons base Nil + +instance DeepSplitPorts (Int n) (Port (Int n)) where + deepSplitPorts = Port + deepUnsplitPorts (Port x) = x + deepSplitPortNames _ base = Cons base Nil + instance DeepSplitPorts () () where deepSplitPorts _ = () deepUnsplitPorts _ = () deepSplitPortNames _ _ = Nil -instance (DeepSplitTuplePorts (a, b) r) => DeepSplitPorts (a, b) r where +instance (DeepSplitTuplePorts (a, b) p) => DeepSplitPorts (a, b) p where deepSplitPorts = deepSplitTuplePorts deepUnsplitPorts = deepUndeepSplitTuplePorts deepSplitPortNames = deepSplitTuplePortNames 1 @@ -112,8 +122,7 @@ instance (DeepSplitPorts a p) => DeepSplitTuplePorts a p where deepSplitTuplePortNames i _ base = deepSplitPortNames (_ :: a) $ base +++ "_" +++ integerToString i -instance (Generic a r, DeepSplitPorts' r a p) => - DeepSplitPorts a p where +instance (Generic a r, DeepSplitPorts' r a p) => DeepSplitPorts a p where deepSplitPorts = deepSplitPorts' (_ :: r) deepUnsplitPorts = deepUnsplitPorts' (_ :: r) deepSplitPortNames = deepSplitPortNames' (_ :: r) From 2522a8705832688bc3f5a3f32fe3d6c004dde01c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 16:33:58 -0700 Subject: [PATCH 29/89] Add test cases for port splitting --- testsuite/bsc.verilog/splitports/DeepSplit.bs | 59 ++++++++++++++ .../bsc.verilog/splitports/InstanceSplit.bs | 76 +++++++++++++++++++ testsuite/bsc.verilog/splitports/Makefile | 5 ++ .../bsc.verilog/splitports/ShallowSplit.bs | 59 ++++++++++++++ .../bsc.verilog/splitports/splitports.exp | 39 ++++++++++ .../splitports/sysDeepSplit.out.expected | 5 ++ .../splitports/sysInstanceSplit.out.expected | 5 ++ .../splitports/sysShallowSplit.out.expected | 5 ++ 8 files changed, 253 insertions(+) create mode 100644 testsuite/bsc.verilog/splitports/DeepSplit.bs create mode 100644 testsuite/bsc.verilog/splitports/InstanceSplit.bs create mode 100644 testsuite/bsc.verilog/splitports/Makefile create mode 100644 testsuite/bsc.verilog/splitports/ShallowSplit.bs create mode 100644 testsuite/bsc.verilog/splitports/splitports.exp create mode 100644 testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected create mode 100644 testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected create mode 100644 testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected diff --git a/testsuite/bsc.verilog/splitports/DeepSplit.bs b/testsuite/bsc.verilog/splitports/DeepSplit.bs new file mode 100644 index 000000000..79bd97470 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/DeepSplit.bs @@ -0,0 +1,59 @@ +package DeepSplit where + +import Vector +import BuildVector +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +struct Bar = + v :: Vector 3 Bool + w :: (Bool, UInt 16) + z :: Foo + -- No Bits instance needed + +struct Baz = + a :: Maybe Foo + b :: Bar + c :: Vector 3 (Vector 8 Foo, Bar) + d :: () + e :: Vector 0 Foo + -- No Bits instance needed + +interface SplitTest = + putFoo :: DeepSplit Foo -> Action + putBar :: DeepSplit Bar -> Action {-# prefix = "PUT_BAR" #-} + putFooBar :: DeepSplit Foo -> DeepSplit Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} + putFoos :: DeepSplit (Vector 50 Foo) -> Action + putBaz :: DeepSplit Baz -> Action + + +{-# synthesize mkDeepSplitTest #-} +mkDeepSplitTest :: Module SplitTest +mkDeepSplitTest = + module + interface + putFoo (DeepSplit x) = $display "putFoo: " (cshow x) + putBar (DeepSplit x) = $display "putBar: " (cshow x) + putFooBar (DeepSplit x) (DeepSplit y) = $display "putFooBar: " (cshow x) " " (cshow y) + putFoos (DeepSplit x) = $display "putFoos: " (cshow x) + putBaz (DeepSplit x) = $display "putBaz: " (cshow x) + +{-# synthesize sysDeepSplit #-} +sysDeepSplit :: Module Empty +sysDeepSplit = + module + s <- mkDeepSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFoo $ DeepSplit $ Foo { x = 1; y = 2; } + when i == 1 ==> s.putBar $ DeepSplit $ Bar { v = vec True False True; w = (True, 0x1234); z = Foo { x = 3; y = 4; } } + when i == 2 ==> s.putFooBar (DeepSplit $ Foo { x = 5; y = 6; }) (DeepSplit $ Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) + when i == 3 ==> s.putFoos $ DeepSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } + when i == 4 ==> s.putBaz $ DeepSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } + when i == 5 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/InstanceSplit.bs b/testsuite/bsc.verilog/splitports/InstanceSplit.bs new file mode 100644 index 000000000..1e6a71314 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/InstanceSplit.bs @@ -0,0 +1,76 @@ +package InstanceSplit where + +import Vector +import BuildVector +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port Bool, Port (Bit 7)) where + splitPorts x = (Port x.x, Port (x.y > 0), Port $ truncate $ pack x.y) + unsplitPorts (Port x, Port s, Port y) = Foo { x = x; y = (if s then id else negate) $ unpack $ zeroExtend y; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_ysign") $ Cons (base +++ "_yvalue") Nil + +struct Bar = + v :: Vector 3 Bool + w :: (Bool, UInt 16) + z :: Foo + deriving (Bits) + +-- XXX would be nice to be able to derive this +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Baz = + a :: Maybe Foo + b :: Bar + c :: Vector 3 (Vector 8 Foo, Bar) + d :: () + e :: Vector 0 Foo + -- No Bits instance needed + +-- XXX would be nice to be able to derive this +instance (ShallowSplitPorts Baz p) => SplitPorts Baz p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putFoo :: Foo -> Action + putBar :: Bar -> Action {-# prefix = "PUT_BAR" #-} + putFooBar :: Foo -> Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} + putFoos :: (Vector 50 Foo) -> Action + putBaz :: Baz -> Action + + +{-# synthesize mkInstanceSplitTest #-} +mkInstanceSplitTest :: Module SplitTest +mkInstanceSplitTest = + module + interface + putFoo x = $display "putFoo: " (cshow x) + putBar x = $display "putBar: " (cshow x) + putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) + putFoos x = $display "putFoos: " (cshow x) + putBaz x = $display "putBaz: " (cshow x) + +{-# synthesize sysInstanceSplit #-} +sysInstanceSplit :: Module Empty +sysInstanceSplit = + module + s <- mkInstanceSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFoo $ Foo { x = 1; y = 2; } + when i == 1 ==> s.putBar $ Bar { v = vec True False True; w = (True, 0x1234); z = Foo { x = 3; y = 4; } } + when i == 2 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) + when i == 3 ==> s.putFoos $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } + when i == 4 ==> s.putBaz $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } + when i == 5 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/Makefile b/testsuite/bsc.verilog/splitports/Makefile new file mode 100644 index 000000000..b953e8132 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/Makefile @@ -0,0 +1,5 @@ +# for "make clean" to work everywhere + +CONFDIR = $(realpath ../..) + +include $(CONFDIR)/clean.mk diff --git a/testsuite/bsc.verilog/splitports/ShallowSplit.bs b/testsuite/bsc.verilog/splitports/ShallowSplit.bs new file mode 100644 index 000000000..11166e76a --- /dev/null +++ b/testsuite/bsc.verilog/splitports/ShallowSplit.bs @@ -0,0 +1,59 @@ +package ShallowSplit where + +import Vector +import BuildVector +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +struct Bar = + v :: Vector 3 Bool + w :: (Bool, UInt 16) + z :: Foo + deriving (Bits) + +struct Baz = + a :: Maybe Foo + b :: Bar + c :: Vector 3 (Vector 8 Foo, Bar) + d :: () + e :: Vector 0 Foo + -- No Bits instance needed + +interface SplitTest = + putFoo :: ShallowSplit Foo -> Action + putBar :: ShallowSplit Bar -> Action {-# prefix = "PUT_BAR" #-} + putFooBar :: ShallowSplit Foo -> ShallowSplit Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} + putFoos :: ShallowSplit (Vector 50 Foo) -> Action + putBaz :: ShallowSplit Baz -> Action + + +{-# synthesize mkShallowSplitTest #-} +mkShallowSplitTest :: Module SplitTest +mkShallowSplitTest = + module + interface + putFoo (ShallowSplit x) = $display "putFoo: " (cshow x) + putBar (ShallowSplit x) = $display "putBar: " (cshow x) + putFooBar (ShallowSplit x) (ShallowSplit y) = $display "putFooBar: " (cshow x) " " (cshow y) + putFoos (ShallowSplit x) = $display "putFoos: " (cshow x) + putBaz (ShallowSplit x) = $display "putBaz: " (cshow x) + +{-# synthesize sysShallowSplit #-} +sysShallowSplit :: Module Empty +sysShallowSplit = + module + s <- mkShallowSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFoo $ ShallowSplit $ Foo { x = 1; y = 2; } + when i == 1 ==> s.putBar $ ShallowSplit $ Bar { v = vec True False True; w = (True, 0x1234); z = Foo { x = 3; y = 4; } } + when i == 2 ==> s.putFooBar (ShallowSplit $ Foo { x = 5; y = 6; }) (ShallowSplit $ Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) + when i == 3 ==> s.putFoos $ ShallowSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } + when i == 4 ==> s.putBaz $ ShallowSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } + when i == 5 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp new file mode 100644 index 000000000..bf548ed20 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -0,0 +1,39 @@ + +test_c_veri ShallowSplit +if { $vtest == 1 } { + find_regexp mkShallowSplitTest.v {input \[7 : 0\] putFoo_1_x;} + find_regexp mkShallowSplitTest.v {input \[15 : 0\] PUT_BAR_1_z;} + find_regexp mkShallowSplitTest.v {input \[7 : 0\] putFooBar_fooIn_y;} + find_regexp mkShallowSplitTest.v {input \[16 : 0\] putFooBar_barIn_w;} + find_regexp mkShallowSplitTest.v {input \[15 : 0\] putFoos_1_0;} + find_regexp mkShallowSplitTest.v {input \[15 : 0\] putFoos_1_49;} + find_regexp mkShallowSplitTest.v {input \[16 : 0\] putBaz_1_a;} + find_regexp mkShallowSplitTest.v {input \[491 : 0\] putBaz_1_c;} +} + +test_c_veri DeepSplit +if { $vtest == 1 } { + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFoo_1_x;} + find_regexp mkDeepSplitTest.v {input PUT_BAR_1_v_2;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] PUT_BAR_1_z_y;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFooBar_fooIn_y;} + find_regexp mkDeepSplitTest.v {input putFooBar_barIn_v_2;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFoos_1_0_x;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putFoos_1_49_y;} + find_regexp mkDeepSplitTest.v {input \[16 : 0\] putBaz_1_a;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] putBaz_1_c_2_1_7_y;} + find_regexp mkDeepSplitTest.v {input \[15 : 0\] putBaz_1_c_2_2_w_2;} +} + +test_c_veri InstanceSplit +if { $vtest == 1 } { + find_regexp mkInstanceSplitTest.v {input \[7 : 0\] putFoo_1_x;} + find_regexp mkInstanceSplitTest.v {input putFoo_1_ysign;} + find_regexp mkInstanceSplitTest.v {input \[6 : 0\] putFoo_1_yvalue;} + find_regexp mkInstanceSplitTest.v {input \[7 : 0\] PUT_BAR_1_z_x;} + find_regexp mkInstanceSplitTest.v {input \[6 : 0\] putFooBar_fooIn_yvalue;} + find_regexp mkInstanceSplitTest.v {input \[16 : 0\] putFooBar_barIn_w;} + find_regexp mkInstanceSplitTest.v {input \[799 : 0\] putFoos_1;} + find_regexp mkInstanceSplitTest.v {input \[16 : 0\] putBaz_1_a;} + find_regexp mkInstanceSplitTest.v {input \[491 : 0\] putBaz_1_c;} +} \ No newline at end of file diff --git a/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected new file mode 100644 index 000000000..bb4f2dc03 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected @@ -0,0 +1,5 @@ +putFoo: Foo {x= 1; y= 2} +putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} +putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} +putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] +putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} diff --git a/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected b/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected new file mode 100644 index 000000000..bb4f2dc03 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected @@ -0,0 +1,5 @@ +putFoo: Foo {x= 1; y= 2} +putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} +putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} +putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] +putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} diff --git a/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected b/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected new file mode 100644 index 000000000..bb4f2dc03 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected @@ -0,0 +1,5 @@ +putFoo: Foo {x= 1; y= 2} +putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} +putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} +putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] +putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} From a92ccb84f6579289cf609f4c892ec7bec6026078 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 18:29:59 -0700 Subject: [PATCH 30/89] Add test of DeepSplitPorts with an explicit non-recursive instance --- src/Libraries/Base1/SplitPorts.bs | 10 ++++++++-- testsuite/bsc.verilog/splitports/DeepSplit.bs | 20 ++++++++++++++++++- .../bsc.verilog/splitports/splitports.exp | 1 + .../splitports/sysDeepSplit.out.expected | 1 + 4 files changed, 29 insertions(+), 3 deletions(-) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index dd792ffc3..96e0c6ba8 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -5,12 +5,13 @@ package SplitPorts where import qualified List import Vector - - -- Newtype tags to indicate that a types should be split (recursively or not) into ports data ShallowSplit a = ShallowSplit a data DeepSplit a = DeepSplit a +-- Tag to indicate that the DeepSplitPorts recursion should terminate +data NoSplit a = NoSplit a + instance (ShallowSplitPorts a p) => SplitPorts (ShallowSplit a) p where splitPorts (ShallowSplit x) = shallowSplitPorts x unsplitPorts = ShallowSplit ∘ shallowUnsplitPorts @@ -21,6 +22,11 @@ instance (DeepSplitPorts a p) => SplitPorts (DeepSplit a) p where unsplitPorts = DeepSplit ∘ deepUnsplitPorts portNames _ = deepSplitPortNames (_ :: a) +instance DeepSplitPorts (NoSplit a) (Port a) where + splitPorts (NoSplit x) = Port x + unsplitPorts (Port x) = NoSplit x + portNames _ base = List.Cons base List.Nil + -- Helper class using generics, to split a struct or vector into a tuple of ports. class ShallowSplitPorts a p | a -> p where diff --git a/testsuite/bsc.verilog/splitports/DeepSplit.bs b/testsuite/bsc.verilog/splitports/DeepSplit.bs index 79bd97470..5b9eb8c2d 100644 --- a/testsuite/bsc.verilog/splitports/DeepSplit.bs +++ b/testsuite/bsc.verilog/splitports/DeepSplit.bs @@ -24,12 +24,28 @@ struct Baz = e :: Vector 0 Foo -- No Bits instance needed +struct Quix = + q :: Int 3 + v :: Bool + deriving (Bits) + +-- Don't recurse into Quix with DeepSplitPorts +instance DeepSplitPorts Quix (Port Quix) where + deepSplitPorts x = Port x + deepUnsplitPorts (Port x) = x + deepSplitPortNames _ base = Cons (base) Nil + +struct Zug = + qs :: Vector 2 Quix + blob :: Bool + interface SplitTest = putFoo :: DeepSplit Foo -> Action putBar :: DeepSplit Bar -> Action {-# prefix = "PUT_BAR" #-} putFooBar :: DeepSplit Foo -> DeepSplit Bar -> Action {-# arg_names = ["fooIn", "barIn"] #-} putFoos :: DeepSplit (Vector 50 Foo) -> Action putBaz :: DeepSplit Baz -> Action + putZug :: DeepSplit Zug -> Action {-# synthesize mkDeepSplitTest #-} @@ -42,6 +58,7 @@ mkDeepSplitTest = putFooBar (DeepSplit x) (DeepSplit y) = $display "putFooBar: " (cshow x) " " (cshow y) putFoos (DeepSplit x) = $display "putFoos: " (cshow x) putBaz (DeepSplit x) = $display "putBaz: " (cshow x) + putZug (DeepSplit x) = $display "putZug: " (cshow x) {-# synthesize sysDeepSplit #-} sysDeepSplit :: Module Empty @@ -56,4 +73,5 @@ sysDeepSplit = when i == 2 ==> s.putFooBar (DeepSplit $ Foo { x = 5; y = 6; }) (DeepSplit $ Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) when i == 3 ==> s.putFoos $ DeepSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } when i == 4 ==> s.putBaz $ DeepSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } - when i == 5 ==> $finish + when i == 5 ==> s.putZug $ DeepSplit $ Zug { qs = vec (Quix { q = 1; v = True }) (Quix { q = 2; v = False }); blob = False; } + when i == 6 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp index bf548ed20..8b49efecd 100644 --- a/testsuite/bsc.verilog/splitports/splitports.exp +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -23,6 +23,7 @@ if { $vtest == 1 } { find_regexp mkDeepSplitTest.v {input \[16 : 0\] putBaz_1_a;} find_regexp mkDeepSplitTest.v {input \[7 : 0\] putBaz_1_c_2_1_7_y;} find_regexp mkDeepSplitTest.v {input \[15 : 0\] putBaz_1_c_2_2_w_2;} + find_regexp mkDeepSplitTest.v {input \[3 : 0\] putZug_1_qs_1;} } test_c_veri InstanceSplit diff --git a/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected index bb4f2dc03..fa26cd6e1 100644 --- a/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected +++ b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected @@ -3,3 +3,4 @@ putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} +putZug: Zug {qs=[Quix {q= 1; v=True}, Quix {q= 2; v=False}]; blob=False} From dfdfd1857c02ef5a78d025d8a8330a6e51cd2c7c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 19:10:02 -0700 Subject: [PATCH 31/89] Fix NoSplit instance --- src/Libraries/Base1/SplitPorts.bs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index 96e0c6ba8..e09f8e6a0 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -23,9 +23,9 @@ instance (DeepSplitPorts a p) => SplitPorts (DeepSplit a) p where portNames _ = deepSplitPortNames (_ :: a) instance DeepSplitPorts (NoSplit a) (Port a) where - splitPorts (NoSplit x) = Port x - unsplitPorts (Port x) = NoSplit x - portNames _ base = List.Cons base List.Nil + deepSplitPorts (NoSplit x) = Port x + deepUnsplitPorts (Port x) = NoSplit x + deepSplitPortNames _ base = Cons base Nil -- Helper class using generics, to split a struct or vector into a tuple of ports. From 852457984e4ea0161bca9df7f87a44f827c2a2cc Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 19:34:09 -0700 Subject: [PATCH 32/89] Add a comment --- src/Libraries/Base1/Vector.bs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Libraries/Base1/Vector.bs b/src/Libraries/Base1/Vector.bs index 82a37d9cb..5ec178247 100644 --- a/src/Libraries/Base1/Vector.bs +++ b/src/Libraries/Base1/Vector.bs @@ -1256,7 +1256,7 @@ toChunks x = let padding = (0 :: Bit ch_sz) in unpack(tmp[v_sz-1:0]) - +-- Convert between a vector of n tuples a and a flattened tuple b. class ConcatTuple n a b | n a -> b where concatTuple :: Vector n a -> b unconcatTuple :: b -> Vector n a From 5543a7ad524802b86ef5eb1b0dd9896f6ab541b7 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 19:50:39 -0700 Subject: [PATCH 33/89] 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 6057eb576..3bb8dfe7b 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4451,46 +4451,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 d08f38512..25800c7c6 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) @@ -904,8 +903,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 -- @@ -1110,9 +1110,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] []] -- -------------------- @@ -1202,7 +1203,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) @@ -1614,7 +1617,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) @@ -2173,7 +2177,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 @@ -2181,7 +2186,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 @@ -2223,9 +2228,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: From 8fbca9fadd5ad56d7b1ab0f5677f49fbb70ee44f Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 19 Aug 2024 22:26:11 -0700 Subject: [PATCH 34/89] Fix trailing whitespace --- src/Libraries/Base1/Vector.bs | 2 +- src/comp/IExpandUtils.hs | 4 ++-- src/comp/PragmaCheck.hs | 2 +- testsuite/bsc.verilog/splitports/DeepSplit.bs | 2 +- testsuite/bsc.verilog/splitports/InstanceSplit.bs | 2 +- testsuite/bsc.verilog/splitports/ShallowSplit.bs | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Libraries/Base1/Vector.bs b/src/Libraries/Base1/Vector.bs index 5ec178247..e329ae57b 100644 --- a/src/Libraries/Base1/Vector.bs +++ b/src/Libraries/Base1/Vector.bs @@ -1302,7 +1302,7 @@ instance (Add n1 1 n, ConcatTuple' n1 a b, AppendTuple b b c) => ConcatTuple' n let v1 :: Vector (TExp n1) a = take v v2 :: Vector (TExp n1) a = drop v in concatTuple' v1 `appendTuple` concatTuple' v2 - unconcatTuple' x = + unconcatTuple' x = let res :: (b, b) = splitTuple x v1 :: Vector (TExp n1) a = unconcatTuple' res.fst v2 :: Vector (TExp n1) a = unconcatTuple' res.snd diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index 09b925792..f6e3f7ec1 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -2026,7 +2026,7 @@ chkIfcPortNames errh args ifcs (ClockInfo ci co _ _) (ResetInfo ri ro) = when (not (null emsgs)) $ bsError errh emsgs where input_clock_ports i = - case lookup i ci of + case lookup i ci of Just (Just (VName o, Right (VName g))) -> [o, g] Just (Just (VName o, Left _)) -> [o] _ -> [] @@ -2051,7 +2051,7 @@ chkIfcPortNames errh args ifcs (ClockInfo ci co _ _) (ResetInfo ri ro) = default_clock_names = [ (n, idDefaultClock) | n <- input_clock_ports idDefaultClock ] default_reset_names = [ (n, idDefaultReset) | n <- input_reset_ports idDefaultReset ] - + arg_names = sort $ arg_port_names ++ arg_inout_names ++ arg_clock_names ++ arg_reset_names ++ default_clock_names ++ default_reset_names diff --git a/src/comp/PragmaCheck.hs b/src/comp/PragmaCheck.hs index d8c5a30c3..bd7701396 100644 --- a/src/comp/PragmaCheck.hs +++ b/src/comp/PragmaCheck.hs @@ -557,7 +557,7 @@ checkModulePortNames flgs pos pps vtis ftps = isClkField (_,t,_) = t == tClock isRstField (_,t,_) = t == tReset - + (clk_fs, other_fs) = partition isClkField ftps (rst_fs, _) = partition isRstField other_fs diff --git a/testsuite/bsc.verilog/splitports/DeepSplit.bs b/testsuite/bsc.verilog/splitports/DeepSplit.bs index 5b9eb8c2d..9cab5afea 100644 --- a/testsuite/bsc.verilog/splitports/DeepSplit.bs +++ b/testsuite/bsc.verilog/splitports/DeepSplit.bs @@ -50,7 +50,7 @@ interface SplitTest = {-# synthesize mkDeepSplitTest #-} mkDeepSplitTest :: Module SplitTest -mkDeepSplitTest = +mkDeepSplitTest = module interface putFoo (DeepSplit x) = $display "putFoo: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/InstanceSplit.bs b/testsuite/bsc.verilog/splitports/InstanceSplit.bs index 1e6a71314..83c2ce7da 100644 --- a/testsuite/bsc.verilog/splitports/InstanceSplit.bs +++ b/testsuite/bsc.verilog/splitports/InstanceSplit.bs @@ -51,7 +51,7 @@ interface SplitTest = {-# synthesize mkInstanceSplitTest #-} mkInstanceSplitTest :: Module SplitTest -mkInstanceSplitTest = +mkInstanceSplitTest = module interface putFoo x = $display "putFoo: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/ShallowSplit.bs b/testsuite/bsc.verilog/splitports/ShallowSplit.bs index 11166e76a..1c96ac47b 100644 --- a/testsuite/bsc.verilog/splitports/ShallowSplit.bs +++ b/testsuite/bsc.verilog/splitports/ShallowSplit.bs @@ -34,7 +34,7 @@ interface SplitTest = {-# synthesize mkShallowSplitTest #-} mkShallowSplitTest :: Module SplitTest -mkShallowSplitTest = +mkShallowSplitTest = module interface putFoo (ShallowSplit x) = $display "putFoo: " (cshow x) From 84e9697957dc704c8ce69b466dde842210b4e9ba Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 20 Aug 2024 12:28:53 -0700 Subject: [PATCH 35/89] Addressing Ravi's comments --- src/Libraries/Base1/Prelude.bs | 11 ++++++++--- src/Libraries/Base1/SplitPorts.bs | 12 +++++++----- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 3bb8dfe7b..6bc80f327 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4466,7 +4466,6 @@ class (WrapField :: $ -> * -> * -> *) name f w | name f -> w where -- Save the port types for a field in the wrapped interface, given the module name -- and the prefix, arg_names and result pragmas. saveFieldPortTypes :: StrArg name -> f -> Maybe Name__ -> String -> List String -> String -> Module () - saveFieldPortTypes _ _ _ _ _ _ = return () instance (WrapMethod m w) => (WrapField name m w) where toWrapField _ prefix names = @@ -4482,14 +4481,17 @@ instance (WrapMethod m w) => (WrapField name m w) where instance WrapField name PrimAction PrimAction where toWrapField _ _ _ = id fromWrapField _ = id + saveFieldPortTypes _ _ _ _ _ _ = return () instance WrapField name Clock Clock where toWrapField _ _ _ = id fromWrapField _ = id + saveFieldPortTypes _ _ _ _ _ _ = return () instance WrapField name Reset Reset where toWrapField _ _ _ = id fromWrapField _ = id + saveFieldPortTypes _ _ _ _ _ _ = return () instance (Bits a n) => WrapField name (Inout a) (Inout_ n) where toWrapField _ _ _ = primInoutCast0 @@ -4505,11 +4507,9 @@ class WrapMethod m w | m -> w where -- 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 _ _ _ _ = Nil -- Compute the list of input port names for a method, from the argument base names. inputPortNames :: m -> List String -> List String - inputPortNames _ _ = Nil -- 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 () @@ -4520,6 +4520,7 @@ instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry ( fromWrapMethod f = fromWrapMethod ∘ uncurryN f ∘ packPorts ∘ splitPorts methodArgBaseNames _ prefix (Cons h t) i = Cons + -- arg_names can start with a digit (if prefix == "" && not (isDigit $ stringHead h) then h else prefix +++ "_" +++ h) (methodArgBaseNames (_ :: b) prefix t $ i + 1) methodArgBaseNames _ prefix Nil i = Cons @@ -4537,11 +4538,15 @@ instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry ( instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where toWrapMethod = toActionValue_ fromWrapMethod = fromActionValue_ + methodArgBaseNames _ _ _ _ = Nil + inputPortNames _ _ = Nil saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) instance (Bits a n) => WrapMethod a (Bit n) where toWrapMethod = pack fromWrapMethod = unpack + methodArgBaseNames _ _ _ _ = Nil + inputPortNames _ _ = Nil saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) {- diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index e09f8e6a0..57aeafb8e 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -68,6 +68,7 @@ instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta (MetaField name id shallowSplitPorts' (Meta x) = shallowSplitPorts' x shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' shallowSplitPortNames' _ base = shallowSplitPortNames' (_ :: r) $ + -- Avoid an extra underscore, since data fields names are _[0-9]+ if stringHead (stringOf name) == '_' then base +++ stringOf name else base +++ "_" +++ stringOf name @@ -106,25 +107,25 @@ instance DeepSplitPorts () () where instance (DeepSplitTuplePorts (a, b) p) => DeepSplitPorts (a, b) p where deepSplitPorts = deepSplitTuplePorts - deepUnsplitPorts = deepUndeepSplitTuplePorts + deepUnsplitPorts = deepUnsplitTuplePorts deepSplitPortNames = deepSplitTuplePortNames 1 class DeepSplitTuplePorts a p | a -> p where deepSplitTuplePorts :: a -> p - deepUndeepSplitTuplePorts :: p -> a + deepUnsplitTuplePorts :: p -> a deepSplitTuplePortNames :: Integer -> a -> String -> List String instance (DeepSplitPorts a p, DeepSplitTuplePorts b q, AppendTuple p q r) => DeepSplitTuplePorts (a, b) r where deepSplitTuplePorts (a, b) = deepSplitPorts a `appendTuple` deepSplitTuplePorts b - deepUndeepSplitTuplePorts x = case splitTuple x of - (a, b) -> (deepUnsplitPorts a, deepUndeepSplitTuplePorts b) + deepUnsplitTuplePorts x = case splitTuple x of + (a, b) -> (deepUnsplitPorts a, deepUnsplitTuplePorts b) deepSplitTuplePortNames i _ base = deepSplitPortNames (_ :: a) (base +++ "_" +++ integerToString i) `List.append` deepSplitTuplePortNames (i + 1) (_ :: b) base instance (DeepSplitPorts a p) => DeepSplitTuplePorts a p where deepSplitTuplePorts = deepSplitPorts - deepUndeepSplitTuplePorts x = deepUnsplitPorts x + deepUnsplitTuplePorts x = deepUnsplitPorts x deepSplitTuplePortNames i _ base = deepSplitPortNames (_ :: a) $ base +++ "_" +++ integerToString i @@ -178,6 +179,7 @@ instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r deepSplitPorts'' (Meta x) = deepSplitPorts'' x deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ + -- Avoid an extra underscore, since data fields names are _[0-9]+ if stringHead (stringOf name) == '_' then base +++ stringOf name else base +++ "_" +++ stringOf name From 5e04b7d972a02a050728a048e0686f1e29a3155f Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 20 Aug 2024 17:02:31 -0700 Subject: [PATCH 36/89] Fix more comments --- src/comp/CVPrint.hs | 4 ++-- src/comp/ContextErrors.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/comp/CVPrint.hs b/src/comp/CVPrint.hs index 100b93685..f2c8c95d6 100644 --- a/src/comp/CVPrint.hs +++ b/src/comp/CVPrint.hs @@ -287,8 +287,8 @@ instance PVPrint CDefn where pvPrint d p (CprimType (IdKind i k)) = t"primitive type" <+> pp d i <+> t "::" <+> pp d k - pvPrint d p (Cforeign i ty oname opnames _) = - text "foreign" <+> pvpId d i <+> t "::" + pvPrint d p (Cforeign i ty oname opnames ni) = + text "foreign" <> (if ni then text " noinline" else empty) <+> pvpId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> empty; Just s -> text (" = " ++ show s)) <> (case opnames of diff --git a/src/comp/ContextErrors.hs b/src/comp/ContextErrors.hs index 0519ee94c..824a6a77f 100644 --- a/src/comp/ContextErrors.hs +++ b/src/comp/ContextErrors.hs @@ -464,7 +464,7 @@ handleCtxRedPrimPort pos (vp, reduced_ps) userty = 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.") + "This method uses types that are not in the Bits or SplitPorts typeclasses.") -- ======================================================================== From 57c58240ab56668bee0dfe9720abb5cad99356f3 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 22 Aug 2024 11:11:01 -0700 Subject: [PATCH 37/89] Fix testsuite failure after error message tweak --- .../noinline/NoInline_ArgNotInBits.bsv.bsc-vcomp-out.expected | 2 +- .../noinline/NoInline_ResNotInBits.bsv.bsc-vcomp-out.expected | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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 8cb78a0bb..e274d2a83 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 @@ -8,4 +8,4 @@ Error: Unknown position: (T0031) "NoInline_ArgNotInBits.bsv", line 4, column 15 Error: "NoInline_ArgNotInBits.bsv", line 4, column 15: (T0043) Cannot synthesize `fnNoInline_ArgNotInBits': This method uses types that are - not in the Bits or SplitPorts typeclass. + not in the Bits or SplitPorts typeclasses. 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 f00649d96..66f5ca699 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 @@ -8,7 +8,7 @@ Error: Unknown position: (T0031) "NoInline_ResNotInBits.bsv", line 4, column 12 Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0043) Cannot synthesize `fnNoInline_ResNotInBits': This method uses types that are - not in the Bits or SplitPorts typeclass. + not in the Bits or SplitPorts typeclasses. Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0029) Signature mismatch (given too general): given: From 35fd767f69365ebcb0636098173e4dadad34821c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 22 Aug 2024 16:03:25 -0700 Subject: [PATCH 38/89] Record the full field name path in WrapField context, for better errors for a non-synthesizable subinterface --- src/comp/GenWrap.hs | 20 +++++++++++++------ .../signature/NestedIfcIntegerArg.bs | 14 +++++++++++++ testsuite/bsc.codegen/signature/signature.exp | 1 + 3 files changed, 29 insertions(+), 6 deletions(-) create mode 100644 testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 25800c7c6..99ceefeb4 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -19,7 +19,7 @@ import Error(internalError, EMsg, EMsgs(..), ErrMsg(..), ErrorHandle, bsError) import ErrorMonad(ErrorMonad, convErrorMonadToIO) import Flags(Flags) import FStringCompat -import PreStrings(fsUnderscore, fs_t, fsTo, fsFrom, fsEmpty, fsEnable, fs_rdy) +import PreStrings(fsUnderscore, fs_t, fsTo, fsFrom, fsEmpty, fsEnable, fs_rdy, fsDot) import Id import IdPrint import PreIds @@ -903,7 +903,7 @@ 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 fnt = cTStr (fieldPathName prefixes fieldId) (getIdPosition fieldIdQ) let v = cTVar $ head tmpTyVarIds let ctx = CPred (CTypeclass idWrapField) [fnt, foldr arrow rettype argtypes, v] @@ -1110,7 +1110,7 @@ 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) + fnp = mkProxy $ 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 id_toWrapField) [fnp, prefix, arg_names, ec] @@ -1204,7 +1204,7 @@ genFrom pps ty var = let qs = if (hasNoRdy || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f) + let fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) let e = CApply (CVar id_fromWrapField) [fnp, sel binf] return (f, e, qs) @@ -1617,7 +1617,7 @@ 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 fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f) + let fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) let e = CApply (CVar id_fromWrapField) [fnp, sel binf] return (f, e, qs) @@ -1933,6 +1933,14 @@ binId :: IfcPrefixes -> Id -> Id binId ifcp i | i == idEmpty = mkId noPosition (concatFString (init (ifcp_pathIdString ifcp))) binId ifcp i = (mkIdPre (concatFString (ifcp_pathIdString ifcp)) (unQualId i)) +fieldPathName :: IfcPrefixes -> Id -> FString +-- XXX horrible hack when there isn't selection required at the end +fieldPathName ifcp i | i == idEmpty = concatFString $ init $ map underscoreToDot $ ifcp_pathIdString ifcp +fieldPathName ifcp i = concatFString $ map underscoreToDot (ifcp_pathIdString ifcp) ++ [getIdBase i] + +underscoreToDot :: FString -> FString +underscoreToDot fs = if fs == fsUnderscore then fsDot else fs + -- Extend the prefixes -- Take the current set of prefix information, add to that information -- from the the pragma of the current field Id, and add it to the current set of @@ -2177,7 +2185,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId Just str -> joinStrings_ currentPre str Nothing -> joinStrings_ currentPre methodStr - let fproxy = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString f) (getIdPosition f) + let fproxy = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) proxy = mkProxy $ foldr arrow r as prefix = stringLiteralAt noPosition localPrefix arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] diff --git a/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs new file mode 100644 index 000000000..0c8072713 --- /dev/null +++ b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs @@ -0,0 +1,14 @@ +package NestedIfcIntegerArg where + +interface Foo = + put :: Integer -> Action + +interface Bar = + f :: Foo + +{-# synthesize mkBar #-} +mkBar :: Module Bar +mkBar = module + interface + f = interface Foo + put _ = noAction \ No newline at end of file diff --git a/testsuite/bsc.codegen/signature/signature.exp b/testsuite/bsc.codegen/signature/signature.exp index f560b908f..e33bf0603 100644 --- a/testsuite/bsc.codegen/signature/signature.exp +++ b/testsuite/bsc.codegen/signature/signature.exp @@ -10,6 +10,7 @@ compile_verilog_fail_error ProvisoMethod.bsv T0043 compile_verilog_fail_error NonBitsModuleArg.bsv T0043 compile_verilog_fail_error NonIfc.bsv T0043 compile_verilog_fail_error NonModule.bsv T0043 1 sysNonModule +compile_verilog_fail_error NestedIfcIntegerArg.bs T0043 # Test that types which are not simple constructors (but have arguments) # are also handled From a4873ac457f85a775130dfd59d617b82778e3625 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 22 Aug 2024 16:29:54 -0700 Subject: [PATCH 39/89] Don't surface implicit conditions from inside ICMethod --- src/comp/IExpand.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index e02855e69..28b10e0a7 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -4149,10 +4149,6 @@ getBuriedPreds (IAps ic@(ICon i_sel (ICSel { })) ts1 [e]) | (i_sel == idAVValue_ || i_sel == idAVAction_) = do --traceM("getBuriedPreds: AV sel") getBuriedPreds e -getBuriedPreds (ICon _ (ICMethod _ _ eb)) = do - -- traceM("getBuriedPreds: method") - p <- getBuriedPreds eb - return p getBuriedPreds e@(ICon _ _) = do --traceM("getBuriedPreds: con: e = " ++ ppReadable e ++ show e) return pTrue From 4f585a099a03f1efdb0e406370ad1b0477167f32 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 22 Aug 2024 17:02:57 -0700 Subject: [PATCH 40/89] FIx trailing whitespace --- testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs index 0c8072713..8ae222666 100644 --- a/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs +++ b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs @@ -1,9 +1,9 @@ package NestedIfcIntegerArg where -interface Foo = +interface Foo = put :: Integer -> Action -interface Bar = +interface Bar = f :: Foo {-# synthesize mkBar #-} From ad67afde1912d1a902fd9bc52b7a74d113dd5dda Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 23 Aug 2024 11:48:03 -0700 Subject: [PATCH 41/89] Slightly less gross list deconstruction in IExpand --- src/comp/IExpand.hs | 23 ++++++++++++----------- src/comp/PreIds.hs | 3 ++- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 28b10e0a7..d5ec4e4bd 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -2123,17 +2123,18 @@ evalStringList :: HExpr -> G ([String], Position) evalStringList e = do e' <- evaleUH e case e' of - IAps (ICon _ c) _ [a] -> do - a' <- evaleUH a - -- XXX this is a horrible way of pulling apart a list, but I don't think there is a better way: - case a' of - IAps (ICon i' (ICTuple {})) _ [e_h, e_t] | getIdBaseString i' == "List_$Cons" -> do - (h, _) <- evalString e_h - (t, _) <- evalStringList e_t - return (h:t, getIExprPosition e') - ICon _ (ICInt _ (IntLit { ilValue = 0 })) -> - return ([], getIExprPosition e') - _ -> internalError ("evalStringList con: " ++ showTypeless a') + IAps (ICon i _) _ [a] -> + if i == idPreludeCons then do + a' <- evaleUH a + case a' of + IAps (ICon _ (ICTuple {})) _ [e_h, e_t] -> do + (h, _) <- evalString e_h + (t, _) <- evalStringList e_t + return (h:t, getIExprPosition e') + _ -> internalError ("evalStringList Cons: " ++ showTypeless a') + -- We get primChr for Nil, since it's a no-argument constructor + else if i == idPrimChr then return ([], getIExprPosition e') + else internalError ("evalStringList con: " ++ show i) _ -> do e'' <- unheapAll e' errG (getIExprPosition e', EStringListNF (ppString e')) diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index e48c1cf66..b178aab2b 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -121,10 +121,11 @@ idInvalid = prelude_id_no fsInvalid idValid = prelude_id_no fsValid idEmpty = prelude_id_no fsEmptyIfc idFile = prelude_id_no fsFile -idEither, idLeft, idRight :: Id +idEither, idLeft, idRight, idPreludeCons :: Id idEither = prelude_id_no fsEither idLeft = prelude_id_no fsLeft idRight = prelude_id_no fsRight +idPreludeCons = prelude_id_no fsCons -- idCons isn't qualified idActionValue :: Id idActionValue = prelude_id_no fsActionValue From a7da1761bd25390cb121ba7ab9c2e1c15c48d848 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 23 Aug 2024 12:31:46 -0700 Subject: [PATCH 42/89] Add more tests --- .../ArgNamesPragma_PortNameConflict.bs | 25 ++++++++++ ...PortNameConflict.bs.bsc-vcomp-out.expected | 7 +++ .../BadSplitInst_PortNameConflict.bs | 25 ++++++++++ ...PortNameConflict.bs.bsc-vcomp-out.expected | 7 +++ .../BadSplitInst_TooManyPortNames.bs | 24 ++++++++++ ...TooManyPortNames.bs.bsc-vcomp-out.expected | 8 ++++ .../splitports/PortNameConflict.bs | 34 ++++++++++++++ ...PortNameConflict.bs.bsc-vcomp-out.expected | 7 +++ .../bsc.verilog/splitports/SomeArgNames.bs | 46 +++++++++++++++++++ .../bsc.verilog/splitports/splitports.exp | 23 +++++++++- .../splitports/sysSomeArgNames.out.expected | 1 + 11 files changed, 206 insertions(+), 1 deletion(-) create mode 100644 testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs create mode 100644 testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected create mode 100644 testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs create mode 100644 testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected create mode 100644 testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs create mode 100644 testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected create mode 100644 testsuite/bsc.verilog/splitports/PortNameConflict.bs create mode 100644 testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected create mode 100644 testsuite/bsc.verilog/splitports/SomeArgNames.bs create mode 100644 testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected diff --git a/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs new file mode 100644 index 000000000..85046dab3 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs @@ -0,0 +1,25 @@ +package ArgNamesPragma_PortNameConflict where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + z :: Bool + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port (Int 8), Port Bool) where + splitPorts f = (Port f.x, Port f.y, Port f.z) + unsplitPorts (Port x, Port y, Port z) = Foo { x=x; y=y; z=z; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_y") $ Cons (base +++ "_z") Nil + +interface SplitTest = + putFoo :: Foo -> Bool -> Action {-# prefix = "fooIn", arg_names = ["f", "f_z"] #-} + +{-# synthesize sysArgNamesPragma_PortNameConflict #-} +sysArgNamesPragma_PortNameConflict :: Module SplitTest +sysArgNamesPragma_PortNameConflict = + module + interface + putFoo x y = $display "putFoo: " (cshow x) (cshow y) diff --git a/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..37bd887de --- /dev/null +++ b/testsuite/bsc.verilog/splitports/ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out.expected @@ -0,0 +1,7 @@ +checking package dependencies +compiling ArgNamesPragma_PortNameConflict.bs +code generation for sysArgNamesPragma_PortNameConflict starts +Error: "ArgNamesPragma_PortNameConflict.bs", line 21, column 0: (G0055) + Method `putFoo' generates a port with name `fooIn_f_z' which conflicts with + a port of the same name generated by method `putFoo' at location + "ArgNamesPragma_PortNameConflict.bs", line 21, column 0. diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs new file mode 100644 index 000000000..8fc5d1518 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs @@ -0,0 +1,25 @@ +package BadSplitInst_PortNameConflict where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + z :: Bool + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port (Int 8), Port Bool) where + splitPorts f = (Port f.x, Port f.y, Port f.z) + unsplitPorts (Port x, Port y, Port z) = Foo { x=x; y=y; z=z; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_y") $ Cons (base +++ "_x") Nil + +interface SplitTest = + putFoo :: Foo -> Action {-# prefix = "fooIn" #-} + +{-# synthesize sysBadSplitInst_PortNameConflict #-} +sysBadSplitInst_PortNameConflict :: Module SplitTest +sysBadSplitInst_PortNameConflict = + module + interface + putFoo x = $display "putFoo: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..e825168aa --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_PortNameConflict.bs.bsc-vcomp-out.expected @@ -0,0 +1,7 @@ +checking package dependencies +compiling BadSplitInst_PortNameConflict.bs +code generation for sysBadSplitInst_PortNameConflict starts +Error: "BadSplitInst_PortNameConflict.bs", line 21, column 0: (G0055) + Method `putFoo' generates a port with name `fooIn_1_x' which conflicts with + a port of the same name generated by method `putFoo' at location + "BadSplitInst_PortNameConflict.bs", line 21, column 0. diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs new file mode 100644 index 000000000..b6bd12629 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs @@ -0,0 +1,24 @@ +package BadSplitInst_TooManyPortNames where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance SplitPorts Foo (Port (Int 8), Port (Int 8)) where + splitPorts f = (Port f.x, Port f.y) + unsplitPorts (Port x, Port y) = Foo { x=x; y=y; } + portNames _ base = Cons (base +++ "_x") $ Cons (base +++ "_y") $ Cons (base +++ "_z") Nil + +interface SplitTest = + putFoo :: Foo -> Action {-# prefix = "fooIn" #-} + +{-# synthesize sysBadSplitInst_TooManyPortNames #-} +sysBadSplitInst_TooManyPortNames :: Module SplitTest +sysBadSplitInst_TooManyPortNames = + module + interface + putFoo x = $display "putFoo: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..173d964cb --- /dev/null +++ b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected @@ -0,0 +1,8 @@ +checking package dependencies +compiling BadSplitInst_TooManyPortNames.bs +code generation for sysBadSplitInst_TooManyPortNames starts +Error: "Prelude.bs", line 4589, column 61: (S0015) + Bluespec evaluation-time error: SplitPorts: fooIn_1 has 2 ports, but 3 port + names were given + During elaboration of `sysBadSplitInst_TooManyPortNames' at + "BadSplitInst_TooManyPortNames.bs", line 20, column 0. diff --git a/testsuite/bsc.verilog/splitports/PortNameConflict.bs b/testsuite/bsc.verilog/splitports/PortNameConflict.bs new file mode 100644 index 000000000..145bb557c --- /dev/null +++ b/testsuite/bsc.verilog/splitports/PortNameConflict.bs @@ -0,0 +1,34 @@ +package PortNameConflict where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance (ShallowSplitPorts Foo p) => SplitPorts Foo p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Bar = + f :: Foo + f_x :: Int 16 + deriving (Bits) + +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putBar :: Bar -> Action {-# prefix = "barIn" #-} + +{-# synthesize sysPortNameConflict #-} +sysPortNameConflict :: Module SplitTest +sysPortNameConflict = + module + interface + putBar x = $display "putBar: " (cshow x) diff --git a/testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..be3183ec8 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/PortNameConflict.bs.bsc-vcomp-out.expected @@ -0,0 +1,7 @@ +checking package dependencies +compiling PortNameConflict.bs +code generation for sysPortNameConflict starts +Error: "PortNameConflict.bs", line 30, column 0: (G0055) + Method `putBar' generates a port with name `barIn_1_f_x' which conflicts + with a port of the same name generated by method `putBar' at location + "PortNameConflict.bs", line 30, column 0. diff --git a/testsuite/bsc.verilog/splitports/SomeArgNames.bs b/testsuite/bsc.verilog/splitports/SomeArgNames.bs new file mode 100644 index 000000000..fd2b871fe --- /dev/null +++ b/testsuite/bsc.verilog/splitports/SomeArgNames.bs @@ -0,0 +1,46 @@ +package SomeArgNames where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance (ShallowSplitPorts Foo p) => SplitPorts Foo p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Bar = + f :: Foo + b :: Bool + deriving (Bits) + +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putFooBar :: Foo -> Bar -> Action {-# arg_names = ["fooIn"] #-} + +{-# synthesize mkSomeArgNamesSplitTest #-} +mkSomeArgNamesSplitTest :: Module SplitTest +mkSomeArgNamesSplitTest = + module + interface + putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) + +{-# synthesize sysSomeArgNames #-} +sysSomeArgNames :: Module Empty +sysSomeArgNames = + module + s <- mkSomeArgNamesSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { f = Foo { x = 7; y = 8; }; b = True; }) + when i == 1 ==> $finish + diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp index 8b49efecd..430ff5daf 100644 --- a/testsuite/bsc.verilog/splitports/splitports.exp +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -37,4 +37,25 @@ if { $vtest == 1 } { find_regexp mkInstanceSplitTest.v {input \[799 : 0\] putFoos_1;} find_regexp mkInstanceSplitTest.v {input \[16 : 0\] putBaz_1_a;} find_regexp mkInstanceSplitTest.v {input \[491 : 0\] putBaz_1_c;} -} \ No newline at end of file +} + +test_c_veri SomeArgNames +if { $vtest == 1 } { + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_fooIn_x;} + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_fooIn_y;} + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_2_f_x;} + find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_2_f_y;} + find_regexp mkSomeArgNamesSplitTest.v {input putFooBar_2_b;} +} + +compile_verilog_fail_error PortNameConflict.bs G0055 +compare_file PortNameConflict.bs.bsc-vcomp-out + +compile_verilog_fail_error ArgNamesPragma_PortNameConflict.bs G0055 +compare_file ArgNamesPragma_PortNameConflict.bs.bsc-vcomp-out + +compile_verilog_fail_error BadSplitInst_PortNameConflict.bs G0055 +compare_file BadSplitInst_PortNameConflict.bs.bsc-vcomp-out + +compile_verilog_fail_error BadSplitInst_TooManyPortNames.bs S0015 +compare_file BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out \ No newline at end of file diff --git a/testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected b/testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected new file mode 100644 index 000000000..09b08a778 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/sysSomeArgNames.out.expected @@ -0,0 +1 @@ +putFooBar: Foo {x= 5; y= 6} Bar {f=Foo {x= 7; y= 8}; b=True} From 244c703a154a6427d3b03b171f7485a5d7ae49db Mon Sep 17 00:00:00 2001 From: Ravi Nanavati Date: Thu, 19 Dec 2024 15:15:03 -0800 Subject: [PATCH 43/89] Updated expected output for tests (just changes in positions and internal numbers) --- .../bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected | 6 +++--- .../bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected | 4 ++-- .../CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected | 4 ++-- .../signal_names/Method.bsv.bsc-vcomp-out.expected | 2 +- .../BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected index d8b638257..b402d2c80 100644 --- a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected @@ -55,9 +55,9 @@ PreludeBSV vMkCRegA5 PreludeBSV mkCReg PreludeBSV mkCRegU PreludeBSV mkCRegA -PreludeBSV _PreludeBSV.CReg5714 -PreludeBSV _PreludeBSV.CReg5810 -PreludeBSV _PreludeBSV.CReg5905 +PreludeBSV _PreludeBSV.CReg5715 +PreludeBSV _PreludeBSV.CReg5811 +PreludeBSV _PreludeBSV.CReg5906 Prelude Reg Prelude VReg Prelude vMkReg diff --git a/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected b/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected index 0ed61ea89..008aec9a3 100644 --- a/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected @@ -1,9 +1,9 @@ checking package dependencies compiling TestCReg_TooBig.bsv code generation for sysTestCReg_TooBig starts -Error: "PreludeBSV.bsv", line 1003, column 37: (S0015) +Error: "PreludeBSV.bsv", line 1004, column 37: (S0015) Bluespec evaluation-time error: `mkCReg' cannot have more than five ports - During elaboration of `error' at "PreludeBSV.bsv", line 1003, column 13. + During elaboration of `error' at "PreludeBSV.bsv", line 1004, column 13. During elaboration of `rg' at "TestCReg_TooBig.bsv", line 5, column 19. During elaboration of `sysTestCReg_TooBig' at "TestCReg_TooBig.bsv", line 3, column 8. diff --git a/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected b/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected index c846601a5..762058ab9 100644 --- a/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected @@ -1,10 +1,10 @@ checking package dependencies compiling TestCReg_TooSmall.bsv code generation for sysTestCReg_TooSmall starts -Error: "PreludeBSV.bsv", line 1004, column 37: (S0015) +Error: "PreludeBSV.bsv", line 1005, column 37: (S0015) Bluespec evaluation-time error: `mkCReg' cannot have a negative number of ports - During elaboration of `error' at "PreludeBSV.bsv", line 1004, column 13. + During elaboration of `error' at "PreludeBSV.bsv", line 1005, column 13. During elaboration of `rg' at "TestCReg_TooSmall.bsv", line 5, column 19. During elaboration of `sysTestCReg_TooSmall' at "TestCReg_TooSmall.bsv", line 3, column 8. diff --git a/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected index 7ba4cdb40..96e75b7f8 100644 --- a/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected @@ -17,7 +17,7 @@ arg info [clockarg default_clock;, resetarg default_reset;] -- APackage resets [(0, { wire: RST_N })] -- AP state elements -rg :: ABSTRACT: PreludeBSV._PreludeBSV.VRWire110 = RWire +rg :: ABSTRACT: PreludeBSV._PreludeBSV.VRWire112 = RWire (VModInfo RWire clock clk(); diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected index 173d964cb..b51ed54dd 100644 --- a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected +++ b/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: "Prelude.bs", line 4589, column 61: (S0015) +Error: "Prelude.bs", line 4590, column 61: (S0015) Bluespec evaluation-time error: SplitPorts: fooIn_1 has 2 ports, but 3 port names were given During elaboration of `sysBadSplitInst_TooManyPortNames' at From 364ce692e2d1956cba5d1abe0689d1604873d8dc Mon Sep 17 00:00:00 2001 From: Ravi Nanavati Date: Tue, 9 Sep 2025 14:36:04 -0700 Subject: [PATCH 44/89] Stop including explicit indices in the string type argument to the WrapField typeclass when generating vector-expanded interfaces. The differing strings at each index were defeating the joinNeededCtxs optimization in the typechecker, resulting in generating n times as many dictionaries as needed when compiling wrappers for vector-expanded interfaces. --- src/comp/GenWrap.hs | 29 +++++++++++++++---- .../vector_interfaces/WrapFieldRepeat.bs | 14 +++++++++ .../vector_interfaces/vector_interfaces.exp | 4 +++ 3 files changed, 42 insertions(+), 5 deletions(-) create mode 100644 testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 99ceefeb4..6f9ece3e1 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -9,6 +9,7 @@ module GenWrap( import Prelude hiding ((<>)) #endif +import Data.Char(isDigit) import Data.List(nub, (\\), find) import Control.Monad(when, foldM, filterM, zipWithM) import Control.Monad.Except(ExceptT, runExceptT, throwError) @@ -1935,11 +1936,29 @@ binId ifcp i = (mkIdPre (concatFString (ifcp_pathIdString ifcp)) (unQualId i)) fieldPathName :: IfcPrefixes -> Id -> FString -- XXX horrible hack when there isn't selection required at the end -fieldPathName ifcp i | i == idEmpty = concatFString $ init $ map underscoreToDot $ ifcp_pathIdString ifcp -fieldPathName ifcp i = concatFString $ map underscoreToDot (ifcp_pathIdString ifcp) ++ [getIdBase i] - -underscoreToDot :: FString -> FString -underscoreToDot fs = if fs == fsUnderscore then fsDot else fs +fieldPathName ifcp i | i == idEmpty = concatFString $ init $ map fixupPathElement $ ifcp_pathIdString ifcp +fieldPathName ifcp i = concatFString $ map fixupPathElement (ifcp_pathIdString ifcp) ++ [getIdBase i] + +fsIndexPlaceholder :: FString +fsIndexPlaceholder = mkFString "[_]" + +-- This has two transformations we want to do on path elements when constructing +-- the String type passed to WrapField for the field-wrapping error message: +-- 1. Replace the "_" separators in the path with "." to match the field selection that +-- would appear in the source. +-- 2. Replace the concrete index numbers in the path with "[_]". This is so that we do +-- not create multiple independent WrapField contexts when wrapping each element of a +-- vector-blasted field. If we use concrete field numbers each WrapField context needs to +-- be resolved individually, leading to repeated construction of the field-wrapping +-- dictionaries. If we use the placeholder all of the WrapField contexts for each +-- vector-blasted field will match so they will be joined into a single context +-- (see joinNeededCtxs in TCMisc.hs) before being resolved, so the field-wrapping +-- dictionaries will be constructed only once. +fixupPathElement :: FString -> FString +fixupPathElement fs + | fs == fsUnderscore = fsDot + | all isDigit (getFString fs) = fsIndexPlaceholder + | otherwise = fs -- Extend the prefixes -- Take the current set of prefix information, add to that information diff --git a/testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs b/testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs new file mode 100644 index 000000000..696f0811f --- /dev/null +++ b/testsuite/bsc.codegen/vector_interfaces/WrapFieldRepeat.bs @@ -0,0 +1,14 @@ +package WrapFieldRepeat where + +import Vector + +interface WrapFieldRepeat = + regs :: Vector 16 (Reg Bool) + +{-# verilog mkWrapFieldRepeat #-} +mkWrapFieldRepeat :: (IsModule m c) => m WrapFieldRepeat +mkWrapFieldRepeat = module + regs :: Vector 16 (Reg Bool) <- replicateM (mkReg True) + interface + regs = regs + diff --git a/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp b/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp index 8e919880d..b79e5bc63 100644 --- a/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp +++ b/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp @@ -6,3 +6,7 @@ compare_verilog mkClockVectorPassThrough.v compile_verilog_pass SizeZero.bsv +# This relies on the -dtypecheck dump from wrapper compilation +# overwriting the original -dtypecheck dump. +compile_object_pass WrapFieldRepeat.bs {} "-dtypecheck=tcwrapper.out" +find_n_strings tcwrapper.out "Prelude.Bits Prelude.Bool 1" 2 From ede3091ef133cf6496d7de379ebbe23e59d82cb3 Mon Sep 17 00:00:00 2001 From: Ravi Nanavati Date: Tue, 9 Sep 2025 18:25:38 -0700 Subject: [PATCH 45/89] Update position in expected error output. --- .../BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected index b51ed54dd..bf9aa089e 100644 --- a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected +++ b/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: "Prelude.bs", line 4590, column 61: (S0015) +Error: "Prelude.bs", line 4593, column 61: (S0015) Bluespec evaluation-time error: SplitPorts: fooIn_1 has 2 ports, but 3 port names were given During elaboration of `sysBadSplitInst_TooManyPortNames' at From b94b9911919030a20987184099f15c47407e45d2 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 21 Jan 2025 16:39:06 -0600 Subject: [PATCH 46/89] Clean up exports --- src/Libraries/Base1/Prelude.bs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 6bc80f327..460587cc4 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -172,7 +172,7 @@ package Prelude( Tuple6, tuple6, Has_tpl_6(..), Tuple7, tuple7, Has_tpl_7(..), Tuple8, tuple8, Has_tpl_8(..), - AppendTuple(..), AppendTuple'(..), TupleSize(..), + AppendTuple(..), AppendTuple', TupleSize, -- lists required for desugaring List(..), @@ -258,7 +258,8 @@ package Prelude( NumConArg(..), StarConArg(..), OtherConArg(..), MetaConsNamed(..), MetaConsAnon(..), MetaField(..), - primMethod, WrapField(..), WrapMethod(..), WrapPorts(..), + primMethod, -- TODO: Needed only in PreludeBSV for vMkRWire1, should be removed. + WrapField(..), WrapMethod(..), WrapPorts(..), Port(..), SplitPorts(..) ) where From 6d23a4896cfa7f3dd425b3dac17df2fe9e672c83 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 17 Nov 2025 11:55:40 -0800 Subject: [PATCH 47/89] Update expected test result --- .../commands/bpackage.tcl.bluetcl-bh-out.expected | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected index 576752ed7..b402d2c80 100644 --- a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected @@ -55,9 +55,9 @@ PreludeBSV vMkCRegA5 PreludeBSV mkCReg PreludeBSV mkCRegU PreludeBSV mkCRegA -PreludeBSV _PreludeBSV.CReg5713 -PreludeBSV _PreludeBSV.CReg5809 -PreludeBSV _PreludeBSV.CReg5904 +PreludeBSV _PreludeBSV.CReg5715 +PreludeBSV _PreludeBSV.CReg5811 +PreludeBSV _PreludeBSV.CReg5906 Prelude Reg Prelude VReg Prelude vMkReg From d971a02a4c653e61bcfa5d426445f0ca30affbc0 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 17 Nov 2025 15:39:58 -0800 Subject: [PATCH 48/89] Better position for error when wrong number of ports are returned by portNames --- src/Libraries/Base1/Prelude.bs | 3 ++- .../BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 460587cc4..de8303e6c 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4602,7 +4602,8 @@ checkPortNames proxy base = let pn = portNames proxy base in if listLength pn /= valueOf n - then error $ "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ + then primError (getEvalPosition proxy) $ + "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ " ports, but " +++ integerToString (listLength pn) +++ " port names were given" else pn diff --git a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected index bf9aa089e..f73317139 100644 --- a/testsuite/bsc.verilog/splitports/BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out.expected +++ b/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: "Prelude.bs", line 4593, column 61: (S0015) +Error: "BadSplitInst_TooManyPortNames.bs", line 17, column 12: (S0015) Bluespec evaluation-time error: SplitPorts: fooIn_1 has 2 ports, but 3 port names were given During elaboration of `sysBadSplitInst_TooManyPortNames' at From addfcbfa27b68df413ac06491a26255a4e3dc63b Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 17 Nov 2025 16:20:39 -0800 Subject: [PATCH 49/89] Include nolinline pragma in pPrint of Cforeign --- src/comp/CSyntax.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/comp/CSyntax.hs b/src/comp/CSyntax.hs index aec23f599..6f6ba841d 100644 --- a/src/comp/CSyntax.hs +++ b/src/comp/CSyntax.hs @@ -1132,7 +1132,8 @@ instance PPrint CDefn where (IdK i) -> ppConId d i (IdKind i k) -> ppConId d i <+> t "::" <+> pp d k (IdPKind i pk) -> ppConId d i <+> t "::" <+> pp d pk - pPrint d p (Cforeign i ty oname opnames _) = + pPrint d p (Cforeign i ty oname opnames ni) = + (if ni then text "{-# noinline" <+> ppVarId d i <+> text "#-}" else text "") <+> text "foreign" <+> ppVarId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> text ""; Just s -> text (" = " ++ show s)) <> (case opnames of Nothing -> text ""; Just (is, os) -> t"," <> pparen True (sep (map (text . show) is ++ po os))) From 008eb535fd3d8bf087c9baac7d15eb0d2c0af75c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 11:42:56 -0800 Subject: [PATCH 50/89] Make mkList take a Position argument --- src/comp/CSyntaxUtil.hs | 6 +++--- src/comp/GenWrap.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/comp/CSyntaxUtil.hs b/src/comp/CSyntaxUtil.hs index 284339e6d..8272d64c4 100644 --- a/src/comp/CSyntaxUtil.hs +++ b/src/comp/CSyntaxUtil.hs @@ -63,9 +63,9 @@ mkMaybe :: (Maybe CExpr) -> CExpr mkMaybe Nothing = CCon idInvalid [] mkMaybe (Just e) = CCon idValid [e] -mkList :: [CExpr] -> CExpr -mkList [] = CCon (idNil noPosition) [] -mkList (e:es) = CCon (idCons $ getPosition e) [e, mkList es] +mkList :: Position -> [CExpr] -> CExpr +mkList pos [] = CCon (idNil pos) [] +mkList pos (e:es) = CCon (idCons pos) [e, mkList pos es] num_to_cliteral_at :: Integral n => Position -> n -> CLiteral num_to_cliteral_at pos num = CLiteral pos $ LInt $ ilDec (toInteger num) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 6f9ece3e1..c34fd2768 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1110,7 +1110,7 @@ genTo pps ty mk = localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) localPrefix = joinStrings_ currentPre localPrefix1 prefix = stringLiteralAt noPosition localPrefix - arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] + arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] fnp = mkProxy $ 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) @@ -2207,7 +2207,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId let fproxy = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) proxy = mkProxy $ foldr arrow r as prefix = stringLiteralAt noPosition localPrefix - arg_names = mkList [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] + arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] result = stringLiteralAt noPosition resultName return [ CSExpr Nothing $ From 3987cac8ddb67b2c3b6f0c9e3f43cd2e90ca2994 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 13:19:17 -0800 Subject: [PATCH 51/89] Remove idPreludeCons, qualify idCons and idNil --- src/comp/IExpand.hs | 2 +- src/comp/PreIds.hs | 10 ++++------ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index d5ec4e4bd..41b6121fa 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -2124,7 +2124,7 @@ evalStringList e = do e' <- evaleUH e case e' of IAps (ICon i _) _ [a] -> - if i == idPreludeCons then do + if i == idCons noPosition then do a' <- evaleUH a case a' of IAps (ICon _ (ICTuple {})) _ [e_h, e_t] -> do diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index b178aab2b..54ff0c23f 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -121,11 +121,10 @@ idInvalid = prelude_id_no fsInvalid idValid = prelude_id_no fsValid idEmpty = prelude_id_no fsEmptyIfc idFile = prelude_id_no fsFile -idEither, idLeft, idRight, idPreludeCons :: Id +idEither, idLeft, idRight :: Id idEither = prelude_id_no fsEither idLeft = prelude_id_no fsLeft idRight = prelude_id_no fsRight -idPreludeCons = prelude_id_no fsCons -- idCons isn't qualified idActionValue :: Id idActionValue = prelude_id_no fsActionValue @@ -310,14 +309,13 @@ idSJump pos = mkId pos fsSJump idSNamed pos = mkId pos fsSNamed idS pos = mkId pos fsS idStmt pos = mkId pos fsStmt -idSBreak, idSContinue, idSReturn, idCons, idConcat :: Position -> Id +idSBreak, idSContinue, idSReturn, idCons :: Position -> Id idSBreak pos = mkId pos fsSBreak idSContinue pos = mkId pos fsSContinue idSReturn pos = mkId pos fsSReturn -idCons pos = mkId pos fsCons -idConcat pos = mkId pos fsConcat +idCons pos = prelude_id pos fsCons idNil, idNothing, idSprime :: Position -> Id -idNil pos = mkId pos fsNil +idNil pos = prelude_id pos fsNil idNothing pos = mkId pos fsNothing idSprime pos = mkId pos fsSprime From 9a0584111e26634436026a1492380c66f7d3a798 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 13:20:50 -0800 Subject: [PATCH 52/89] Add missing newline --- testsuite/bsc.verilog/splitports/splitports.exp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp index 430ff5daf..814b416c5 100644 --- a/testsuite/bsc.verilog/splitports/splitports.exp +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -58,4 +58,4 @@ compile_verilog_fail_error BadSplitInst_PortNameConflict.bs G0055 compare_file BadSplitInst_PortNameConflict.bs.bsc-vcomp-out compile_verilog_fail_error BadSplitInst_TooManyPortNames.bs S0015 -compare_file BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out \ No newline at end of file +compare_file BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out From e4d82adb96255fbebfc94f9d278c2685ae6d2e21 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 15:44:24 -0800 Subject: [PATCH 53/89] Avoid treating (a, ()) as a tuple of size 1 --- src/Libraries/Base1/Prelude.bs | 54 +++++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 17 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index de8303e6c..887f6c351 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -95,7 +95,8 @@ package Prelude( primCharToString, primUIntBitsToInteger, primIntBitsToInteger, - ($), (∘), id, const, constFn, flip, while, curry, uncurry, Curry(..), asTypeOf, + ($), (∘), id, const, constFn, flip, while, + curry, uncurry, Curry(..), Curry', asTypeOf, liftM, liftM2, bindM, (<+>), rJoin, @@ -172,7 +173,7 @@ package Prelude( Tuple6, tuple6, Has_tpl_6(..), Tuple7, tuple7, Has_tpl_7(..), Tuple8, tuple8, Has_tpl_8(..), - AppendTuple(..), AppendTuple', TupleSize, + AppendTuple(..), AppendTuple', AppendTuple'', TupleSize, TupleSize', -- lists required for desugaring List(..), @@ -2605,17 +2606,25 @@ class Curry f g | f -> g where curryN :: f -> g uncurryN :: g -> f -instance (Curry (b -> c) d) => Curry ((a, b) -> c) (a -> d) where - curryN f x = curryN $ \y -> f (x, y) - uncurryN f (x, y) = uncurryN (f x) y - instance Curry (() -> a) a where curryN f = f () uncurryN f _ = f -instance Curry (a -> b) (a -> b) where - curryN = id - uncurryN = id +instance (Curry' f g) => Curry f g where + curryN = curryN' + uncurryN = uncurryN' + +class Curry' f g | f -> g where + curryN' :: f -> g + uncurryN' :: g -> f + +instance (Curry' (b -> c) d) => Curry' ((a, b) -> c) (a -> d) where + curryN' f x = curryN' $ \y -> f (x, y) + uncurryN' f (x, y) = uncurryN' (f x) y + +instance Curry' (a -> b) (a -> b) where + curryN' = id + uncurryN' = id --@ Constant function --@ \index{const@\te{const} (Prelude function)} @@ -3429,19 +3438,30 @@ instance AppendTuple' () a a where appendTuple' _ = id splitTuple' x = ((), x) -instance AppendTuple' a b (a, b) where - appendTuple' a b = (a, b) - splitTuple' = id +instance (AppendTuple'' a b c) => AppendTuple' a b c where + appendTuple' = appendTuple'' + splitTuple' = splitTuple'' -instance (AppendTuple' a b c) => AppendTuple' (h, a) b (h, c) where - appendTuple' (x, y) z = (x, appendTuple' y z) - splitTuple' (x, y) = case splitTuple' y of +class AppendTuple'' a b c | a b -> c where + appendTuple'' :: a -> b -> c + splitTuple'' :: c -> (a, b) + +instance AppendTuple'' a b (a, b) where + appendTuple'' a b = (a, b) + splitTuple'' = id + +instance (AppendTuple'' a b c) => AppendTuple'' (h, a) b (h, c) where + appendTuple'' (x, y) z = (x, appendTuple'' y z) + splitTuple'' (x, y) = case splitTuple'' y of (w, z) -> ((x, w), z) class TupleSize a n | a -> n where {} instance TupleSize () 0 where {} -instance TupleSize a 1 where {} -instance (TupleSize b n) => TupleSize (a, b) (TAdd n 1) where {} +instance (TupleSize' a n) => TupleSize a n where {} + +class TupleSize' a n | a -> n where {} +instance TupleSize' a 1 where {} +instance (TupleSize' b n) => TupleSize' (a, b) (TAdd n 1) where {} -- FUNCTIONS TO REPLACE UNAVAILABLE INFIXES From 7cac8f47ee444fbd4368b0a346d56f62bee5de34 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 16:06:15 -0800 Subject: [PATCH 54/89] Remove unused fsConcat --- src/comp/PreStrings.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index 41a8d1ba9..792032084 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -393,7 +393,6 @@ fsSBreak = mkFString "SBreak" fsSContinue = mkFString "SContinue" fsSReturn = mkFString "SReturn" fsCons = mkFString "Cons" -fsConcat = mkFString "concat" fsNil = mkFString "Nil" fsNothing = mkFString "Nothing" fsSprime = mkFString "_s__" From 734e740efd6c7f54626020aa5a0a9deedfd3214c Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 16:09:58 -0800 Subject: [PATCH 55/89] Remove outdated comment --- testsuite/bsc.verilog/noinline/noinline.exp | 3 --- 1 file changed, 3 deletions(-) diff --git a/testsuite/bsc.verilog/noinline/noinline.exp b/testsuite/bsc.verilog/noinline/noinline.exp index 598f7c411..974c1acc6 100644 --- a/testsuite/bsc.verilog/noinline/noinline.exp +++ b/testsuite/bsc.verilog/noinline/noinline.exp @@ -41,9 +41,6 @@ test_c_veri_bsv_modules \ module_testLessPatternsBSVFunction \ sysNoInline_LessPatternsThanArgs.out.expected -# The typedef fails because BSC doesn't expand the synonym before checking -# to see if the result type is in Bits, so the user gets a proviso error -# (bug 1466) compile_verilog_pass NoInline_LessPatternsThanArgs_BSV_TypeDef.bsv # ----- From db02f570a572edc48e61a60341f7eca9704f6e2d Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 16:12:21 -0800 Subject: [PATCH 56/89] mkProxy -> mkTypeProxyExpr --- src/comp/GenFuncWrap.hs | 2 +- src/comp/GenWrap.hs | 10 +++++----- src/comp/GenWrapUtils.hs | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/comp/GenFuncWrap.hs b/src/comp/GenFuncWrap.hs index 6a94d95fe..c14b801ef 100644 --- a/src/comp/GenFuncWrap.hs +++ b/src/comp/GenFuncWrap.hs @@ -246,7 +246,7 @@ funcDef errh symt i oqt@(CQType _ ot) i_ n (CQType _ t) = -- the result is either an actionvalue or a value isAV = isActionValue symt r - fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (getIdFString i) (getIdPosition i) + fnp = mkTypeProxyExpr $ 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, diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index c34fd2768..aad26179f 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1111,7 +1111,7 @@ genTo pps ty mk = localPrefix = joinStrings_ currentPre localPrefix1 prefix = stringLiteralAt noPosition localPrefix arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] - fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f)(getIdPosition f) + fnp = mkTypeProxyExpr $ 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 id_toWrapField) [fnp, prefix, arg_names, ec] @@ -1205,7 +1205,7 @@ genFrom pps ty var = let qs = if (hasNoRdy || isClock || isReset || isIot) then [] else [CQFilter meth_guard] - let fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) + let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) let e = CApply (CVar id_fromWrapField) [fnp, sel binf] return (f, e, qs) @@ -1618,7 +1618,7 @@ 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 fnp = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) + let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) let e = CApply (CVar id_fromWrapField) [fnp, sel binf] return (f, e, qs) @@ -2204,8 +2204,8 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId Just str -> joinStrings_ currentPre str Nothing -> joinStrings_ currentPre methodStr - let fproxy = mkProxy $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) - proxy = mkProxy $ foldr arrow r as + let fproxy = mkTypeProxyExpr $ 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] result = stringLiteralAt noPosition resultName diff --git a/src/comp/GenWrapUtils.hs b/src/comp/GenWrapUtils.hs index d8c6fe8f7..fbca33dd7 100644 --- a/src/comp/GenWrapUtils.hs +++ b/src/comp/GenWrapUtils.hs @@ -88,7 +88,7 @@ getDefArgs dcls t = -- ==================== -mkProxy :: CType -> CExpr -mkProxy ty = CHasType (CAny (getPosition ty) UNotUsed) $ CQType [] ty +mkTypeProxyExpr :: CType -> CExpr +mkTypeProxyExpr ty = CHasType (CAny (getPosition ty) UNotUsed) $ CQType [] ty From b6d066b3d32289fa1435657a1836847ace20d206 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 16:36:26 -0800 Subject: [PATCH 57/89] Add util to unwrap a Port value --- src/Libraries/Base1/Prelude.bs | 7 +++++-- src/Libraries/Base1/SplitPorts.bs | 4 ++-- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 887f6c351..0459ab8bc 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -261,7 +261,7 @@ package Prelude( primMethod, -- TODO: Needed only in PreludeBSV for vMkRWire1, should be removed. WrapField(..), WrapMethod(..), WrapPorts(..), - Port(..), SplitPorts(..) + Port(..), unPort, SplitPorts(..) ) where infixr 0 $ @@ -4641,6 +4641,9 @@ class SplitPorts a p | a -> p where data Port a = Port a deriving (FShow) +unPort :: Port a -> a +unPort (Port a) = a + -- XXX if the default instance is the only one, then it gets inlined in CtxReduce -- and other instances for this class are ignored. instance SplitPorts () () where @@ -4651,7 +4654,7 @@ instance SplitPorts () () where -- Default instance: don't split anything we don't know how to split. instance SplitPorts a (Port a) where splitPorts = Port - unsplitPorts (Port a) = a + unsplitPorts = unPort portNames _ base = Cons base Nil {- diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index 57aeafb8e..ea8288bd2 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -92,12 +92,12 @@ class DeepSplitPorts a p | a -> p where instance DeepSplitPorts (UInt n) (Port (UInt n)) where deepSplitPorts = Port - deepUnsplitPorts (Port x) = x + deepUnsplitPorts = unPort deepSplitPortNames _ base = Cons base Nil instance DeepSplitPorts (Int n) (Port (Int n)) where deepSplitPorts = Port - deepUnsplitPorts (Port x) = x + deepUnsplitPorts = unPort deepSplitPortNames _ base = Cons base Nil instance DeepSplitPorts () () where From 1448c16571d8e47d5df0a42c1c44b5111edabe63 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 18 Nov 2025 16:47:39 -0800 Subject: [PATCH 58/89] Avoid stringHead of an empty string --- src/Libraries/Base1/Prelude.bs | 4 +++- src/Libraries/Base1/SplitPorts.bs | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 0459ab8bc..2f9cb9b58 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4542,7 +4542,9 @@ instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry ( methodArgBaseNames _ prefix (Cons h t) i = Cons -- arg_names can start with a digit - (if prefix == "" && not (isDigit $ stringHead h) then h else prefix +++ "_" +++ h) + (if prefix == "" && (h == "" || not (isDigit $ stringHead h)) + then h + else prefix +++ "_" +++ h) (methodArgBaseNames (_ :: b) prefix t $ i + 1) methodArgBaseNames _ prefix Nil i = Cons (prefix +++ "_" +++ integerToString i) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index ea8288bd2..bca267139 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -69,7 +69,7 @@ instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta (MetaField name id shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' shallowSplitPortNames' _ base = shallowSplitPortNames' (_ :: r) $ -- Avoid an extra underscore, since data fields names are _[0-9]+ - if stringHead (stringOf name) == '_' + if stringOf name == "" || stringHead (stringOf name) == '_' then base +++ stringOf name else base +++ "_" +++ stringOf name @@ -180,7 +180,7 @@ instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ -- Avoid an extra underscore, since data fields names are _[0-9]+ - if stringHead (stringOf name) == '_' + if stringOf name == "" || stringHead (stringOf name) == '_' then base +++ stringOf name else base +++ "_" +++ stringOf name From c13b8b245bafab17884ba31ea115e51845497ee0 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 9 Dec 2025 16:01:33 -0800 Subject: [PATCH 59/89] Fix error in NFData CDefn instance from rebasing --- src/comp/CSyntax.hs | 2 +- src/comp/Prim.hs | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/comp/CSyntax.hs b/src/comp/CSyntax.hs index 6f6ba841d..e2c687aaa 100644 --- a/src/comp/CSyntax.hs +++ b/src/comp/CSyntax.hs @@ -196,7 +196,7 @@ instance NFData CDefn where rnf (Cinstance qt defls) = rnf2 qt defls rnf (CValue i cs) = rnf2 i cs rnf (CValueSign def) = rnf def - rnf (Cforeign name ty fname ports) = rnf4 name ty fname ports + rnf (Cforeign name ty fname ports ni) = rnf5 name ty fname ports ni rnf (Cprimitive i qt) = rnf2 i qt rnf (CprimType ik) = rnf ik rnf (CPragma pr) = rnf pr diff --git a/src/comp/Prim.hs b/src/comp/Prim.hs index 2af390c89..1702b4d50 100644 --- a/src/comp/Prim.hs +++ b/src/comp/Prim.hs @@ -674,6 +674,7 @@ instance NFData PrimOp where rnf PrimBOr = () rnf PrimInoutCast = () rnf PrimInoutUncast = () + rnf PrimMethod = () rnf PrimIf = () rnf PrimMux = () rnf PrimPriMux = () From 48f8f4ba0a8c7f50858d2efbe3a548cda9212903 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 5 Jan 2026 18:36:47 -0700 Subject: [PATCH 60/89] Fix to avoid extra _ in deepSplitPortNames/shallowSplitPortNames when base is empty --- src/Libraries/Base1/SplitPorts.bs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index bca267139..c1ff06bba 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -69,7 +69,7 @@ instance (ShallowSplitPorts' r p) => ShallowSplitPorts' (Meta (MetaField name id shallowUnsplitPorts' = Meta ∘ shallowUnsplitPorts' shallowSplitPortNames' _ base = shallowSplitPortNames' (_ :: r) $ -- Avoid an extra underscore, since data fields names are _[0-9]+ - if stringOf name == "" || stringHead (stringOf name) == '_' + if base == "" || stringOf name == "" || stringHead (stringOf name) == '_' then base +++ stringOf name else base +++ "_" +++ stringOf name @@ -180,7 +180,7 @@ instance (DeepSplitPorts'' r p) => DeepSplitPorts'' (Meta (MetaField name idx) r deepUnsplitPorts'' = Meta ∘ deepUnsplitPorts'' deepSplitPortNames'' _ base = deepSplitPortNames'' (_ :: r) $ -- Avoid an extra underscore, since data fields names are _[0-9]+ - if stringOf name == "" || stringHead (stringOf name) == '_' + if base == "" || stringOf name == "" || stringHead (stringOf name) == '_' then base +++ stringOf name else base +++ "_" +++ stringOf name From 63fdebf4cdabdc8a8fcea88e2e0bb3f7f0a50cfd Mon Sep 17 00:00:00 2001 From: Julie Schwartz Date: Sat, 10 Jan 2026 20:41:23 +1300 Subject: [PATCH 61/89] Update expected heap number in test --- testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp b/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp index 82b0d4347..1bd8faafb 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp +++ b/testsuite/bsc.bugs/bluespec_inc/b1894/b1894.exp @@ -18,8 +18,8 @@ if { $ctest == 1 } { # backend, and only then if the user has specified that it's OK # for the Verilog and Bluesim backends to diverge). # - find_regexp mkTop.cxx {2047u \& \(\(\(\(\(tUInt32\)\(\(tUInt8\)0u\)\) << 3u\) \| \(\(\(tUInt32\)\(DEF_cond__h[0-9]+\)\) << 2u\)\) \| \(tUInt32\)\(DEF_v__h178\)\);} - find_regexp mkTop.cxx {DEF_v__h178 = DEF_AVMeth_s_m;} + find_regexp mkTop.cxx {2047u \& \(\(\(\(\(tUInt32\)\(\(tUInt8\)0u\)\) << 3u\) \| \(\(\(tUInt32\)\(DEF_cond__h[0-9]+\)\) << 2u\)\) \| \(tUInt32\)\(DEF_v__h195\)\);} + find_regexp mkTop.cxx {DEF_v__h195 = DEF_AVMeth_s_m;} } # Also test that BSC fully initializes DEF_AVMeth_s_m From 2bb6215c5bb78e94e9d5f1a58b87c5e50ee2b376 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 13:40:02 -0800 Subject: [PATCH 62/89] Tweak to TupleSize instance --- src/Libraries/Base1/Prelude.bs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 2f9cb9b58..16a8a6506 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -3461,7 +3461,7 @@ instance (TupleSize' a n) => TupleSize a n where {} class TupleSize' a n | a -> n where {} instance TupleSize' a 1 where {} -instance (TupleSize' b n) => TupleSize' (a, b) (TAdd n 1) where {} +instance (TupleSize' b (TSub n 1)) => TupleSize' (a, b) n where {} -- FUNCTIONS TO REPLACE UNAVAILABLE INFIXES From ff6119041bf8432b209cb6e8ff7441d0d5d052e2 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 13:52:33 -0800 Subject: [PATCH 63/89] Add comments about DeepSplitPorts Int/UInt instances --- src/Libraries/Base1/SplitPorts.bs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Libraries/Base1/SplitPorts.bs b/src/Libraries/Base1/SplitPorts.bs index c1ff06bba..dd15071f8 100644 --- a/src/Libraries/Base1/SplitPorts.bs +++ b/src/Libraries/Base1/SplitPorts.bs @@ -90,6 +90,9 @@ class DeepSplitPorts a p | a -> p where deepUnsplitPorts :: p -> a deepSplitPortNames :: a -> String -> List String +-- Avoid recursing into Int and UInt. +-- These are wrappers around Bit, and we want to generate ports like foo_x and +-- not `foo_x_1` for an Int or UInt field x. instance DeepSplitPorts (UInt n) (Port (UInt n)) where deepSplitPorts = Port deepUnsplitPorts = unPort From 2bcf7d4257a100c53f6ef2d4e758b4f164675465 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 13:57:51 -0800 Subject: [PATCH 64/89] Change pPrint for Cforeign to match pvPrint --- src/comp/CSyntax.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/comp/CSyntax.hs b/src/comp/CSyntax.hs index e2c687aaa..c8d40355e 100644 --- a/src/comp/CSyntax.hs +++ b/src/comp/CSyntax.hs @@ -1133,8 +1133,7 @@ instance PPrint CDefn where (IdKind i k) -> ppConId d i <+> t "::" <+> pp d k (IdPKind i pk) -> ppConId d i <+> t "::" <+> pp d pk pPrint d p (Cforeign i ty oname opnames ni) = - (if ni then text "{-# noinline" <+> ppVarId d i <+> text "#-}" else text "") <+> - text "foreign" <+> ppVarId d i <+> t "::" <+> pp d ty <> + text "foreign" <> (if ni then text " noinline" else empty) <+> ppVarId d i <+> t "::" <+> pp d ty <> (case oname of Nothing -> text ""; Just s -> text (" = " ++ show s)) <> (case opnames of Nothing -> text ""; Just (is, os) -> t"," <> pparen True (sep (map (text . show) is ++ po os))) where po [o] = [text ",", text (show o)] From f4fb88503a1d3777d047384b3ca9502ffacc9b3e Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 14:01:04 -0800 Subject: [PATCH 65/89] Renaming PreIds ids --- src/comp/GenFuncWrap.hs | 4 ++-- src/comp/GenWrap.hs | 8 ++++---- src/comp/PreIds.hs | 8 ++++---- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/comp/GenFuncWrap.hs b/src/comp/GenFuncWrap.hs index c14b801ef..c25dc2dbc 100644 --- a/src/comp/GenFuncWrap.hs +++ b/src/comp/GenFuncWrap.hs @@ -9,7 +9,7 @@ import Error(internalError, ErrMsg(..), ErrorHandle, bsError) import Flags(Flags) import PPrint import Id -import PreIds(id_fromWrapField, idActionValue, idStrArg) +import PreIds(idFromWrapField, idActionValue, idStrArg) import CSyntax import SymTab import Scheme @@ -247,7 +247,7 @@ funcDef errh symt i oqt@(CQType _ ot) i_ n (CQType _ t) = isAV = isActionValue symt r fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (getIdFString i) (getIdPosition i) - expr = cVApply id_fromWrapField [fnp, CVar i_] + expr = cVApply idFromWrapField [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 aad26179f..020fee571 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1114,7 +1114,7 @@ genTo pps ty mk = fnp = mkTypeProxyExpr $ 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 id_toWrapField) [fnp, prefix, arg_names, ec] + let e = CApply (CVar idToWrapField) [fnp, prefix, arg_names, ec] return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- @@ -1206,7 +1206,7 @@ genFrom pps ty var = then [] else [CQFilter meth_guard] let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) - let e = CApply (CVar id_fromWrapField) [fnp, sel binf] + let e = CApply (CVar idFromWrapField) [fnp, sel binf] return (f, e, qs) @@ -1619,7 +1619,7 @@ mkFromBind true_ifc_ids var ft = let qs = if (wbinf `elem` true_ifc_ids || isClock || isReset || isIot) then [] else [CQFilter meth_guard] let fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f) (getIdPosition f) - let e = CApply (CVar id_fromWrapField) [fnp, sel binf] + let e = CApply (CVar idFromWrapField) [fnp, sel binf] return (f, e, qs) @@ -2212,7 +2212,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId return [ CSExpr Nothing $ cVApply idLiftModule $ - [cVApply id_saveFieldPortTypes + [cVApply idSaveFieldPortTypes [fproxy, proxy, mkMaybe v, prefix, arg_names, result]]] diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index 54ff0c23f..4eef48788 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -236,11 +236,11 @@ idPolyWrapField = mk_no fsPolyWrapField idLiftModule :: Id idLiftModule = prelude_id_no fsLiftModule -idWrapField, id_fromWrapField, id_toWrapField, id_saveFieldPortTypes :: Id +idWrapField, idFromWrapField, idToWrapField, idSaveFieldPortTypes :: Id idWrapField = prelude_id_no fsWrapField -id_fromWrapField = prelude_id_no fsFromWrapField -id_toWrapField = prelude_id_no fsToWrapField -id_saveFieldPortTypes = prelude_id_no fsSaveFieldPortTypes +idFromWrapField = prelude_id_no fsFromWrapField +idToWrapField = prelude_id_no fsToWrapField +idSaveFieldPortTypes = prelude_id_no fsSaveFieldPortTypes -- Used by desugaring id_lam, id_if, id_read, id_write :: Position -> Id From bfd96ce6ea07260c061391745a9cc5793b01df58 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 14:01:38 -0800 Subject: [PATCH 66/89] Add missing final newline --- testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs index 8ae222666..b54196d3e 100644 --- a/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs +++ b/testsuite/bsc.codegen/signature/NestedIfcIntegerArg.bs @@ -11,4 +11,4 @@ mkBar :: Module Bar mkBar = module interface f = interface Foo - put _ = noAction \ No newline at end of file + put _ = noAction From 7fc664df67ed6370bbc398542746302983079ac4 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 14:12:18 -0800 Subject: [PATCH 67/89] Add comment on test for vector interface instance dicts combining --- testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp b/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp index b79e5bc63..4b6d1412e 100644 --- a/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp +++ b/testsuite/bsc.codegen/vector_interfaces/vector_interfaces.exp @@ -6,6 +6,8 @@ compare_verilog mkClockVectorPassThrough.v compile_verilog_pass SizeZero.bsv +# We substitute _ for vector indices in the string types passed to WrapField in GenWrap.hs +# to ensure that theinstance dictionaries can be combined for vector-blasted interfaces. # This relies on the -dtypecheck dump from wrapper compilation # overwriting the original -dtypecheck dump. compile_object_pass WrapFieldRepeat.bs {} "-dtypecheck=tcwrapper.out" From 589f8064a0cf822e240a8b6c5b2ec53c8083d17a Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 14:14:58 -0800 Subject: [PATCH 68/89] Revert error code being checked for noinline type-not-in-bits tests --- testsuite/bsc.verilog/noinline/noinline.exp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/bsc.verilog/noinline/noinline.exp b/testsuite/bsc.verilog/noinline/noinline.exp index 974c1acc6..bf7b15e7a 100644 --- a/testsuite/bsc.verilog/noinline/noinline.exp +++ b/testsuite/bsc.verilog/noinline/noinline.exp @@ -56,11 +56,11 @@ test_c_veri_bsv_modules NoInlineInSched {module_inv} if { $vtest == 1 } { -compile_verilog_fail_error NoInline_ArgNotInBits.bsv T0031 +compile_verilog_fail_error NoInline_ArgNotInBits.bsv T0043 # compare for good measure, since the error has a configurable string compare_file NoInline_ArgNotInBits.bsv.bsc-vcomp-out -compile_verilog_fail_error NoInline_ResNotInBits.bsv T0031 +compile_verilog_fail_error NoInline_ResNotInBits.bsv T0043 # compare for good measure, since the error has a configurable string compare_file NoInline_ResNotInBits.bsv.bsc-vcomp-out From e9dbbce08c9e9f0dafb2b59ece0f7e149ad724c4 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 14:33:18 -0800 Subject: [PATCH 69/89] Eliminate EStringListNF --- src/comp/Error.hs | 4 ---- src/comp/IExpand.hs | 2 +- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/src/comp/Error.hs b/src/comp/Error.hs index 99fe44774..11c48ee11 100644 --- a/src/comp/Error.hs +++ b/src/comp/Error.hs @@ -1004,7 +1004,6 @@ data ErrMsg = | EModuleUndet | EModuleUndetNoMatch | EStringNF String - | EStringListNF String | ENoNF String String | EHasImplicit String | EModPortHasImplicit String String @@ -3944,9 +3943,6 @@ getErrorText (WRuleUndetPred is_meth rule poss) = nest 4 (vcat (map (text . prPosition) poss)) ) -getErrorText (EStringListNF s) = - (Generate 129, empty, s2par ("Not a compile time string list: " ++ s)) - --------------------------------------------------------------------------- --------------------------------------------------------------------------- diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 41b6121fa..8c6836870 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -2136,7 +2136,7 @@ evalStringList e = do else if i == idPrimChr then return ([], getIExprPosition e') else internalError ("evalStringList con: " ++ show i) _ -> do e'' <- unheapAll e' - errG (getIExprPosition e', EStringListNF (ppString e')) + eNoNF e'' ----------------------------------------------------------------------------- From c4246adc550d738467e946a404fb520dae722d70 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 18:05:47 -0800 Subject: [PATCH 70/89] Check for too many arg_names supplied for a method --- src/Libraries/Base1/Prelude.bs | 16 +++++-- .../bsc.verilog/splitports/TooManyArgNames.bs | 46 +++++++++++++++++++ .../TooManyArgNames.bs.bsc-vcomp-out.expected | 10 ++++ .../bsc.verilog/splitports/splitports.exp | 5 ++ 4 files changed, 73 insertions(+), 4 deletions(-) create mode 100644 testsuite/bsc.verilog/splitports/TooManyArgNames.bs create mode 100644 testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 16a8a6506..7837af151 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4561,15 +4561,23 @@ instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry ( instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where toWrapMethod = toActionValue_ fromWrapMethod = fromActionValue_ - methodArgBaseNames _ _ _ _ = Nil - inputPortNames _ _ = Nil + methodArgBaseNames _ _ Nil _ = Nil + methodArgBaseNames prx prefix argNames _ = + primError (getEvalPosition prx) $ integerToString (listLength argNames) +++ + " excess arg_names provided for method " +++ prefix + inputPortNames _ Nil = Nil + inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names" saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) instance (Bits a n) => WrapMethod a (Bit n) where toWrapMethod = pack fromWrapMethod = unpack - methodArgBaseNames _ _ _ _ = Nil - inputPortNames _ _ = Nil + methodArgBaseNames _ _ Nil _ = Nil + methodArgBaseNames prx prefix argNames _ = + primError (getEvalPosition prx) $ integerToString (listLength argNames) +++ + " excess arg_names provided for method " +++ prefix + inputPortNames _ Nil = Nil + inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names" saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) {- diff --git a/testsuite/bsc.verilog/splitports/TooManyArgNames.bs b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs new file mode 100644 index 000000000..9a97f196f --- /dev/null +++ b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs @@ -0,0 +1,46 @@ +package TooManyArgNames where + +import SplitPorts +import CShow + +struct Foo = + x :: Int 8 + y :: Int 8 + deriving (Bits) + +instance (ShallowSplitPorts Foo p) => SplitPorts Foo p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +struct Bar = + f :: Foo + b :: Bool + deriving (Bits) + +instance (ShallowSplitPorts Bar p) => SplitPorts Bar p where + splitPorts = shallowSplitPorts + unsplitPorts = shallowUnsplitPorts + portNames = shallowSplitPortNames + +interface SplitTest = + putFooBar :: Foo -> Bar -> Action {-# arg_names = ["fooIn1", "fooIn2", "fooIn3", "fooIn4"] #-} + +{-# synthesize mkTooManyArgNamesSplitTest #-} +mkTooManyArgNamesSplitTest :: Module SplitTest +mkTooManyArgNamesSplitTest = + module + interface + putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) + +{-# synthesize sysTooManyArgNames #-} +sysTooManyArgNames :: Module Empty +sysTooManyArgNames = + module + s <- mkTooManyArgNamesSplitTest + i :: Reg (UInt 8) <- mkReg 0 + rules + when True ==> i := i + 1 + when i == 0 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { f = Foo { x = 7; y = 8; }; b = True; }) + when i == 1 ==> $finish + diff --git a/testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected new file mode 100644 index 000000000..ca84b40ce --- /dev/null +++ b/testsuite/bsc.verilog/splitports/TooManyArgNames.bs.bsc-vcomp-out.expected @@ -0,0 +1,10 @@ +checking package dependencies +compiling TooManyArgNames.bs +code generation for mkTooManyArgNamesSplitTest starts +Error: "TooManyArgNames.bs", line 27, column 29: (S0015) + Bluespec evaluation-time error: 2 excess arg_names provided for method + putFooBar + During elaboration of the interface method `putFooBar' at + "TooManyArgNames.bs", line 30, column 0. + During elaboration of `mkTooManyArgNamesSplitTest' at "TooManyArgNames.bs", + line 30, column 0. diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp index 814b416c5..0987ba1ba 100644 --- a/testsuite/bsc.verilog/splitports/splitports.exp +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -39,6 +39,8 @@ if { $vtest == 1 } { find_regexp mkInstanceSplitTest.v {input \[491 : 0\] putBaz_1_c;} } +# Supplying an arg_names pragma that is shorter than the number of arguments +# is currently supported: test_c_veri SomeArgNames if { $vtest == 1 } { find_regexp mkSomeArgNamesSplitTest.v {input \[7 : 0\] putFooBar_fooIn_x;} @@ -48,6 +50,9 @@ if { $vtest == 1 } { find_regexp mkSomeArgNamesSplitTest.v {input putFooBar_2_b;} } +compile_verilog_fail_error TooManyArgNames.bs S0015 +compare_file TooManyArgNames.bs.bsc-vcomp-out + compile_verilog_fail_error PortNameConflict.bs G0055 compare_file PortNameConflict.bs.bsc-vcomp-out From 0dbb7fa575c3387daa76d185bfa9220639c540a4 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 19:13:35 -0800 Subject: [PATCH 71/89] Add comments in GenWrap --- src/comp/GenWrap.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 020fee571..8c9e877fd 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -1106,6 +1106,7 @@ genTo pps ty mk = fields <- mapM recurse nums return (concat fields) _ -> do + -- Compute the prefix and arg_names pragmas for the flattened interface field, extended according to the current prefix. let currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) localPrefix = joinStrings_ currentPre localPrefix1 @@ -1205,6 +1206,8 @@ genFrom pps ty var = let qs = if (hasNoRdy || isClock || isReset || isIot) then [] else [CQFilter meth_guard] + -- 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 e = CApply (CVar idFromWrapField) [fnp, sel binf] return (f, e, qs) @@ -1618,6 +1621,9 @@ 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] + + -- 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 e = CApply (CVar idFromWrapField) [fnp, sel binf] return (f, e, qs) @@ -2195,6 +2201,8 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId meth newprefixes ifcIdIn (FInf (mkNumId num) [] tVec []) concatMapM recurse nums _ -> do + -- Compute the local prefix and result name for this field in the flattened interface + -- from the current prefixes and pragmas from the field definition. let methodStr = getIdBaseString f currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) @@ -2204,6 +2212,8 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId Just str -> joinStrings_ currentPre str Nothing -> joinStrings_ currentPre methodStr + -- 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) proxy = mkTypeProxyExpr $ foldr arrow r as prefix = stringLiteralAt noPosition localPrefix From ca5c30835e9f978c3bc2d1bc5143a60b8b9f369a Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Jan 2026 16:59:46 -0800 Subject: [PATCH 72/89] Improve error message when a synthesized method or noinline function uses a type lacking a Bit or SplitPorts instance --- src/comp/ContextErrors.hs | 14 +++++++++++--- src/comp/Error.hs | 7 +++++-- src/comp/GenWrap.hs | 10 +++++----- src/comp/IExpand.hs | 4 ++-- ...oInline_ArgNotInBits.bsv.bsc-vcomp-out.expected | 5 +++-- ...oInline_ResNotInBits.bsv.bsc-vcomp-out.expected | 5 +++-- 6 files changed, 29 insertions(+), 16 deletions(-) diff --git a/src/comp/ContextErrors.hs b/src/comp/ContextErrors.hs index 824a6a77f..fb1dd59d4 100644 --- a/src/comp/ContextErrors.hs +++ b/src/comp/ContextErrors.hs @@ -462,9 +462,17 @@ handleCtxRedPrimPort pos (vp, reduced_ps) userty = -- -------------------- 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 typeclasses.") +handleCtxRedWrapField pos (vp, reduced_ps) name userty = + (pos, EBadIfcType Nothing $ + "The interface method `" ++ getFString name ++ + "' uses type(s) that are not in the Bits or SplitPorts typeclasses: " ++ + intercalate ", " (concatMap bitsPredType reduced_ps) + ) + where + bitsPredType :: VPred -> [String] + bitsPredType (VPred _ (PredWithPositions (IsIn (Class { name=(CTypeclass cid) }) [t, _]) _)) + | cid == idBits = [pfpString t] + bitsPredType _ = [] -- ======================================================================== diff --git a/src/comp/Error.hs b/src/comp/Error.hs index 11c48ee11..a3cd7adb0 100644 --- a/src/comp/Error.hs +++ b/src/comp/Error.hs @@ -805,7 +805,7 @@ data ErrMsg = | EPolyField | ENotKNum String | EBadGenArg String - | EBadIfcType String String + | EBadIfcType (Maybe String) String | EBadForeignIfcType String | ENoTypeSign String | EStmtContext String @@ -2120,9 +2120,12 @@ getErrorText (ENotKNum t) = (Type 41, empty, s2par ("Only size polymorphism allowed in code generation: " ++ t)) getErrorText (EBadGenArg i) = (Type 42, empty, s2par ("Bad argument in code generation: " ++ ishow i)) -getErrorText (EBadIfcType mod msg) = +getErrorText (EBadIfcType (Just mod) msg) = (Type 43, empty, s2par ("Cannot synthesize " ++ quote mod ++ ": " ++ msg)) +getErrorText (EBadIfcType Nothing msg) = + (Type 43, empty, + s2par ("Cannot synthesize this module or function: " ++ msg)) getErrorText (ENoTypeSign e) = (Type 44, empty, s2par ("Missing or bad type signature for a module: " ++ e)) getErrorText (EStmtContext c) = diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 8c9e877fd..03fa7dc11 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -430,12 +430,12 @@ chkType def ty = Right ((_:_) :=> _) -> let ctx = if isClassic() then "context" else "proviso" msg = "It has a " ++ ctx ++ "." - in bad (getPosition def, EBadIfcType (pfpString defId) msg) + in bad (getPosition def, EBadIfcType (Just $ pfpString defId) msg) Right ([] :=> t) -> do if not (null (tv t)) then let msg = "Its interface is polymorphic." - in bad (getPosition def, EBadIfcType (pfpString defId) msg) + in bad (getPosition def, EBadIfcType (Just $ pfpString defId) msg) else do --traceM ("chkType: " ++ pfpReadable (t, getArrows t)) @@ -447,7 +447,7 @@ chkType def ty = (f:_) -> let msg = "Its interface has a polymorphic field " ++ quote (pfpString f) ++ "." in bad (getPosition def, - EBadIfcType (pfpString defId) msg) + EBadIfcType (Just $ pfpString defId) msg) [] -> do ----traceM ("chkType 2: " ++ pfpReadable (chkInterface tr)) @@ -461,10 +461,10 @@ chkType def ty = quote (pfpString t) ++ " is not an interface." in bad (getPosition def, - EBadIfcType (pfpString defId) msg) + EBadIfcType (Just $ pfpString defId) msg) _ -> let msg = "It is not a module." in bad (getPosition def, - EBadIfcType (pfpString defId) msg) + EBadIfcType (Just $ pfpString defId) msg) -- Return a list of names of any fields which are polymorphic, -- if the given type is an interface; otherwise return an empty list. diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 8c6836870..1eb0d799f 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -5227,7 +5227,7 @@ reportNonSynthTypeInMethod modId methId methExpr = let str = "The interface method " ++ quote (pfpString methId) ++ " uses type " ++ quote (pfpString v) ++ " which is not in the Bits class." - in (modPos, EBadIfcType modName str) + in (modPos, EBadIfcType (Just modName) str) in case (getNonSynthTypes methExpr) of [] -> -- this shouldn't happen (modPos, EPolyField) @@ -5247,7 +5247,7 @@ reportNonSynthTypeInModuleArg modId modExpr = let str = "A parameter of the module uses the type " ++ quote (pfpString v) ++ " which is not in the Bits class." - in (modPos, EBadIfcType modName str) + in (modPos, EBadIfcType (Just modName) str) in case (getNonSynthTypes modExpr) of [] -> internalError ("IExpand: unexplained module with type parameter: " ++ 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 e274d2a83..cfc220460 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,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 `fnNoInline_ArgNotInBits': This method uses types that are - not in the Bits or SplitPorts typeclasses. + Cannot synthesize this module or function: The interface method + `fnNoInline_ArgNotInBits' uses type(s) that are not in the Bits or + SplitPorts typeclasses: NoInline_ArgNotInBits::L 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 66f5ca699..4ac6833dc 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,9 @@ 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 `fnNoInline_ResNotInBits': This method uses types that are - not in the Bits or SplitPorts typeclasses. + Cannot synthesize this module or function: 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) Signature mismatch (given too general): given: From 06d3552eb4f3b5b399d2779ef9f8264264bb1305 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Jan 2026 17:27:40 -0800 Subject: [PATCH 73/89] Add docs for new tuple utilites (mostly written by Claude) --- doc/libraries_ref_guide/LibDoc/Prelude.tex | 108 ++++++++++++++++++++ doc/libraries_ref_guide/LibDoc/Vector.tex | 112 +++++++++++++++++++++ 2 files changed, 220 insertions(+) diff --git a/doc/libraries_ref_guide/LibDoc/Prelude.tex b/doc/libraries_ref_guide/LibDoc/Prelude.tex index 4eff2aae5..80fbac8d5 100644 --- a/doc/libraries_ref_guide/LibDoc/Prelude.tex +++ b/doc/libraries_ref_guide/LibDoc/Prelude.tex @@ -3540,6 +3540,114 @@ \subsubsection{Tuples} foo = tuple2( !field1, field2 ); \end{verbatim} +\paragraph{TupleSize} + +\te{TupleSize} provides a way to determine the number of elements in a tuple +at the type level. The size is represented as a numeric type parameter. + +\index{TupleSize@\te{TupleSize} (type class)} +\index[typeclass]{TupleSize} + +\begin{libverbatim} + typeclass TupleSize #(type a, numeric type n) + dependencies (a determines n); + endtypeclass +\end{libverbatim} + +The type class has instances for unit type \te{void} with size 0, and for all +tuple types with their respective sizes. The numeric type \te{n} represents +the number of elements in the tuple. + +\begin{center} +\begin{tabular}{|p{1.5 in}|p{3.8 in}|} +\hline +\multicolumn{2}{|c|}{\te{TupleSize} Instances}\\ +\hline +\hline +\te{TupleSize \#(void, 0)}&The unit type has size 0.\\ +\hline +\te{TupleSize \#(a, 1)}&A single element (non-tuple) has size 1.\\ +\hline +\te{TupleSize \#((a, b), 2)}&A 2-tuple has size 2.\\ +\hline +\te{TupleSize \#((a,b,c), 3)}&A 3-tuple has size 3.\\ +\hline +\te{...}&Instances exist for all tuple sizes.\\ +\hline +\end{tabular} +\end{center} + +\paragraph{AppendTuple} + +\te{AppendTuple} provides a way to join two tuples of arbitrary size into a single larger +tuple, and to split a tuple back into two parts. + +\index{AppendTuple@\te{AppendTuple} (type class)} +\index{appendTuple@\texttt{appendTuple} (\texttt{AppendTuple} type class function)} +\index{splitTuple@\texttt{splitTuple} (\texttt{AppendTuple} type class function)} +\index[function]{Prelude!appendTuple} +\index[function]{Prelude!splitTuple} +\index[typeclass]{AppendTuple} + +\begin{libverbatim} + typeclass AppendTuple #(type a, type b, type c) + dependencies (a b determines c); + function c appendTuple(a x, b y); + function Tuple2#(a, b) splitTuple(c x); + endtypeclass +\end{libverbatim} + +The type class has instances for various tuple combinations, including special +handling for unit type \te{void}. + +\begin{center} +\begin{tabular}{|p{1.5 in}|p{3.8 in}|} +\hline +\multicolumn{2}{|c|}{\te{AppendTuple} Functions}\\ +\hline +\hline +\te{appendTuple}&Concatenates two tuples \te{x} and \te{y} into a single +larger tuple. The elements from \te{x} appear first, followed by the elements +from \te{y}.\\ +\cline{2-2} +&\\ +& \te{function c appendTuple(a x, b y);}\\ +&\\ +\hline +\te{splitTuple}&Splits a tuple \te{x} into two parts. Returns a 2-tuple +containing the first part of type \te{a} and the second part of type \te{b}.\\ +\cline{2-2} +&\\ +& \te{function Tuple2\#(a, b) splitTuple(c x);}\\ +&\\ +\hline +\end{tabular} +\end{center} + +{\bf Examples} + +\begin{verbatim} + // Appending a 2-tuple and a 3-tuple to create a 5-tuple + Tuple2#(Bool, Int#(8)) t1 = tuple2(True, 42); + Tuple3#(String, Bit#(4), UInt#(16)) t2 = tuple3("test", 4'hA, 100); + + Tuple5#(Bool, Int#(8), String, Bit#(4), UInt#(16)) t3 = + appendTuple(t1, t2); + + // Splitting a 4-tuple into a 2-tuple and a 2-tuple + Tuple4#(Bool, Int#(8), String, Bit#(4)) t4 = + tuple4(True, 42, "test", 4'hA); + + Tuple2#(Tuple2#(Bool, Int#(8)), Tuple2#(String, Bit#(4))) parts = + splitTuple(t4); + + // Appending with unit type + Tuple2#(Bool, Int#(8)) t5 = tuple2(False, 0); + Tuple2#(Bool, Int#(8)) t6 = appendTuple(t5, ?); // same as t5 + Tuple2#(Bool, Int#(8)) t7 = appendTuple(?, t5); // same as t5 +\end{verbatim} + + % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \com{Array} \subsubsection{Array} diff --git a/doc/libraries_ref_guide/LibDoc/Vector.tex b/doc/libraries_ref_guide/LibDoc/Vector.tex index 06cf9e077..1e6e0a799 100644 --- a/doc/libraries_ref_guide/LibDoc/Vector.tex +++ b/doc/libraries_ref_guide/LibDoc/Vector.tex @@ -2273,6 +2273,118 @@ \subsubsection{Converting to and from Vectors} \hline \end{tabular} +\paragraph{ConcatTuple} + +The \te{ConcatTuple} type class provides functions to convert between a Vector +of tuples and a single flattened tuple. When you have a Vector where each +element is a tuple (or can be viewed as a tuple), \te{concatTuple} flattens +all the elements into one large tuple by concatenating them together. The +reverse operation, \te{unconcatTuple}, splits a large tuple back into a Vector +of smaller tuples. + +\index{ConcatTuple@\te{ConcatTuple} (type class)} +\index{concatTuple@\texttt{concatTuple} (\texttt{ConcatTuple} type class function)} +\index{unconcatTuple@\texttt{unconcatTuple} (\texttt{ConcatTuple} type class function)} +\index[function]{Vector!concatTuple} +\index[function]{Vector!unconcatTuple} +\index[typeclass]{ConcatTuple} + +\begin{libverbatim} + typeclass ConcatTuple #(numeric type n, type a, type b) + dependencies (n a determines b); + function b concatTuple(Vector#(n, a) v); + function Vector#(n, a) unconcatTuple(b x); + endtypeclass +\end{libverbatim} + +The type class has instances for various vector sizes: +\begin{itemize} +\item A vector of size 0 converts to/from the unit type \te{void} +\item A vector of size 1 converts to/from a single element +\item Larger vectors convert by flattening: each element is appended to +form a larger tuple +\end{itemize} + +\begin{tabular}{|p{1.2 in}|p{4.4 in}|} +\hline +\multicolumn{2}{|c|}{\te{ConcatTuple} Functions}\\ +\hline +\hline +&\\ \te{concatTuple} & Flattens a Vector of tuples into a single large tuple +by concatenating all the tuple elements together. Each element of the vector +is appended sequentially to form the result tuple.\\ +& \\ \cline{2-2} +&\begin{libverbatim} +function b concatTuple(Vector#(n, a) v); +\end{libverbatim} +\\ +\hline +&\\ \te{unconcatTuple}&Splits a large tuple into a Vector of smaller tuples. +This is the inverse of \te{concatTuple}, distributing the tuple elements across +a Vector of the specified size.\\ +& \\ \cline{2-2} +&\begin{libverbatim} +function Vector#(n, a) unconcatTuple(b x); +\end{libverbatim} +\\ +\hline +\end{tabular} + +{\bf Example - ConcatTuple} + +Flatten a vector of 3 pairs (2-tuples) into a single 6-tuple: +\begin{libverbatim} + // Create a vector of three 2-tuples + Vector#(3, Tuple2#(Bool, Int#(8))) vec_of_pairs = vec( + tuple2(True, 1), + tuple2(False, 2), + tuple2(True, 3) + ); + + // Flatten into a single 6-tuple + Tuple6#(Bool, Int#(8), Bool, Int#(8), Bool, Int#(8)) flat = + concatTuple(vec_of_pairs); + // Result: (True, 1, False, 2, True, 3) + + // Convert back to vector of pairs + Vector#(3, Tuple2#(Bool, Int#(8))) restored = unconcatTuple(flat); +\end{libverbatim} + +Flatten a vector of 4 single elements (which can be viewed as 1-tuples) into a 4-tuple: +\begin{libverbatim} + Vector#(4, Int#(8)) vec_ints = vec(10, 20, 30, 40); + + // Each Int#(8) is treated as a single element + Tuple4#(Int#(8), Int#(8), Int#(8), Int#(8)) tuple_ints = + concatTuple(vec_ints); + // Result: (10, 20, 30, 40) +\end{libverbatim} + +Flatten a vector of 2 triples (3-tuples) into a single 6-tuple: +\begin{libverbatim} + Vector#(2, Tuple3#(Bool, UInt#(4), String)) vec_triples = vec( + tuple3(True, 5, "hello"), + tuple3(False, 10, "world") + ); + + Tuple6#(Bool, UInt#(4), String, Bool, UInt#(4), String) result = + concatTuple(vec_triples); + // Result: (True, 5, "hello", False, 10, "world") +\end{libverbatim} + +Special cases: +\begin{libverbatim} + // Empty vector converts to unit type + Vector#(0, Tuple2#(Bool, Int#(8))) empty = nil; + void unit = concatTuple(empty); + + // Single element vector returns just that element + Vector#(1, Tuple2#(Bool, Int#(8))) single = + vec(tuple2(True, 42)); + Tuple2#(Bool, Int#(8)) pair = concatTuple(single); + // Result: (True, 42) +\end{libverbatim} + {\bf Example - Converting to and from Vectors} From bbcfc566c690bec0df68a5bc09a179d3a53988b1 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Jan 2026 18:00:28 -0800 Subject: [PATCH 74/89] Add test cases for tuple utilites (generated by Claude) --- testsuite/bsc.lib/Prelude/AppendTuple.bs | 134 +++++++++++++++++ testsuite/bsc.lib/Prelude/Prelude.exp | 2 + testsuite/bsc.lib/Prelude/TupleSize.bs | 71 +++++++++ .../Prelude/sysAppendTuple.out.expected | 18 +++ .../bsc.lib/Prelude/sysTupleSize.out.expected | 11 ++ testsuite/bsc.lib/vector/ConcatTuple.bs | 140 ++++++++++++++++++ testsuite/bsc.lib/vector/libvector.exp | 2 + .../vector/sysConcatTuple.out.expected | 20 +++ 8 files changed, 398 insertions(+) create mode 100644 testsuite/bsc.lib/Prelude/AppendTuple.bs create mode 100644 testsuite/bsc.lib/Prelude/TupleSize.bs create mode 100644 testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected create mode 100644 testsuite/bsc.lib/Prelude/sysTupleSize.out.expected create mode 100644 testsuite/bsc.lib/vector/ConcatTuple.bs create mode 100644 testsuite/bsc.lib/vector/sysConcatTuple.out.expected diff --git a/testsuite/bsc.lib/Prelude/AppendTuple.bs b/testsuite/bsc.lib/Prelude/AppendTuple.bs new file mode 100644 index 000000000..bc0464fce --- /dev/null +++ b/testsuite/bsc.lib/Prelude/AppendTuple.bs @@ -0,0 +1,134 @@ +package AppendTuple where + +-- Test the AppendTuple type class + +{-# verilog sysAppendTuple #-} +sysAppendTuple :: Module Empty +sysAppendTuple = + module + counter :: Reg (UInt 5) <- mkReg 0 + + rules + "test0": when counter == 0 ==> action + $display "=== Testing AppendTuple ===" + -- Test appendTuple with two empty tuples + let u1 :: () + u1 = () + let u2 :: () + u2 = () + let result :: () + result = appendTuple u1 u2 + $display "appendTuple((), ()) = () [unit type]" + counter := counter + 1 + + "test1": when counter == 1 ==> action + -- Test appendTuple with unit type (left) + let t1 :: (Bool, Int 8) + t1 = (True, 42) + let t2 :: (Bool, Int 8) + t2 = appendTuple () t1 + $display "appendTuple((), (True, 42)) = (%b, %0d)" (tpl_1 t2) (tpl_2 t2) + counter := counter + 1 + + "test2": when counter == 2 ==> action + -- Test appendTuple with unit type (right) + let t1 :: (Bool, Int 8) + t1 = (False, negate 10) + let t2 :: (Bool, Int 8) + t2 = appendTuple t1 () + $display "appendTuple((False, -10), ()) = (%b, %0d)" (tpl_1 t2) (tpl_2 t2) + counter := counter + 1 + + "test3": when counter == 3 ==> action + -- Test append two 2-tuples to create 4-tuple + let t1 :: (Bool, Int 8) + t1 = (True, 5) + let t2 :: (UInt 4, Bit 3) + t2 = (12, 0b101) + let t4 :: (Bool, Int 8, UInt 4, Bit 3) + t4 = appendTuple t1 t2 + $display "appendTuple((True, 5), (12, 0b101)) = (%b, %0d, %0d, %b)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + counter := counter + 1 + + "test4": when counter == 4 ==> action + -- Test append single element and 2-tuple to create 3-tuple + let b :: Bool + b = False + let t2 :: (Int 8, UInt 4) + t2 = (negate 3, 7) + let t3 :: (Bool, Int 8, UInt 4) + t3 = appendTuple b t2 + $display "appendTuple(False, (-3, 7)) = (%b, %0d, %0d)" (tpl_1 t3) (tpl_2 t3) (tpl_3 t3) + counter := counter + 1 + + "test5": when counter == 5 ==> action + -- Test append 3-tuple and single element to create 4-tuple + let t3 :: (Bool, Int 8, UInt 4) + t3 = (True, 20, 8) + let b :: Bit 5 + b = 0b11010 + let t4 :: (Bool, Int 8, UInt 4, Bit 5) + t4 = appendTuple t3 b + $display "appendTuple((True, 20, 8), 0b11010) = (%b, %0d, %0d, %b)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + counter := counter + 1 + + "test6": when counter == 6 ==> action + -- Test append 2-tuple and 3-tuple to create 5-tuple + let t2 :: (Bool, Int 8) + t2 = (False, 15) + let t3 :: (UInt 4, Bit 3, Int 16) + t3 = (6, 0b111, negate 100) + let t5 :: (Bool, Int 8, UInt 4, Bit 3, Int 16) + t5 = appendTuple t2 t3 + $display "appendTuple((False, 15), (6, 0b111, -100)) = (%b, %0d, %0d, %b, %0d)" (tpl_1 t5) (tpl_2 t5) (tpl_3 t5) (tpl_4 t5) (tpl_5 t5) + $display "" + $display "=== Testing splitTuple ===" + counter := counter + 1 + + "test7": when counter == 7 ==> action + -- Test splitTuple: 4-tuple into 2-tuple and 2-tuple + let t4 :: (Bool, Int 8, UInt 4, Bit 3) + t4 = (True, negate 15, 9, 0b110) + let split :: ((Bool, Int 8), (UInt 4, Bit 3)) + split = splitTuple t4 + (t1, t2) = split + $display "splitTuple((True, -15, 9, 0b110)) = ((%b, %0d), (%0d, %b))" (tpl_1 t1) (tpl_2 t1) (tpl_1 t2) (tpl_2 t2) + counter := counter + 1 + + "test8": when counter == 8 ==> action + -- Test splitTuple: 3-tuple into single and 2-tuple + let t3 :: (Bool, Int 8, UInt 4) + t3 = (False, 33, 15) + let split :: (Bool, (Int 8, UInt 4)) + split = splitTuple t3 + (b, t2) = split + $display "splitTuple((False, 33, 15)) = (%b, (%0d, %0d))" b (tpl_1 t2) (tpl_2 t2) + counter := counter + 1 + + "test9": when counter == 9 ==> action + -- Test splitTuple: 5-tuple into 2-tuple and 3-tuple + let t5 :: (Bool, Int 8, UInt 4, Bit 3, Int 16) + t5 = (True, 50, 11, 0b001, negate 200) + let split :: ((Bool, Int 8), (UInt 4, Bit 3, Int 16)) + split = splitTuple t5 + (t2, t3) = split + $display "splitTuple((True, 50, 11, 0b001, -200)) = ((%b, %0d), (%0d, %b, %0d))" (tpl_1 t2) (tpl_2 t2) (tpl_1 t3) (tpl_2 t3) (tpl_3 t3) + $display "" + $display "=== Round-trip test ===" + counter := counter + 1 + + "test10": when counter == 10 ==> action + -- Test appendTuple and splitTuple round-trip + let t1 :: (Bool, Int 8) + t1 = (True, 42) + let t2 :: (UInt 4, Bit 5) + t2 = (13, 0b10101) + let t4 :: (Bool, Int 8, UInt 4, Bit 5) + t4 = appendTuple t1 t2 + let split :: ((Bool, Int 8), (UInt 4, Bit 5)) + split = splitTuple t4 + (r1, r2) = split + $display "appendTuple/splitTuple round-trip: ((%b, %0d), (%0d, %b))" (tpl_1 r1) (tpl_2 r1) (tpl_1 r2) (tpl_2 r2) + $display "" + $display "All AppendTuple tests passed" + $finish 0 diff --git a/testsuite/bsc.lib/Prelude/Prelude.exp b/testsuite/bsc.lib/Prelude/Prelude.exp index 0cc8d18e9..0b781b577 100644 --- a/testsuite/bsc.lib/Prelude/Prelude.exp +++ b/testsuite/bsc.lib/Prelude/Prelude.exp @@ -6,3 +6,5 @@ test_c_veri_bsv Eq2 compile_verilog_fail_no_internal_error Eq3 test_c_veri_bs_modules TuplePack {} +test_c_veri_bs_modules TupleSize {} +test_c_veri_bs_modules AppendTuple {} diff --git a/testsuite/bsc.lib/Prelude/TupleSize.bs b/testsuite/bsc.lib/Prelude/TupleSize.bs new file mode 100644 index 000000000..ce33fd2f2 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/TupleSize.bs @@ -0,0 +1,71 @@ +package TupleSize where + +-- Test the TupleSize type class by using it in proviso constraints + +-- Helper function that requires TupleSize constraint +tupleSize :: (TupleSize t n) => t -> Integer +tupleSize _ = valueOf n + +{-# verilog sysTupleSize #-} +sysTupleSize :: Module Empty +sysTupleSize = module + rules + "test": when True ==> action + $display "=== Testing TupleSize type class ===" + + -- Test TupleSize for unit type + let u :: () + u = () + let size0 = tupleSize u + $display "TupleSize of () = %0d (expected 0)" size0 + + -- Test TupleSize for single element (non-tuple) + let b :: Bool + b = True + let size1 = tupleSize b + $display "TupleSize of Bool = %0d (expected 1)" size1 + + -- Test TupleSize for 2-tuple + let t2 :: (Bool, Int 8) + t2 = (True, 0) + let size2 = tupleSize t2 + $display "TupleSize of Tuple2 = %0d (expected 2)" size2 + + -- Test TupleSize for 3-tuple + let t3 :: (Bool, Int 8, UInt 4) + t3 = (True, 0, 0) + let size3 = tupleSize t3 + $display "TupleSize of Tuple3 = %0d (expected 3)" size3 + + -- Test TupleSize for 4-tuple + let t4 :: (Bool, Int 8, UInt 4, Bit 5) + t4 = (True, 0, 0, 0) + let size4 = tupleSize t4 + $display "TupleSize of Tuple4 = %0d (expected 4)" size4 + + -- Test TupleSize for 5-tuple + let t5 :: (Bool, Int 8, UInt 4, Bit 5, Int 16) + t5 = (True, 0, 0, 0, 0) + let size5 = tupleSize t5 + $display "TupleSize of Tuple5 = %0d (expected 5)" size5 + + -- Test TupleSize for 6-tuple + let t6 :: (Bool, Int 8, UInt 4, Bit 5, Int 16, UInt 3) + t6 = (True, 0, 0, 0, 0, 0) + let size6 = tupleSize t6 + $display "TupleSize of Tuple6 = %0d (expected 6)" size6 + + -- Test TupleSize for 7-tuple + let t7 :: (Bool, Int 8, UInt 4, Bit 5, Int 16, UInt 3, Bit 2) + t7 = (True, 0, 0, 0, 0, 0, 0) + let size7 = tupleSize t7 + $display "TupleSize of Tuple7 = %0d (expected 7)" size7 + + -- Test TupleSize for 8-tuple + let t8 :: (Bool, Int 8, UInt 4, Bit 5, Int 16, UInt 3, Bit 2, Int 32) + t8 = (True, 0, 0, 0, 0, 0, 0, 0) + let size8 = tupleSize t8 + $display "TupleSize of Tuple8 = %0d (expected 8)" size8 + + $display "All TupleSize type class tests passed" + $finish 0 diff --git a/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected b/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected new file mode 100644 index 000000000..f45188783 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected @@ -0,0 +1,18 @@ +=== Testing AppendTuple === +appendTuple((), ()) = () [unit type] +appendTuple((), (True, 42)) = (1, 42) +appendTuple((False, -10), ()) = (0, -10) +appendTuple((True, 5), (12, 0b101)) = (1, 5, 12, 101) +appendTuple(False, (-3, 7)) = (0, -3, 7) +appendTuple((True, 20, 8), 0b11010) = (1, 20, 8, 11010) +appendTuple((False, 15), (6, 0b111, -100)) = (0, 15, 6, 111, -100) + +=== Testing splitTuple === +splitTuple((True, -15, 9, 0b110)) = ((1, -15), (9, 110)) +splitTuple((False, 33, 15)) = (0, (33, 15)) +splitTuple((True, 50, 11, 0b001, -200)) = ((1, 50), (11, 001, -200)) + +=== Round-trip test === +appendTuple/splitTuple round-trip: ((1, 42), (13, 10101)) + +All AppendTuple tests passed diff --git a/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected b/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected new file mode 100644 index 000000000..7850d0739 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected @@ -0,0 +1,11 @@ +=== Testing TupleSize type class === +TupleSize of () = 0 (expected 0) +TupleSize of Bool = 1 (expected 1) +TupleSize of Tuple2 = 2 (expected 2) +TupleSize of Tuple3 = 3 (expected 3) +TupleSize of Tuple4 = 4 (expected 4) +TupleSize of Tuple5 = 5 (expected 5) +TupleSize of Tuple6 = 6 (expected 6) +TupleSize of Tuple7 = 7 (expected 7) +TupleSize of Tuple8 = 8 (expected 8) +All TupleSize type class tests passed diff --git a/testsuite/bsc.lib/vector/ConcatTuple.bs b/testsuite/bsc.lib/vector/ConcatTuple.bs new file mode 100644 index 000000000..84484876c --- /dev/null +++ b/testsuite/bsc.lib/vector/ConcatTuple.bs @@ -0,0 +1,140 @@ +package ConcatTuple where + +import Vector + +-- Test the ConcatTuple type class + +{-# verilog sysConcatTuple #-} +sysConcatTuple :: Module Empty +sysConcatTuple = + module + counter :: Reg (UInt 6) <- mkReg 0 + + rules + "test0": when counter == 0 ==> action + $display "=== Testing ConcatTuple ===" + -- Test empty vector to unit type + let empty :: Vector 0 (Bool, Int 8) + empty = nil + let unit :: () + unit = concatTuple empty + $display "concatTuple(empty_vector) = () [unit type]" + counter := counter + 1 + + "test1": when counter == 1 ==> action + -- Test single element vector + let v1 :: Vector 1 (Bool, Int 8) + v1 = (True, 25) :> nil + let result :: (Bool, Int 8) + result = concatTuple v1 + $display "concatTuple([(True, 25)]) = (%b, %0d)" (tpl_1 result) (tpl_2 result) + counter := counter + 1 + + "test2": when counter == 2 ==> action + -- Test vector of 3 single elements to 3-tuple + let v3 :: Vector 3 (Int 8) + v3 = 10 :> 20 :> 30 :> nil + let t3 :: (Int 8, Int 8, Int 8) + t3 = concatTuple v3 + $display "concatTuple([10, 20, 30]) = (%0d, %0d, %0d)" (tpl_1 t3) (tpl_2 t3) (tpl_3 t3) + counter := counter + 1 + + "test3": when counter == 3 ==> action + -- Test vector of 4 single elements to 4-tuple + let v4 :: Vector 4 (UInt 4) + v4 = 1 :> 2 :> 3 :> 4 :> nil + let t4 :: (UInt 4, UInt 4, UInt 4, UInt 4) + t4 = concatTuple v4 + $display "concatTuple([1, 2, 3, 4]) = (%0d, %0d, %0d, %0d)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + counter := counter + 1 + + "test4": when counter == 4 ==> action + -- Test vector of 2 pairs to 4-tuple + let v2 :: Vector 2 (Bool, Int 8) + v2 = (True, 5) :> (False, negate 12) :> nil + let t4 :: (Bool, Int 8, Bool, Int 8) + t4 = concatTuple v2 + $display "concatTuple([(True, 5), (False, -12)]) = (%b, %0d, %b, %0d)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + counter := counter + 1 + + "test5": when counter == 5 ==> action + -- Test vector of 3 pairs to 6-tuple + let v3 :: Vector 3 (UInt 4, Bit 3) + v3 = (1, 0b001) :> (2, 0b010) :> (3, 0b011) :> nil + let t6 :: (UInt 4, Bit 3, UInt 4, Bit 3, UInt 4, Bit 3) + t6 = concatTuple v3 + $display "concatTuple([(1, 0b001), (2, 0b010), (3, 0b011)]) = (%0d, %b, %0d, %b, %0d, %b)" (tpl_1 t6) (tpl_2 t6) (tpl_3 t6) (tpl_4 t6) (tpl_5 t6) (tpl_6 t6) + counter := counter + 1 + + "test6": when counter == 6 ==> action + -- Test vector of 2 triples to 6-tuple + let v2 :: Vector 2 (Bool, Int 8, UInt 4) + v2 = (True, 10, 5) :> (False, negate 20, 8) :> nil + let t6 :: (Bool, Int 8, UInt 4, Bool, Int 8, UInt 4) + t6 = concatTuple v2 + $display "concatTuple([(True, 10, 5), (False, -20, 8)]) = (%b, %0d, %0d, %b, %0d, %0d)" (tpl_1 t6) (tpl_2 t6) (tpl_3 t6) (tpl_4 t6) (tpl_5 t6) (tpl_6 t6) + $display "" + $display "=== Testing unconcatTuple ===" + counter := counter + 1 + + "test7": when counter == 7 ==> action + -- Test 4-tuple to vector of 4 singles + let t4 :: (Int 8, Int 8, Int 8, Int 8) + t4 = (7, 8, 9, 10) + let v4 :: Vector 4 (Int 8) + v4 = unconcatTuple t4 + $display "unconcatTuple((7, 8, 9, 10)) = [%0d, %0d, %0d, %0d]" (v4 !! 0) (v4 !! 1) (v4 !! 2) (v4 !! 3) + counter := counter + 1 + + "test8": when counter == 8 ==> action + -- Test 4-tuple to vector of 2 pairs + let t4 :: (Bool, Int 8, Bool, Int 8) + t4 = (False, 100, True, negate 50) + let v2 :: Vector 2 (Bool, Int 8) + v2 = unconcatTuple t4 + $display "unconcatTuple((False, 100, True, -50)) = [(%b, %0d), (%b, %0d)]" (tpl_1 (v2 !! 0)) (tpl_2 (v2 !! 0)) (tpl_1 (v2 !! 1)) (tpl_2 (v2 !! 1)) + counter := counter + 1 + + "test9": when counter == 9 ==> action + -- Test 6-tuple to vector of 3 pairs + let t6 :: (UInt 4, Bit 2, UInt 4, Bit 2, UInt 4, Bit 2) + t6 = (5, 0b00, 10, 0b01, 15, 0b10) + let v3 :: Vector 3 (UInt 4, Bit 2) + v3 = unconcatTuple t6 + $display "unconcatTuple((5, 0b00, 10, 0b01, 15, 0b10)) = [(%0d, %b), (%0d, %b), (%0d, %b)]" (tpl_1 (v3 !! 0)) (tpl_2 (v3 !! 0)) (tpl_1 (v3 !! 1)) (tpl_2 (v3 !! 1)) (tpl_1 (v3 !! 2)) (tpl_2 (v3 !! 2)) + counter := counter + 1 + + "test10": when counter == 10 ==> action + -- Test 6-tuple to vector of 2 triples + let t6 :: (Bool, Int 8, UInt 4, Bool, Int 8, UInt 4) + t6 = (True, 15, 3, False, negate 25, 7) + let v2 :: Vector 2 (Bool, Int 8, UInt 4) + v2 = unconcatTuple t6 + $display "unconcatTuple((True, 15, 3, False, -25, 7)) = [(%b, %0d, %0d), (%b, %0d, %0d)]" (tpl_1 (v2 !! 0)) (tpl_2 (v2 !! 0)) (tpl_3 (v2 !! 0)) (tpl_1 (v2 !! 1)) (tpl_2 (v2 !! 1)) (tpl_3 (v2 !! 1)) + $display "" + $display "=== Round-trip test ===" + counter := counter + 1 + + "test11": when counter == 11 ==> action + -- Test concatTuple and unconcatTuple round-trip with singles + let v_orig :: Vector 5 (Int 8) + v_orig = 1 :> 2 :> 3 :> 4 :> 5 :> nil + let t5 :: (Int 8, Int 8, Int 8, Int 8, Int 8) + t5 = concatTuple v_orig + let v_restored :: Vector 5 (Int 8) + v_restored = unconcatTuple t5 + $display "concatTuple/unconcatTuple round-trip (singles): [%0d, %0d, %0d, %0d, %0d]" (v_restored !! 0) (v_restored !! 1) (v_restored !! 2) (v_restored !! 3) (v_restored !! 4) + counter := counter + 1 + + "test12": when counter == 12 ==> action + -- Test concatTuple and unconcatTuple round-trip with pairs + let v_orig :: Vector 3 (Bool, Int 8) + v_orig = (True, 11) :> (False, 22) :> (True, 33) :> nil + let t6 :: (Bool, Int 8, Bool, Int 8, Bool, Int 8) + t6 = concatTuple v_orig + let v_restored :: Vector 3 (Bool, Int 8) + v_restored = unconcatTuple t6 + $display "concatTuple/unconcatTuple round-trip (pairs): [(%b, %0d), (%b, %0d), (%b, %0d)]" (tpl_1 (v_restored !! 0)) (tpl_2 (v_restored !! 0)) (tpl_1 (v_restored !! 1)) (tpl_2 (v_restored !! 1)) (tpl_1 (v_restored !! 2)) (tpl_2 (v_restored !! 2)) + $display "" + $display "All ConcatTuple tests passed" + $finish 0 diff --git a/testsuite/bsc.lib/vector/libvector.exp b/testsuite/bsc.lib/vector/libvector.exp index 2b3d88edc..eab59382b 100644 --- a/testsuite/bsc.lib/vector/libvector.exp +++ b/testsuite/bsc.lib/vector/libvector.exp @@ -11,3 +11,5 @@ test_c_veri_bsv FindElem test_c_veri_bsv FindIndex test_c_veri_bsv RotateBy test_c_veri_bsv ZeroVector + +test_c_veri_bs_modules ConcatTuple {} diff --git a/testsuite/bsc.lib/vector/sysConcatTuple.out.expected b/testsuite/bsc.lib/vector/sysConcatTuple.out.expected new file mode 100644 index 000000000..9c2f73228 --- /dev/null +++ b/testsuite/bsc.lib/vector/sysConcatTuple.out.expected @@ -0,0 +1,20 @@ +=== Testing ConcatTuple === +concatTuple(empty_vector) = () [unit type] +concatTuple([(True, 25)]) = (1, 25) +concatTuple([10, 20, 30]) = (10, 20, 30) +concatTuple([1, 2, 3, 4]) = (1, 2, 3, 4) +concatTuple([(True, 5), (False, -12)]) = (1, 5, 0, -12) +concatTuple([(1, 0b001), (2, 0b010), (3, 0b011)]) = (1, 001, 2, 010, 3, 011) +concatTuple([(True, 10, 5), (False, -20, 8)]) = (1, 10, 5, 0, -20, 8) + +=== Testing unconcatTuple === +unconcatTuple((7, 8, 9, 10)) = [7, 8, 9, 10] +unconcatTuple((False, 100, True, -50)) = [(0, 100), (1, -50)] +unconcatTuple((5, 0b00, 10, 0b01, 15, 0b10)) = [(5, 00), (10, 01), (15, 10)] +unconcatTuple((True, 15, 3, False, -25, 7)) = [(1, 15, 3), (0, -25, 7)] + +=== Round-trip test === +concatTuple/unconcatTuple round-trip (singles): [1, 2, 3, 4, 5] +concatTuple/unconcatTuple round-trip (pairs): [(1, 11), (0, 22), (1, 33)] + +All ConcatTuple tests passed From 0864b7543c984abd2f2468a296ce9ae682685ae8 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Tue, 13 Jan 2026 18:16:20 -0800 Subject: [PATCH 75/89] Pass the current module name into handleContextReduction for better error message --- src/comp/ContextErrors.hs | 24 +++++++++---------- src/comp/TCheck.hs | 2 +- src/comp/TypeCheck.hs | 12 +++++----- ...ne_ArgNotInBits.bsv.bsc-vcomp-out.expected | 2 +- ...ne_ResNotInBits.bsv.bsc-vcomp-out.expected | 2 +- 5 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/comp/ContextErrors.hs b/src/comp/ContextErrors.hs index fb1dd59d4..8ac0ffe8b 100644 --- a/src/comp/ContextErrors.hs +++ b/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,7 +167,7 @@ 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") @@ -175,7 +175,7 @@ handleContextReduction' pos -- | 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 -- ======================================================================== diff --git a/src/comp/TCheck.hs b/src/comp/TCheck.hs index 74b62ffef..a579f8c30 100644 --- a/src/comp/TCheck.hs +++ b/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) diff --git a/src/comp/TypeCheck.hs b/src/comp/TypeCheck.hs index 0de5020b9..eae82833a 100644 --- a/src/comp/TypeCheck.hs +++ b/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,9 +113,9 @@ 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 @@ -123,7 +123,7 @@ checkTopPreds a ps = do 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 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 cfc220460..935cb5070 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,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 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 4ac6833dc..d2fe133e0 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,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) From 194544db28a538c4faf4539db542a504ebdfabf5 Mon Sep 17 00:00:00 2001 From: Julie Schwartz Date: Thu, 15 Jan 2026 12:13:27 +1300 Subject: [PATCH 76/89] Simplify vMkRWire1, rename to __mkRWireSubmodule, expand the comment This module only exists so that AAddSchedAssumps can create an AVInst for mkRWire of size 1. We could consider eliminating it by having BSC construct the AVInst in a better way. Until then, the interface is at least unneeded, so remove it -- eliminating the need for RWireN. Also remove vMkUnsafeRWire1, which is unneeded and should not have been created (when adding unsafe versions of the real modules). --- src/Libraries/Base1/Prelude.bs | 1 - src/Libraries/Base1/PreludeBSV.bsv | 38 +++++++----------------------- src/comp/AAddSchedAssumps.hs | 6 ++--- src/comp/PreIds.hs | 5 ++-- src/comp/PreStrings.hs | 3 +-- src/comp/Type.hs | 4 ++-- 6 files changed, 15 insertions(+), 42 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 7837af151..7d6472321 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -259,7 +259,6 @@ package Prelude( NumConArg(..), StarConArg(..), OtherConArg(..), MetaConsNamed(..), MetaConsAnon(..), MetaField(..), - primMethod, -- TODO: Needed only in PreludeBSV for vMkRWire1, should be removed. WrapField(..), WrapMethod(..), WrapPorts(..), Port(..), unPort, SplitPorts(..) ) where diff --git a/src/Libraries/Base1/PreludeBSV.bsv b/src/Libraries/Base1/PreludeBSV.bsv index 5f1e5e73b..a2cf7d7f7 100644 --- a/src/Libraries/Base1/PreludeBSV.bsv +++ b/src/Libraries/Base1/PreludeBSV.bsv @@ -82,25 +82,16 @@ interface VRWire#(type a) ; method Bool whas() ; endinterface: VRWire -interface VRWireN#(numeric type n); - method PrimAction wset(Bit#(n) datain); - method Bit#(n) wget(); - method Bit#(1) whas(); -endinterface - -// for addCFWire desugaring -// This uses prim types like something coming from genwrap. -module vMkRWire1(VRWireN#(1)); - +// __mkRWireSubmodule only exists so that BSC can get a handle on the +// 'AVInst' for the submodule instantiation of 'vMkRWire', by applying +// a few compiler stages to the definition. This occurs in +// 'AAddSchedAssumps' where BSC implements the checking of +// 'conflict_free' attributes by adding RWire writes to those rules, +// and for that it needs to instantiate new RWire modules. +// +module __mkRWireSubmodule(); (* hide *) VRWire#(Bit#(1)) _rw <- vMkRWire; - function rw_wset(v); - return toPrimAction(_rw.wset(v)); - endfunction - method wset = primMethod(Cons("v", Nil), rw_wset); - method wget = primMethod(Nil, _rw.wget); - method whas = primMethod(Nil, pack(_rw.whas)); - endmodule interface VRWire0; @@ -416,19 +407,6 @@ endmodule // ======= -// for addCFWire desugaring -module vMkUnsafeRWire1(VRWireN#(1)); - - (* hide *) - VRWire#(Bit#(1)) _rw <- vMkUnsafeRWire; - method wset(v); - return(toPrimAction(_rw.wset(v))); - endmethod - method wget = _rw.wget; - method whas = pack(_rw.whas); - -endmodule - import "BVI" RWire = module vMkUnsafeRWire (VRWire#(a)) provisos (Bits#(a,sa)); diff --git a/src/comp/AAddSchedAssumps.hs b/src/comp/AAddSchedAssumps.hs index b5c3bf62a..d09f1ca15 100644 --- a/src/comp/AAddSchedAssumps.hs +++ b/src/comp/AAddSchedAssumps.hs @@ -3,7 +3,6 @@ module AAddSchedAssumps(aAddSchedAssumps, aAddCFConditionWires) where import CSyntax import SymTab import TypeCheck(topExpr) -import CType import Type import qualified TIMonad as TIM(runTI) import Flags(Flags, showElabProgress) @@ -29,7 +28,6 @@ import PPrint import Pragma(ASchedulePragma) import Error(internalError, ErrMsg(..), showErrorList, ErrorHandle) import Id -import Position(noPosition) import Util(unzipWith, ordPairBy) import Util(mapSnd) @@ -223,8 +221,8 @@ buildMethCondList uses = M.toList (M.fromListWith aOr uses') getRWireInstFn :: ErrorHandle -> Flags -> SymTab -> M.Map AId HExpr -> IO (Id -> AVInst) getRWireInstFn errh flags r alldefs = do - let blobT = TAp tModule (TAp tVRWireN (cTNum 1 noPosition)) - case fst $ (TIM.runTI flags False r (topExpr blobT (CVar idVmkRWire1))) of + let blobT = TAp tModule tEmpty + case fst $ (TIM.runTI flags False r (topExpr blobT (CVar id__mkRWireSubmodule))) of Left errs -> internalError (ppReadable errs) Right (_,e') -> do let iexpr = iConvExpr errh flags r alldefs e' diff --git a/src/comp/PreIds.hs b/src/comp/PreIds.hs index 4eef48788..9036e06c9 100644 --- a/src/comp/PreIds.hs +++ b/src/comp/PreIds.hs @@ -510,9 +510,8 @@ idPrimAdd = prelude_id_no fsPrimAdd idPrimSub = prelude_id_no fsPrimSub -- | Used by AddCFWire -idVRWireN, idVmkRWire1, idWGet, idWSet, idWHas :: Id -idVRWireN = prelude_bsv_id_no fsVRWireN -idVmkRWire1 = prelude_bsv_id_no fsVmkRWire1 +id__mkRWireSubmodule, idWGet, idWSet, idWHas :: Id +id__mkRWireSubmodule = prelude_bsv_id_no fs__mkRWireSubmodule idWGet = prelude_bsv_id_no fsWGet idWSet = prelude_bsv_id_no fsWSet idWHas = prelude_bsv_id_no fsWHas diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index 792032084..c4e2efbcf 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -319,8 +319,7 @@ fsExposeCurrentReset = mkFString "exposeCurrentReset" fsNoClock = mkFString "noClock" fsNoReset = mkFString "noReset" fsPrimReplaceClockGate = mkFString "primReplaceClockGate" -fsVRWireN = mkFString "VRWireN" -fsVmkRWire1 = mkFString "vMkRWire1" +fs__mkRWireSubmodule = mkFString "__mkRWireSubmodule" fsWGet = mkFString "wget" fsWSet = mkFString "wset" fsWHas = mkFString "whas" diff --git a/src/comp/Type.hs b/src/comp/Type.hs index c030015eb..c8d598ce3 100644 --- a/src/comp/Type.hs +++ b/src/comp/Type.hs @@ -76,10 +76,10 @@ tRules = TCon (TyCon idRules (Just KStar) TIabstract) tRulesAt :: Position -> Type tRulesAt pos = TCon (TyCon (idRulesAt pos) (Just KStar) TIabstract) -tSchedPragma, tModule, tVRWireN, tId, t32 :: Type +tSchedPragma, tModule, tEmpty, tId, t32 :: Type tSchedPragma = TCon (TyCon idSchedPragma (Just KStar) TIabstract) tModule = TCon (TyCon idModule (Just (Kfun KStar KStar)) TIabstract) -tVRWireN = TCon (TyCon idVRWireN (Just (Kfun KNum KStar)) (TIstruct SStruct [idWSet, idWGet, idWHas])) +tEmpty = TCon (TyCon idEmpty (Just KStar) (TIstruct (SInterface []) [])) tId = TCon (TyCon idId (Just (Kfun KStar KStar)) TIabstract) t32 = tOfSize 32 noPosition From 60df15d1f99cdbdd6b181a7aa4942c06e19e6f7c Mon Sep 17 00:00:00 2001 From: Julie Schwartz Date: Thu, 15 Jan 2026 12:49:05 +1300 Subject: [PATCH 77/89] Testsuite: Update expected PreludeBSV positions --- .../commands/bpackage.tcl.bluetcl-bh-out.expected | 6 +++--- .../bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected | 6 +++--- .../bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected | 4 ++-- .../CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected | 4 ++-- .../signal_names/Method.bsv.bsc-vcomp-out.expected | 2 +- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected index b402d2c80..ca4442acb 100644 --- a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-bh-out.expected @@ -55,9 +55,9 @@ PreludeBSV vMkCRegA5 PreludeBSV mkCReg PreludeBSV mkCRegU PreludeBSV mkCRegA -PreludeBSV _PreludeBSV.CReg5715 -PreludeBSV _PreludeBSV.CReg5811 -PreludeBSV _PreludeBSV.CReg5906 +PreludeBSV _PreludeBSV.CReg5693 +PreludeBSV _PreludeBSV.CReg5789 +PreludeBSV _PreludeBSV.CReg5884 Prelude Reg Prelude VReg Prelude vMkReg diff --git a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected index b402d2c80..ca4442acb 100644 --- a/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/commands/bpackage.tcl.bluetcl-out.expected @@ -55,9 +55,9 @@ PreludeBSV vMkCRegA5 PreludeBSV mkCReg PreludeBSV mkCRegU PreludeBSV mkCRegA -PreludeBSV _PreludeBSV.CReg5715 -PreludeBSV _PreludeBSV.CReg5811 -PreludeBSV _PreludeBSV.CReg5906 +PreludeBSV _PreludeBSV.CReg5693 +PreludeBSV _PreludeBSV.CReg5789 +PreludeBSV _PreludeBSV.CReg5884 Prelude Reg Prelude VReg Prelude vMkReg diff --git a/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected b/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected index 008aec9a3..5c1229365 100644 --- a/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.lib/CReg/TestCReg_TooBig.bsv.bsc-vcomp-out.expected @@ -1,9 +1,9 @@ checking package dependencies compiling TestCReg_TooBig.bsv code generation for sysTestCReg_TooBig starts -Error: "PreludeBSV.bsv", line 1004, column 37: (S0015) +Error: "PreludeBSV.bsv", line 982, column 37: (S0015) Bluespec evaluation-time error: `mkCReg' cannot have more than five ports - During elaboration of `error' at "PreludeBSV.bsv", line 1004, column 13. + During elaboration of `error' at "PreludeBSV.bsv", line 982, column 13. During elaboration of `rg' at "TestCReg_TooBig.bsv", line 5, column 19. During elaboration of `sysTestCReg_TooBig' at "TestCReg_TooBig.bsv", line 3, column 8. diff --git a/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected b/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected index 762058ab9..be6e45ecc 100644 --- a/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.lib/CReg/TestCReg_TooSmall.bsv.bsc-vcomp-out.expected @@ -1,10 +1,10 @@ checking package dependencies compiling TestCReg_TooSmall.bsv code generation for sysTestCReg_TooSmall starts -Error: "PreludeBSV.bsv", line 1005, column 37: (S0015) +Error: "PreludeBSV.bsv", line 983, column 37: (S0015) Bluespec evaluation-time error: `mkCReg' cannot have a negative number of ports - During elaboration of `error' at "PreludeBSV.bsv", line 1005, column 13. + During elaboration of `error' at "PreludeBSV.bsv", line 983, column 13. During elaboration of `rg' at "TestCReg_TooSmall.bsv", line 5, column 19. During elaboration of `sysTestCReg_TooSmall' at "TestCReg_TooSmall.bsv", line 3, column 8. diff --git a/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected index 96e75b7f8..451dbc6c4 100644 --- a/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected @@ -17,7 +17,7 @@ arg info [clockarg default_clock;, resetarg default_reset;] -- APackage resets [(0, { wire: RST_N })] -- AP state elements -rg :: ABSTRACT: PreludeBSV._PreludeBSV.VRWire112 = RWire +rg :: ABSTRACT: PreludeBSV._PreludeBSV.VRWire103 = RWire (VModInfo RWire clock clk(); From fba6a10b5a6be9e8b7fbbc021d6525e4d41e1740 Mon Sep 17 00:00:00 2001 From: Julie Schwartz Date: Thu, 15 Jan 2026 12:51:32 +1300 Subject: [PATCH 78/89] Revert id_to_vName change It may have been needed for the VModInfo created by vMkRWire1, but that has been removed and testing passes without the change. Plus, VName should not be qualified, so better to catch if we are creating a qualified name somewhere. --- src/comp/VModInfo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/comp/VModInfo.hs b/src/comp/VModInfo.hs index 66ca50458..6964602a1 100644 --- a/src/comp/VModInfo.hs +++ b/src/comp/VModInfo.hs @@ -67,7 +67,7 @@ getVNameString (VName string) = string -- convert Bluespec identifier to Verilog names id_to_vName :: Id -> VName -id_to_vName i = VName (getIdBaseString i) +id_to_vName i = VName (getIdString i) vName_to_id :: VName -> Id vName_to_id (VName s) = mk_homeless_id s From e336086abb7e72d67f9eea9ee646d201a9498ccd Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Jan 2026 11:57:45 -0800 Subject: [PATCH 79/89] Clean up documentation --- doc/libraries_ref_guide/LibDoc/Prelude.tex | 22 ++++++------------- doc/libraries_ref_guide/LibDoc/Vector.tex | 25 ++++++++++------------ 2 files changed, 18 insertions(+), 29 deletions(-) diff --git a/doc/libraries_ref_guide/LibDoc/Prelude.tex b/doc/libraries_ref_guide/LibDoc/Prelude.tex index 80fbac8d5..7d2a290a9 100644 --- a/doc/libraries_ref_guide/LibDoc/Prelude.tex +++ b/doc/libraries_ref_guide/LibDoc/Prelude.tex @@ -3531,17 +3531,6 @@ \subsubsection{Tuples} \end{tabular} \end{center} -{\bf Examples} - -\begin{verbatim} - Tuple2#( Bool, int ) foo = tuple2( True, 25 ); - Bool field1 = tpl_1( foo ); // this is value 1 in the list - int field2 = tpl_2( foo ); // this is value 2 in the list - foo = tuple2( !field1, field2 ); -\end{verbatim} - -\paragraph{TupleSize} - \te{TupleSize} provides a way to determine the number of elements in a tuple at the type level. The size is represented as a numeric type parameter. @@ -3577,8 +3566,6 @@ \subsubsection{Tuples} \end{tabular} \end{center} -\paragraph{AppendTuple} - \te{AppendTuple} provides a way to join two tuples of arbitrary size into a single larger tuple, and to split a tuple back into two parts. @@ -3591,7 +3578,7 @@ \subsubsection{Tuples} \begin{libverbatim} typeclass AppendTuple #(type a, type b, type c) - dependencies (a b determines c); + dependencies ((a, b) determines c); function c appendTuple(a x, b y); function Tuple2#(a, b) splitTuple(c x); endtypeclass @@ -3627,6 +3614,11 @@ \subsubsection{Tuples} {\bf Examples} \begin{verbatim} + Tuple2#( Bool, int ) foo = tuple2( True, 25 ); + Bool field1 = tpl_1( foo ); // this is value 1 in the list + int field2 = tpl_2( foo ); // this is value 2 in the list + foo = tuple2( !field1, field2 ); + // Appending a 2-tuple and a 3-tuple to create a 5-tuple Tuple2#(Bool, Int#(8)) t1 = tuple2(True, 42); Tuple3#(String, Bit#(4), UInt#(16)) t2 = tuple3("test", 4'hA, 100); @@ -3641,7 +3633,7 @@ \subsubsection{Tuples} Tuple2#(Tuple2#(Bool, Int#(8)), Tuple2#(String, Bit#(4))) parts = splitTuple(t4); - // Appending with unit type + // Appending with unit type (void) Tuple2#(Bool, Int#(8)) t5 = tuple2(False, 0); Tuple2#(Bool, Int#(8)) t6 = appendTuple(t5, ?); // same as t5 Tuple2#(Bool, Int#(8)) t7 = appendTuple(?, t5); // same as t5 diff --git a/doc/libraries_ref_guide/LibDoc/Vector.tex b/doc/libraries_ref_guide/LibDoc/Vector.tex index 1e6e0a799..77a3fe830 100644 --- a/doc/libraries_ref_guide/LibDoc/Vector.tex +++ b/doc/libraries_ref_guide/LibDoc/Vector.tex @@ -2273,8 +2273,6 @@ \subsubsection{Converting to and from Vectors} \hline \end{tabular} -\paragraph{ConcatTuple} - The \te{ConcatTuple} type class provides functions to convert between a Vector of tuples and a single flattened tuple. When you have a Vector where each element is a tuple (or can be viewed as a tuple), \te{concatTuple} flattens @@ -2291,7 +2289,7 @@ \subsubsection{Converting to and from Vectors} \begin{libverbatim} typeclass ConcatTuple #(numeric type n, type a, type b) - dependencies (n a determines b); + dependencies ((n, a) determines b); function b concatTuple(Vector#(n, a) v); function Vector#(n, a) unconcatTuple(b x); endtypeclass @@ -2301,7 +2299,7 @@ \subsubsection{Converting to and from Vectors} \begin{itemize} \item A vector of size 0 converts to/from the unit type \te{void} \item A vector of size 1 converts to/from a single element -\item Larger vectors convert by flattening: each element is appended to +\item Larger vectors convert by appending each element tuple to form a larger tuple \end{itemize} @@ -2330,7 +2328,15 @@ \subsubsection{Converting to and from Vectors} \hline \end{tabular} -{\bf Example - ConcatTuple} +{\bf Examples - Lists} + +Convert the vector \te{my\_vector} to a list named \te{my\_list}. +\begin{libverbatim} + Vector#(5,Int#(13)) my_vector; + List#(Int#(13)) my_list = toList(my_vector); +\end{libverbatim} + +{\bf Examples - Tuples} Flatten a vector of 3 pairs (2-tuples) into a single 6-tuple: \begin{libverbatim} @@ -2386,15 +2392,6 @@ \subsubsection{Converting to and from Vectors} \end{libverbatim} -{\bf Example - Converting to and from Vectors} - -Convert the vector \te{my\_vector} to a list named \te{my\_list}. -\begin{libverbatim} - Vector#(5,Int#(13)) my_vector; - List#(Int#(13)) my_list = toList(my_vector); -\end{libverbatim} - - \subsubsection{ListN} \index{ListN@\te{ListN} (type)} From 8418a2964476250f5e178fc86fe295e543ad66b9 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Jan 2026 12:54:29 -0800 Subject: [PATCH 80/89] Tests and docs for the Curry type class --- doc/libraries_ref_guide/LibDoc/Prelude.tex | 47 +++++++ testsuite/bsc.lib/Prelude/CurryTypeClass.bs | 129 ++++++++++++++++++ testsuite/bsc.lib/Prelude/Prelude.exp | 1 + .../Prelude/sysCurryTypeClass.out.expected | 5 + 4 files changed, 182 insertions(+) create mode 100644 testsuite/bsc.lib/Prelude/CurryTypeClass.bs create mode 100644 testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected diff --git a/doc/libraries_ref_guide/LibDoc/Prelude.tex b/doc/libraries_ref_guide/LibDoc/Prelude.tex index 7d2a290a9..22dd6d279 100644 --- a/doc/libraries_ref_guide/LibDoc/Prelude.tex +++ b/doc/libraries_ref_guide/LibDoc/Prelude.tex @@ -6311,12 +6311,59 @@ \subsubsection{Operations on Functions} \end{tabular} \end{center} +\index{Curry@\te{Curry} (type class)} +\index[typeclass]{Curry} +\index{curryN@\te{curryN} (function)} +\index[function]{Prelude!curryN} +\index{uncurryN@\te{uncurryN} (function)} +\index[function]{Prelude!uncurryN} + +The \te{Curry} typeclass generalizes the \te{curry} and \te{uncurry} functions +to work with tuples of any size (not just Tuple2). + +\begin{libverbatim} +typeclass Curry#(type f, type g) + dependencies (f determines g); + function g curryN(f x); + function f uncurryN(g x); +endtypeclass +\end{libverbatim} + +\begin{center} +\begin{tabular}{|p{1 in}|p{4 in}|} +\hline +\te{curryN}&Converts an uncurried function (taking an N-tuple argument) into a curried +function (taking N arguments one at a time). For example, \te{curryN} can convert a +function taking \te{Tuple3\#(a,b,c)} into a function \te{a -> b -> c -> result}.\\ +\hline +\te{uncurryN}&The inverse of \te{curryN}. Converts a curried function (taking N arguments +one at a time) into an uncurried function (taking an N-tuple argument).\\ +\hline +\end{tabular} +\end{center} + {\bf Examples} \begin{libverbatim} //using constFn to set the initial values of the registers in a list List#(Reg#(Resource)) items <- mapM( constFn(mkReg(initRes)),upto(1,numAdd) ); + + // Using curryN with a 3-tuple + function Int#(32) add3Tuple(Tuple3#(Int#(32), Int#(32), Int#(32)) t); + return tpl_1(t) + tpl_2(t) + tpl_3(t); + endfunction + + let add3Curried = curryN(add3Tuple); + Int#(32) result = add3Curried(1)(2)(3); // result = 6 + + // Using uncurryN + function Int#(32) add3(Int#(32) a, Int#(32) b, Int#(32) c); + return a + b + c; + endfunction + + let add3Uncurried = uncurryN(add3); + Int#(32) result2 = add3Uncurried(tuple3(1, 2, 3)); // result2 = 6 return(pack(map(compose(head0,toList),state))); diff --git a/testsuite/bsc.lib/Prelude/CurryTypeClass.bs b/testsuite/bsc.lib/Prelude/CurryTypeClass.bs new file mode 100644 index 000000000..462468604 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/CurryTypeClass.bs @@ -0,0 +1,129 @@ +----------------------------------------------------------------------- +-- Test for the Curry type class and curryN/uncurryN functions +----------------------------------------------------------------------- + +package CurryTypeClass where + +import Vector + +----------------------------------------------------------------------- +-- Test with Tuple2 +----------------------------------------------------------------------- + +add2Tuple :: (Int 32, Int 32) -> Int 32 +add2Tuple t = tpl_1 t + tpl_2 t + +add2 :: Int 32 -> Int 32 -> Int 32 +add2 a b = a + b + +testCurry2 :: Bool +testCurry2 = + let curried :: Int 32 -> Int 32 -> Int 32 + curried = curryN add2Tuple + result1 :: Int 32 + result1 = curried 5 10 + uncurried :: (Int 32, Int 32) -> Int 32 + uncurried = uncurryN add2 + result2 :: Int 32 + result2 = uncurried (5, 10) + in result1 == 15 && result2 == 15 + + +----------------------------------------------------------------------- +-- Test with Tuple3 +----------------------------------------------------------------------- + +add3Tuple :: (Int 32, Int 32, Int 32) -> Int 32 +add3Tuple t = tpl_1 t + tpl_2 t + tpl_3 t + +add3 :: Int 32 -> Int 32 -> Int 32 -> Int 32 +add3 a b c = a + b + c + +testCurry3 :: Bool +testCurry3 = + let curried :: Int 32 -> Int 32 -> Int 32 -> Int 32 + curried = curryN add3Tuple + result1 :: Int 32 + result1 = curried 1 2 3 + uncurried :: (Int 32, Int 32, Int 32) -> Int 32 + uncurried = uncurryN add3 + result2 :: Int 32 + result2 = uncurried (1, 2, 3) + in result1 == 6 && result2 == 6 + + +----------------------------------------------------------------------- +-- Test with Tuple4 +----------------------------------------------------------------------- + +add4Tuple :: (Int 32, Int 32, Int 32, Int 32) -> Int 32 +add4Tuple t = tpl_1 t + tpl_2 t + tpl_3 t + tpl_4 t + +add4 :: Int 32 -> Int 32 -> Int 32 -> Int 32 -> Int 32 +add4 a b c d = a + b + c + d + +testCurry4 :: Bool +testCurry4 = + let curried :: Int 32 -> Int 32 -> Int 32 -> Int 32 -> Int 32 + curried = curryN add4Tuple + result1 :: Int 32 + result1 = curried 1 2 3 4 + uncurried :: (Int 32, Int 32, Int 32, Int 32) -> Int 32 + uncurried = uncurryN add4 + result2 :: Int 32 + result2 = uncurried (1, 2, 3, 4) + in result1 == 10 && result2 == 10 + + +----------------------------------------------------------------------- +-- Test roundtrip: curryN . uncurryN = id and uncurryN . curryN = id +----------------------------------------------------------------------- + +testRoundtrip :: Bool +testRoundtrip = + -- Test that uncurrying then currying gets back the original behavior + let temp :: (Int 32, Int 32, Int 32) -> Int 32 + temp = uncurryN add3 + f1 :: Int 32 -> Int 32 -> Int 32 -> Int 32 + f1 = curryN temp + result1 :: Int 32 + result1 = f1 10 20 30 + -- Test that currying then uncurrying gets back the original behavior + f2 :: (Int 32, Int 32, Int 32) -> Int 32 + f2 = uncurryN (curryN add3Tuple) + result2 :: Int 32 + result2 = f2 (10, 20, 30) + in result1 == 60 && result2 == 60 + + +----------------------------------------------------------------------- +-- Test with unit tuple (special case) +----------------------------------------------------------------------- + +fromUnitTuple :: () -> Int 32 +fromUnitTuple _ = 42 + +testUnitTuple :: Bool +testUnitTuple = + let curried :: Int 32 + curried = curryN fromUnitTuple + in curried == 42 + + +----------------------------------------------------------------------- +-- Module for testing +----------------------------------------------------------------------- + +{-# verilog sysCurryTypeClass #-} +sysCurryTypeClass :: Module Empty +sysCurryTypeClass = + module + rules + "test": when True ==> + action + $display "Test Curry2: %b" testCurry2 + $display "Test Curry3: %b" testCurry3 + $display "Test Curry4: %b" testCurry4 + $display "Test Roundtrip: %b" testRoundtrip + $display "Test Unit Tuple: %b" testUnitTuple + $finish 0 diff --git a/testsuite/bsc.lib/Prelude/Prelude.exp b/testsuite/bsc.lib/Prelude/Prelude.exp index 0b781b577..90f22806f 100644 --- a/testsuite/bsc.lib/Prelude/Prelude.exp +++ b/testsuite/bsc.lib/Prelude/Prelude.exp @@ -8,3 +8,4 @@ compile_verilog_fail_no_internal_error Eq3 test_c_veri_bs_modules TuplePack {} test_c_veri_bs_modules TupleSize {} test_c_veri_bs_modules AppendTuple {} +test_c_veri_bs_modules CurryTypeClass {} diff --git a/testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected b/testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected new file mode 100644 index 000000000..347740d19 --- /dev/null +++ b/testsuite/bsc.lib/Prelude/sysCurryTypeClass.out.expected @@ -0,0 +1,5 @@ +Test Curry2: 1 +Test Curry3: 1 +Test Curry4: 1 +Test Roundtrip: 1 +Test Unit Tuple: 1 From fdbb48e1f53d7d75f2af920aa694f32bb6460539 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Jan 2026 12:59:02 -0800 Subject: [PATCH 81/89] Misc cleanup --- src/comp/IExpand.hs | 3 +-- src/comp/TCheck.hs | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 1eb0d799f..25c9875a1 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -2135,8 +2135,7 @@ evalStringList e = do -- We get primChr for Nil, since it's a no-argument constructor else if i == idPrimChr then return ([], getIExprPosition e') else internalError ("evalStringList con: " ++ show i) - _ -> do e'' <- unheapAll e' - eNoNF e'' + _ -> nfError "evalStringList" e' ----------------------------------------------------------------------------- diff --git a/src/comp/TCheck.hs b/src/comp/TCheck.hs index a579f8c30..036cfcf67 100644 --- a/src/comp/TCheck.hs +++ b/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 (Just i) (getPosition i) uds + handleContextReduction Nothing (getPosition i) uds else -- No ambiguous variables, so... -- Produce the return values (deferred preds, CDefl) From 41ee7fc3fd565a8af37a65ea7d829e990a9833e5 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Jan 2026 13:08:25 -0800 Subject: [PATCH 82/89] Clean up tests --- testsuite/bsc.lib/Prelude/AppendTuple.bs | 28 ++++++++----------- testsuite/bsc.lib/Prelude/TupleSize.bs | 2 -- .../Prelude/sysAppendTuple.out.expected | 22 +++++++-------- .../bsc.lib/Prelude/sysTupleSize.out.expected | 1 - testsuite/bsc.lib/vector/ConcatTuple.bs | 2 -- 5 files changed, 22 insertions(+), 33 deletions(-) diff --git a/testsuite/bsc.lib/Prelude/AppendTuple.bs b/testsuite/bsc.lib/Prelude/AppendTuple.bs index bc0464fce..ddb8a2b56 100644 --- a/testsuite/bsc.lib/Prelude/AppendTuple.bs +++ b/testsuite/bsc.lib/Prelude/AppendTuple.bs @@ -1,5 +1,7 @@ package AppendTuple where +import CShow + -- Test the AppendTuple type class {-# verilog sysAppendTuple #-} @@ -27,7 +29,7 @@ sysAppendTuple = t1 = (True, 42) let t2 :: (Bool, Int 8) t2 = appendTuple () t1 - $display "appendTuple((), (True, 42)) = (%b, %0d)" (tpl_1 t2) (tpl_2 t2) + $display "appendTuple((), (True, 42)) = " (cshow t2) counter := counter + 1 "test2": when counter == 2 ==> action @@ -36,7 +38,7 @@ sysAppendTuple = t1 = (False, negate 10) let t2 :: (Bool, Int 8) t2 = appendTuple t1 () - $display "appendTuple((False, -10), ()) = (%b, %0d)" (tpl_1 t2) (tpl_2 t2) + $display "appendTuple((False, -10), ()) = " (cshow t2) counter := counter + 1 "test3": when counter == 3 ==> action @@ -47,7 +49,7 @@ sysAppendTuple = t2 = (12, 0b101) let t4 :: (Bool, Int 8, UInt 4, Bit 3) t4 = appendTuple t1 t2 - $display "appendTuple((True, 5), (12, 0b101)) = (%b, %0d, %0d, %b)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + $display "appendTuple((True, 5), (12, 0b101)) = " (cshow t4) counter := counter + 1 "test4": when counter == 4 ==> action @@ -58,7 +60,7 @@ sysAppendTuple = t2 = (negate 3, 7) let t3 :: (Bool, Int 8, UInt 4) t3 = appendTuple b t2 - $display "appendTuple(False, (-3, 7)) = (%b, %0d, %0d)" (tpl_1 t3) (tpl_2 t3) (tpl_3 t3) + $display "appendTuple(False, (-3, 7)) = " (cshow t3) counter := counter + 1 "test5": when counter == 5 ==> action @@ -69,7 +71,7 @@ sysAppendTuple = b = 0b11010 let t4 :: (Bool, Int 8, UInt 4, Bit 5) t4 = appendTuple t3 b - $display "appendTuple((True, 20, 8), 0b11010) = (%b, %0d, %0d, %b)" (tpl_1 t4) (tpl_2 t4) (tpl_3 t4) (tpl_4 t4) + $display "appendTuple((True, 20, 8), 0b11010) = " (cshow t4) counter := counter + 1 "test6": when counter == 6 ==> action @@ -80,7 +82,7 @@ sysAppendTuple = t3 = (6, 0b111, negate 100) let t5 :: (Bool, Int 8, UInt 4, Bit 3, Int 16) t5 = appendTuple t2 t3 - $display "appendTuple((False, 15), (6, 0b111, -100)) = (%b, %0d, %0d, %b, %0d)" (tpl_1 t5) (tpl_2 t5) (tpl_3 t5) (tpl_4 t5) (tpl_5 t5) + $display "appendTuple((False, 15), (6, 0b111, -100)) = " (cshow t5) $display "" $display "=== Testing splitTuple ===" counter := counter + 1 @@ -91,8 +93,7 @@ sysAppendTuple = t4 = (True, negate 15, 9, 0b110) let split :: ((Bool, Int 8), (UInt 4, Bit 3)) split = splitTuple t4 - (t1, t2) = split - $display "splitTuple((True, -15, 9, 0b110)) = ((%b, %0d), (%0d, %b))" (tpl_1 t1) (tpl_2 t1) (tpl_1 t2) (tpl_2 t2) + $display "splitTuple((True, -15, 9, 0b110)) = " (cshow split) counter := counter + 1 "test8": when counter == 8 ==> action @@ -101,8 +102,7 @@ sysAppendTuple = t3 = (False, 33, 15) let split :: (Bool, (Int 8, UInt 4)) split = splitTuple t3 - (b, t2) = split - $display "splitTuple((False, 33, 15)) = (%b, (%0d, %0d))" b (tpl_1 t2) (tpl_2 t2) + $display "splitTuple((False, 33, 15)) = " (cshow split) counter := counter + 1 "test9": when counter == 9 ==> action @@ -111,8 +111,7 @@ sysAppendTuple = t5 = (True, 50, 11, 0b001, negate 200) let split :: ((Bool, Int 8), (UInt 4, Bit 3, Int 16)) split = splitTuple t5 - (t2, t3) = split - $display "splitTuple((True, 50, 11, 0b001, -200)) = ((%b, %0d), (%0d, %b, %0d))" (tpl_1 t2) (tpl_2 t2) (tpl_1 t3) (tpl_2 t3) (tpl_3 t3) + $display "splitTuple((True, 50, 11, 0b001, -200)) = " (cshow split) $display "" $display "=== Round-trip test ===" counter := counter + 1 @@ -127,8 +126,5 @@ sysAppendTuple = t4 = appendTuple t1 t2 let split :: ((Bool, Int 8), (UInt 4, Bit 5)) split = splitTuple t4 - (r1, r2) = split - $display "appendTuple/splitTuple round-trip: ((%b, %0d), (%0d, %b))" (tpl_1 r1) (tpl_2 r1) (tpl_1 r2) (tpl_2 r2) - $display "" - $display "All AppendTuple tests passed" + $display "appendTuple/splitTuple round-trip: " (cshow split) $finish 0 diff --git a/testsuite/bsc.lib/Prelude/TupleSize.bs b/testsuite/bsc.lib/Prelude/TupleSize.bs index ce33fd2f2..8596eb9e6 100644 --- a/testsuite/bsc.lib/Prelude/TupleSize.bs +++ b/testsuite/bsc.lib/Prelude/TupleSize.bs @@ -66,6 +66,4 @@ sysTupleSize = module t8 = (True, 0, 0, 0, 0, 0, 0, 0) let size8 = tupleSize t8 $display "TupleSize of Tuple8 = %0d (expected 8)" size8 - - $display "All TupleSize type class tests passed" $finish 0 diff --git a/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected b/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected index f45188783..492bf6a4c 100644 --- a/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected +++ b/testsuite/bsc.lib/Prelude/sysAppendTuple.out.expected @@ -1,18 +1,16 @@ === Testing AppendTuple === appendTuple((), ()) = () [unit type] -appendTuple((), (True, 42)) = (1, 42) -appendTuple((False, -10), ()) = (0, -10) -appendTuple((True, 5), (12, 0b101)) = (1, 5, 12, 101) -appendTuple(False, (-3, 7)) = (0, -3, 7) -appendTuple((True, 20, 8), 0b11010) = (1, 20, 8, 11010) -appendTuple((False, 15), (6, 0b111, -100)) = (0, 15, 6, 111, -100) +appendTuple((), (True, 42)) = (True, 42) +appendTuple((False, -10), ()) = (False, -10) +appendTuple((True, 5), (12, 0b101)) = (True, 5, 12, 0x5) +appendTuple(False, (-3, 7)) = (False, -3, 7) +appendTuple((True, 20, 8), 0b11010) = (True, 20, 8, 0x1a) +appendTuple((False, 15), (6, 0b111, -100)) = (False, 15, 6, 0x7, -100) === Testing splitTuple === -splitTuple((True, -15, 9, 0b110)) = ((1, -15), (9, 110)) -splitTuple((False, 33, 15)) = (0, (33, 15)) -splitTuple((True, 50, 11, 0b001, -200)) = ((1, 50), (11, 001, -200)) +splitTuple((True, -15, 9, 0b110)) = ((True, -15), 9, 0x6) +splitTuple((False, 33, 15)) = (False, 33, 15) +splitTuple((True, 50, 11, 0b001, -200)) = ((True, 50), 11, 0x1, -200) === Round-trip test === -appendTuple/splitTuple round-trip: ((1, 42), (13, 10101)) - -All AppendTuple tests passed +appendTuple/splitTuple round-trip: ((True, 42), 13, 0x15) diff --git a/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected b/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected index 7850d0739..c04bed8cb 100644 --- a/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected +++ b/testsuite/bsc.lib/Prelude/sysTupleSize.out.expected @@ -8,4 +8,3 @@ TupleSize of Tuple5 = 5 (expected 5) TupleSize of Tuple6 = 6 (expected 6) TupleSize of Tuple7 = 7 (expected 7) TupleSize of Tuple8 = 8 (expected 8) -All TupleSize type class tests passed diff --git a/testsuite/bsc.lib/vector/ConcatTuple.bs b/testsuite/bsc.lib/vector/ConcatTuple.bs index 84484876c..892d624e6 100644 --- a/testsuite/bsc.lib/vector/ConcatTuple.bs +++ b/testsuite/bsc.lib/vector/ConcatTuple.bs @@ -135,6 +135,4 @@ sysConcatTuple = let v_restored :: Vector 3 (Bool, Int 8) v_restored = unconcatTuple t6 $display "concatTuple/unconcatTuple round-trip (pairs): [(%b, %0d), (%b, %0d), (%b, %0d)]" (tpl_1 (v_restored !! 0)) (tpl_2 (v_restored !! 0)) (tpl_1 (v_restored !! 1)) (tpl_2 (v_restored !! 1)) (tpl_1 (v_restored !! 2)) (tpl_2 (v_restored !! 2)) - $display "" - $display "All ConcatTuple tests passed" $finish 0 From 35c37135cf9397c558ce702f2fb39d4b5ef3a398 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Jan 2026 16:16:18 -0800 Subject: [PATCH 83/89] Clean up uncurryN examples --- doc/libraries_ref_guide/LibDoc/Prelude.tex | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/doc/libraries_ref_guide/LibDoc/Prelude.tex b/doc/libraries_ref_guide/LibDoc/Prelude.tex index 22dd6d279..e8af76ec1 100644 --- a/doc/libraries_ref_guide/LibDoc/Prelude.tex +++ b/doc/libraries_ref_guide/LibDoc/Prelude.tex @@ -6346,8 +6346,11 @@ \subsubsection{Operations on Functions} {\bf Examples} \begin{libverbatim} - //using constFn to set the initial values of the registers in a list + // Using constFn to set the initial values of the registers in a list List#(Reg#(Resource)) items <- mapM( constFn(mkReg(initRes)),upto(1,numAdd) ); + + // Using compose when mapping over a list + return(pack(map(compose(head0,toList),state))); // Using curryN with a 3-tuple function Int#(32) add3Tuple(Tuple3#(Int#(32), Int#(32), Int#(32)) t); @@ -6364,10 +6367,6 @@ \subsubsection{Operations on Functions} let add3Uncurried = uncurryN(add3); Int#(32) result2 = add3Uncurried(tuple3(1, 2, 3)); // result2 = 6 - - return(pack(map(compose(head0,toList),state))); - - xs <- mapM(constFn(mkReg(False)),genList); \end{libverbatim} From fb52a66098a899a7c9414b9f9faeae41290a3a54 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Thu, 15 Jan 2026 16:17:31 -0800 Subject: [PATCH 84/89] Fix expected output --- testsuite/bsc.lib/vector/sysConcatTuple.out.expected | 2 -- 1 file changed, 2 deletions(-) diff --git a/testsuite/bsc.lib/vector/sysConcatTuple.out.expected b/testsuite/bsc.lib/vector/sysConcatTuple.out.expected index 9c2f73228..a9c59ffed 100644 --- a/testsuite/bsc.lib/vector/sysConcatTuple.out.expected +++ b/testsuite/bsc.lib/vector/sysConcatTuple.out.expected @@ -16,5 +16,3 @@ unconcatTuple((True, 15, 3, False, -25, 7)) = [(1, 15, 3), (0, -25, 7)] === Round-trip test === concatTuple/unconcatTuple round-trip (singles): [1, 2, 3, 4, 5] concatTuple/unconcatTuple round-trip (pairs): [(1, 11), (0, 22), (1, 33)] - -All ConcatTuple tests passed From f23096de26f57b15fc4d79358ffffb042099dfa3 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Fri, 9 Jan 2026 09:34:28 -0800 Subject: [PATCH 85/89] Support port spltting methods with multiple output ports --- src/Libraries/Base1/Prelude.bs | 240 +++++++++++------- src/comp/AAddScheduleDefs.hs | 12 +- src/comp/ACheck.hs | 3 +- src/comp/AConv.hs | 204 +++++++++------ src/comp/ADropUndet.hs | 2 + src/comp/ADumpSchedule.hs | 2 +- src/comp/AExpand.hs | 6 + src/comp/AExpr2STP.hs | 29 ++- src/comp/AExpr2Util.hs | 14 +- src/comp/AExpr2Yices.hs | 30 ++- src/comp/ANoInline.hs | 2 +- src/comp/APaths.hs | 134 ++++++---- src/comp/ARankMethCalls.hs | 3 +- src/comp/ARenameIO.hs | 4 +- src/comp/ASchedule.hs | 12 +- src/comp/AState.hs | 99 +++++--- src/comp/ASyntax.hs | 156 +++++++----- src/comp/ASyntaxUtil.hs | 41 +++ src/comp/ATaskSplice.hs | 7 +- src/comp/AUses.hs | 2 + src/comp/AVeriQuirks.hs | 7 + src/comp/AVerilog.hs | 8 +- src/comp/AVerilogUtil.hs | 12 +- src/comp/BackendNamingConventions.hs | 54 ++-- src/comp/BinData.hs | 8 + src/comp/CSyntax.hs | 6 +- src/comp/CType.hs | 10 +- src/comp/CVPrint.hs | 7 +- src/comp/DisjointTest.hs | 30 ++- src/comp/GenWrap.hs | 34 ++- src/comp/IExpand.hs | 93 ++++--- src/comp/IExpandUtils.hs | 15 +- src/comp/IInlineFmt.hs | 22 +- src/comp/ISplitIf.hs | 6 +- src/comp/ISyntax.hs | 10 +- src/comp/ISyntaxUtil.hs | 48 ++-- src/comp/ITransform.hs | 4 +- src/comp/IfcBetterInfo.hs | 8 +- src/comp/LambdaCalc.hs | 12 +- src/comp/LambdaCalcUtil.hs | 13 +- src/comp/Parser/BSV/CVParser.lhs | 8 +- src/comp/Parser/BSV/CVParserImperative.lhs | 16 +- src/comp/Parser/Classic/CParser.hs | 2 +- src/comp/PreStrings.hs | 2 + src/comp/SAL.hs | 13 +- src/comp/SignalNaming.hs | 7 + src/comp/SimCCBlock.hs | 29 ++- src/comp/SimCOpt.hs | 1 + src/comp/SimExpand.hs | 11 +- src/comp/SimMakeCBlocks.hs | 47 +++- src/comp/SimPackage.hs | 12 +- src/comp/SimPackageOpt.hs | 13 +- src/comp/SystemCWrapper.hs | 8 +- src/comp/TCheck.hs | 51 ++-- src/comp/TopUtils.hs | 4 +- src/comp/Type.hs | 23 +- src/comp/VIOProps.hs | 17 +- src/comp/VModInfo.hs | 22 +- src/comp/bluetcl.hs | 167 ++++++------ src/comp/showrules.hs | 2 +- .../module.tcl.bluetcl-bh-out.expected | 6 +- .../commands/module.tcl.bluetcl-out.expected | 6 +- .../submodule.tcl.bluetcl-bh-out.expected | 68 +++-- .../submodule.tcl.bluetcl-out.expected | 68 +++-- .../inhigh.tcl.bluetcl-bh-out.expected | 4 +- .../inhigh.tcl.bluetcl-out.expected | 4 +- .../prims.tcl.bluetcl-bh-out.expected | 46 ++-- .../port_types/prims.tcl.bluetcl-out.expected | 46 ++-- .../zero_size.tcl.bluetcl-bh-out.expected | 4 +- .../zero_size.tcl.bluetcl-out.expected | 4 +- .../bluespec_inc/b1354/mkMulti.v.expected | 96 +++---- .../bsc.bugs/bluespec_inc/b1490/b1490.exp | 2 +- .../bsc.bugs/bluespec_inc/b1610/Test2.bs | 2 +- .../bsc.bugs/bluespec_inc/b1758/b1758.exp | 12 +- .../bluespec_inc/b262/sysBug262Opt.v.expected | 6 +- .../bluespec_inc/b292/mkDesign.v.expected | 22 +- .../bluespec_inc/b293/mkDesign1.v.expected | 16 +- .../bluespec_inc/b302/mkDesign.v.expected | 113 ++++----- .../bsc.codegen/foreign/BDPIActionValue_.bsv | 2 +- testsuite/bsc.doc/UserGuide_mkGCD.v.expected | 8 +- .../bsc.evaluator/mkTest.atsexpand.expected | 8 +- .../mkTest.atsexpand.nolift.expandif.expected | 8 +- ...ormConstantAcrossEquals.atsexpand.expected | 8 +- .../bsc.evaluator/sysShiftMult.ats.expected | 30 +-- .../EResources.bs.bsc-vcomp-out.expected | 4 +- .../lc-sysMultiArityConcat.out.expected | 8 +- .../lc-sysStructs.out.expected | 18 +- .../lambda_calculus/lc-sysTb.out.expected | 50 ++-- .../sal/CTX_sysMultiArityConcat.sal.expected | 10 +- .../bsc.misc/sal/CTX_sysStructs.sal.expected | 18 +- testsuite/bsc.misc/sal/CTX_sysTb.sal.expected | 50 ++-- ...alNum_ENotation.bsv.bsc-vcomp-out.expected | 2 +- .../Method.bsv.bsc-vcomp-out.expected | 6 +- ...thodActionValue.bsv.bsc-vcomp-out.expected | 12 +- .../MethodRead.bsv.bsc-vcomp-out.expected | 12 +- .../NoInline.bsv.bsc-vcomp-out.expected | 8 +- .../SplitIf.bsv.bsc-sched-out.expected | 4 +- .../SplitIf2.bsv.bsc-sched-out.expected | 8 +- .../AVArgUse_C.bsv.bsc-sched-out.expected | 2 +- .../AVArgUse_SBR.bsv.bsc-sched-out.expected | 2 +- .../sysStateNameTest.atsexpand.expected | 2 +- .../sysStateNameTest2.atsexpand.expected | 2 +- .../statename/sysUseMod2.atsexpand.expected | 2 +- .../sysUseMod2Arrow.atsexpand.expected | 2 +- .../DummyInRuleQual.bs.bsc-vcomp-out.expected | 2 +- testsuite/bsc.verilog/astate/astate.exp | 6 +- testsuite/bsc.verilog/inline/inline.exp | 4 +- ...ne_ResNotInBits.bsv.bsc-vcomp-out.expected | 6 - testsuite/bsc.verilog/splitports/DeepSplit.bs | 26 +- .../bsc.verilog/splitports/InstanceSplit.bs | 23 +- .../bsc.verilog/splitports/ShallowSplit.bs | 23 +- .../bsc.verilog/splitports/splitports.exp | 42 +++ .../splitports/sysDeepSplit.out.expected | 5 + .../splitports/sysInstanceSplit.out.expected | 4 + .../splitports/sysShallowSplit.out.expected | 4 + 115 files changed, 1729 insertions(+), 1091 deletions(-) diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index 7d6472321..04aba7f0d 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -259,8 +259,8 @@ package Prelude( NumConArg(..), StarConArg(..), OtherConArg(..), MetaConsNamed(..), MetaConsAnon(..), MetaField(..), - WrapField(..), WrapMethod(..), WrapPorts(..), - Port(..), unPort, SplitPorts(..) + WrapField(..), WrapMethod(..), WrapPorts(..), NonEmptyBits(..), + Port(..), unPort, SplitPorts(..), PrimSeqTupleBits(..) ) where infixr 0 $ @@ -920,9 +920,9 @@ fromPrimAction a = ActionValue (\aw -> AVStruct { avValue = _; avAction = a; avW type Action = ActionValue () --X@ \begin{verbatim} ---X@ typedef ActionValue_#(0) Action_; +--X@ typedef ActionValue_#(void) Action_; --X@ \end{verbatim} -type Action_ = ActionValue_ 0 +type Action_ = ActionValue_ () --@ An empty \te{Action}. --@ \index{noAction@\te{noAction} (empty action)} @@ -939,23 +939,36 @@ noAction = fromPrimAction primNoActions (:<-) :: Reg a -> ActionValue a -> Action (:<-) r av = av `bind` r._write ---X@ A primitive \te{ActionValue} of bits +--X@ A primitive \te{ActionValue} of bits. +--X@ The type parameter should be either (), Bit n, or a tuple of Bit n. --X@ \begin{verbatim} ---X@ struct ActionValue_ #(type n); +--X@ struct ActionValue_ #(type a; --X@ \end{verbatim} -struct ActionValue_ n +struct ActionValue_ a = - avValue_ :: Bit n + avValue_ :: a avAction_ :: PrimAction -toActionValue_ :: (Bits a n) => ActionValue a -> ActionValue_ n -toActionValue_ (ActionValue av) = +toActionValue_ :: (Bits a n) => ActionValue a -> ActionValue_ (Bit n) +toActionValue_ = bitsToActionValue_ ∘ fmap pack + +fromActionValue_ :: (Bits a n) => ActionValue_ (Bit n) -> ActionValue a +fromActionValue_ = fmap unpack ∘ bitsFromActionValue_ + +toAction_ :: Action -> Action_ +toAction_ = bitsToActionValue_ + +fromAction_ :: Action_ -> Action +fromAction_ = bitsFromActionValue_ + +bitsToActionValue_ :: ActionValue a -> ActionValue_ a +bitsToActionValue_ (ActionValue av) = letseq av' = av ActionWorld - in ActionValue_ { avValue_ = pack av'.avValue; avAction_ = av'.avAction} + in ActionValue_ { avValue_ = av'.avValue; avAction_ = av'.avAction} -fromActionValue_ :: (Bits a n) => ActionValue_ n -> ActionValue a -fromActionValue_ av_ = ActionValue (\aw -> - AVStruct { avValue = unpack av_.avValue_; avAction = av_.avAction_; avWorld = aw}) +bitsFromActionValue_ :: ActionValue_ a -> ActionValue a +bitsFromActionValue_ av_ = ActionValue (\ aw -> + AVStruct { avValue = av_.avValue_; avAction = av_.avAction_; avWorld = aw}) -- ---------------------------------------------------------------- @@ -2586,7 +2599,7 @@ messageM s = do --@ endfunction: id --@ \end{libverbatim} id :: a -> a -id x = x +id _x = _x --@ Make a function curried --@ \index{curry@\te{curry} (Prelude function)} @@ -3223,9 +3236,9 @@ $time = fromActionValue_ (__time__) $stime :: ActionValue (Bit 32) $stime = fromActionValue_ (__stime__) -foreign __time__ :: ActionValue_ 64 = "$time" +foreign __time__ :: ActionValue_ (Bit 64) = "$time" -foreign __stime__ :: ActionValue_ 32 = "$stime" +foreign __stime__ :: ActionValue_ (Bit 32) = "$stime" -- File type and system tasks which use it data File = InvalidFile | @@ -3279,7 +3292,7 @@ foreign $fflush :: PrimAction = "$fflush" -- Type checking is done by bsc -- $fopen :: String -> ActionValue#(File) -- $fopen :: String -> String -> ActionValue#(File) -foreign $fopen :: ActionValue_ 32 = "$fopen" +foreign $fopen :: ActionValue_ (Bit 32) = "$fopen" -- The arguments for these are handled internally @@ -3288,16 +3301,16 @@ foreign $fwriteb :: PrimAction = "$fwriteb" foreign $fwriteo :: PrimAction = "$fwriteo" foreign $fwriteh :: PrimAction = "$fwriteh" -foreign $swriteAV :: ActionValue_ n = "$swriteAV" +foreign $swriteAV :: ActionValue_ (Bit n) = "$swriteAV" foreign $swrite :: PrimAction = "$swrite" -foreign $swritebAV :: ActionValue_ n = "$swritebAV" +foreign $swritebAV :: ActionValue_ (Bit n) = "$swritebAV" foreign $swriteb :: PrimAction = "$swriteb" -foreign $swriteoAV :: ActionValue_ n = "$swriteoAV" +foreign $swriteoAV :: ActionValue_ (Bit n) = "$swriteoAV" foreign $swriteo :: PrimAction = "$swriteo" -foreign $swritehAV :: ActionValue_ n = "$swritehAV" +foreign $swritehAV :: ActionValue_ (Bit n) = "$swritehAV" foreign $swriteh :: PrimAction = "$swriteh" -foreign $sformatAV :: ActionValue_ n = "$sformatAV" +foreign $sformatAV :: ActionValue_ (Bit n) = "$sformatAV" foreign $sformat :: PrimAction = "$sformat" foreign $fdisplay :: PrimAction = "$fdisplay" @@ -3305,20 +3318,19 @@ foreign $fdisplayb :: PrimAction = "$fdisplayb" foreign $fdisplayo :: PrimAction = "$fdisplayo" foreign $fdisplayh :: PrimAction = "$fdisplayh" -foreign $random :: ActionValue_ 32 = "$random" +foreign $random :: ActionValue_ (Bit 32) = "$random" $fgetc :: File -> ActionValue (Int 32) -- to allow space for -1 $fgetc f = fromActionValue_ (__fgetc__ (pack f)) -foreign __fgetc__ :: Bit 32 -> ActionValue_ 32 = "$fgetc" +foreign __fgetc__ :: Bit 32 -> ActionValue_ (Bit 32) = "$fgetc" $fclose :: File -> Action -$fclose f = fromActionValue_ (__fclose__ (pack f)) +$fclose f = fromAction_ (__fclose__ (pack f)) foreign __fclose__ :: Bit 32 -> Action_ = "$fclose" $ungetc :: Bit 8 -> File -> ActionValue (Int 32) $ungetc c f = fromActionValue_ ( __fungetc__ c (pack f)) -foreign __fungetc__ :: Bit 8 -> Bit 32 -> ActionValue_ 32 = "$ungetc" - +foreign __fungetc__ :: Bit 8 -> Bit 32 -> ActionValue_ (Bit 32) = "$ungetc" -- "standard" file descriptors stdin :: File @@ -3333,7 +3345,7 @@ stdout_mcd = MCD 1 $test$plusargs :: String -> ActionValue Bool $test$plusargs x = fromActionValue_ (__testplusargs__ x) -foreign __testplusargs__ :: String -> ActionValue_ 1 = "$test$plusargs" +foreign __testplusargs__ :: String -> ActionValue_ (Bit 1) = "$test$plusargs" ------------------ @@ -3419,8 +3431,8 @@ class AppendTuple a b c | a b -> c where splitTuple :: c -> (a, b) instance AppendTuple a () a where - appendTuple x _ = x - splitTuple x = (x, ()) + appendTuple _x _ = _x + splitTuple _x = (_x, ()) -- The above instance should take precedence over the other cases that assume -- b is non-unit. To avoid overlapping instances, the below are factored out as @@ -3435,7 +3447,7 @@ class AppendTuple' a b c | a b -> c where instance AppendTuple' () a a where appendTuple' _ = id - splitTuple' x = ((), x) + splitTuple' _x = ((), _x) instance (AppendTuple'' a b c) => AppendTuple' a b c where appendTuple' = appendTuple'' @@ -3446,13 +3458,13 @@ class AppendTuple'' a b c | a b -> c where splitTuple'' :: c -> (a, b) instance AppendTuple'' a b (a, b) where - appendTuple'' a b = (a, b) + appendTuple'' _x _y = (_x, _y) splitTuple'' = id instance (AppendTuple'' a b c) => AppendTuple'' (h, a) b (h, c) where - appendTuple'' (x, y) z = (x, appendTuple'' y z) - splitTuple'' (x, y) = case splitTuple'' y of - (w, z) -> ((x, w), z) + appendTuple'' (_x, _y) _z = (_x, appendTuple'' _y _z) + splitTuple'' (_x, _y) = case splitTuple'' _y of + (_w, _z) -> ((_x, _w), _z) class TupleSize a n | a -> n where {} instance TupleSize () 0 where {} @@ -4466,18 +4478,16 @@ data (MetaField :: $ -> # -> *) name idx = MetaField deriving (FShow) --- Tag a method with metadata. --- Currently just the list of input port names. --- Should eventually include the output port names, when we support multiple output ports. -primitive primMethod :: List String -> a -> a +-- Tag a method with metadata: the input and output port names. +primitive primMethod :: List String -> List String -> a -> a -- 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, + -- Given a proxy value for the field name, and the values of the prefix, arg_names and result pragmas, -- converts a synthesized interface field value to its wrapper interface field. - toWrapField :: StrArg name -> String -> List String -> f -> w + toWrapField :: StrArg name -> String -> List String -> String -> f -> w -- Given a proxy value for the field name, converts a wrapper interface field value -- to its synthesized interface field. @@ -4488,35 +4498,39 @@ 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 names = - let baseNames = methodArgBaseNames (_ :: m) prefix names 1 - in primMethod (inputPortNames (_ :: m) baseNames) ∘ toWrapMethod + toWrapField _ prefix argNames resultName = + let argBaseNames = methodArgBaseNames (_ :: m) prefix argNames 1 + in primMethod + (inputPortNames (_ :: m) argBaseNames) + (outputPortNames (_ :: m) resultName) + ∘ toWrapMethod fromWrapField _ = fromWrapMethod - saveFieldPortTypes _ _ modName prefix names = - let baseNames = methodArgBaseNames (_ :: m) prefix names 1 - in saveMethodPortTypes (_ :: m) modName baseNames + saveFieldPortTypes _ _ modName prefix argNames resultName = + let baseNames = methodArgBaseNames (_ :: m) prefix argNames 1 + in saveMethodPortTypes (_ :: m) 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. instance WrapField name PrimAction PrimAction where - toWrapField _ _ _ = id + toWrapField _ _ _ _ = id fromWrapField _ = id saveFieldPortTypes _ _ _ _ _ _ = return () instance WrapField name Clock Clock where - toWrapField _ _ _ = id + toWrapField _ _ _ _ = id fromWrapField _ = id saveFieldPortTypes _ _ _ _ _ _ = return () instance WrapField name Reset Reset where - toWrapField _ _ _ = id + toWrapField _ _ _ _ = id fromWrapField _ = id saveFieldPortTypes _ _ _ _ _ _ = return () instance (Bits a n) => WrapField name (Inout a) (Inout_ n) where - toWrapField _ _ _ = primInoutCast0 + toWrapField _ _ _ _ = primInoutCast0 fromWrapField _ = primInoutUncast0 - saveFieldPortTypes _ _ modName _ _ result = primSavePortType modName result $ typeOf (_ :: (Inout a)) + 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. @@ -4531,6 +4545,9 @@ class WrapMethod m w | m -> w where -- Compute the list of input port names for a method, from the argument base names. inputPortNames :: m -> List String -> List String + -- Compute the list of input port names for a method, from the result base name. + outputPortNames :: m -> 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 () @@ -4549,83 +4566,122 @@ instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, WrapMethod b v, Curry ( (prefix +++ "_" +++ integerToString i) (methodArgBaseNames (_ :: b) prefix Nil $ i + 1) - inputPortNames _ (Cons h t) = checkPortNames (_ :: a) h `listPrimAppend` inputPortNames (_ :: b) t + inputPortNames _ (Cons h t) = + filterZeroWidthPorts (_ :: p) (checkPortNames (_ :: a) h) + `listPrimAppend` inputPortNames (_ :: b) t inputPortNames _ Nil = error "inputPortNames: empty arg names list" + outputPortNames _ = outputPortNames (_ :: b) + saveMethodPortTypes _ modName (Cons h t) result = do savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) h saveMethodPortTypes (_ :: b) modName t result saveMethodPortTypes _ _ Nil _ = error "saveMethodPortTypes: empty arg names list" -instance (Bits a n) => WrapMethod (ActionValue a) (ActionValue_ n) where - toWrapMethod = toActionValue_ - fromWrapMethod = fromActionValue_ +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, 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) +++ " excess arg_names provided for method " +++ prefix inputPortNames _ Nil = Nil inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names" - saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) + outputPortNames _ base = filterZeroWidthPorts (_ :: p) $ checkPortNames (_ :: a) base + saveMethodPortTypes _ modName _ result = + savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result -instance (Bits a n) => WrapMethod a (Bit n) where - toWrapMethod = pack - fromWrapMethod = unpack +instance (SplitPorts a p, TupleSize p n, WrapPorts p pb, 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) +++ " excess arg_names provided for method " +++ prefix inputPortNames _ Nil = Nil inputPortNames _ (Cons _ _) = error "inputPortNames: uncaught excess arg names" - saveMethodPortTypes _ modName _ result = primSavePortType modName result $ typeOf (_ :: a) - -{- -Eventually, we should support splitting multiple output ports. -instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod (ActionValue a) (ActionValue pb) where - toWrapMethod = fmap packPorts - fromWrapMethod = fmap unpackPorts - outputPortNames _ base = checkPortNames (_ :: a) base - saveMethodPortTypes _ modName _ result = - savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result - -instance (SplitPorts a p, TupleSize p n, WrapPorts p pb) => WrapMethod a pb where - toWrapMethod a = packPorts a - fromWrapMethod a = unpackPorts a - outputPortNames _ base = checkPortNames (_ :: a) base + outputPortNames _ base = filterZeroWidthPorts (_ :: p) $ checkPortNames (_ :: a) base saveMethodPortTypes _ modName _ result = savePortTypes (_ :: p) modName $ checkPortNames (_ :: a) result --} class WrapPorts p pb | p -> pb where - -- Convert from a tuple of values to a tuple of bits. + -- Convert from a tuple of Port values to a tuple of bits. packPorts :: p -> pb - -- Convert from a tuple of bits to a tuple of values. + -- Convert from a tuple of bits to a tuple of Port values. unpackPorts :: pb -> p -- Save the port types, given their names. savePortTypes :: p -> Maybe Name__ -> List String -> Module () - -instance (Bits a n, WrapPorts b bb) => WrapPorts (Port a, b) (Bit n, bb) where - packPorts (Port a, b) = (pack a, packPorts b) - unpackPorts (a, b) = (Port $ unpack a, unpackPorts b) + -- Filter the port names to only those that have non-zero width. + filterZeroWidthPorts :: p -> List String -> List String + +instance (Bits a n, NonEmptyBits n ab, WrapPorts b bb, AppendTuple ab bb pb) => + WrapPorts (Port a, b) pb where + packPorts (Port a, b) = toNonEmptyBits (pack a) `appendTuple` packPorts b + unpackPorts p = case splitTuple p of + (ab, bb) -> (Port (unpack (fromNonEmptyBits ab)), unpackPorts bb) savePortTypes _ modName (Cons h t) = do - primSavePortType modName h $ typeOf (_ :: a) + if valueOf n > 0 + then primSavePortType modName h $ typeOf (_ :: a) + else return () savePortTypes (_ :: b) modName t savePortTypes _ _ Nil = error "savePortTypes: empty port names list" - -instance (Bits a n) => WrapPorts (Port a) (Bit n) where - packPorts (Port a) = pack a - unpackPorts = Port ∘ unpack - savePortTypes _ modName (Cons h _) = primSavePortType modName h $ typeOf (_ :: a) - savePortTypes _ _ Nil = error "savePortTypes: empty port names list" + filterZeroWidthPorts _ (Cons h t) = + if valueOf n > 0 + then Cons h (filterZeroWidthPorts (_ :: b) t) + else filterZeroWidthPorts (_ :: b) t + filterZeroWidthPorts _ Nil = error "filterZeroWidthPorts: empty port names list" + +instance (Bits a n, NonEmptyBits n pb) => WrapPorts (Port a) pb where + packPorts (Port a) = toNonEmptyBits (pack a) + unpackPorts = Port ∘ unpack ∘ fromNonEmptyBits + savePortTypes _ modName (Cons h Nil) = primSavePortType modName h $ typeOf (_ :: a) + savePortTypes _ _ _ = error "savePortTypes: expected one port name" + filterZeroWidthPorts _ (Cons h Nil) = + if valueOf n > 0 then Cons h Nil else Nil + filterZeroWidthPorts _ _ = error "filterZeroWidthPorts: expected one port name" instance WrapPorts () () where packPorts _ = () unpackPorts _ = () - savePortTypes _ _ _ = return () + savePortTypes _ _ Nil = return () + savePortTypes _ _ _ = error "savePortTypes: non-empty port names list" + filterZeroWidthPorts _ Nil = Nil + filterZeroWidthPorts _ _ = error "filterZeroWidthPorts: non-empty port names list" + +-- Helper class to conditionally convert Bit 0 to () +class NonEmptyBits n pb | n -> pb where + toNonEmptyBits :: Bit n -> pb + fromNonEmptyBits :: pb -> Bit n + +instance NonEmptyBits 0 () where + toNonEmptyBits _ = () + fromNonEmptyBits _ = 0 + +instance NonEmptyBits n (Bit n) where + toNonEmptyBits = id + fromNonEmptyBits = id + +-- Force a tuple of bit values to be fully expanded by the evaluator. +primDeepSeqTupleBits :: (PrimSeqTupleBits a) => a -> a +primDeepSeqTupleBits a = primSeqTupleBits a a + +class PrimSeqTupleBits a where + primSeqTupleBits :: a -> b -> b + +instance (PrimSeqTupleBits b) => PrimSeqTupleBits (Bit n, b) where + primSeqTupleBits (a, b) c = primSeq a (primSeqTupleBits b c) + +instance PrimSeqTupleBits (Bit n) where + primSeqTupleBits = primSeq + +instance PrimSeqTupleBits () where + primSeqTupleBits () = id -- 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 WrapPorts instance. +-- 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 = let pn = portNames proxy base diff --git a/src/comp/AAddScheduleDefs.hs b/src/comp/AAddScheduleDefs.hs index 44449a2ed..d90ae6e8a 100644 --- a/src/comp/AAddScheduleDefs.hs +++ b/src/comp/AAddScheduleDefs.hs @@ -105,12 +105,12 @@ aAddScheduleDefs flags pps pkg aschedinfo = -- The ExprMaps map from a method name (not RDY) to the expression -- for that method's ready or enable condition. let pre_rdy_map = M.fromList $ - [ (dropReadyPrefixId (aIfaceName m), adef_expr (aif_value m)) + [ (dropReadyPrefixId (aif_name m), adef_expr $ aif_value m) | m <- ifc0 - , isRdyId (aIfaceName m) + , isRdyId (aif_name m) ] pre_en_map = M.fromList $ - [ (aIfaceName m, e) + [ (aif_name m, e) | m <- ifc0 , (Just e) <- [getMethodEnExpr m] ] @@ -280,11 +280,11 @@ mkIfcWFs _ _ _ = [] -- ignore RDY methods, clocks, resets, inouts -- Get the map from a method to its rule names (or def name, for value method) buildRuleMap :: AIFace -> Maybe (Id, [Id]) buildRuleMap m@(AIAction {}) = - Just (aIfaceName m, map aRuleName (aIfaceRules m)) + Just (aif_name m, map aRuleName (aIfaceRules m)) buildRuleMap m@(AIActionValue {}) = - Just (aIfaceName m, map aRuleName (aIfaceRules m)) + Just (aif_name m, map aRuleName (aIfaceRules m)) buildRuleMap m@(AIDef { aif_name = mid }) | not (isRdyId mid) = - Just (mid, [aIfaceName m]) + Just (mid, [aif_name m]) buildRuleMap _ = Nothing -- Replace the value in a RDY method diff --git a/src/comp/ACheck.hs b/src/comp/ACheck.hs index f42553812..602d8227e 100644 --- a/src/comp/ACheck.hs +++ b/src/comp/ACheck.hs @@ -98,7 +98,6 @@ chkAIface aa@(AIAction { aif_body = rs }) = chkAIface aa@(AIActionValue { aif_value = d, aif_body = rs }) = tracePP "chkAIface AIActionValue" aa $ (all chkARule rs) && (chkADef d) - chkAIface aa@(AIClock { aif_clock = c }) = tracePP "chkAIface AIClock" aa $ chkAClock c @@ -422,6 +421,8 @@ checkUse :: S.Set AId -> S.Set AId -> S.Set AId -> AExpr -> [AId] checkUse ds is ps (APrim _ _ _ es) = checkUses ds is ps es checkUse ds is ps (AMethCall _ i m es) = checkUses ds is ps es -- XXX check i and m ? checkUse ds is ps (AMethValue _ i m) = [] -- XXX check i and m ? +checkUse ds is ps (ATuple _ es) = checkUses ds is ps es +checkUse ds is ps (ATupleSel _ e _) = checkUse ds is ps e checkUse ds is ps (ANoInlineFunCall _ _ _ es) = checkUses ds is ps es checkUse ds is ps (AFunCall { ae_args = es }) = checkUses ds is ps es -- because all of the expressions used are used by the ATaskAction diff --git a/src/comp/AConv.hs b/src/comp/AConv.hs index 2ea42a585..b939ba1a0 100644 --- a/src/comp/AConv.hs +++ b/src/comp/AConv.hs @@ -13,8 +13,8 @@ import Id import FStringCompat import Flags(Flags) import PreStrings(sSigned) -import PreIds(idBit, idAVAction_, idAVValue_, idClockOsc, idClockGate, - idInout_, idPrimArray) +import PreIds(idBit, idActionValue_, idAVAction_, idAVValue_, idClockOsc, idClockGate, + idInout_, idPrimArray, idPrimPair, idPrimFst, idPrimSnd, idPrimUnit) import Pragma import Error(internalError, EMsg, WMsg, ErrMsg(..), ErrorHandle, bsError, bsWarning) @@ -28,7 +28,6 @@ import GenWrapUtils(isGenId, dropGenSuffixId) import Prim import Data.List(genericLength, nub) import Data.Maybe(fromMaybe) -import CType(TISort(..), StructSubType(..)) import VModInfo(lookupOutputClockWires, lookupOutputResetWire, lookupIfcInoutWire, vArgs, VArgInfo(..)) import SignalNaming @@ -187,18 +186,18 @@ aDo imod@(IModule mi fmod be wi ps iks its clks rsts itvs pts idefs rs ifc ffcal flags <- getFlags -- AVInst keeps the types of method ports - let tsConv :: Id -> [IType] -> ([AType], Maybe AType, Maybe AType) + let tsConv :: Id -> [IType] -> ([AType], Maybe AType, [AType]) tsConv i ts = let inputs = initOrErr "tsConv" ts res = lastOrErr "tsConv" ts in_types = map (aTypeConv i) inputs (en_type, val_type) - | isitActionValue_ res && getAV_Size res > 0 - = (Just (ATBit 1), Just (ATBit (getAV_Size res))) + | isitActionValue_ res + = (Just (ATBit 1), aTypesConv i (getAV_Type res)) | isActionType res - = (Just (ATBit 1), Nothing) + = (Just (ATBit 1), []) | otherwise - = (Nothing, Just (aTypeConv i res)) + = (Nothing, aTypesConv i res) in (in_types, en_type, val_type) let (IRules sps irule_list) = rs @@ -366,9 +365,7 @@ aIface flags iface@(IEFace i its maybe_e maybe_rs wp fi) = do ++ ppReadable iface) | otherwise -> do - -- internal error if type actionvalue XXX ae <- aExpr e - --trace ("exit v " ++ ppReadable i) $ return () return (AIDef i its' wp g (ADef i (aTypeConv i t) ae []) fi []) (Nothing, Just rs) -> do @@ -382,7 +379,7 @@ aIface flags iface@(IEFace i its maybe_e maybe_rs wp fi) = do ae <- aExpr val_ --trace ("exit av " ++ ppReadable i) $ return () return (AIActionValue its' wp g i arule_list - (ADef i (aTypeConv i t) ae []) fi ) + (ADef i (aTypeConv i t) ae []) fi ) -- should internalError if size(val_)==0 XXX aRule :: IRule a -> M ARule @@ -507,69 +504,17 @@ aExpr (IAps (ICon i (ICSel { })) ts (e:es)) = internalError ("aExpr: too many arguments to avValue_: " ++ ppReadable es) --- value part of ActionValue task without arguments -aExpr e@(IAps (ICon m (ICSel { })) _ - [(ICon i (ICForeign {fName = name, - isC = isC, - foports = Nothing, - fcallNo = mn}))]) - | m == idAVValue_ = - let n = case (mn) of - Nothing -> internalError - ("aExpr: avValue_ on ICForeign without fcallNo") - Just val -> val - t = aTypeConvE e (iGetType e) - in - return (ATaskValue t i name isC n) - --- value part of ActionValue task with arguments -aExpr e@(IAps (ICon m (ICSel { })) _ - [(IAps (ICon i (ICForeign {fName = name, - isC = isC, - foports = Nothing, - fcallNo = mn})) fts fes)]) - | m == idAVValue_ = - let n = case (mn) of - Nothing -> internalError - ("aExpr: avValue_ on ICForeign without fcallNo") - Just val -> val - t = aTypeConvE e (iGetType e) - in - -- the value side carries no arguments - -- the cookie "n" will connect it back up to the action side - return (ATaskValue t i name isC n) - --- value part of ActionValue method -aExpr e@(IAps (ICon sel_id (ICSel { })) ts - [(IAps (ICon m (ICSel { })) _ (ICon i (ICStateVar { }) : es))]) - | (sel_id == idAVValue_) = do - i' <- transId i - let atype = aTypeConvE e (iGetType e) - -- arguments should have been dropped in IExpand - when (not (null es)) $ - internalError ("AConv.aExpr actionvalue value with args " ++ - ppReadable e) - -- IExpand is failing to optimize away bit-zero results from methods - -- and foreign functions, so catch that here for ActionValue methods - return $ if (atype == aTZero) - then ASInt i (ATBit 0) (ilDec 0) - else AMethValue atype i' m +aExpr e@(IAps (ICon _ (ICSel {})) _ _) = aSelExpr sels selExpr + where + (sels, selExpr) = unfoldICSel e --- value method -aExpr e@(IAps (ICon m (ICSel { })) _ (ICon i (ICStateVar { }) : es)) = do - i' <- transId i - let atype = aTypeConvE e (iGetType e) - es' <- mapM aSExpr es - return $ AMethCall atype i' m es' + unfoldICSel :: IExpr a -> ([(Id, AType)], [IExpr a]) + unfoldICSel e@(IAps (ICon i (ICSel {})) _ [e']) = + let (sels, a) = unfoldICSel e' + in ((i, aTypeConvE e $ iGetType e) : sels, a) + unfoldICSel e@(IAps (ICon i (ICSel {})) _ a) = ([(i, aTypeConvE e $ iGetType e)], a) + unfoldICSel e = ([], [e]) -aExpr e@(IAps (ICon m (ICSel { })) _ [(ICon i (ICClock { iClock = c }))]) | m == idClockGate = do - ac <- aClock c - return (aclock_gate ac) --- XXX This is here because aClock calls aSExpr on the oscillator. However, --- XXX that should be the only place where an osc ever appears in an expr. -aExpr e@(IAps (ICon m (ICSel { })) _ [(ICon i (ICClock { iClock = c }))]) | m == idClockOsc = do - ac <- aClock c - return (aclock_osc ac) aExpr (IAps (ICon _ (ICCon { iConType = ITAp _ t, conTagInfo = cti })) _ _) | t == itBit1 = return $ aSBool (conNo cti /= 0) aExpr e@(IAps (ICon i (ICForeign { fName = name, isC = isC, foports = Nothing})) ts es) = do @@ -593,6 +538,11 @@ aExpr e@(IAps (ICon i (ICForeign { fName = name, isC = False, foports = (Just op return $ ANoInlineFunCall t i' (ANoInlineFun name ns ops Nothing) es' +aExpr e@(IAps (ICon i _) _ _) | i == idPrimPair = do + let at = aTypeConvE e (iGetType e) + aes <- aTupleExpr e + return (ATuple at aes) + aExpr e@(ICon v (ICModPort { iConType = t })) = return (ASPort (aTypeConvE e t) v) aExpr e@(ICon v (ICModParam { iConType = t })) = return (ASParam (aTypeConvE e t) v) aExpr e@(ICon v (ICMethArg { iConType = t })) = return (ASPort (aTypeConvE e t) v) @@ -638,11 +588,105 @@ aExpr e@(ICon _ (ICInout { iConType = it, iInout = i})) | (isitInout_ it) = do ai <- aInout i return (ASInout at ai) +aExpr (ICon i _) | i == idPrimUnit = return $ ASInt i (ATBit 0) (ilDec 0) + aExpr e = internalError ("AConv.aExpr at " ++ ppString p ++ ":" ++ ppReadable e ++ "\n" ++ (show p) ++ ":" ++ (showTypeless e)) where p = getIExprPosition e +aTupleExpr :: IExpr a -> M [AExpr] +aTupleExpr (IAps (ICon i _) [t1, t2] [e1, e2]) | i == idPrimPair = do + ae1 <- aSExpr e1 + ae2 <- aTupleExpr e2 + return (ae1:ae2) +aTupleExpr e = fmap (:[]) (aSExpr e) + +aSelExpr :: [(Id, AType)] -> [IExpr a] -> M AExpr + +-- value part of ActionValue task without arguments +aSelExpr [(m, t)] [(ICon i (ICForeign {fName = name, + isC = isC, + foports = Nothing, + fcallNo = mn}))] + | m == idAVValue_ = + let n = case (mn) of + Nothing -> internalError + ("aExpr: avValue_ on ICForeign without fcallNo") + Just val -> val + in + return (ATaskValue t i name isC n) + +-- value part of ActionValue task with arguments +aSelExpr [(m, t)] [(IAps (ICon i (ICForeign {fName = name, + isC = isC, + foports = Nothing, + fcallNo = mn})) fts fes)] + | m == idAVValue_ = + let n = case (mn) of + Nothing -> internalError + ("aExpr: avValue_ on ICForeign without fcallNo") + Just val -> val + in + -- the value side carries no arguments + -- the cookie "n" will connect it back up to the action side + return (ATaskValue t i name isC n) + +-- port selected from value part of ActionValue method +aSelExpr ((sel, atype) : sels) base@(ICon i (ICStateVar { }) : es) + | (sel == idPrimFst || sel == idPrimSnd) + , [(iav, atypeTup), (m, _)] <- dropWhile ((== idPrimSnd) . fst) sels = do + i' <- transId i + -- arguments should have been dropped in IExpand + when (not (null es)) $ + internalError ("AConv.aExpr actionvalue value with args " ++ + ppReadable sels ++ "\n" ++ ppReadable base) + let idx = toInteger $ (if sel == idPrimSnd then 1 else 0) + length sels - 2 + return $ ATupleSel atype (AMethValue atypeTup i' m) $ idx + 1 + +-- port selected from value method +aSelExpr ((sel, atype) : sels) (ICon i (ICStateVar { }) : es) + | (sel == idPrimFst || sel == idPrimSnd) + , [(m, atypeTup)] <- dropWhile ((== idPrimSnd) . fst) sels = do + i' <- transId i + es' <- mapM aSExpr es + let idx = toInteger $ (if sel == idPrimSnd then 1 else 0) + length sels - 1 + return $ ATupleSel atype (AMethCall atypeTup i' m es') $ idx + 1 + +-- value part of ActionValue method +aSelExpr sels@[(iav, atype), (m, _)] base@(ICon i (ICStateVar { }) : es) + | (iav == idAVValue_) = do + i' <- transId i + -- arguments should have been dropped in IExpand + when (not (null es)) $ + internalError ("AConv.aExpr actionvalue value with args " ++ + ppReadable sels ++ "\n" ++ ppReadable base) + -- IExpand is failing to optimize away bit-zero results from methods + -- and foreign functions, so catch that here for ActionValue methods + return $ if (atype == aTZero) + then ASInt i (ATBit 0) (ilDec 0) + else AMethValue atype i' m + +-- value method +aSelExpr [(m, atype)] (ICon i (ICStateVar { }) : es) = do + i' <- transId i + es' <- mapM aSExpr es + return $ AMethCall atype i' m es' + +aSelExpr [(m, _)] [ICon i (ICClock { iClock = c })] | m == idClockGate = do + ac <- aClock c + return (aclock_gate ac) +-- XXX This is here because aClock calls aSExpr on the oscillator. However, +-- XXX that should be the only place where an osc ever appears in an expr. +aSelExpr [(m, _)] [ICon i (ICClock { iClock = c })] | m == idClockOsc = do + ac <- aClock c + return (aclock_osc ac) + +aSelExpr sels base = internalError + ("AConv.aSelExpr:" ++ + ppReadable sels ++ "\n" ++ ppReadable base) + + aEDef :: Id -> IExpr a -> [DefProp] -> M AExpr aEDef i e ps = do da <- getDA @@ -662,12 +706,14 @@ aTypeConv _ (ITAp (ITCon i _ _) (ITNum n)) | i == idInout_ = ATAbstract idInout_ aTypeConv a (ITAp (ITCon r _ _) elem_ty) | r == idPrimArray = -- no way to get the size internalError("aTypeConv: array: " ++ ppReadable a) +aTypeConv a t@(ITAp (ITAp (ITCon p _ _) _) _) | p == idPrimPair = + ATTuple (aTypesConv a t) aTypeConv _ t | t == itReal = ATReal aTypeConv _ t | t == itString = ATString Nothing -- Deal with AVs -aTypeConv _ (ITAp (ITCon i t (TIstruct SStruct fs@(val:_))) (ITNum n)) = - ATBit n - -- internalError ("Yes\n\n" ++ (show a) ++"\n\n" ++ (show n)) +aTypeConv a (ITAp (ITCon i _ _) t) | i == idActionValue_ = + aTypeConv a t +aTypeConv a (ITCon i _ _) | i == idPrimUnit = ATBit 0 aTypeConv _ t = abs t [] where abs (ITCon i _ _) ns = ATAbstract i (reverse ns) abs (ITAp t _) ns = abs t ns @@ -684,17 +730,25 @@ aTypeConvE a (ITAp (ITCon r _ _) elem_ty) | r == idPrimArray = -- XXX we could examine the expression and find the type -- XXX but this func isn't used to get the type of PrimBuildArray internalError ("aTypeConv: array: " ++ ppReadable a) +aTypeConvE _ t@(ITAp (ITAp (ITCon p _ _) _) _) | p == idPrimPair = + ATTuple (aTypesConv p t) aTypeConvE a t | t == itReal = ATReal aTypeConvE a t | t == itString = case a of (ICon _ (ICString _ s)) -> ATString (Just (genericLength s)) otherwise -> ATString Nothing +aTypeConvE a (ITCon i _ _) | i == idPrimUnit = ATBit 0 aTypeConvE a t = abs t [] where abs (ITCon i _ _) ns = ATAbstract i (reverse ns) abs (ITAp t _) ns = abs t ns abs _ _ = -- ATAbstract idBit [] -- XXX what's this internalError ("aTypeConvE|" ++ show t) +aTypesConv :: Id -> IType -> [AType] +aTypesConv a (ITAp (ITAp (ITCon p _ _) t1) t2) | p == idPrimPair = + aTypeConv a t1 : aTypesConv a t2 +aTypesConv a t = [aTypeConv a t] + realPrim :: PrimOp -> Bool realPrim p = p `elem` [ diff --git a/src/comp/ADropUndet.hs b/src/comp/ADropUndet.hs index 2e9a0fb9f..fd764c4e1 100644 --- a/src/comp/ADropUndet.hs +++ b/src/comp/ADropUndet.hs @@ -100,6 +100,8 @@ hasNoActionValue :: M.Map AId Bool -> AExpr -> Bool hasNoActionValue avm (APrim { ae_args = es }) = all (hasNoActionValue avm) es hasNoActionValue avm (AMethCall { ae_args = es }) = all (hasNoActionValue avm) es hasNoActionValue avm (AMethValue {}) = False +hasNoActionValue avm (ATuple _ es) = all (hasNoActionValue avm) es +hasNoActionValue avm (ATupleSel { ae_exp = e }) = hasNoActionValue avm e hasNoActionValue avm (ANoInlineFunCall { ae_args = es }) = all (hasNoActionValue avm) es hasNoActionValue avm (AFunCall { ae_args = es }) = all (hasNoActionValue avm) es hasNoActionValue avm (ATaskValue {}) = False diff --git a/src/comp/ADumpSchedule.hs b/src/comp/ADumpSchedule.hs index ab6ecd630..5f0c59dda 100644 --- a/src/comp/ADumpSchedule.hs +++ b/src/comp/ADumpSchedule.hs @@ -322,7 +322,7 @@ genMethodDumpMap vSchedInfo ifc = methodDumpMap -- don't include output clocks and resets -- don't include ready Ids methodList = filter (not . isRdyId) $ - map aIfaceName (aIfaceMethods ifc) + map aif_name (aIfaceMethods ifc) methodRdys = [(mn, p) | (AIDef { aif_name = mn, aif_value = (ADef _ _ p _) }) <- ifc, isRdyId mn] methodDumpMap = [ (mid, p, clist) diff --git a/src/comp/AExpand.hs b/src/comp/AExpand.hs index 7f3227c5d..bf8f32eb5 100644 --- a/src/comp/AExpand.hs +++ b/src/comp/AExpand.hs @@ -458,6 +458,8 @@ isSimple c (APrim i t PrimConcat es) = c && all (is isSimple c e@(APrim _ _ p es) = c && isSmall e && cheap p es -- && all (isSimple c) es isSimple c (AMethCall _ _ _ es) = null es isSimple c (AMethValue _ _ _) = True +isSimple c (ATupleSel _ e _) = isSimple c e +isSimple c (ATuple _ es) = all (isSimple c) es -- foreign function calls cannot be inlined -- (except for $signed and $unsigned - handled by mustInline) isSimple c e@(AFunCall { }) = False @@ -537,6 +539,10 @@ getExprSize (APrim _ _ _ es) = (nub $ concat vars, sum terms, 1 + maximum depths getExprSize (AMethCall t i mid args) = ([mid],1,1) getExprSize (AMethValue t i mid) = ([mid],1,1) +getExprSize (ATupleSel t e i) = (vars, terms + 1, depth + 1) + where (vars,terms,depth) = getExprSize e +getExprSize (ATuple t es) = (nub $ concat vars, sum terms + 1, maximum depths + 1) + where (vars,terms,depths) = unzip3 $ map getExprSize es getExprSize (ATaskValue { }) = ([], 1,1) getExprSize (ASPort t i) = ([i], 1,1) getExprSize (ASParam t i) = ([i], 1,1) diff --git a/src/comp/AExpr2STP.hs b/src/comp/AExpr2STP.hs index ce45f26cd..49acffe8e 100644 --- a/src/comp/AExpr2STP.hs +++ b/src/comp/AExpr2STP.hs @@ -19,6 +19,7 @@ import qualified Data.Map as M import qualified STP as S import Data.Maybe(fromMaybe) +import Data.List (genericIndex) import ErrorUtil(internalError) import Flags @@ -32,7 +33,7 @@ import PFPrint import Util(itos, map_insertMany, makePairs) import TopUtils(withElapsed) -import AExpr2Util(getMethodOutputPort) +import AExpr2Util(getMethodOutputPorts) import Debug.Trace(traceM) import IOUtil(progArgs) @@ -583,15 +584,35 @@ convAExpr2SExpr mty (AMethCall ty@(ATBit width) modId methId args) = do -- get the actual port name, so that methods which share the same output port -- will appear logically equivalent smap <- gets stateMap - let portId = getMethodOutputPort smap modId methId - e = (AMethCall ty modId portId args) + let e = case getMethodOutputPorts smap modId methId of + [portId] -> AMethCall ty modId portId args + ports -> internalError ("convAExpr2SExpr: unexpected output ports: " ++ + ppReadable (modId, methId, ports)) -- XXX This could be an unevaluated function, applied to converted arguments addUnknownExpr mty e width convAExpr2SExpr mty (AMethValue ty@(ATBit width) modId methId) = do -- get the actual port name, so that methods which share the same output port -- will appear logically equivalent smap <- gets stateMap - let portId = getMethodOutputPort smap modId methId + let e = case getMethodOutputPorts smap modId methId of + [portId] -> AMethValue ty modId portId + ports -> internalError ("convAExpr2SExpr: unexpected output ports: " ++ + ppReadable (modId, methId, ports)) + -- XXX This could be an unevaluated function, applied to converted arguments + addUnknownExpr mty e width +convAExpr2SExpr mty (ATupleSel ty@(ATBit width) (AMethCall _ modId methId args) selIdx) = do + -- get the actual port name, so that methods which share the same output port + -- will appear logically equivalent + smap <- gets stateMap + let portId = getMethodOutputPorts smap modId methId `genericIndex` selIdx + e = (AMethCall ty modId portId args) + -- XXX This could be an unevaluated function, applied to converted arguments + addUnknownExpr mty e width +convAExpr2SExpr mty (ATupleSel ty@(ATBit width) (AMethValue _ modId methId) selIdx) = do + -- get the actual port name, so that methods which share the same output port + -- will appear logically equivalent + smap <- gets stateMap + let portId = getMethodOutputPorts smap modId methId `genericIndex` selIdx e = (AMethValue ty modId portId) -- XXX This could be an unevaluated function, applied to converted arguments addUnknownExpr mty e width diff --git a/src/comp/AExpr2Util.hs b/src/comp/AExpr2Util.hs index 104a25735..37db3c5fb 100644 --- a/src/comp/AExpr2Util.hs +++ b/src/comp/AExpr2Util.hs @@ -1,7 +1,7 @@ -- Common code used by various converters module AExpr2Util( - getMethodOutputPort + getMethodOutputPorts ) where import qualified Data.Map as M @@ -32,8 +32,8 @@ import VModInfo(VModInfo(..), VFieldInfo(..), vName_to_id) -- XXX we can replace them with an unevaluated function applied to its arguments! -- XXX That way, the SMT solver will handle any equivalence of the arguments. -getMethodOutputPort :: (M.Map AId VModInfo) -> AId -> AId -> AId -getMethodOutputPort stateMap modId methId = +getMethodOutputPorts :: (M.Map AId VModInfo) -> AId -> AId -> [AId] +getMethodOutputPorts stateMap modId methId = let mod_err = internalError("canonMethCalls: module not found: " ++ ppReadable modId) fields = vFields $ M.findWithDefault mod_err modId stateMap @@ -41,14 +41,12 @@ getMethodOutputPort stateMap modId methId = ppReadable (modId, methId)) findFn (Method { vf_name = i }) = qualEq i methId findFn _ = False - mport = case (find findFn fields) of - Just (Method { vf_output = mo }) -> mo + ports = case (find findFn fields) of + Just (Method { vf_outputs = os }) -> os _ -> meth_err out_err = internalError("canonMethCalls: method has no output: " ++ ppReadable (modId, methId)) - in case mport of - Just (vn,_) -> vName_to_id vn - _ -> out_err + in if null ports then out_err else map (vName_to_id . fst) ports -- ------------------------- diff --git a/src/comp/AExpr2Yices.hs b/src/comp/AExpr2Yices.hs index b621930e0..6e96878c4 100644 --- a/src/comp/AExpr2Yices.hs +++ b/src/comp/AExpr2Yices.hs @@ -18,6 +18,7 @@ import Control.Monad.State(StateT, runStateT, liftIO, import qualified Data.Map as M import qualified Yices as Y import Data.Word(Word32) +import Data.List (genericIndex) import ErrorUtil(internalError) import Flags @@ -30,7 +31,7 @@ import VModInfo(VModInfo) import PFPrint import Util(itos, map_insertMany, makePairs) import TopUtils(withElapsed) -import AExpr2Util(getMethodOutputPort) +import AExpr2Util(getMethodOutputPorts) import Debug.Trace(traceM) import IOUtil(progArgs) @@ -587,16 +588,37 @@ convAExpr2YExpr mty (AMethCall ty@(ATBit width) modId methId args) = do -- get the actual port name, so that methods which share the same output port -- will appear logically equivalent smap <- gets stateMap - let portId = getMethodOutputPort smap modId methId - e = (AMethCall ty modId portId args) + let e = case getMethodOutputPorts smap modId methId of + [portId] -> AMethCall ty modId portId args + ports -> internalError ("convAExpr2YExpr: unexpected output ports: " + ++ ppReadable (modId, methId, ports)) -- XXX This could be an unevaluated function, applied to converted arguments addUnknownExpr mty e width convAExpr2YExpr mty (AMethValue ty@(ATBit width) modId methId) = do -- get the actual port name, so that methods which share the same output port -- will appear logically equivalent smap <- gets stateMap - let portId = getMethodOutputPort smap modId methId + let e = case getMethodOutputPorts smap modId methId of + [portId] -> AMethValue ty modId portId + ports -> internalError ("convAExpr2YExpr: unexpected output ports: " + ++ ppReadable (modId, methId, ports)) + -- XXX This could be an unevaluated function, applied to converted arguments + addUnknownExpr mty e width +convAExpr2YExpr mty (ATupleSel ty@(ATBit width) (AMethCall _ modId methId args) selIdx) = do + -- get the actual port name, so that methods which share the same output port + -- will appear logically equivalent + smap <- gets stateMap + let portId = getMethodOutputPorts smap modId methId `genericIndex` selIdx + e = (AMethCall ty modId portId args) + -- XXX This could be an unevaluated function, applied to converted arguments + addUnknownExpr mty e width +convAExpr2YExpr mty (ATupleSel ty@(ATBit width) (AMethValue _ modId methId) selIdx) = do + -- get the actual port name, so that methods which share the same output port + -- will appear logically equivalent + smap <- gets stateMap + let portId = getMethodOutputPorts smap modId methId `genericIndex` selIdx e = (AMethValue ty modId portId) + -- XXX This could be an unevaluated function, applied to converted arguments addUnknownExpr mty e width convAExpr2YExpr mty e@(AMGate (ATBit 1) _ _) = diff --git a/src/comp/ANoInline.hs b/src/comp/ANoInline.hs index 4cee039c9..8b5449fed 100644 --- a/src/comp/ANoInline.hs +++ b/src/comp/ANoInline.hs @@ -157,7 +157,7 @@ liftAExpr True (ANoInlineFunCall t i f es) = do liftAExpr _ (APrim aid ty op es) = do es' <- mapM (liftAExpr False) es return $ APrim aid ty op es' -liftAExpr _ (AMethCall ty aid mid es) = do +liftAExpr _ (AMethCall ty aid mid es) = do es' <- mapM (liftAExpr False) es return $ AMethCall ty aid mid es' liftAExpr _ (AFunCall ty aid fun isC es) = do diff --git a/src/comp/APaths.hs b/src/comp/APaths.hs index 4b6e9bc64..5b761890e 100644 --- a/src/comp/APaths.hs +++ b/src/comp/APaths.hs @@ -116,7 +116,7 @@ import VModInfo(vPath, vFields, vArgs, import Pragma import Control.Monad(when) import Data.Maybe(isJust, isNothing, fromJust) -import Data.List(partition) +import Data.List(partition, genericIndex) import Id(unQualId, getIdBaseString) import Eval import Position(getPosition) @@ -170,8 +170,8 @@ data PathNode = PNDef AId | -- arguments to methods of submodules (Ids: instance, method, arg #) PNStateMethodArg AId AId Integer | - -- return values of methods of submodules (Ids: instance, method) - PNStateMethodRes AId AId | + -- return values of methods of submodules (Ids: instance, method, result #) + PNStateMethodRes AId AId Integer | -- enable signal of action methods of submodules (Ids: instance, method) PNStateMethodEnable AId AId | -- imported state has no ready signal @@ -190,8 +190,8 @@ data PathNode = PNWillFire AId | -- arguments to methods of current module (Ids: method, argument) PNTopMethodArg AId AId | - -- return values of methods of current module (Id: method) - PNTopMethodRes AId | + -- return values of methods of current module (Ids: method, result #) + PNTopMethodRes AId Integer | -- this is an internal graph node for the method's ready signal, -- the real output port is handled by a separate read method -- (Id: method) @@ -228,8 +228,8 @@ printPathNode use_pvprint d p node = fsep [text "Argument", pp port_id, s2par "of method", quotes (pp meth_id), s2par "of submodule", quotes (pp inst_id)] - (PNStateMethodRes inst_id meth_id) -> - fsep [s2par "Return value", + (PNStateMethodRes inst_id meth_id port_id) -> + fsep [s2par "Return value", pp port_id, s2par "of method", quotes (pp meth_id), s2par "of submodule", quotes (pp inst_id)] (PNStateMethodEnable inst_id meth_id) -> @@ -255,8 +255,8 @@ printPathNode use_pvprint d p node = (PNTopMethodArg meth_id arg_id) -> fsep [text "Argument", pp arg_id, s2par "of top-level method", quotes (pp meth_id)] - (PNTopMethodRes meth_id) -> - fsep [text "Output", + (PNTopMethodRes meth_id res_num) -> + fsep [text "Output", pp res_num, s2par "of top-level method", quotes (pp meth_id)] (PNTopMethodReady meth_id) -> fsep [s2par "Ready condition", @@ -290,14 +290,14 @@ instance PVPrint PathNode where instance NFData PathNode where rnf (PNDef aid) = rnf aid rnf (PNStateMethodArg a1 a2 n) = rnf3 a1 a2 n - rnf (PNStateMethodRes a1 a2) = rnf2 a1 a2 + rnf (PNStateMethodRes a1 a2 n) = rnf3 a1 a2 n rnf (PNStateMethodEnable a1 a2) = rnf2 a1 a2 rnf (PNStateArgument aid vn n) = rnf3 aid vn n rnf (PNStateMethodArgMux a1 a2) = rnf2 a1 a2 rnf (PNCanFire aid) = rnf aid rnf (PNWillFire aid) = rnf aid rnf (PNTopMethodArg a1 a2) = rnf2 a1 a2 - rnf (PNTopMethodRes aid) = rnf aid + rnf (PNTopMethodRes aid n) = rnf2 aid n rnf (PNTopMethodReady aid) = rnf aid rnf (PNTopMethodEnable aid) = rnf aid rnf (PNTopArgument aid n) = rnf2 aid n @@ -314,7 +314,7 @@ filterPNDefs pns = filter (not . isPNDef) pns isPNDef _ = False alwaysRdyNode :: [PProp] -> PathNode -> Bool -alwaysRdyNode pps (PNTopMethodRes m) = isAlwaysRdy pps m +alwaysRdyNode pps (PNTopMethodRes m _) = isAlwaysRdy pps m alwaysRdyNode pps _ = False enWhenRdyNode :: [PProp] -> PathNode -> Bool @@ -475,13 +475,13 @@ aPathsPreSched errh flags apkg = do -- 1) method name -- 2) input argument list zipped with [1..] -- 3) (Maybe VName) if method has an enable signal (action method) - -- 4) (Maybe VName) if method has a result (now only value methods) + -- 4) result list zipped with [1..] (value methods only) -- 5) (Maybe Id) if method has an associated clock -- Note: the VPort's are stripped of VeriPortProp to be just VName -- XXX is the VeriPortProp info worth keeping? state_instances :: [ ( AId, [(VName, VName)], [(VName, Integer, AExpr)], - [(AId, [(VName,Integer)], Maybe VName, Maybe VName, Maybe AId)] ) ] + [(AId, [(VName,Integer)], Maybe VName, [(VName, Integer)], Maybe AId)] ) ] state_instances = [(inst_id, nns, args, meth_info) | avi <- vs, @@ -498,12 +498,13 @@ aPathsPreSched errh flags apkg = do -- method info let meth_info = - [(meth_id, numbered_args, maybe_EN, maybe_res, maybe_clk) | + [(meth_id, numbered_args, maybe_EN, numbered_res, maybe_clk) | vfieldinfo@(Method { vf_name = meth_id }) <- vFields vmi, let args = map fst (vf_inputs vfieldinfo), let numbered_args = zip args [1..], let maybe_EN = (vf_enable vfieldinfo) >>= return . fst, - let maybe_res = (vf_output vfieldinfo) >>= return . fst, + let res = (vf_outputs vfieldinfo) >>= return . fst, + let numbered_res = zip res [1..], let maybe_clk = vf_clock vfieldinfo ] ] @@ -511,13 +512,14 @@ aPathsPreSched errh flags apkg = do state_input_nodes = [ PNStateMethodArg inst_id meth_id arg_num | (inst_id, _, _, methods) <- state_instances, - (meth_id, numbered_args, maybe_EN, maybe_res, _) <- methods, + (meth_id, numbered_args, maybe_EN, _, _) <- methods, arg_num <- map snd numbered_args ] state_output_nodes = - [ PNStateMethodRes inst_id meth_id | + [ PNStateMethodRes inst_id meth_id res_num | (inst_id, _, _, methods) <- state_instances, - (meth_id, _, _, Just res_name, _) <- methods + (meth_id, _, _, numbered_res, _) <- methods, + res_num <- map snd numbered_res ] state_enable_nodes = [ PNStateMethodEnable inst_id meth_id | @@ -558,7 +560,7 @@ aPathsPreSched errh flags apkg = do let method_inputs = [(arg, PNTopMethodArg m arg) | (AIDef { aif_inputs = args, - aif_value = (ADef m _ _ _) }) <- ifc, + aif_name = m }) <- ifc, (arg,_) <- args] ++ [(arg, PNTopMethodArg m arg) | (AIAction { aif_inputs = args, aif_name = m }) <- ifc, @@ -567,9 +569,14 @@ aPathsPreSched errh flags apkg = do aif_name = m }) <- ifc, (arg,_) <- args] + num_outputs (ADef {adef_type = ATTuple ts}) = fromIntegral (length ts) + num_outputs _ = 1 + method_outputs = - [(m, PNTopMethodRes m) | (AIDef { aif_value = (ADef m _ _ _) }) <- ifc] ++ - [(m, PNTopMethodRes m) | (AIActionValue { aif_name = m, aif_value = (ADef m' _ _ _) }) <- ifc] + [(m, PNTopMethodRes m res) | (AIDef { aif_name = m, aif_value = v }) <- ifc, + res <- [1..(num_outputs v)] ] ++ + [(m, PNTopMethodRes m res) | (AIActionValue { aif_name = m, aif_value = v }) <- ifc, + res <- [1..(num_outputs v)] ] method_enables = -- Name creation is safe, since it is based on VFieldInfo @@ -620,7 +627,7 @@ aPathsPreSched errh flags apkg = do -- These are internal graph nodes, not part of the interface. -- There are separate read methods which become the Verilog ports. - method_ready_nodes = map (PNTopMethodReady . aIfaceName) ifc + method_ready_nodes = map (PNTopMethodReady . aif_name) ifc -- ---------- @@ -683,17 +690,24 @@ aPathsPreSched errh flags apkg = do -- methods (ifc) let mkMethodEdges :: AIFace -> [(PathNode,PathNode)] - mkMethodEdges (AIDef mid inputs wp rdy (ADef m _ e _) _ _) = + mkMethodEdges (AIDef mid inputs wp rdy def@(ADef _ t e _) _ _) = -- connect the rdy expression (likely just an ASDef reference) -- to the internal graph node for the method ready - (mkEdges (PNTopMethodReady m) rdy env) ++ + (mkEdges (PNTopMethodReady mid) rdy env) ++ -- make faux connections from the rdy to the arguments, so that -- dependencies in the other direction are caught as loops - [(PNTopMethodReady m, PNTopMethodArg m arg) | (arg,_) <- inputs] ++ + [(PNTopMethodReady mid, PNTopMethodArg mid arg) | (arg,_) <- inputs] ++ + if length result_types /= length results + then internalError + ("APaths.aPathsPreSched: unexpected method results: " ++ ppReadable def) -- connect the definition to the method result -- (this method has no enable, so it cannot contribute to any -- methcall argument muxes, so just use "mkEdges") - (mkEdges (PNTopMethodRes m) e env) + else [edge | (res, e') <- zip [1..] results, edge <- mkEdges (PNTopMethodRes mid res) e' env] + where result_types | ATTuple ts <- t = ts + | otherwise = [t] + results | ATuple { ae_elems = elems } <- e = elems + | otherwise = [e] mkMethodEdges (AIAction inputs wp rdy m rs fi) = let rdy_node = PNTopMethodReady m en_node = PNTopMethodEnable m @@ -726,7 +740,7 @@ aPathsPreSched errh flags apkg = do -- connect the rules concatMap mkMRuleEdges rs - mkMethodEdges (AIActionValue inputs wp rdy m rs (ADef m' _ e _) fi) = + mkMethodEdges (AIActionValue inputs wp rdy m rs def@(ADef _ t e _) fi) = let rdy_node = PNTopMethodReady m en_node = PNTopMethodEnable m mkMRuleEdges (ARule ri _ _ _ rpred actions _ _) = @@ -748,6 +762,10 @@ aPathsPreSched errh flags apkg = do [(en_node, wf_node)] ++ -- add edges from rule WillFire to ENs in each action (concatMap (mkActionEdges env wf_node) actions) + result_types | ATTuple ts <- t = ts + | otherwise = [t] + results | ATuple { ae_elems = elems } <- e = elems + | otherwise = [e] in -- make faux connections from the rdy to the arguments and the -- enable, so that dependencies in the other direction are caught @@ -755,10 +773,14 @@ aPathsPreSched errh flags apkg = do [(rdy_node, en_node)] ++ [(rdy_node, PNTopMethodArg m arg) | (arg,_) <- inputs] ++ - -- connect the definition to the method result + (if length result_types /= length results + then internalError + ("APaths.aPathsPreSched: unexpected method results: " ++ ppReadable def) + -- connect the definitions to the method results -- (this method's Enable could contribute to methcall argument -- muxes, so use "mkEdgesWithMux") - (mkEdgesWithMux en_node (PNTopMethodRes m) e env) ++ + else [edge | (res, e') <- zip [1..] results, + edge <- (mkEdgesWithMux en_node (PNTopMethodRes m res) e' env)]) ++ -- connect the rules concatMap mkMRuleEdges rs @@ -788,9 +810,10 @@ aPathsPreSched errh flags apkg = do -- (but there are paths for instantiation arguments which become ports) let findOutputPathNodes inst_id vname methods = - [ (clk, PNStateMethodRes inst_id meth_id) | - (meth_id, _, _, Just res, clk) <- methods, - res == vname + [ (clk, PNStateMethodRes inst_id meth_id res_num) | + (meth_id, _, _, numbered_res, clk) <- methods, + (res_name, res_num) <- numbered_res, + res_name == vname ] findInputPathNodes inst_id vname methods argpairs = [ (Nothing, PNStateArgument inst_id arg_id arg_num) | @@ -885,7 +908,7 @@ aPathsPreSched errh flags apkg = do n <- filter (\x -> not (S.member x pathnodeset)) [n1,n2] ] when (not (null unknown_nodes)) $ internalError ("APath.aPaths': nodes not in graph: " ++ - show unknown_nodes) + ppReadable unknown_nodes ++ "\npathnodes = " ++ ppReadable pathnodes) -- ==================== -- Construct the graph @@ -905,10 +928,10 @@ aPathsPreSched errh flags apkg = do -- For urgency to be computed by paths, we must assume a path from -- a method's ready signal to its enable signal. - let rdy_to_en_edges = [(PNTopMethodRes rdy_id, PNTopMethodEnable m_id) | + let rdy_to_en_edges = [(PNTopMethodRes rdy_id 1, PNTopMethodEnable m_id) | (AIAction { aif_pred = (ASDef _ rdy_id), aif_name = m_id, aif_fieldinfo = m_fi }) <- ifc ] ++ - [(PNTopMethodRes rdy_id, PNTopMethodEnable m_id) | + [(PNTopMethodRes rdy_id 1, PNTopMethodEnable m_id) | (AIActionValue { aif_pred = (ASDef _ rdy_id), aif_name = m_id, aif_fieldinfo = m_fi }) <- ifc ] @@ -928,7 +951,7 @@ aPathsPreSched errh flags apkg = do -- edges from WF to RDY of value method [ (wf_rule_id, meth_id, filtered_path) | (PNWillFire wf_rule_id, rs) <- zip will_fire_nodes reachables, - (AIDef { aif_value = (ADef meth_id _ _ _) }) <- ifc, + (AIDef { aif_name = meth_id }) <- ifc, let meth_node = (PNTopMethodReady meth_id), let mpath = lookup meth_node rs, isJust mpath, @@ -1066,14 +1089,14 @@ aPathsPostSched flags pps apkg pathGraphInfo (ASchedule scheds _) = do -- We don't currently need the argument conversion info, because -- the node already contains the converted name (and not the number) let meth_info_map = M.fromList $ - [ (meth_id, ({-numbered_args,-} maybe_EN, maybe_res)) | + [ (meth_id, ({-numbered_args,-} maybe_EN, res)) | meth <- apkg_interface apkg, let vfieldinfo = aif_fieldinfo meth, let meth_id = vf_name vfieldinfo, --let args = map fst (vf_inputs vfieldinfo), --let numbered_args = zip args [1..], let maybe_EN = (vf_enable vfieldinfo) >>= return . fst, - let maybe_res = (vf_output vfieldinfo) >>= return . fst + let res = (vf_outputs vfieldinfo) >>= return . fst ] let findMethod m = @@ -1084,10 +1107,9 @@ aPathsPostSched flags pps apkg pathGraphInfo (ASchedule scheds _) = do -- the "arg" is already the VName and not a number let convertArg m arg = aidToVName arg - let convertRes m = + let convertRes m res_num = case (findMethod m) of - (_, Just res) -> res - _ -> internalError ("APaths convertRes: " ++ ppReadable m) + (_, res) -> res `genericIndex` (res_num - 1) let convertEnable m = case (findMethod m) of @@ -1096,7 +1118,7 @@ aPathsPostSched flags pps apkg pathGraphInfo (ASchedule scheds _) = do -- convert PathNode back to VName let pnToVName (PNTopMethodArg m arg) = convertArg m arg - pnToVName (PNTopMethodRes m) = convertRes m + pnToVName (PNTopMethodRes m res) = convertRes m res pnToVName (PNTopMethodEnable m) = convertEnable m pnToVName (PNTopArgument a _) = aidToVName a pnToVName (PNTopClkGate a) = aidToVName a @@ -1219,9 +1241,31 @@ findEdges env (AMethCall t i qmi exprs) = (edges, ms) = concatUnzip (map f (zip [1..] exprs)) meth_arg_mux = PNStateMethodArgMux i mi muxes = if null exprs then ms else meth_arg_mux:ms - in ([PNStateMethodRes i mi], edges, muxes) + in ([PNStateMethodRes i mi 1], edges, muxes) findEdges env (AMethValue t i qmi) = - ([PNStateMethodRes i (unQualId qmi)], [], []) + ([PNStateMethodRes i (unQualId qmi) 1], [], []) +findEdges env (ATupleSel _ (AMethCall t i qmi exprs) oi) = + -- make edges between exprs and meth input + -- return the output connection + let mi = unQualId qmi + -- like mkEdgesWithMux, but want to return the muxes, not connect them + f (n,exp) = let (is, edges, muxes) = findEdges env exp + pn = PNStateMethodArg i mi n + es = edges ++ (connectEdge pn is) + in (es, muxes) + (edges, ms) = concatUnzip (map f (zip [1..] exprs)) + meth_arg_mux = PNStateMethodArgMux i mi + muxes = if null exprs then ms else meth_arg_mux:ms + in ([PNStateMethodRes i mi oi], edges, muxes) +findEdges env (ATupleSel _ (AMethValue t i qmi) oi) = + ([PNStateMethodRes i (unQualId qmi) oi], [], []) +findEdges env (ATupleSel _ e _) = + internalError + ("APaths.findEdges: unexpected ATupleSel expression: " ++ ppReadable e) + +findEdges env (ATuple _ es) = + -- return any connections found in the element expressions + concatUnzip3 (map (findEdges env) es) findEdges env (ANoInlineFunCall { ae_args = es }) = -- return the function call inputs -- and return any connections found in the argument expressions diff --git a/src/comp/ARankMethCalls.hs b/src/comp/ARankMethCalls.hs index 9826b41b9..9b6a946f6 100644 --- a/src/comp/ARankMethCalls.hs +++ b/src/comp/ARankMethCalls.hs @@ -42,7 +42,7 @@ aRankMethCalls errh pprops orig_pkg = aRankMethCallsInternal :: ErrorHandle -> [[Id]] -> APackage -> IO APackage aRankMethCallsInternal _ [] orig_pkg = return orig_pkg aRankMethCallsInternal errh orig_ranks orig_pkg = - do let method_map = [(aIfaceName m, m) | m <- apkg_interface orig_pkg] + do let method_map = [(aif_name m, m) | m <- apkg_interface orig_pkg] rule_map = [(dropRulePrefixId (arule_id r), r) | r <- apkg_rules orig_pkg] def_map = [(adef_objid d, d) | d <- apkg_local_defs orig_pkg] -- add method ready signals foreach method in (* perf_spec *) @@ -121,6 +121,7 @@ class RankMethCalls ats_t where rankMethCalls :: Int -> ats_t -> (ats_t, [Id] {- local defs to rank -}) instance RankMethCalls AExpr where + -- TODO handle ATupleSel here? rankMethCalls ver expr@(AMethCall { ameth_id = name, ae_args = args }) = let (ranked_args, defs_to_rewrite) = rankMethCalls ver args in (expr { ameth_id = rankId ver name, ae_args = ranked_args }, diff --git a/src/comp/ARenameIO.hs b/src/comp/ARenameIO.hs index deb852f21..9403b7b44 100644 --- a/src/comp/ARenameIO.hs +++ b/src/comp/ARenameIO.hs @@ -134,11 +134,11 @@ trSI mp si = trM (Nothing) = Nothing trM (Just x) = Just (tr mp x) - trMeth ami@(ASPMethodInfo i ty mr me mv args rs) = + trMeth ami@(ASPMethodInfo i ty mr me vs args rs) = ami { aspm_name = tr mp i, aspm_mrdyid = trM mr, aspm_menableid = trM me, - aspm_mresultid = trM mv, + aspm_resultids = map (tr mp) vs, aspm_inputs = map (tr mp) args } in ASPSignalInfo { diff --git a/src/comp/ASchedule.hs b/src/comp/ASchedule.hs index 5b152464e..6a5d2127b 100644 --- a/src/comp/ASchedule.hs +++ b/src/comp/ASchedule.hs @@ -4146,13 +4146,13 @@ cvtIfc (AIActionValue _ _ ifPred ifId ifRs (ADef dId t _ _) _) = -- call will be in the same Rule structure as the action part) -- (note that, if the method body is not split into multiple -- rule, dId and rId will be the same) - [(Rule rId rOrig [ifPred, rPred] [ifPred, rPred, dExpr] rActs) + [(Rule rId rOrig [ifPred, rPred] ([ifPred, rPred, dExpr]) rActs) | (ARule rId rps rDesc rWireProps rPred rActs _ rOrig) <- ifRs] - where dExpr = ASDef t dId -cvtIfc (AIDef _ _ _ ifPred (ADef dId t _ _) _ _) - | isRdyId dId = [] - | otherwise = [(Rule dId Nothing [ifPred] [ifPred,dExpr] [])] - where dExpr = ASDef t dId + where dExpr = ASDef t dId +cvtIfc (AIDef mId _ _ _ _ _ _) | isRdyId mId = [] +cvtIfc (AIDef mId _ _ ifPred (ADef dId t _ _) _ _) = + [(Rule mId Nothing [ifPred] [ifPred, dExpr] [])] + where dExpr = ASDef t dId cvtIfc (AIClock {}) = [] cvtIfc (AIReset {}) = [] cvtIfc (AIInout {}) = [] diff --git a/src/comp/AState.hs b/src/comp/AState.hs index dda4ded85..d4ab80910 100644 --- a/src/comp/AState.hs +++ b/src/comp/AState.hs @@ -37,6 +37,7 @@ import AUses(useDropCond) import AVerilogUtil(vNameToTask) import RSchedule(RAT, ratToNestedLists) import Wires(WireProps(..)) +import Data.Maybe (listToMaybe) --import Debug.Trace --import Util(traces) @@ -209,12 +210,12 @@ aState' flags pps schedule_info apkg = do -- We separate out the RDY defs for always_ready methods from others, -- because we want the defs (they feed into enables) but do want the -- RDY ports. - isAlwaysReadyMethod m = (isRdyId (aIfaceName m)) && (isAlwaysRdy pps (aIfaceName m)) + isAlwaysReadyMethod m = (isRdyId (aif_name m)) && (isAlwaysRdy pps (aif_name m)) (always_rdy_ifc,other_ifc) = partition isAlwaysReadyMethod ifc outs :: [ADef] - outs = concatMap (outputDefToADef fmod pps) other_ifc + outs = concatMap (outputDefToADefs fmod pps) other_ifc always_ready_defs :: [ADef] - always_ready_defs = concatMap (outputDefToADef fmod pps) always_rdy_ifc + always_ready_defs = concatMap (outputDefToADefs fmod pps) always_rdy_ifc --traceM( "ifc are: " ++ ppReadable ifc ) ; --traceM( "outs are: " ++ ppReadable outs ) ; @@ -413,7 +414,7 @@ aState' flags pps schedule_info apkg = do -- mkEmuxxs needs to know which are the value methods, because -- selectors for muxes are RDY for value methods (instead of WILLFIRE) - value_method_ids = [ i | (AIDef { aif_value = (ADef i _ _ _) }) <- ifc ] + value_method_ids = [ i | (AIDef { aif_name = i }) <- ifc ] -- muxes for values (definitions) (emux_selss, emux_valss, emux_outss, esss) = @@ -444,7 +445,9 @@ aState' flags pps schedule_info apkg = do -- actionvalue method value references can be unconditionally converted subst :: AExpr -> Maybe AExpr subst (AMethValue vt modId methId) = - Just (ASPort vt (mkMethId modId methId Nothing MethodResult)) + Just (ASPort vt (mkMethId modId methId Nothing (MethodResult 1))) + subst (ATupleSel vt (AMethValue _ modId methId) idx) = + Just (ASPort vt (mkMethId modId methId Nothing (MethodResult idx))) -- substitute AMOsc, AMGate, AMReset references with their port subst (AMGate gt modId clkId) = Just (mkOutputGatePort vmi_map modId clkId) @@ -455,7 +458,15 @@ aState' flags pps schedule_info apkg = do let ino = do mult <- M.lookup (modId, methId) omMultMap -- send unused calls of multi-ported methods to port 0 toMaybe (mult > 1) 0 - in Just (ASPort vt (mkMethId modId methId ino MethodResult)) + in Just (ASPort vt (mkMethId modId methId ino (MethodResult 1))) + me' -> me' + subst e@(ATupleSel vt (AMethCall _ modId methId es) idx) = + case (M.lookup e substs) of + Nothing -> + let ino = do mult <- M.lookup (modId, methId) omMultMap + -- send unused calls of multi-ported methods to port 0 + toMaybe (mult > 1) 0 + in Just (ASPort vt (mkMethId modId methId ino (MethodResult idx))) me' -> me' -- AMethValue, AMGate and AMethCall should cover it subst e = Nothing @@ -658,7 +669,7 @@ genModVars vs omMultMap = allmvars -- and whether it's an action method) -- ( m@(Method { vf_name = methId, vf_inputs = argIds, vf_mult = mult }), - (argTypes, en_type, val_type) ) + (argTypes, en_type, val_types) ) <- zip (vFields vmodinfo) methType, -- -- for each part of the method, produce a triple of @@ -674,9 +685,8 @@ genModVars vs omMultMap = allmvars Nothing -> [] (Just t) -> [(MethodEnable, t, True)]) ++ -- value triple - (case (val_type) of - Nothing -> [] - (Just t) -> [(MethodResult, t, False)]), + [(MethodResult n, t, False) + | (n, t) <- zip [1..] val_types ], -- uniquifiers for multiple ports -- (if only one copy, then the list just contains 0) ino <- map (toMaybe (mult > 1)) [ 0 .. (getMultUse (modId, methId) - 1) `max` 0 ], @@ -709,25 +719,38 @@ isForeign (ATaskAction { }) = True isForeign _ = False --- Create an output ADef from the Interface method +-- Create output ADefs from the Interface method -- consider only value method returns and outputs of ActionValue methods -- note that expressions are named according to the information on -- the VFieldInfo -outputDefToADef :: Bool -> [PProp] -> AIFace -> [ADef] -outputDefToADef fmod pps ai@(AIDef{}) = if convert then [newdef] else [] - where def = aif_value ai - resName = mkNamedOutput (aif_fieldinfo ai) - newdef = def{ adef_objid = resName } - convert = not (fmod && isRdyId (aif_name ai)) -outputDefToADef _ pps ai@(AIActionValue{}) = [newdef] - where def = aif_value ai - resName = mkNamedOutput (aif_fieldinfo ai) - newdef = def{ adef_objid = resName } -outputDefToADef _ _ a@(AIAction{}) = [] -outputDefToADef _ _ a@(AIClock{}) = [] -outputDefToADef _ _ a@(AIReset{}) = [] -outputDefToADef _ _ a@(AIInout{}) = [] - +outputDefToADefs :: Bool -> [PProp] -> AIFace -> [ADef] +outputDefToADefs fmod pps (AIDef{aif_name=name, aif_value=def, aif_fieldinfo=fi}) = if convert then newdefs else [] + where resNames= mkNamedOutputs fi + newdefs = outputADefToADefs def resNames + convert = not (fmod && isRdyId name) +outputDefToADefs _ pps (AIActionValue{aif_name=name, aif_value=def, aif_fieldinfo=fi}) = newdefs + where resNames= mkNamedOutputs fi + newdefs = outputADefToADefs def resNames +outputDefToADefs _ _ a@(AIAction{}) = [] +outputDefToADefs _ _ a@(AIClock{}) = [] +outputDefToADefs _ _ a@(AIReset{}) = [] +outputDefToADefs _ _ a@(AIInout{}) = [] + +outputADefToADefs :: ADef -> [Id] -> [ADef] +outputADefToADefs (ADef { adef_type = ATTuple ts, adef_expr = ATuple _ es }) resNames = + zipWith3 (\t e resName -> ADef { adef_objid = resName, + adef_type = t, + adef_expr = e, + adef_props = [] }) + ts es resNames +outputADefToADefs (ADef { adef_type = t, adef_expr = e }) [resName] = + [ADef { adef_objid = resName, + adef_type = t, + adef_expr = e, + adef_props = [] }] +outputADefToADefs (ADef { adef_type = ATBit 0}) [] = [] +outputADefToADefs def resNames = + internalError $ "outputADefToADefs: unexpected ADef resNames: " ++ ppReadable (def, resNames) getVInst :: AId -> [AVInst] -> AVInst getVInst i as = head ( [ a | a <- as, i == (avi_vname a) ] ++ @@ -756,7 +779,7 @@ mkSIMethodTuple (AIDef name args _ pred _ vfi _) = aspm_type = "value", aspm_mrdyid = Just rdy, aspm_menableid = Nothing, - aspm_mresultid = Just res, + aspm_resultids = res, aspm_inputs = map fst args, aspm_assocrules = [] } ] @@ -767,7 +790,7 @@ mkSIMethodTuple (AIAction args _ pred name rs vfi) = aspm_type = "action", aspm_mrdyid = Just rdy, aspm_menableid = Just ena, - aspm_mresultid = Nothing, + aspm_resultids = [], aspm_inputs = map fst args, aspm_assocrules = map aRuleName rs } ] @@ -778,7 +801,7 @@ mkSIMethodTuple (AIActionValue args _ pred name rs _ vfi) = aspm_type = "actionvalue", aspm_mrdyid = Just rdy, aspm_menableid = Just ena, - aspm_mresultid = Just res, + aspm_resultids = res, aspm_inputs = map fst args, aspm_assocrules = map aRuleName rs } ] @@ -808,8 +831,8 @@ mkSignalInfoMethod aifaces = merged mergePorts [a] = [a] mergePorts [a, b] = [res] where res = case (isRdyId (aspm_name a), isRdyId (aspm_name b)) of - (True, False) -> b { aspm_mrdyid = (aspm_mresultid a) } - (False, True) -> a { aspm_mrdyid = (aspm_mresultid b) } + (True, False) -> b { aspm_mrdyid = listToMaybe (aspm_resultids a) } + (False, True) -> a { aspm_mrdyid = listToMaybe (aspm_resultids b) } _ -> internalError( "mergePorts" ++ ppReadable (a,b) ) mergePorts x = internalError( "mergePorts2:" ++ ppReadable x ) @@ -830,6 +853,7 @@ ratToBlobs mMap omMultMap rat = let -- True if there are 2 or more uses of the method, -- which means we need to do some sort of muxing + nonTrivial :: MethBlob -> Bool nonTrivial (_, (((AMethCall _ _ _ _, _) : _) : _)) = True nonTrivial _ = False @@ -1014,8 +1038,7 @@ mkEmuxs :: ([AExpr] -> [AExpr]) -> ([AExpr] -> AExpr) -> AId -> AId -> Maybe Integer -> MethPortBlob -> ([ADef], [ADef], [ADef], AExprSubst) mkEmuxs tl cnd rdb value_method_ids om o m ino emrs = - let meth_id = mkMethId o m ino MethodResult - + let -- Break each MethPortBlob into a list of the expressions for -- each argument, and then transpose the entire structure to -- make a list of, for each argument, a list of the different @@ -1031,8 +1054,16 @@ mkEmuxs tl cnd rdb value_method_ids om o m ino emrs = [1..] arg_blobs (sel_defs, val_defs, out_defs) = concatUnzip3 def_tuples + mkPortSubsts (e, _) = + case aType e of + ATTuple ats -> + [ (ATupleSel at e idx, + ASPort at $ mkMethId o m ino $ MethodResult idx) + | (idx, at) <- zip [1..] ats ] + at -> [ (e, ASPort at $ mkMethId o m ino $ MethodResult 1) ] + -- Replace the method call with the output port of the method - subst = [(e, ASPort (aType e) meth_id) | (e, _) <- emrs] + subst = concatMap mkPortSubsts emrs in -- traces ("mkEmuxs " ++ ppReadable emrs ++ ppReadable xs) $ (sel_defs, val_defs, out_defs, subst) diff --git a/src/comp/ASyntax.hs b/src/comp/ASyntax.hs index c60a6c0a0..c08febd54 100644 --- a/src/comp/ASyntax.hs +++ b/src/comp/ASyntax.hs @@ -61,14 +61,12 @@ module ASyntax( isUnsizedString, dropSize, unifyStringTypes, + isTupleType, getArrayElemType, getArraySize, - aIfaceName, - aIfaceNameString, aIfaceProps, - aIfaceResSize, - aIfaceResType, - aIfaceResId, + aIfaceResTypes, + aIfaceResIds, aIfaceArgs, aIfaceArgSize, aIfaceRules, @@ -97,6 +95,8 @@ module ASyntax( ppeAPackage, mkMethId, mkMethStr, + mkMethArgStr, + mkMethResStr, isMethId, MethodPart(..), getParams, @@ -127,12 +127,12 @@ import Prim import ErrorUtil(internalError) import Backend import Pragma -import PreStrings(fsDollar, fsUnderscore, fsEnable) +import PreStrings(fsDollar, fsUnderscore, fsEnable, fs_arg, fs_res) import FStringCompat -- import Position(noPosition) import Position import Data.Maybe -import Util(itos, fromJustOrErr) +import Util(itos) import VModInfo import Wires import ProofObligation(ProofObligation, MsgFn) @@ -340,7 +340,7 @@ data ASPMethodInfo = ASPMethodInfo { aspm_type :: String, aspm_mrdyid :: Maybe AId, aspm_menableid :: Maybe AId, - aspm_mresultid :: Maybe AId, + aspm_resultids :: [AId], aspm_inputs :: [AId], aspm_assocrules :: [AId] } @@ -351,7 +351,7 @@ instance PPrint ASPMethodInfo where <+> text (aspm_type aspmi) <> equals <> braces ( pPrint d 0 (aspm_mrdyid aspmi) <+> pPrint d 0 (aspm_menableid aspmi) <+> - pPrint d 0 (aspm_mresultid aspmi) <+> + pPrint d 0 (aspm_resultids aspmi) $+$ pPrint d 0 (aspm_inputs aspmi) $+$ pPrint d 0 (aspm_assocrules aspmi) ) @@ -446,6 +446,10 @@ data AType = atr_length :: ASize, atr_elem_type :: AType } + -- Tuple type, for methods with multiple return values + | ATTuple { + att_elem_types :: [AType] + } -- abstract type, PrimAction, Interface, Clock, .. -- (can take size parameters as arguments) | ATAbstract { @@ -459,6 +463,7 @@ instance NFData AType where rnf (ATString msz) = rnf msz rnf ATReal = () rnf (ATArray len typ) = rnf2 len typ + rnf (ATTuple typs) = rnf typs rnf (ATAbstract aid args) = rnf2 aid args instance HasPosition AType where @@ -505,6 +510,10 @@ unifyStringTypes (t:ts) | isUnsizedString t = t helper t (t1:ts) | t /= t1 = dropSize t | otherwise = helper t ts +isTupleType :: AType -> Bool +isTupleType (ATTuple _) = True +isTupleType _ = False + type ASize = Integer getArrayElemType :: AType -> AType @@ -571,10 +580,10 @@ data AVInst = AVInst { -- XXX This list corresponds to vFields in the VModInfo, but cannot be -- XXX stored there, because VModInfo is created before types are known. -- There is a triple for each method in vFields of VModInfo. - -- The triple contains the types of each argument (in order) and maybe - -- the types of the EN and return value. + -- The triple contains the types of each argument (in order), maybe + -- the type of the EN, and the return values. -- NOTE: These are the output language types (i.e. ATBit n) - avi_meth_types :: [([AType], Maybe AType, Maybe AType)], + avi_meth_types :: [([AType], Maybe AType, [AType])], -- This field maps source-language types to their corresponding ports avi_port_types :: M.Map VName IType, avi_vmi :: VModInfo, -- Verilog names, conflict info, etc. @@ -672,11 +681,12 @@ getIfcInoutPorts :: AVInst -> [(AId, (AId, AType, VPort))] getIfcInoutPorts avi = let vmi = avi_vmi avi - res_types = map (\ (_,_,mr) -> mr) (avi_meth_types avi) + res_types = map (\ (_,_,rs) -> rs) (avi_meth_types avi) ifc_inouts = [(id,vn,ty) - | (Inout id vn _ _, mr) <- zip (vFields vmi) res_types, - let ty = fromJustOrErr ("ASyntax.unknown inout " ++ - ppReadable id) mr] + | (Inout id vn _ _, rs) <- zip (vFields vmi) res_types, + let ty = case rs of + [r] -> r + _ -> error ("ASyntax.unknown inout " ++ ppReadable id)] mkInoutPort ty vname = (mkOutputWireId (avi_vname avi) vname, @@ -817,17 +827,6 @@ instance NFData AIFace where rnf (AIReset name rst finfo) = rnf3 name rst finfo rnf (AIInout name inout finfo) = rnf3 name inout finfo -aIfaceName :: AIFace -> AId -aIfaceName (AIDef { aif_value = (ADef i _ _ _)}) = i -- XXX use aif_name -aIfaceName (AIAction { aif_name = i}) = i -aIfaceName (AIActionValue { aif_name = i}) = i -aIfaceName (AIClock { aif_name = i}) = i -aIfaceName (AIReset { aif_name = i}) = i -aIfaceName (AIInout { aif_name = i}) = i - -aIfaceNameString :: AIFace -> String -aIfaceNameString i = getIdString (aIfaceName i) - aiface_vname :: AIFace -> String aiface_vname i = getIdString (vf_name (aif_fieldinfo i)) @@ -838,25 +837,18 @@ aIfaceProps (AIAction { aif_props = p }) = p aIfaceProps (AIActionValue { aif_props = p }) = p aIfaceProps _ = emptyWireProps --- result size -aIfaceResSize :: AIFace -> Integer -aIfaceResSize (AIAction { }) = 0 -aIfaceResSize (AIDef {aif_value = (ADef _ (ATBit n) _ _) }) = n -aIfaceResSize (AIActionValue {aif_value = (ADef _ (ATBit n) _ _) }) = n -aIfaceResSize x = internalError ("aIfaceResSize: " ++ show x) - -aIfaceResType :: AIFace -> AType +aIfaceResTypes :: AIFace -> [AType] -- XXX should be ATAction? -aIfaceResType (AIAction { }) = ATBit 0 -aIfaceResType (AIDef { aif_value = (ADef _ t _ _)}) = t -aIfaceResType (AIActionValue { aif_value = (ADef _ t _ _)}) = t +aIfaceResTypes (AIAction { }) = [ATBit 0] +aIfaceResTypes (AIDef { aif_value = (ADef _ t _ _) }) = [t] +aIfaceResTypes (AIActionValue { aif_value = (ADef _ t _ _) }) = [t] -- should not need type of clock or reset -aIfaceResType x = internalError ("aIfaceResType: " ++ show x) +aIfaceResTypes x = internalError ("aIfaceResTypes: " ++ show x) -aIfaceResId :: AIFace -> [AId] -aIfaceResId (AIDef {aif_value = (ADef i _ _ _) }) = [i] -aIfaceResId (AIActionValue {aif_value = (ADef i _ _ _) }) = [i] -aIfaceResId _ = [] +aIfaceResIds :: AIFace -> [AId] +aIfaceResIds (AIDef {aif_name=id}) = [id] +aIfaceResIds (AIActionValue {aif_name=id}) = [id] +aIfaceResIds _ = [] aIfaceArgs :: AIFace -> [AInput] aIfaceArgs (AIClock {}) = [] @@ -904,7 +896,7 @@ addRdyToARule rdyId r0@(ARule { arule_id = ri, arule_pred = e }) = (d, r) aIfaceSchedNames :: AIFace -> [ARuleId] aIfaceSchedNames (AIAction { aif_body = rs}) = map arule_id rs aIfaceSchedNames (AIActionValue { aif_body = rs}) = map arule_id rs -aIfaceSchedNames (AIDef { aif_value = d }) = [adef_objid d] +aIfaceSchedNames (AIDef { aif_name = i }) = [i] aIfaceSchedNames _ = [] aIfacePred :: AIFace -> APred @@ -1054,6 +1046,16 @@ data AExpr ae_objid :: AId, ameth_id :: AMethodId } + | ATuple { + ae_type :: AType, + ae_elems :: [AExpr] + } + -- selection from an ATTuple + | ATupleSel { + ae_type :: AType, + ae_exp :: AExpr, + ae_index :: Integer + } -- calls a combinatorial function expressed via module instantiation -- XXX this can be created not only via "noinline" in BSV, -- XXX but also "foreign" in Classic syntax; consider renaming? @@ -1152,6 +1154,8 @@ instance NFData AExpr where rnf (APrim oid typ prim args) = rnf4 oid typ prim args rnf (AMethCall typ oid mid args) = rnf4 typ oid mid args rnf (AMethValue typ oid mid) = rnf3 typ oid mid + rnf (ATuple typ elems) = rnf2 typ elems + rnf (ATupleSel typ expr index) = rnf3 typ expr index rnf (ANoInlineFunCall typ oid fun args) = rnf4 typ oid fun args rnf (AFunCall typ oid fname isC args) = rnf5 typ oid fname isC args rnf (ATaskValue typ oid fname isC cookie) = rnf5 typ oid fname isC cookie @@ -1177,6 +1181,12 @@ instance Eq AExpr where AMethValue t aid mid == AMethValue t' aid' mid' = (t == t') && (mid == mid') && (aid == aid') + ATuple t aexprs == ATuple t' aexprs' = + (t == t') && (aexprs == aexprs') + + ATupleSel t aexpr index == ATupleSel t' aexpr' index' = + (t == t') && (index == index') && (aexpr == aexpr') + ANoInlineFunCall t aid af aexprs == ANoInlineFunCall t' aid' af' aexprs' = (t == t') && (af == af') && (aexprs == aexprs') && (aid == aid') @@ -1222,6 +1232,9 @@ instance HasPosition AExpr where getPosition APrim{ ae_objid = p } = getPosition p getPosition AMethCall{ ae_objid = p } = getPosition p getPosition AMethValue{ ae_objid = p } = getPosition p + getPosition ATuple{ ae_elems = e : _ } = getPosition e + getPosition ATuple{ ae_elems = [] } = noPosition -- Is there something better? + getPosition ATupleSel{ ae_exp = e } = getPosition e getPosition ANoInlineFunCall{ ae_objid = p } = getPosition p getPosition AFunCall{ ae_objid = p } = getPosition p getPosition ATaskValue{ ae_objid = p } = getPosition p @@ -1434,7 +1447,7 @@ instance PPrint AIFace where pPrint d p ai@(AIDef {} ) = (text "--AIDef" <+> pPrint d p (aif_name ai)) $+$ foldr (($+$) . ppV d) empty (aif_inputs ai) $+$ - pPrint d 0 (aif_value ai) $+$ + pPrint d p (aif_value ai) $+$ pPred d p (aif_pred ai) $+$ pPrint d 0 (aif_props ai) $+$ pPrint d 0 (aif_fieldinfo ai) $+$ @@ -1560,9 +1573,14 @@ instance PPrint AExpr where pPrint d p (ATaskValue _ i _ _ n) = pparen (p>0) $ pPrint d 1 i <> text ("#" ++ itos(n)) pPrint d p (AMethCall _ i m es) = pparen (p>0 && not (null es)) $ - pPrint d 1 i <> sep (text "." <> ppMethId d m : map (pPrint d 1) es) + pPrint d 1 i <> + sep (text "." <> ppMethId d m : map (pPrint d 1) es) pPrint d p (AMethValue _ i m) = pparen (p>0) $ pPrint d 1 i <> text "." <> ppMethId d m + pPrint d p (ATuple _ es) = + pparen (p>0) $ parens (commaSep (map (pPrint d 0) es)) + pPrint d p (ATupleSel _ e idx) = + pparen (p>0) $ pPrint d 0 e <> text "[" <> pPrint d 0 idx <> text "]" pPrint d p (ASPort _ i) = pPrint d p i pPrint d p (ASParam _ i) = pPrint d p i pPrint d p (ASDef _ i) = pPrint d p i @@ -1592,6 +1610,8 @@ instance PPrint AType where pPrint d p (ATString (Just n)) = text ("String (" ++ (itos n) ++ " chars)") pPrint d p (ATArray sz ty) = text "Array" <+> text (itos sz) <+> pPrint d 0 ty + pPrint d p (ATTuple ts) = + text "Tuple" <+> parens (commaSep (map (pPrint d 0) ts)) pPrint d p (ATAbstract i ns) = sep (text "ABSTRACT: " : pPrint d 0 i : map (pPrint d 0) ns) binOp :: PrimOp -> Bool @@ -1854,7 +1874,12 @@ instance PPrintExpand AExpr where <> if (null es) then empty else (parens (hsep ( punctuate comma docArgs )) ) where docArgs = map (pPrintExpand m d defContext) es - pPrintExpand m d ec (AMethValue _ i meth) = pPrint d 1 i <> text "." <> ppMethId d meth + pPrintExpand m d ec (AMethValue _ i meth) = + pPrint d 1 i <> text "." <> ppMethId d meth + pPrintExpand m d ec (ATuple _ es) = + pparen (useParen ec) $ parens (commaSep (map (pPrintExpand m d defContext) es)) + pPrintExpand m d ec (ATupleSel _ e idx) = + pparen (useParen ec) $ pPrintExpand m d defContext e <> text ("[" ++ itos idx ++ "]") pPrintExpand m d ec (ASPort _ i) = pPrint d (getP ec) i pPrintExpand m d ec (ASParam _ i) = pPrint d (getP ec) i pPrintExpand m d ec (ASDef _ i) | isIdWillFire i && (lookupLevel m) > 0 || @@ -1885,19 +1910,21 @@ defLookup d ped = M.findWithDefault err d (defmap ped) -- # Some standardized methods for making (default) method strings -- ############################################################################# data MethodPart = - MethodArg Integer | -- argument 1, 2, ... input - MethodResult | -- return value output - MethodEnable -- enable signal input + MethodArg Integer | -- argument 1, 2, ... input + MethodResult Integer | -- return value 1, 2, ... output + MethodEnable -- enable signal input deriving (Eq) -- The method syntax is as follows: --- Arguments are $_ starting from 1 --- (e.g. the_fifo$enq_1) --- Return values are $ (e.g. the_fifo$first) +-- Arguments are $_ARG_ starting from 1 +-- (e.g. the_fifo$enq_ARG_1) +-- Return values are $_RES_ (e.g. the_fifo$first_RES_1) -- Enable signals are $EN_ (e.g. the_fifo$EN_enq) --- Multi-ported methods are $__ +-- Multi-ported methods are $__ARG_ +-- or $__RES_ -- The portnum is only omitted if the method has one or -- and infinite number of ports (like a register) +-- XXX these should probably just be a data type rather than Ids mkMethId :: Id -> Id -> Maybe Integer -> MethodPart -> Id mkMethId o m ino mp = -- trace ("POS O: " ++ (show (getIdPosition o)) ++ " " ++ @@ -1922,13 +1949,8 @@ mkMethStr obj m m_port mp = fsUnderscore, mkNumFString port] base = case mp of - MethodArg n -> - if (n == 0) - then internalError "mkMethStr" - else concatFString [meth_port, - fsUnderscore, - mkNumFString n] - MethodResult -> meth_port + MethodArg n -> mkMethArgStr meth_port n + MethodResult n -> mkMethResStr meth_port n MethodEnable -> -- XXX are we overloading fsEnable? concatFString [fsEnable, meth_port] @@ -1937,6 +1959,18 @@ mkMethStr obj m m_port mp = fsDollar, base] +mkMethArgStr :: FString -> Integer -> FString +mkMethArgStr meth_port n = + if (n == 0) + then internalError "mkMethArgStr" + else concatFString [meth_port, fsUnderscore, fs_arg, mkNumFString n] + +mkMethResStr :: FString -> Integer -> FString +mkMethResStr meth_port n = + if (n == 0) + then internalError "mkMethResStr" + else concatFString [meth_port, fsUnderscore, fs_res, mkNumFString n] + -- ############################################################################# -- # -- ############################################################################# diff --git a/src/comp/ASyntaxUtil.hs b/src/comp/ASyntaxUtil.hs index 561672e45..a12b6580d 100644 --- a/src/comp/ASyntaxUtil.hs +++ b/src/comp/ASyntaxUtil.hs @@ -72,6 +72,8 @@ instance AVars AExpr where aVars (ANoInlineFunCall _ _ _ es) = concatMap aVars es aVars (AFunCall _ _ _ _ es) = concatMap aVars es aVars (AMethCall _ _ _ es) = concatMap aVars es + aVars (ATuple _ es) = concatMap aVars es + aVars (ATupleSel _ e _) = aVars e -- aVars (ATaskValue ...) = [] -- because the variables are really "used" -- by the action which sets it -- same for AMethValue @@ -117,6 +119,8 @@ aMethValues :: AExpr -> [(AId, AId, AType)] aMethValues e@(APrim {}) = concatMap aMethValues (ae_args e) aMethValues e@(AMethCall {}) = concatMap aMethValues (ae_args e) aMethValues (AMethValue ty obj meth) = [(obj,meth,ty)] +aMethValues (ATuple _ es) = concatMap aMethValues es +aMethValues (ATupleSel _ e _) = aMethValues e aMethValues e@(ANoInlineFunCall {}) = concatMap aMethValues (ae_args e) aMethValues e@(AFunCall {}) = concatMap aMethValues (ae_args e) aMethValues (ATaskValue {}) = [] @@ -137,6 +141,8 @@ aMethCalls :: AExpr -> [(AId, AId)] aMethCalls e@(APrim {}) = concatMap aMethCalls (ae_args e) aMethCalls (AMethCall _ obj meth es) = ((obj,meth) : concatMap aMethCalls es) aMethCalls (AMethValue _ obj meth) = [] +aMethCalls (ATuple _ es) = concatMap aMethCalls es +aMethCalls (ATupleSel _ e _) = aMethCalls e aMethCalls e@(ANoInlineFunCall {}) = concatMap aMethCalls (ae_args e) aMethCalls e@(AFunCall {}) = concatMap aMethCalls (ae_args e) aMethCalls (ATaskValue {}) = [] @@ -157,6 +163,8 @@ aTaskValues :: AExpr -> [(AId, Integer, AType)] aTaskValues e@(APrim {}) = concatMap aTaskValues (ae_args e) aTaskValues e@(AMethCall {}) = concatMap aTaskValues (ae_args e) aTaskValues (AMethValue {}) = [] +aTaskValues (ATuple _ es) = concatMap aTaskValues es +aTaskValues (ATupleSel _ e _) = aTaskValues e aTaskValues e@(ANoInlineFunCall {}) = concatMap aTaskValues (ae_args e) aTaskValues e@(AFunCall {}) = concatMap aTaskValues (ae_args e) aTaskValues (ATaskValue ty f_id fun isC cookie) = [(f_id, cookie, ty)] @@ -180,6 +188,8 @@ exprForeignCalls e@(AFunCall {}) = else (concatMap exprForeignCalls (ae_args e)) exprForeignCalls e@(APrim {}) = concatMap exprForeignCalls (ae_args e) exprForeignCalls e@(AMethCall {}) = concatMap exprForeignCalls (ae_args e) +exprForeignCalls (ATuple _ es) = concatMap exprForeignCalls es +exprForeignCalls (ATupleSel _ e _) = exprForeignCalls e exprForeignCalls e@(ANoInlineFunCall {}) = concatMap exprForeignCalls (ae_args e) exprForeignCalls _ = [] @@ -227,6 +237,7 @@ instance ATypeC AType where aSize e = case aType e of ATBit s -> s + ATTuple ts -> sum (map aSize ts) ATString (Just s) -> 8*s -- 8 bits per character ATAbstract i [n] | i==idInout_ -> n ATArray sz t -> sz * (aSize t) @@ -455,6 +466,8 @@ aSubst m = mapAExprs xsub xsub x@(ASDef _ i) = M.findWithDefault x i m xsub (APrim aid t p es) = APrim aid t p (aSubst m es) xsub (AMethCall t i meth es) = AMethCall t i meth (aSubst m es) + xsub (ATuple t es) = ATuple t (aSubst m es) + xsub (ATupleSel t e n) = ATupleSel t (aSubst m e) n xsub (ANoInlineFunCall t i f es) = ANoInlineFunCall t i f (aSubst m es) xsub (AFunCall t i f isC es) = AFunCall t i f isC (aSubst m es) xsub (ASAny t me) = ASAny t (fmap (aSubst m) me) @@ -474,6 +487,12 @@ exprMap f e@(APrim i t o args) = exprMap f e@(AMethCall t i m args) = let e' = AMethCall t i m (map (exprMap f) args) in fromMaybe e' (f e) +exprMap f e@(ATuple t args) = + let e' = ATuple t (map (exprMap f) args) + in fromMaybe e' (f e) +exprMap f e@(ATupleSel t expr n) = + let e' = ATupleSel t (exprMap f expr) n + in fromMaybe e' (f e) exprMap f e@(ANoInlineFunCall t i fun args) = let e' = ANoInlineFunCall t i fun (map (exprMap f) args) in fromMaybe e' (f e) @@ -501,6 +520,18 @@ exprMapM f e@(AMethCall t i m args) = do Just e' -> return e' Nothing -> do args' <- mapM (exprMapM f) args return $ AMethCall t i m args' +exprMapM f e@(ATuple t elems) = do + me <- f e + case me of + Just e' -> return e' + Nothing -> do elems' <- mapM (exprMapM f) elems + return $ ATuple t elems' +exprMapM f e@(ATupleSel t expr n) = do + me <- f e + case me of + Just e' -> return e' + Nothing -> do expr' <- exprMapM f expr + return $ ATupleSel t expr' n exprMapM f e@(ANoInlineFunCall t i fun args) = do me <- f e case me of @@ -527,6 +558,12 @@ exprFold f v e@(APrim i t o args) = exprFold f v e@(AMethCall t i m args) = let v' = foldr (flip (exprFold f)) v args in f e v' +exprFold f v e@(ATuple t elems) = + let v' = foldr (flip (exprFold f)) v elems + in f e v' +exprFold f v e@(ATupleSel t expr n) = + let v' = exprFold f v expr + in f e v' exprFold f v e@(ANoInlineFunCall t i fun args) = let v' = foldr (flip (exprFold f)) v args in f e v' @@ -612,6 +649,10 @@ aIdFnToAExprFn fn (AMethCall ty aid mid args) = AMethCall ty (fn aid) mid (mapAExprs (aIdFnToAExprFn fn) args) aIdFnToAExprFn fn (AMethValue ty aid mid) = AMethValue ty (fn aid) mid +aIdFnToAExprFn fn (ATuple ty exprs) = + ATuple ty (mapAExprs (aIdFnToAExprFn fn) exprs) +aIdFnToAExprFn fn (ATupleSel ty expr n) = + ATupleSel ty (aIdFnToAExprFn fn expr) n aIdFnToAExprFn fn (ANoInlineFunCall ty aid fun args) = ANoInlineFunCall ty (fn aid) fun (mapAExprs (aIdFnToAExprFn fn) args) aIdFnToAExprFn fn (AFunCall ty aid fun isC args) = diff --git a/src/comp/ATaskSplice.hs b/src/comp/ATaskSplice.hs index 42d131c4d..8b821fcd0 100644 --- a/src/comp/ATaskSplice.hs +++ b/src/comp/ATaskSplice.hs @@ -1,7 +1,6 @@ module ATaskSplice(aTaskSplice) where import ASyntax import ASyntaxUtil -import Data.Maybe import Id import qualified Data.Map as M import ErrorUtil(internalError) @@ -14,9 +13,9 @@ aTaskSplice :: APackage -> APackage aTaskSplice apkg = mapAActions (spliceAction spliceMap) apkg where spliceMap = M.fromList [ (n, (id, t)) | ADef id t (ATaskValue { ae_cookie = n }) _ <- defs ] defs = (apkg_local_defs apkg) ++ - (mapMaybe av_ret_def (apkg_interface apkg)) - av_ret_def act@(AIActionValue {}) = Just (aif_value act) - av_ret_def _ = Nothing + (concatMap av_ret_def (apkg_interface apkg)) + av_ret_def act@(AIActionValue {}) = [aif_value act] + av_ret_def _ = [] spliceAction :: SpliceMap -> AAction -> AAction spliceAction spliceMap a@(ATaskAction { ataskact_temp = Nothing }) = diff --git a/src/comp/AUses.hs b/src/comp/AUses.hs index 557271206..cfe6961ba 100644 --- a/src/comp/AUses.hs +++ b/src/comp/AUses.hs @@ -846,6 +846,8 @@ eDomain e@(AMethCall _ i mi es) = do let this_use = singleMethodExprUse i (unQualId mi) e ucTrue es_uses <- mapM eDomain es mergeExprUsesM (this_use : es_uses) +eDomain (ATuple _ es) = mapM eDomain es >>= mergeExprUsesM +eDomain (ATupleSel _ e _) = eDomain e eDomain e@(AFunCall { ae_objid = i, ae_args = es }) = do let this_use = singleFFuncExprUse i e ucTrue es_uses <- mapM eDomain es diff --git a/src/comp/AVeriQuirks.hs b/src/comp/AVeriQuirks.hs index c09ab72bb..86cf40b1b 100644 --- a/src/comp/AVeriQuirks.hs +++ b/src/comp/AVeriQuirks.hs @@ -308,6 +308,12 @@ aQExp top (APrim aid t p es) = mapM (aQExp False) es >>= return . APrim ai aQExp top (AMethCall t i m es) = mapM (aQExp False) es >>= return . AMethCall t i m aQExp top (ANoInlineFunCall t i f es) = mapM (aQExp False) es >>= return . ANoInlineFunCall t i f aQExp top (AFunCall t i f isC es) = mapM (aQExp False) es >>= return . AFunCall t i f isC +aQExp top (ATuple t es) = do + es' <- mapM (aQExp False) es + return (ATuple t es') +aQExp top (ATupleSel t e n) = do + e' <- aQExp False e + return (ATupleSel t e' n) aQExp top e@(AMethValue {}) = return e aQExp top e@(ASInt _ _ _) = return e aQExp top e@(ASReal _ _ _) = return e @@ -396,6 +402,7 @@ aSInt t i = ASInt defaultAId t (ilHex i) mkDefS :: AExpr -> QQState AExpr mkDefS e@(AMethCall _ o m []) = return e -- XXX shouldn't exist mkDefS e@(AMethValue _ o m) = return e -- XXX shouldn't exist +mkDefS e@(ATupleSel _ _ _) = return e -- XXX shouldn't exist mkDefS e@(ASDef {}) = return e mkDefS e@(ASPort {}) = return e mkDefS e@(ASParam {}) = return e diff --git a/src/comp/AVerilog.hs b/src/comp/AVerilog.hs index 155495c48..438d735a8 100644 --- a/src/comp/AVerilog.hs +++ b/src/comp/AVerilog.hs @@ -474,8 +474,8 @@ groupPorts si as = -- (function to be folded over the method port info) findMethod :: ASPMethodInfo -> ([(AId,String,[VArg])],[(Id,VArg)]) -> ([(AId,String,[VArg])],[(Id,VArg)]) - findMethod (ASPMethodInfo i ty mr me mv args _) (ms, ports) = - let is = (catMaybes [mr, me, mv]) ++ args + findMethod (ASPMethodInfo i ty mr me vs args _) (ms, ports) = + let is = (catMaybes [mr, me]) ++ vs ++ args (ps, remaining) = findIds is ports in ((i,ty,ps):ms, remaining) @@ -574,10 +574,10 @@ groupMethodDefs vDef si ds = mkForMethod :: ASPMethodInfo -> ([VMItem], [VMItem], [VMItem], M.Map AId ADef) -> ([VMItem], [VMItem], [VMItem], M.Map AId ADef) - mkForMethod (ASPMethodInfo i ty mr _ mv _ rs) (odecls, idecls, gs, defs) = + mkForMethod (ASPMethodInfo i ty mr _ vs _ rs) (odecls, idecls, gs, defs) = let -- get the output defs - output_ids = catMaybes [mv, mr] + output_ids = vs ++ maybeToList mr (output_defs, other_defs) = findADefs output_ids defs -- get the rule defs rule_sched_ids = concatMap getRuleSignals rs diff --git a/src/comp/AVerilogUtil.hs b/src/comp/AVerilogUtil.hs index 36b06f395..0034e13c6 100644 --- a/src/comp/AVerilogUtil.hs +++ b/src/comp/AVerilogUtil.hs @@ -862,7 +862,7 @@ vState flags rewire_map avinst = mkEnId m m_port = vMethId v_inst_name m m_port MethodEnable port_rename_table - mkResId m m_port = vMethId v_inst_name m m_port MethodResult port_rename_table + mkResId m k m_port = vMethId v_inst_name m m_port (MethodResult k) port_rename_table -- add the multiplicity to Verilog port names -- (if there are not multiple ports, no uniquifier is added) @@ -886,9 +886,10 @@ vState flags rewire_map avinst = inps = [ (mkVId (portid s ino), mkArgId m k ino, vSize argType) - | (meth@(Method m _ _ mult ps mo me), + | (meth@(Method m _ _ mult ps outs me), (argTypes,_,_)) <- zip (vFields vi) mts, + -- (VName s, vps) -- let multu = getMethodMultUse m, ino <- if mult > 1 then map Just [0..mult-1] else [Nothing], (VName s, argType, k) <- zip3 (map fst ps) argTypes [1..], @@ -908,7 +909,7 @@ vState flags rewire_map avinst = mkVId (portid s ino), mkEnId m ino, inhigh ) - | (Method m _ _ mult ss mo me@(Just (VName s,vps))) + | (Method m _ _ mult ss outs me@(Just (VName s,vps))) <- vFields vi, let inhigh = VPinhigh `elem` vps, -- let multu = getMethodMultUse m, @@ -922,9 +923,10 @@ vState flags rewire_map avinst = meth_return_vals = nub [ (mkVId (portid s ino), - mkResId m ino) - | ((Method m _ _ mult ss mo@(Just (VName s, vps)) me), (_,_,Just retType)) + mkResId m k ino) + | ((Method m _ _ mult ss outs me), (_,_,retTypes)) <- zip (vFields vi) mts, + ((VName s, vps), retType, k) <- zip3 outs retTypes [1..], isNotZeroSized retType, -- let multu = getMethodMultUse m, ino <- if mult > 1 then map Just [0..mult-1] else [Nothing] diff --git a/src/comp/BackendNamingConventions.hs b/src/comp/BackendNamingConventions.hs index 7aec08133..bf3e4bdf7 100644 --- a/src/comp/BackendNamingConventions.hs +++ b/src/comp/BackendNamingConventions.hs @@ -96,8 +96,8 @@ rwireHasId = mkId noPosition (mkFString rwireHasStr) rwireSetEnId, rwireSetArgId, rwireGetResId, rwireHasResId :: Id -> Id rwireSetEnId i = mkMethId i rwireSetId Nothing MethodEnable rwireSetArgId i = mkMethId i rwireSetId Nothing (MethodArg 1) -rwireGetResId i = mkMethId i rwireGetId Nothing MethodResult -rwireHasResId i = mkMethId i rwireHasId Nothing MethodResult +rwireGetResId i = mkMethId i rwireGetId Nothing (MethodResult 1) +rwireHasResId i = mkMethId i rwireHasId Nothing (MethodResult 1) -- ============================== -- Primitive CReg @@ -134,7 +134,7 @@ cregReadId n = mkId noPosition (mkFString (cregReadStr n)) cregWriteId n = mkId noPosition (mkFString (cregWriteStr n)) cregReadResId, cregWriteEnId, cregWriteArgId :: Id -> Int -> Id -cregReadResId i n = mkMethId i (cregReadId n) Nothing MethodResult +cregReadResId i n = mkMethId i (cregReadId n) Nothing (MethodResult 1) cregWriteEnId i n = mkMethId i (cregWriteId n) Nothing MethodEnable cregWriteArgId i n = mkMethId i (cregWriteId n) Nothing (MethodArg 1) @@ -351,7 +351,7 @@ regWriteId pos = mkId pos (mkFString regWriteStr) -- XXX no position? regReadResId, regWriteEnId, regWriteArgId :: Id -> Id -regReadResId i = mkMethId i (regReadId noPosition) Nothing MethodResult +regReadResId i = mkMethId i (regReadId noPosition) Nothing (MethodResult 1) regWriteEnId i = mkMethId i (regWriteId noPosition) Nothing MethodEnable regWriteArgId i = mkMethId i (regWriteId noPosition) Nothing (MethodArg 1) @@ -378,17 +378,17 @@ cregToReg old_avi = updVPort new_vn (_, ps) = (new_vn, ps) (new_vFields, new_meth_types) = - let convField (Method nm c r m [] (Just res) Nothing, ts) + let convField (Method nm c r m [] [res] Nothing, ts) | (nm == cregReadId 0) = let nm' = regReadId (getPosition nm) res' = updVPort qoutPortName res - in Just (Method nm' c r m [] (Just res') Nothing, ts) - convField (Method nm c r m [arg] Nothing (Just en), ts) + in Just (Method nm' c r m [] [res'] Nothing, ts) + convField (Method nm c r m [arg] [] (Just en), ts) | (nm == cregWriteId 0) = let nm' = regWriteId (getPosition nm) arg' = updVPort dinPortName arg en' = updVPort enPortName en - in Just (Method nm' c r m [arg'] Nothing (Just en'), ts) + in Just (Method nm' c r m [arg'] [] (Just en'), ts) convField _ = Nothing in unzip $ mapMaybe convField $ @@ -530,11 +530,11 @@ createMapForVMod :: AId -> VFieldInfo -> [(FString,FString)] createMapForVMod _ (Clock _) = [] createMapForVMod _ (Reset _) = [] createMapForVMod _ (Inout {}) = [] -createMapForVMod inst_id (Method meth_id _ _ mult ins mo me) = -- trace (ppReadable result) $ +createMapForVMod inst_id (Method meth_id _ _ mult ins outs me) = -- trace (ppReadable result) $ result where result = zip meths_fstr ports_fstr - (fmeths,fports) = createMapForOneMeth meth_id mult ins me mo + (fmeths,fports) = createMapForOneMeth meth_id mult ins outs me inst_fstr = getIdFString inst_id addInstId fs = concatFString [inst_fstr, fsDollar, fs] meths_fstr = map addInstId fmeths @@ -545,8 +545,8 @@ createMapForVMod inst_id (Method meth_id _ _ mult ins mo me) = -- trace (ppReada -- For a single method, create two lists: -- * The Bluespec names for the arguments and RDY/EN -- (for example, ["set_1","set"] or ["get"]) --- The first items in the list are the arguments, and the last is --- the return value or the enable (depending on the type of method). +-- The first items in the list are the arguments, followed by +-- the return value(s) and/or the enable (depending on the type of method). -- * The Verilog port names corresponding to the Bluespec names -- (for example, ["D_IN","EN"] or ["Q_OUT"]) -- If the method has multiplicity > 1, then the first list @@ -559,37 +559,35 @@ createMapForVMod inst_id (Method meth_id _ _ mult ins mo me) = -- trace (ppReada -- mkMethId in ASyntax -- the two lists should be the same length (this is checked) createMapForOneMeth :: Id -> Integer -> - [VPort] -> Maybe VPort -> Maybe VPort -> + [VPort] -> [VPort] -> Maybe VPort -> ([FString],[FString]) -createMapForOneMeth meth_id mult ins me mo = if check then +createMapForOneMeth meth_id mult ins outs me = if check then -- trace (ppReadable (method_names, verilog_names)) $ (method_names, verilog_names) else err where check = length method_names == length verilog_names err = internalError ("createMapForOneMeth " ++ - ppReadable (meth_id, mult, ins, me, mo)) + ppReadable (meth_id, mult, ins, me, outs)) meth_fstr = getIdFString meth_id meth_mult = if mult <= 1 then [meth_fstr] else [ concatFString [meth_fstr, fsUnderscore, mkNumFString n] | n <- [0 .. mult-1] ] - -- for method "x", make the names "x_1, x_2, .." for the ports - -- make the names x__n for multi-ported methods - method_input_names = [ addNum meth_n arg_n | + -- for method "x", make the names "x_ARG_1, x_ARG_2, .." for the ports + -- make the names x__ARG_n for multi-ported methods + method_input_names = [ mkMethArgStr meth_n (toInteger arg_n) | meth_n <- meth_mult, arg_n <- [1 .. length ins]] - addNum fs n = - concatFString [fs, fsUnderscore, (mkNumFString (toInteger n))] - -- the Verilog port names for the above verilog_input_names = map getFStringForVerilogPair ins - -- names for the output port - (method_output_names, verilog_output_name) = - case (mo) of - Nothing -> ([], []) - Just p -> (meth_mult, [getFStringForVerilogPair p]) + -- names for the output ports + method_output_names = [ mkMethResStr meth_n (toInteger out_n) | + meth_n <- meth_mult, out_n <- [1 .. length outs]] + + -- the Verilog port names for the above + verilog_output_names = map getFStringForVerilogPair outs -- names for the enable (method_enable_names, verilog_enable_name) = @@ -608,14 +606,14 @@ createMapForOneMeth meth_id mult ins me mo = if check then verilog_names_pre_mult = verilog_input_names ++ verilog_enable_name ++ - verilog_output_name + verilog_output_names -- handle the multiplicity for verilog names here -- note how we go from 1..mult instead of 0..mult-1 -- as the method side does verilog_names = if (mult <= 1) then verilog_names_pre_mult - else [addNum fs n | -- PORT_N + else [concatFString [fs, fsUnderscore, (mkNumFString (toInteger n))] | -- PORT_N fs <- verilog_names_pre_mult, n <- [1..mult]] diff --git a/src/comp/BinData.hs b/src/comp/BinData.hs index 96dbac24a..8999c37f4 100644 --- a/src/comp/BinData.hs +++ b/src/comp/BinData.hs @@ -997,6 +997,7 @@ instance Bin AType where writeBytes (ATReal) = do putI 2; writeBytes (ATArray sz t) = do putI 3; toBin sz; toBin t writeBytes (ATAbstract i szs) = do putI 4; toBin i; toBin szs + writeBytes (ATTuple ts) = do putI 5; toBin ts readBytes = do i <- getI case i of @@ -1005,6 +1006,7 @@ instance Bin AType where 2 -> do return ATReal 3 -> do sz <- fromBin; t <- fromBin; return (ATArray sz t) 4 -> do i <- fromBin; szs <- fromBin; return (ATAbstract i szs) + 5 -> do ts <- fromBin; return (ATTuple ts) n -> internalError $ "GenABin.Bin(AType).readBytes: " ++ show n -- ---------- @@ -1034,6 +1036,8 @@ instance Bin AExpr where writeBytes (AMGate t obj clk) = section "AExpr" $ do putI 14; toBin t; toBin obj; toBin clk writeBytes (ASInout t iot) = section "AExpr" $ do putI 15; toBin t; toBin iot writeBytes (ASReal i t val) = section "AExpr" $ do putI 16; toBin i; toBin t; toBin val + writeBytes (ATupleSel t e idx) = section "AExpr" $ do putI 17; toBin t; toBin e; toBin idx + writeBytes (ATuple t es) = section "AExpr" $ do putI 18; toBin t; toBin es readBytes = do i <- getI case i of @@ -1067,6 +1071,10 @@ instance Bin AExpr where 15 -> do t <- fromBin; iot <- fromBin; return (ASInout t iot) 16 -> do { i <- fromBin; t <- fromBin; val <- fromBin; return (ASReal i t val) } + 17 -> do { t <- fromBin; e <- fromBin; idx <- fromBin; + return (ATupleSel t e idx) } + 18 -> do { t <- fromBin; es <- fromBin; + return (ATuple t es) } n -> internalError $ "GenABin.Bin(IExpr).readBytes: " ++ show n -- toBin e = Out [AExp e] () -- fromBin = readShared diff --git a/src/comp/CSyntax.hs b/src/comp/CSyntax.hs index c8d40355e..9b3c7c04e 100644 --- a/src/comp/CSyntax.hs +++ b/src/comp/CSyntax.hs @@ -1272,9 +1272,11 @@ instance PPrint CExpr where f (Inout i (VName p) mc mr) = t "inout_field " <> ppVarId d i <+> t p <+> mfi "clocked_by" mc <+> mfi "reset_by" mr - f (Method i mc mr n ps mo me) = + f (Method i mc mr n ps os me) = ppVarId d i <> g n <+> t "=" <+> t (unwords (map h ps)) <+> - mfi "clocked_by" mc <+> mfi "reset_by" mr <+> mfp "output" mo <+> mfp "enable" me + mfi "clocked_by" mc <+> mfi "reset_by" mr <+> + (if null os then empty else t"output" <+> t (unwords (map h os))) <+> + mfp "enable" me g 1 = t"" g n = t("[" ++ itos n ++ "]") h (s,[]) = show s diff --git a/src/comp/CType.hs b/src/comp/CType.hs index 5978c408e..5f33c015e 100644 --- a/src/comp/CType.hs +++ b/src/comp/CType.hs @@ -449,14 +449,20 @@ getActionValueArg t = internalError ("getActionValueArg: " ++ ppReadable t) -- These are used during foreign function processing to determine if arguments -- and return values are polymorphic or of a known size. isTypePolyBit :: Type -> Bool +isTypePolyBit (TAp (TCon (TyCon i _ _)) (TAp (TCon (TyCon i' _ _)) arg)) + | (i == idActionValue) || (i == idActionValue_), (i' == idBit) = isTVar arg isTypePolyBit (TAp (TCon (TyCon i _ _)) arg) | (i == idBit) || (i == idActionValue) || (i == idActionValue_) = isTVar arg isTypePolyBit _ = False +-- Note that this is only used for foreign functions, so it does not currently handle tuples of Bits bitWidth :: Type -> Integer +bitWidth (TAp (TCon (TyCon i _ _)) (TAp (TCon (TyCon i' _ _)) arg)) + | ((i == idActionValue) || (i == idActionValue_)) && + (i' == idBit) && + (isTNum arg) = getTNum arg bitWidth (TAp (TCon (TyCon i _ _)) arg) - | ((i == idBit) || (i == idActionValue) || (i == idActionValue_)) && - (isTNum arg) = getTNum arg + | (i == idBit) && (isTNum arg) = getTNum arg bitWidth t = internalError $ "bitWidth: not a Bit type of known width -- " ++ (show t) diff --git a/src/comp/CVPrint.hs b/src/comp/CVPrint.hs index f2c8c95d6..e75f79ddc 100644 --- a/src/comp/CVPrint.hs +++ b/src/comp/CVPrint.hs @@ -842,7 +842,7 @@ ppVeriMethod d _ (Inout i (VName s) mclk mrst) = (case mrst of Nothing -> empty Just i -> t"reset_by (" <> pvpId d i <> t")") -ppVeriMethod d mr (Method i mc mreset n pts mo me) = +ppVeriMethod d mr (Method i mc mreset n pts os me) = let f _ _ Nothing = empty f before after (Just (VName vn, prs)) = (case prs of @@ -851,7 +851,10 @@ ppVeriMethod d mr (Method i mc mreset n pts mo me) = (t (before ++ vn ++ after)) in t"method " <> - (f "" " " mo) <> + (case os of + [] -> empty + [o] -> f "" " " (Just o) + _ -> t"(" <> sepList (map (f "" " " . Just) os) (t",") <> t")") <> (pvpId d i <> (if n == 1 then empty else (t"[" <> (pp d n) <> t"]")) <> (t"(" <> sepList (map (f "" "" . Just) pts) (t",") <> t")") <> diff --git a/src/comp/DisjointTest.hs b/src/comp/DisjointTest.hs index 88d177c79..1de2481ce 100644 --- a/src/comp/DisjointTest.hs +++ b/src/comp/DisjointTest.hs @@ -11,12 +11,13 @@ module DisjointTest( import qualified Data.Set as S import qualified Data.Map as M import Control.Monad(foldM {- , when -}) +import Data.List (genericIndex) import Util(ordPair,uniquePairs) -import Error(ErrorHandle) +import Error(ErrorHandle, internalError) import Pretty -import PPrint(PPrint(..)) +import PPrint(PPrint(..), ppReadable) import Flags import ASyntax @@ -24,7 +25,7 @@ import ASyntaxUtil(AExprs(..), aAnd) import Pragma import VModInfo(VModInfo) -import AExpr2Util(getMethodOutputPort) +import AExpr2Util(getMethodOutputPorts) --import Debug.Trace(trace) import qualified AExpr2STP as STP @@ -270,9 +271,26 @@ buildSupportMap adefs avis rs = --trace ("XXX support map:" ++ ppReadable res) $ findSupport e@(ASDef _ i) = [DDef def i] where def = M.findWithDefault (err i) i idToDef findSupport e@(APrim { ae_args = es}) = findAExprs findSupport es - findSupport e@(AMethCall {ae_args = es}) = findAExprs findSupport es ++ [DMethod (ae_objid e) vlogport] - where vlogport = getMethodOutputPort portMap (ae_objid e) (ameth_id e) - findSupport e@(AMethValue {}) = [DMethod (ae_objid e) (ameth_id e)] + findSupport e@(AMethCall {ae_args = es}) = + case getMethodOutputPorts portMap (ae_objid e) (ameth_id e) of + [vlogport] -> findAExprs findSupport es ++ [DMethod (ae_objid e) vlogport] + ports -> internalError ("buildSupportMap: unexpected output ports: " + ++ ppReadable (ae_objid e, ameth_id e, ports)) + findSupport e@(AMethValue {}) = + case getMethodOutputPorts portMap (ae_objid e) (ameth_id e) of + [vlogport] -> [DMethod (ae_objid e) vlogport] + ports -> internalError ("buildSupportMap: unexpected output ports: " + ++ ppReadable (ae_objid e, ameth_id e, ports)) + findSupport e@(ATupleSel _ (AMethCall {ae_args = es}) idx) = + findAExprs findSupport es ++ [DMethod (ae_objid e) vlogport] + where + ports = getMethodOutputPorts portMap (ae_objid e) (ameth_id e) + vlogport = genericIndex ports (idx - 1) + findSupport e@(ATupleSel _ (AMethValue {}) idx) = + [DMethod (ae_objid e) vlogport] + where + ports = getMethodOutputPorts portMap (ae_objid e) (ameth_id e) + vlogport = genericIndex ports (idx - 1) findSupport e@(ANoInlineFunCall{ ae_args = es}) = findAExprs findSupport es findSupport e@(ATaskValue {ae_objid=id}) = [DTask id] findSupport e@(ASPort {ae_objid = id}) = [DLeaf id] diff --git a/src/comp/GenWrap.hs b/src/comp/GenWrap.hs index 03fa7dc11..c297e5da8 100644 --- a/src/comp/GenWrap.hs +++ b/src/comp/GenWrap.hs @@ -684,11 +684,11 @@ fixCModuleVerilog n (ss,ts,ps) in [mStmtSPTO vp e] saveArgTypes _ = [] let saveFieldTypes finf (Method { vf_inputs = inps, - vf_output = mo }) = do + vf_outputs = outs }) = do let rt = ret_type finf isAV <- isActionValue rt output_type <- if isAV then getAVType "fixCModVer" rt else return rt - let output_stmt = maybeToList (fmap ((flip mStmtSPT) rt) mo) + let output_stmt = map ((flip mStmtSPT) rt) outs -- we let the type-checker error on mismatches return (output_stmt ++ (zipWith mStmtSPT inps (arg_types finf))) saveFieldTypes finf (Inout { vf_inout = vn }) = do @@ -796,7 +796,7 @@ procType (n, ns, as, ts, ctx) ty = do if isAV then do av_t <- getAVType "procType" ty return (n+1, newId:ns, newSVar:as, - (ty, (TAp tActionValue_ (cTVarNum newId))):ts, + (ty, (TAp tActionValue_ (TAp tBit (cTVarNum newId)))):ts, (bitsCtx av_t newSVar):ctx) else do isInout <- isInoutType ty @@ -1112,10 +1112,13 @@ genTo pps ty mk = localPrefix = joinStrings_ currentPre localPrefix1 prefix = stringLiteralAt noPosition localPrefix arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] - fnp = mkTypeProxyExpr $ TAp (cTCon idStrArg) $ cTStr (fieldPathName prefixes f)(getIdPosition f) + 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) -- 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, ec] + let e = CApply (CVar idToWrapField) [fnp, prefix, arg_names, result, ec] return [CLValue (binId prefixes f) [CClause [] [] e] []] -- -------------------- @@ -1637,10 +1640,10 @@ fixupVeriField _ _ f@(Reset { }) = f fixupVeriField _ _ f@(Inout { }) = f fixupVeriField pps vportprops m@(Method { }) = m { vf_inputs = inputs', - vf_output = output', + vf_outputs = outputs', vf_enable = enable'' } where inputs' = map fixup (vf_inputs m) - output' = fmap fixup (vf_output m) + outputs' = map fixup (vf_outputs m) enable' = fmap fixup (vf_enable m) fixup = fixupPort vportprops alwaysEnabled = isAlwaysEn pps (vf_name m) @@ -2044,10 +2047,8 @@ genNewMethodIfcPragmas ifcp pragmas fieldId newFieldId = ar = if (isAlwaysReadyIfc joinedPrags) then [PIAlwaysRdy ] else [] ae = if (isAlwaysEnabledIfc joinedPrags) then [PIAlwaysEnabled ] else [] -- The result names used the prefix plus the given of generated name - mResName = lookupResultIfcPragma pragmas - resultName = case mResName of - Just str -> joinStrings_ currentPre str - Nothing -> joinStrings_ currentPre methodStr + localResult1 = fromMaybe (getIdString fieldId) (lookupResultIfcPragma pragmas) + resultName = joinStrings_ currentPre localResult1 -- resName = (PIResultName resultName) -- The ready name @@ -2203,14 +2204,11 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId _ -> do -- Compute the local prefix and result name for this field in the flattened interface -- from the current prefixes and pragmas from the field definition. - let methodStr = getIdBaseString f - currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix + let currentPre = ifcp_renamePrefixes prefixes -- the current rename prefix localPrefix1 = fromMaybe (getIdBaseString f) (lookupPrefixIfcPragma ciPrags) localPrefix = joinStrings_ currentPre localPrefix1 - mResName = lookupResultIfcPragma ciPrags - resultName = case mResName of - Just str -> joinStrings_ currentPre str - Nothing -> joinStrings_ currentPre methodStr + localResult1 = fromMaybe (getIdBaseString f) (lookupResultIfcPragma ciPrags) + localResult = joinStrings_ currentPre localResult1 -- 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. @@ -2218,7 +2216,7 @@ mkFieldSavePortTypeStmts v ifcId = concatMapM $ meth noPrefixes ifcId proxy = mkTypeProxyExpr $ foldr arrow r as prefix = stringLiteralAt noPosition localPrefix arg_names = mkList (getPosition f) [stringLiteralAt (getPosition i) (getIdString i) | i <- aIds] - result = stringLiteralAt noPosition resultName + result = stringLiteralAt noPosition localResult return [ CSExpr Nothing $ cVApply idLiftModule $ diff --git a/src/comp/IExpand.hs b/src/comp/IExpand.hs index 25c9875a1..5406dc632 100644 --- a/src/comp/IExpand.hs +++ b/src/comp/IExpand.hs @@ -295,7 +295,10 @@ iExpand errh flags symt alldefs is_noinlined_func pps def@(IDef mi _ _ _) = do t = iGetType e -- the name for the new IDef being created i = case expr_name of - Just name -> + -- Heuristic: treat names starting with _ as bad names, + -- as these may come from the arguments of functions like + -- id _x = _x + Just name | not (isEmptyId name) && head (getIdBaseString name) /= '_' -> setKeepId $ mkIdPost name (mkFString (iExpandPref ++ show p)) _ -> @@ -311,8 +314,9 @@ iExpand errh flags symt alldefs is_noinlined_func pps def@(IDef mi _ _ _) = do in -- return the expression that should replace the heap pointer, -- and maybe a Def, if the expression is a def reference - if simple e || isActionType t then + if simple e || isActionType t || isPairType t then -- inline the expression, no def is created for this heap ptr + --trace ("not inlining " ++ show i ++ " " ++ ppReadable t) $ (e', Nothing) else -- assign the expr to a def, and replace the ptr reference @@ -1035,11 +1039,11 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) = do showTopProgress ("Elaborating method " ++ quote (pfpString i)) setIfcSchedNameScopeProgress (Just (IEP_Method i False)) (_, P p e') <- evalUH e - let (ins, eb) = case e' of - ICon _ (ICMethod _ ins eb) -> (ins, eb) + let (ins, outs, eb) = case e' of + ICon _ (ICMethod _ ins outs eb) -> (ins, outs, eb) _ -> internalError ("iExpandField: expected ICMethod: " ++ ppReadable e') (its, ((IDef i1 t1 e1 _), ws1, fi1), ((IDef wi wt we _), ws2, fi2)) - <- iExpandMethod modId 1 [] (pConj implicitCond p) clkRst (i, bi, ins, eb) + <- iExpandMethod modId 1 [] (pConj implicitCond p) clkRst (i, bi, ins, outs, eb) let wp1 = wsToProps ws1 -- default clock domain forced in by iExpandField let wp2 = wsToProps ws2 setIfcSchedNameScopeProgress Nothing @@ -1048,10 +1052,10 @@ iExpandField modId implicitCond clkRst (i, bi, e, t) = do -- expand a method iExpandMethod :: Id -> Integer -> [Id] -> HPred -> - (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> + (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], [String], HExpr) -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, ins, e) = do +iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, ins, outs, e) = do when doDebug $ traceM ("iExpandMethod " ++ ppString i ++ " " ++ ppReadable e) (_, P p e') <- evalUH e case e' of @@ -1061,23 +1065,24 @@ iExpandMethod modId n args implicitCond clkRst@(curClk, _) (i, bi, ins, e) = do -- a GenWrap-added context that wasn't satisfied, and GenWrap -- should only be adding Bits) errG (reportNonSynthTypeInMethod modId i e') - ILam li ty eb -> iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p - _ -> iExpandMethod' implicitCond curClk (i, bi, e') p + ILam li ty eb -> iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, outs, eb) li ty p + _ -> iExpandMethod' implicitCond curClk (i, bi, outs, e') p iExpandMethodLam :: Id -> Integer -> [Id] -> HPred -> - (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> + (HClock, HReset) -> (Id, BetterInfo.BetterInfo, [String], [String], HExpr) -> Id -> IType -> Pred HeapData -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do - -- traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show ins) +iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, outs, eb) li ty p = do + --traceM ("iExpandMethodLam " ++ ppString i ++ " " ++ show (ins, outs)) + if null ins then internalError "iExpandMethodLam: no inputs" else return () let i' :: Id i' = mkId (getPosition i) $ mkFString $ head ins -- substitute argument with a modvar and replace with body eb' :: HExpr eb' = eSubst li (ICon i' (ICMethArg ty)) eb (its, (d, ws1, wf1), (wd, ws2, wf2)) <- - iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, tail ins, eb') + iExpandMethod modId (n+1) (i':args) (pConj implicitCond p) clkRst (i, bi, tail ins, outs, eb') let inps :: [VPort] inps = vf_inputs wf1 let wf1' :: VFieldInfo @@ -1086,11 +1091,11 @@ iExpandMethodLam modId n args implicitCond clkRst (i, bi, ins, eb) li ty p = do _ -> internalError "iExpandMethodLam: unexpected wf1" return ((i', ty) : its, (d, ws1, wf1'), (wd, ws2, wf2)) -iExpandMethod' :: HPred -> HClock -> (Id, BetterInfo.BetterInfo, HExpr) -> +iExpandMethod' :: HPred -> HClock -> (Id, BetterInfo.BetterInfo, [String], HExpr) -> Pred HeapData -> G ([(Id, IType)], (HDef, HWireSet, VFieldInfo), (HDef, HWireSet, VFieldInfo)) -iExpandMethod' implicitCond curClk (i, bi, e0) p0 = do +iExpandMethod' implicitCond curClk (i, bi, outs, e0) p0 = do -- want the result type, not a type including arguments let methType :: IType methType = iGetType e0 @@ -1133,7 +1138,7 @@ iExpandMethod' implicitCond curClk (i, bi, e0) p0 = do IAps f@(ICon _ (ICTuple {})) ts [e1, e2] | isActionType methType -> let pos = getIdPosition i - vt = actionValue_BitN methType + vt = getAV_Type methType v = icUndetAt pos vt UNotUsed in (IAps f ts [v, icNoActions], ws) _ -> internalError "iExpandMethod: fixupActionWireSet" @@ -1149,8 +1154,8 @@ iExpandMethod' implicitCond curClk (i, bi, e0) p0 = do rdyId = mkRdyId i let enablePort :: Maybe VPort enablePort = toMaybe (isActionType methType) (BetterInfo.mi_enable bi) - let outputPort :: Maybe VPort - outputPort = toMaybe (isValueType methType) (BetterInfo.mi_result bi) + let outputPorts :: [VPort] + outputPorts = map (id_to_vPort . mkId (getPosition i) . mkFString) outs let rdyPort :: VPort rdyPort = BetterInfo.mi_ready bi @@ -1160,12 +1165,12 @@ iExpandMethod' implicitCond curClk (i, bi, e0) p0 = do Method { vf_name = i, vf_clock = methClock, vf_reset = methReset, vf_mult = 1, vf_inputs = [], - vf_output = outputPort, vf_enable = enablePort }), + vf_outputs = outputPorts, vf_enable = enablePort }), ((IDef rdyId itBit1 readySignal []), final_ws, Method { vf_name = rdyId, vf_clock = methClock, vf_reset = methReset, vf_mult = 1, vf_inputs = [], - vf_output = Just rdyPort, vf_enable = Nothing })) + vf_outputs = [rdyPort], vf_enable = Nothing })) -- deduce clock name for VFieldInfo -- type required to control ancestry-checking with action methods @@ -2519,20 +2524,16 @@ walkNF e = -- XXX is adding the clock to the wire set redundant? clk@(ICon i (ICClock { iClock = c })) : _ -> upd (pConj p0 p) (IAps f ts es') (wsAddClock c ws) - -- if the outer selector is avValue_ or avAction_ - -- and the inner is a method call - [(IAps sel@(ICon i_sel2 (ICSel { })) ts_2 es_2)] - | (i_sel == idAVValue_ || i_sel == idAVAction_) -> do - case es_2 of - st@(ICon i (ICStateVar { iVar = v })) : _ -> - handleMethod i_sel2 v - _ -> internalError ("walkNF: selector should be a method call") - - -- the inner selector can wind up on the heap - -- because of "move" in evalHeap - [e_ref@(IRefT t ptr ref)] | (isitActionValue_ t) || (isitAction t) - -> do (P p' e', ws) <- walkNF e_ref - upd (pConj p0 p') (IAps f ts [e']) ws + -- We can be selecting the avValue or avAction from an ActionValue method, + -- or a tuple member out of the result of calling a method with multiple outputs, + -- and need to recurse. + [e] | (i_sel == idAVValue_ || + i_sel == idAVAction_ || + i_sel == idPrimFst || + i_sel == idPrimSnd) -> do + do (P p' e', ws) <- walkNF e + upd (pConj p0 p') (IAps f ts [e']) ws + _ -> do when doDebug $ traceM "not stvar or foreign\n" when doDebug $ traceM (show u ++ "\n") when doDebug $ traceM (show es' ++ "\n") @@ -2547,6 +2548,11 @@ walkNF e = (P p' e', ws) <- walkNF e upd (pConjs [p0, p, p']) e' ws + IAps f@(ICon _ (ICTuple {})) ts [e1, e2] -> do + (P pe1 e1', ws1) <- walkNF e1 + (P pe2 e2', ws2) <- walkNF e2 + upd (pConj pe1 pe2) (IAps f ts [e1', e2']) (wsJoin ws1 ws2) + -- Any other application is not in NF (which is unexpected?) IAps f ts es -> do _ <- internalError ("walkNF fall-through: " ++ ppReadable (f,ts,es)) @@ -3126,10 +3132,16 @@ conAp' i (ICPrim _ PrimIsRawUndefined) _ (T t : E e : as) = do _ -> -- do traceM ("IsRawUndefined: False") return (P p iFalse) -conAp' i (ICPrim _ PrimMethod) _ [T t, E eInNames, E meth] = do +conAp' i (ICPrim _ PrimMethod) _ [T t, E eInNames, E eOutNames, E meth] = do (inNames, _) <- evalStringList eInNames + (outNames, _) <- evalStringList eOutNames P p meth' <- eval1 meth - return $ P p $ ICon (dummyId noPosition) $ ICMethod {iConType = t, iInputNames = inNames, iMethod = meth'} + return $ P p $ ICon (dummyId noPosition) $ ICMethod { + iConType = t, + iInputNames = inNames, + iOutputNames = outNames, + iMethod = meth' + } -- XXX is this still needed? conAp' i (ICUndet { iConType = t }) e as | t == itClock = @@ -3849,7 +3861,7 @@ conAp' _ (ICPrim _ op) fe@(ICon prim_id _) as | strictPrim op = do when doTrans $ traceM ("conAp: iTransform fallthrough: " ++ ppReadable (op, mkAp fe as')) errh <- getErrHandle case (iTransExpr errh (mkAp fe as')) of - (e', True) -> do + (e', True) | isBitType (iGetType e') -> do -- we used to evaluate further here, but that shouldn't -- be necessary (and probably indicates a bug elsewhere) when (doDebug || doTrans) $ traceM ("conAp: iTransform result: " ++ ppReadable e') @@ -4829,6 +4841,11 @@ doSel sel s tys ty n as ee (p, e) = -- canonical applications are strict (e.g. method call applications) _ | isCanon e -> bldApUH' "Sel" sel (map T tys ++ (E ee : as)) + -- tuple section from a multi-output method result + _ | s == idPrimFst || s == idPrimSnd -> do + (_, P p e') <- evalUH e + addPredG p $ bldApUH' "Sel PrimFst/Snd" sel (map T tys ++ (E e' : as)) + -- otherwise fail _ -> internalError ("doSel: " ++ ppReadable (sel, e, as)) @@ -4842,7 +4859,7 @@ isCanon (ICon _ (ICModParam { })) = True isCanon (ICon _ (ICClock { })) = True --isCanon (IAps (ICon _ (ICPrim _ PrimBlock)) _ _) = True -- XXX is this the best way? isCanon (IAps (ICon _ (ICSel { })) _ [_]) = True -isCanon (IAps (ICon _ (ICOut { })) _ [_]) = True +--isCanon (IAps (ICon _ (ICOut { })) _ [_]) = True -- AV of foreign function application is canon --isCanon (IAps (ICon _ (ICForeign { })) _ _) = True isCanon (IRefT _ _ _) = True diff --git a/src/comp/IExpandUtils.hs b/src/comp/IExpandUtils.hs index f6e3f7ec1..c781effd3 100644 --- a/src/comp/IExpandUtils.hs +++ b/src/comp/IExpandUtils.hs @@ -357,18 +357,23 @@ isPrimType (ITCon i _ _) = i == idPrimAction || -- i == idInteger i == idFmt || -- also not really a primitive i == idClock || - i == idReset + i == idReset || + i == idPrimUnit +-- ActionValue_ must be applied to (a tuple of) Bit +isPrimType (ITAp (ITCon i _ _) t) + | i == idActionValue_ = t == itPrimUnit || isBitTupleType t -- Primitive constructor applied to numeric type(s) isPrimType (ITAp a t) | iGetKind t == Just IKNum = isPrimTAp a -- Primitive arrays isPrimType (ITAp (ITCon i _ _) elem_ty) | i == idPrimArray = isPrimType elem_ty +-- Tuples of bits +isPrimType t | isBitTupleType t = True isPrimType _ = False -- Primitive type applications isPrimTAp :: IType -> Bool isPrimTAp (ITCon _ _ (TIstruct SInterface{} _)) = True -isPrimTAp (ITCon i _ _) = i == idActionValue_ || - i == idBit || +isPrimTAp (ITCon i _ _) = i == idBit || i == idInout_ isPrimTAp (ITAp a t) | iGetKind t == Just IKNum = isPrimTAp a isPrimTAp _ = False @@ -2058,8 +2063,8 @@ chkIfcPortNames errh args ifcs (ClockInfo ci co _ _) (ResetInfo ri ro) = ifc_port_names = [ (n, i) - | IEFace {ief_fieldinfo = Method i _ _ _ ins out en} <- ifcs, - (VName n, _) <- ins ++ maybeToList out ++ maybeToList en ] + | IEFace {ief_fieldinfo = Method i _ _ _ ins outs en} <- ifcs, + (VName n, _) <- ins ++ outs ++ maybeToList en ] ifc_inout_names = [ (n, i) | IEFace {ief_fieldinfo = Inout i (VName n) _ _} <- ifcs ] ifc_clock_names = diff --git a/src/comp/IInlineFmt.hs b/src/comp/IInlineFmt.hs index 54c117277..347e07a50 100644 --- a/src/comp/IInlineFmt.hs +++ b/src/comp/IInlineFmt.hs @@ -354,12 +354,13 @@ createValueExprs x = [createValueExpr x] -- ############################################################################# createValueExpr :: IExpr a -> IExpr a -createValueExpr (IAps (ICon c (ICSel {})) [ITNum s] [e@(IAps (ICon _ (ICForeign {})) _ _)]) | c == idAVAction_ +createValueExpr (IAps (ICon c (ICSel {})) [ITAp b (ITNum s)] [e@(IAps (ICon _ (ICForeign {})) _ _)]) + | c == idAVAction_, b == itBit = x - where x = (IAps (ICon idAVValue_ (ICSel {iConType = tt , selNo = 0, numSel = 2 })) [ITNum s] [e]) + where x = (IAps (ICon idAVValue_ (ICSel {iConType = tt , selNo = 0, numSel = 2 })) [ITAp itBit $ ITNum s] [e]) v0 = head tmpVarIds - tt = ITForAll v0 IKNum (ITAp (ITAp (ITCon (idArrow noPosition) (IKFun IKStar (IKFun IKStar IKStar)) TIabstract) (ITAp (ITCon idActionValue_ (IKFun IKNum IKStar) (TIstruct SStruct [idAVValue_,idAVAction_])) (ITVar v0))) - (ITAp itBit (ITVar v0)) ) + tt = ITForAll v0 IKStar (ITAp (ITAp (ITCon (idArrow noPosition) (IKFun IKStar (IKFun IKStar IKStar)) TIabstract) (ITAp (ITCon idActionValue_ (IKFun IKStar IKStar) (TIstruct SStruct [idAVValue_,idAVAction_])) (ITVar v0))) + (ITVar v0) ) createValueExpr (IAps cc@(ICon i (ICPrim _ PrimIf)) ts [cond, e0, e1]) = x where x = (IAps cc [rt] [cond, e0', e1']) @@ -370,11 +371,12 @@ createValueExpr x = internalError ("createValueExpr: " ++ ppReadable x) createActionExpr :: IExpr a -> IExpr a -createActionExpr (IAps (ICon c (ICSel {})) [ITNum s] [e@(IAps (ICon _ (ICForeign {})) _ _)]) | c == idAVValue_ +createActionExpr (IAps (ICon c (ICSel {})) [ITAp b (ITNum s)] [e@(IAps (ICon _ (ICForeign {})) _ _)]) + | c == idAVValue_, b == itBit = x - where x = (IAps (ICon idAVAction_ (ICSel {iConType = tt , selNo = 1, numSel = 2 })) [ITNum s] [e]) + where x = (IAps (ICon idAVAction_ (ICSel {iConType = tt , selNo = 1, numSel = 2 })) [ITAp itBit $ ITNum s] [e]) v0 = head tmpVarIds - tt = ITForAll v0 IKNum (ITAp (ITAp (ITCon (idArrow noPosition) (IKFun IKStar (IKFun IKStar IKStar)) TIabstract) (ITAp (ITCon idActionValue_ (IKFun IKNum IKStar) (TIstruct SStruct [idAVValue_,idAVAction_])) (ITVar v0))) + tt = ITForAll v0 IKStar (ITAp (ITAp (ITCon (idArrow noPosition) (IKFun IKStar (IKFun IKStar IKStar)) TIabstract) (ITAp (ITCon idActionValue_ (IKFun IKStar IKStar) (TIstruct SStruct [idAVValue_,idAVAction_])) (ITVar v0))) itAction ) createActionExpr (IAps cc@(ICon i (ICPrim _ PrimIf)) ts [cond, e0, e1]) = x @@ -386,14 +388,16 @@ createActionExpr x = joinActions [] allStrings :: IExpr a -> Bool -allStrings (IAps (ICon c (ICSel {})) [ITNum s] [(IAps (ICon _ (ICForeign {})) _ [e])]) | c == idAVAction_ && iGetType e == itString +allStrings (IAps (ICon c (ICSel {})) [ITAp b (ITNum s)] [(IAps (ICon _ (ICForeign {})) _ [e])]) + | c == idAVAction_ && b == itBit && iGetType e == itString = True allStrings (IAps (ICon i (ICPrim _ PrimIf)) _ [_, e0, e1]) = allStrings e0 && allStrings e1 allStrings _ = False createStringExpr :: IExpr a -> IExpr a -createStringExpr (IAps (ICon c (ICSel {})) [ITNum s] [(IAps (ICon _ (ICForeign {})) _ [e])]) | c == idAVAction_ +createStringExpr (IAps (ICon c (ICSel {})) [ITAp b (ITNum s)] [(IAps (ICon _ (ICForeign {})) _ [e])]) + | c == idAVAction_, b == itBit = e createStringExpr (IAps cc@(ICon i (ICPrim _ PrimIf)) ts [cond, e0, e1]) = x diff --git a/src/comp/ISplitIf.hs b/src/comp/ISplitIf.hs index 93fd3c942..07ef8351e 100644 --- a/src/comp/ISplitIf.hs +++ b/src/comp/ISplitIf.hs @@ -445,7 +445,7 @@ iSplitIface flags ieface@(IEFace i xargs (Just (e,t)) Nothing wp fi) in (smap, IEFace i xargs Nothing (Just irules_opt) wp fi) else case e of (IAps (ICon av (ICTuple {fieldIds = [_val_id,_act_id]})) - [ITNum _] [val_,act_]) + [_] [val_,act_]) | (av == idActionValue_) -> let irule = IRule i [] (getIdString i) wp iTrue act_ Nothing [] irules = IRules [] [irule] -- no sps @@ -457,9 +457,9 @@ iSplitIface flags ieface@(IEFace i xargs (Just (e,t)) Nothing wp fi) iSplitIface _ _ = internalError ("iSplitIface: no expression or unexpected rule") mkExpression :: IExpr a -> IType -> Maybe (IExpr a, IType) -mkExpression val_ ty = if (0==(getAV_Size ty)) +mkExpression val_ ty = if (isEmptyType (getAV_Type ty)) then Nothing - else (Just (val_,(actionValue_BitN ty))) + else (Just (val_,(getAV_Type ty))) check_meth_rules :: (PrimOp -> Bool) -> IEFace a -> Maybe (IExpr a) diff --git a/src/comp/ISyntax.hs b/src/comp/ISyntax.hs index 4bb08b7f5..d8635c2a0 100644 --- a/src/comp/ISyntax.hs +++ b/src/comp/ISyntax.hs @@ -822,7 +822,7 @@ data IConInfo a = -- only exists before expansion | ICSchedPragmas { iConType :: IType, iPragmas :: [CSchedulePragma] } - | ICMethod { iConType :: IType, iInputNames :: [String], iMethod :: IExpr a } + | ICMethod { iConType :: IType, iInputNames :: [String], iOutputNames :: [String], iMethod :: IExpr a } | ICClock { iConType :: IType, iClock :: IClock a } | ICReset { iConType :: IType, iReset :: IReset a } -- iReset has effective type itBit1 | ICInout { iConType :: IType, iInout :: IInout a } @@ -917,8 +917,8 @@ cmpC c1 c2 = ICIFace { ifcTyId = ti1, ifcIds = is1 } -> compare (ti1, is1) (ifcTyId c2, ifcIds c2) ICRuleAssert { iAsserts = asserts } -> compare asserts (iAsserts c2) ICSchedPragmas { iPragmas = pragmas } -> compare pragmas (iPragmas c2) - ICMethod { iInputNames = inames1, iMethod = meth1 } -> - compare (inames1, meth1) (iInputNames c2, iMethod c2) + ICMethod { iInputNames = inames1, iOutputNames = outnames1, iMethod = meth1 } -> + compare (inames1, outnames1, meth1) (iInputNames c2, iOutputNames c2, iMethod c2) -- the ICon Id is not sufficient for equality comparison for Clk/Rst ICClock { iClock = clock1 } -> compare clock1 (iClock c2) ICReset { iReset = reset1 } -> compare reset1 (iReset c2) @@ -1243,7 +1243,7 @@ instance NFData (IConInfo a) where rnf (ICIFace x1 x2 x3) = rnf3 x1 x2 x3 rnf (ICRuleAssert x1 x2) = rnf2 x1 x2 rnf (ICSchedPragmas x1 x2) = rnf2 x1 x2 - rnf (ICMethod x1 x2 x3) = rnf3 x1 x2 x3 + rnf (ICMethod x1 x2 x3 x4) = rnf4 x1 x2 x3 x4 rnf (ICClock x1 x2) = rnf2 x1 x2 rnf (ICReset x1 x2) = rnf2 x1 x2 rnf (ICInout x1 x2) = rnf2 x1 x2 @@ -1465,7 +1465,7 @@ showTypelessCI (ICValue {iConType = t, iValDef = e}) = "(ICValue)" showTypelessCI (ICIFace {iConType = t, ifcTyId = i, ifcIds = ids}) = "(ICIFace _ " ++ (show i) ++ " " ++ (show ids) ++ ")" showTypelessCI (ICRuleAssert {iConType = t, iAsserts = rps}) = "(ICRuleAssert _ " ++ (show rps) ++ ")" showTypelessCI (ICSchedPragmas {iConType = t, iPragmas = sps}) = "(ICSchedPragmas _ " ++ (show sps) ++ ")" -showTypelessCI (ICMethod {iConType = t, iInputNames = ins, iMethod = m }) = "(ICMethod " ++ (show ins) ++ " " ++ (ppReadable m) ++ ")" +showTypelessCI (ICMethod {iConType = t, iInputNames = ins, iOutputNames = outs, iMethod = m }) = "(ICMethod " ++ (show ins) ++ " " ++ (show outs) ++ " " ++ (ppReadable m) ++ ")" showTypelessCI (ICClock {iConType = t, iClock = clock}) = "(ICClock)" showTypelessCI (ICReset {iConType = t, iReset = reset}) = "(ICReset)" showTypelessCI (ICInout {iConType = t, iInout = inout}) = "(ICInout)" diff --git a/src/comp/ISyntaxUtil.hs b/src/comp/ISyntaxUtil.hs index abeb7ee8f..f5842f7cb 100644 --- a/src/comp/ISyntaxUtil.hs +++ b/src/comp/ISyntaxUtil.hs @@ -120,18 +120,16 @@ isSimpleType t = t == itInteger || t == itChar isitAction :: IType -> Bool -isitAction (ITAp (ITCon i (IKFun IKNum IKStar) - (TIstruct SStruct [_,_] ) ) (ITNum x)) - | (i == idActionValue_) = (x == 0) -isitAction (ITAp (ITCon i (IKFun IKStar IKStar) _) t) - | (i == idActionValue) = t == itPrimUnit +isitAction (ITAp (ITCon i (IKFun IKStar IKStar) _ ) t) + | (i == idActionValue_) || (i == idActionValue) = isEmptyType t isitAction x = (x == itAction) --- note this returns false for x == - because ActionValue_ 0 is really an Action +-- note this returns false for x == () because ActionValue_ () is really an Action +-- Also handle ActionValue_ (Bit 0), which can be introduced by foreign functions. isitActionValue_ :: IType -> Bool -isitActionValue_ (ITAp (ITCon i (IKFun IKNum IKStar) - (TIstruct SStruct [_,_] ) ) (ITNum x)) - | x > 0 = (i == idActionValue_) +isitActionValue_ (ITAp (ITCon i (IKFun IKStar IKStar) + (TIstruct SStruct [_,_] ) ) t) = + (i == idActionValue_) && not (isEmptyType t) isitActionValue_ _ = False isitActionValue :: IType -> Bool @@ -149,11 +147,11 @@ getInout_Size t = internalError ("getInout_Size: type is not Inout_: " ++ ppReadable t) -getAV_Size :: IType -> Integer -getAV_Size (ITAp (ITCon i (IKFun IKNum IKStar) - (TIstruct SStruct [_,_] ) ) (ITNum x)) | - (i == idActionValue_) = x -getAV_Size t = internalError ("getAV_Size: type is not AV_: " ++ ppReadable t) +getAV_Type :: IType -> IType +getAV_Type (ITAp (ITCon i (IKFun IKStar IKStar) + (TIstruct SStruct [_,_] ) ) t) | + (i == idActionValue_) = t +getAV_Type t = internalError ("getAV_Type: type is not AV_: " ++ ppReadable t) getAVType :: IType -> Maybe IType getAVType (ITAp (ITCon i (IKFun IKStar IKStar) _) t) | i == idActionValue = Just t @@ -175,18 +173,34 @@ itList, itMaybe :: IType -> IType itList t = ITAp (ITCon idList (IKFun IKStar IKStar) tiList) t itMaybe t = ITAp (ITCon idMaybe (IKFun IKStar IKStar) tiMaybe) t +isPairType :: IType -> Bool +isPairType (ITAp (ITAp (ITCon i _ _) _) _) = i == idPrimPair +isPairType _ = False + +isEmptyType :: IType -> Bool +isEmptyType (ITCon i _ _) = i == idPrimUnit +isEmptyType (ITAp c (ITNum 0)) = c == itBit +isEmptyType t = False + isBitType :: IType -> Bool isBitType (ITAp c n) = c == itBit isBitType _ = False +isBitTupleType :: IType -> Bool +isBitTupleType (ITAp (ITAp (ITCon i _ _) t1) t2) | i == idPrimPair = + isBitType t1 && isBitTupleType t2 +isBitTupleType t = isBitType t + -- extension point for ActionValue methods isActionType :: IType -> Bool isActionType x = (x == itAction) || (isitActionValue_ x) || (isitAction x) -- extension point for ActionValue methods isValueType :: IType -> Bool -isValueType x | (isitActionValue_ x) && (getAV_Size x > 0) = True +isValueType x | (isitActionValue_ x) = True isValueType (ITAp t n) | t == itBit = True +isValueType (ITAp (ITAp (ITCon i _ _) t1) t2) | i == idPrimPair = + isBitType t1 && isValueType t2 isValueType _ = False -- Constructors @@ -1066,10 +1080,6 @@ joinActions [] = icNoActions joinActions as = foldr1 ja as where ja a1 a2 = IAps icJoinActions [] [a1, a2] --- perhaps the position information should be transferred over XXX -actionValue_BitN :: IType -> IType -actionValue_BitN t = itBitN (getAV_Size t) - iStrToInt :: String -> Position -> IExpr a iStrToInt s pos = iMkLitAt pos itInteger i where i = foldl sumString 0 s diff --git a/src/comp/ITransform.hs b/src/comp/ITransform.hs index 6267f2c83..98337bba0 100644 --- a/src/comp/ITransform.hs +++ b/src/comp/ITransform.hs @@ -249,8 +249,8 @@ runCSE e@(IAps _ _ _) = do -- because "runCSE" is called from iTrExpr, which already recurses on the -- arguments, so runCSE will already have been called on the arguments. let t = iGetType e - -- Only CSE applications that are not actions - if not (isActionType t) then + -- Only CSE applications that are not actions or tuple method values + if not (isActionType t || isPairType t) then newExprT t e else return e diff --git a/src/comp/IfcBetterInfo.hs b/src/comp/IfcBetterInfo.hs index 8baded88b..a519d8877 100644 --- a/src/comp/IfcBetterInfo.hs +++ b/src/comp/IfcBetterInfo.hs @@ -25,7 +25,6 @@ import VModInfo -- and for recording the types of external method ports data BetterInfo = BetterMethodInfo { mi_id :: Id, -- method Id - mi_result :: VPort, -- possible rename for method result mi_ready :: VPort, -- for ready signal mi_enable :: VPort, -- for enable signal mi_prefix :: Id -- default prefix for arguments (which are not found in classic) @@ -49,7 +48,6 @@ matchMethodName id mn = qualEq id (mi_id mn) -- creates a basic method remaing noMethodInfo :: Id -> BetterInfo noMethodInfo fieldId = BetterMethodInfo {mi_id = fieldId, - mi_result = id_to_vPort fieldId, mi_ready = id_to_vPort $ mkRdyId fieldId, mi_enable = id_to_vPort $ mkEnableId fieldId, mi_prefix = fieldId @@ -58,8 +56,7 @@ noMethodInfo fieldId = BetterMethodInfo {mi_id = fieldId, instance PPrint BetterInfo where pPrint d i info = (text "methodNames") <> ppId d (mi_id info) <> equals <> braces - ( printMaybe d i "Result:" (mi_result info) <> - printMaybe d i "Ready:" (mi_ready info) <> + ( printMaybe d i "Ready:" (mi_ready info) <> printMaybe d i "Enable:" (mi_enable info) <> text "Prefix:" <> pPrint d i (mi_prefix info) ) @@ -93,10 +90,9 @@ fieldInfoToBetterInfo :: Flags -> SymTab -> (Id,Maybe FieldInfo) -> BetterInfo fieldInfoToBetterInfo flags symTab (fieldId, Nothing) = noMethodInfo fieldId fieldInfoToBetterInfo flags symTab (fieldId, Just fi) = BetterMethodInfo {mi_id = fieldId, - mi_result = maybe (id_to_vPort fieldId) (str_to_vPort) mres, mi_ready = maybe (id_to_vPort $ mkRdyId fieldId) str_to_vPort mrdy, mi_enable = maybe (id_to_vPort $ mkEnableId fieldId) str_to_vPort men, mi_prefix = maybe fieldId (setIdBaseString fieldId) mprefix } where prags = fi_pragmas fi - (mprefix,mres,mrdy,men,_,_,_) = getMethodPragmaInfo prags + (mprefix,_,mrdy,men,_,_,_) = getMethodPragmaInfo prags diff --git a/src/comp/LambdaCalc.hs b/src/comp/LambdaCalc.hs index 8a62f0fa8..bc55c1db7 100644 --- a/src/comp/LambdaCalc.hs +++ b/src/comp/LambdaCalc.hs @@ -915,6 +915,7 @@ convAType (ATString (Just width)) = stringType -- XXX ? convAType (ATReal) = realType convAType (ATArray sz t) = arrType sz (convAType t) convAType t | (t == mkATBool) = boolType +convAType (ATTuple ts) = internalError ("convAType: multi-output methods are not yet supported") convAType t@(ATAbstract {}) = internalError ("convAType: " ++ ppReadable t) -- ----- @@ -1026,7 +1027,11 @@ convStmt modId avmap (AStmtAction cset (ACall obj meth as)) = do Nothing -> -- no name because the value is unused -- but we still need to declare the correct type case (M.lookup (unQualId meth) meth_ty_map) of - Just t -> (convAType t, Nothing) + Just [t] -> (convAType t, Nothing) + Just [] -> (voidType, Nothing) + -- TODO: support multiple return values + Just ts -> error ("convStmt: multiple return values for method " ++ + ppReadable (obj, meth, ts)) Nothing -> (voidType, Nothing) -- we'll create new defs "act#", "guard#", and "state#" with a unique number @@ -1187,6 +1192,11 @@ convAExpr e@(AMethValue t obj meth) = -- these are handled by convStmts and are not expected here internalError("convAExpr: AMethValue: " ++ ppReadable e) +convAExpr (ATupleSel _ _ _) = + internalError "convAExpr: multi-output methods are not yet supported" +convAExpr (ATuple {}) = + internalError "convAExpr: multi-output methods are not yet supported" + convAExpr (ANoInlineFunCall t i (ANoInlineFun name _ _ _) as) = do let func_id = noinlineId i a_exprs <- mapM convAExpr as diff --git a/src/comp/LambdaCalcUtil.hs b/src/comp/LambdaCalcUtil.hs index 1ed84f5a5..01876d349 100644 --- a/src/comp/LambdaCalcUtil.hs +++ b/src/comp/LambdaCalcUtil.hs @@ -159,11 +159,11 @@ lookupDef defmap i = -- Digested AVInst info for each submodule instance -- * The module name -- * The numeric type arguments for polymorphic modules --- * A map from AV method names to their return value +-- * A map from AV method names to their return values -- -type InstMap = M.Map Id (String, [Integer], M.Map Id AType) +type InstMap = M.Map Id (String, [Integer], M.Map Id [AType]) -lookupMod :: InstMap -> Id -> (String, [Integer], M.Map Id AType) +lookupMod :: InstMap -> Id -> (String, [Integer], M.Map Id [AType]) lookupMod instmap obj = case (M.lookup obj instmap) of Nothing -> internalError ("lookupMod: " ++ ppReadable obj) @@ -1037,6 +1037,9 @@ updateAExprTypes _ (AMethCall t obj meth as) = do -- method return values are Bit type updateAExprTypes _ e@(AMethValue t obj meth) = return e +updateAExprTypes _ (ATupleSel _ _ _) = error "updateAExprTypes: multi-output methods not yet supported" +updateAExprTypes _ (ATuple _ _) = error "updateAExprTypes: multi-output methods not yet supported" + -- noinline function arguments and return values are Bit type updateAExprTypes _ (ANoInlineFunCall t i f as) = do as' <- mapM updateAExprTypes_Bits as @@ -1224,13 +1227,13 @@ inlineUndet = mapAExprs g -- ------------------------- -getSubModAVMethReturnTypes :: AVInst -> M.Map Id AType +getSubModAVMethReturnTypes :: AVInst -> M.Map Id [AType] getSubModAVMethReturnTypes avi = let meth_types = avi_meth_types avi vfis = vFields (avi_vmi avi) - mkPair vfi (_, Just _, Just ret_ty) = Just (vf_name vfi, ret_ty) + mkPair vfi (_, Just _, ret_tys) = Just (vf_name vfi, ret_tys) mkPair _ _ = Nothing pairs = catMaybes $ zipWith mkPair vfis meth_types diff --git a/src/comp/Parser/BSV/CVParser.lhs b/src/comp/Parser/BSV/CVParser.lhs index 72a34959d..d22ecd528 100644 --- a/src/comp/Parser/BSV/CVParser.lhs +++ b/src/comp/Parser/BSV/CVParser.lhs @@ -1447,7 +1447,9 @@ returns a single identifier formed by joining the components with underscores. > -- Bool indicates whether there's a separate Ready method for this one > pMethodVeriProt prefix = > do pos <- getPos +> -- TODO: Add syntax for specifiying multiple output ports > (optOPort, name) <- pMethodNameOptOPort "method output port or name" +> let oPorts = maybeToList optOPort > multi <- option 1 (pInBrackets pDecimal) > args <- (option [] (pInParens (pCommaSep pMethodArgVeriPort)) > "method arguments") @@ -1492,7 +1494,7 @@ returns a single identifier formed by joining the components with underscores. > Just (VeriPt p) -> > [(mkRdyId name, > V.Method (mkRdyId fullname) -> clk rst 0 [] (Just p) Nothing, +> clk rst 0 [] [p] Nothing, > False)] > Just _ -> internalError "pMethodVeriProt(4)" > return ((name, @@ -1501,7 +1503,7 @@ returns a single identifier formed by joining the components with underscores. > rst > multi > args -> optOPort +> oPorts > en, > not(null nullOrReady)) > : nullOrReady) @@ -4584,7 +4586,7 @@ a "module verilog": > let g (s,Nothing) = [(s,[])] > g (s,Just g) = [(s,[]),(g,[])] > f (Nothing, _) = [] -> f (Just i , cmg) = [V.Method i Nothing Nothing 1 (concat(map g cmg)) Nothing Nothing] +> f (Just i , cmg) = [V.Method i Nothing Nothing 1 (concat(map g cmg)) [] Nothing] > in concat . (map f) > pImperativeForeignModuleAt :: Position -> Attributes -> ImperativeFlags diff --git a/src/comp/Parser/BSV/CVParserImperative.lhs b/src/comp/Parser/BSV/CVParserImperative.lhs index 4a8aafa9c..cccc59949 100644 --- a/src/comp/Parser/BSV/CVParserImperative.lhs +++ b/src/comp/Parser/BSV/CVParserImperative.lhs @@ -1473,9 +1473,9 @@ some of these restrictions could be lifted if we made the compiler more clever > Port (name, _) _ _ -> addInput pos name ioerrs > _ -> ioerrs > chkBVIPorts (ISBVI pos (BVI_method (_,inf@(Method {}),_))) ioerrs = ioerrs3 -> where ioerrs1 = case (vf_output inf) of -> Just (name, _) -> addOutputPort pos name ioerrs -> _ -> ioerrs +> where ioerrs1 = foldr (\(name, _) iers -> addOutputPort pos name iers) +> ioerrs +> (vf_outputs inf) > ioerrs2 = case (vf_enable inf) of > Just (name, _) -> addInput pos name ioerrs1 > _ -> ioerrs1 @@ -1704,13 +1704,13 @@ Extract each type of statement, making sure to preserve the order > CLValue si [CClause [] [] > (cVApply idPrimInoutUncast0 [(CSelect (CVar bviMname) i)])] [] > -- the following case will generate an error in chkBSVMethod below: -> mkBSVMethod (sn, Method n _ _ _ is Nothing Nothing, b) = -- ... mo me needsReady +> mkBSVMethod (sn, Method n _ _ _ is [] Nothing, b) = -- ... mo me needsReady > mkBasicDef (\ e -> e) n sn is b -> mkBSVMethod (sn, Method n _ _ _ is (Just _) Nothing, b) = -- ... mo me needsReady +> mkBSVMethod (sn, Method n _ _ _ is (_ : _) Nothing, b) = -- ... mo me needsReady > mkBasicDef (\ e -> cVApply idUnpack [e]) n sn is b -> mkBSVMethod (sn, Method n _ _ _ is Nothing (Just _), b) = -- ... mo me needsReady +> mkBSVMethod (sn, Method n _ _ _ is [] (Just _), b) = -- ... mo me needsReady > mkBasicDef (\ e -> cVApply idFromActionValue_ [e]) n sn is b -> mkBSVMethod (sn, Method n _ _ _ is (Just _) (Just _), b) = -- ... mo me needsReady +> mkBSVMethod (sn, Method n _ _ _ is (_ : _) (Just _), b) = -- ... mo me needsReady > mkBasicDef (\ e -> cVApply idFromActionValue_ [e]) n sn is b > mkBSVIfc (name,constr,ss) = @@ -1728,7 +1728,7 @@ Extract each type of statement, making sure to preserve the order > lastPos = getPosition (last stmts) > bviMname = idM lastPos -> chkBSVMethod (Method n _ _ _ _ Nothing Nothing) = -- mo me +> chkBSVMethod (Method n _ _ _ _ [] Nothing) = -- os me > cvtErr (getPosition n) (EForeignModOutputOrEnable (pvpReadable n)) > chkBSVMethod m = return () > theFamilies cs as fs = do diff --git a/src/comp/Parser/Classic/CParser.hs b/src/comp/Parser/Classic/CParser.hs index 6e37b20b6..e4e703275 100644 --- a/src/comp/Parser/Classic/CParser.hs +++ b/src/comp/Parser/Classic/CParser.hs @@ -148,7 +148,7 @@ pModule = l L_module `into` \ pos -> ||! literal (mkFString "const") .> VPconst ||! literal (mkFString "unused") .> VPunused ||! literal (mkFString "inhigh") .> VPinhigh - mkMethod i n vps mo me = Method i Nothing Nothing n vps Nothing Nothing + mkMethod i n vps mo me = Method i Nothing Nothing n vps [] Nothing pMStmt :: CParser CMStmt pMStmt = pModuleInterface diff --git a/src/comp/PreStrings.hs b/src/comp/PreStrings.hs index c4e2efbcf..e7a246220 100644 --- a/src/comp/PreStrings.hs +++ b/src/comp/PreStrings.hs @@ -206,6 +206,8 @@ fsMuxVal = mkFString "VAL" fsEnable = mkFString "EN_" fs_rdy = mkFString "RDY_" fs_rl = mkFString "RL_" +fs_arg = mkFString "ARG_" +fs_res = mkFString "RES_" fs_unnamed = mkFString "unnamed" s_unnamed = "unnamed" fs_T = mkFString "_T" diff --git a/src/comp/SAL.hs b/src/comp/SAL.hs index 52b7d8951..ad58492ac 100644 --- a/src/comp/SAL.hs +++ b/src/comp/SAL.hs @@ -503,6 +503,7 @@ boolToBitVar = SVar $ primCtx (SId "boolToBit") anyVar :: AType -> SExpr anyVar (ATBit width) = SVar $ bitCtx width (SId "undef") anyVar t | (t == mkATBool) = SVar $ primCtx (SId "undefBool") +anyVar (ATTuple ts) = internalError ("anyVar: multi-output methods are not yet supported") anyVar (ATString _) = SVar $ stringCtx (SId "undef") anyVar (ATReal) = SVar $ primCtx (SId "undefReal") anyVar (ATArray sz t) = arrBuild sz $ @@ -891,6 +892,7 @@ convARule defmap instmap mmap r@(ARule rId _ _ _ p as _ _) = convAIFace :: DefMap -> InstMap -> MethodOrderMap -> AIFace -> [SDefn] +-- TODO: support multiple method output ports convAIFace defmap instmap mmap (AIDef methId args _ p (ADef _ ret_t ret_e _) _ _) = let @@ -927,6 +929,7 @@ convAIFace defmap instmap mmap sLam (arg_infos ++ [(stateId, modType)]) $ body] +-- TODO: support multiple method output ports convAIFace defmap instmap mmap (AIActionValue args _ p methId rs (ADef _ def_t def_e _) _) = let @@ -1042,6 +1045,7 @@ convAType (ATString (Just width)) = stringType -- XXX ? convAType (ATReal) = realType convAType (ATArray sz t) = arrType sz (convAType t) convAType t | (t == mkATBool) = boolType +convAType (ATTuple ts) = internalError ("convAType: multi-output methods are not yet supported") convAType t@(ATAbstract {}) = internalError ("convAType: " ++ ppReadable t) -- ----- @@ -1156,7 +1160,11 @@ convStmt avmap (AStmtAction cset (ACall obj meth as)) = do Nothing -> -- no name because the value is unused -- but we still need to declare the correct type case (M.lookup (unQualId meth) meth_ty_map) of - Just t -> (convAType t, Nothing) + Just [t] -> (convAType t, Nothing) + Just [] -> (voidType, Nothing) + Just _ -> error ("convStmt: multiple return values for method " + ++ ppReadable meth ++ " on instance " + ++ ppReadable obj) Nothing -> (voidType, Nothing) -- we'll create new defs "act#" and "state#" with a unique number @@ -1292,6 +1300,9 @@ convAExpr e@(AMethValue t obj meth) = -- these are handled by convStmts and are not expected here internalError("convAExpr: AMethValue: " ++ ppReadable e) +convAExpr (ATupleSel _ _ _) = internalError "convAExpr: multi-output methods are not yet supported" +convAExpr (ATuple {}) = internalError "convAExpr: multi-output methods are not yet supported" + convAExpr (ANoInlineFunCall t _ (ANoInlineFun name _ _ _) as) = do let func_id = noinlineQId name a_exprs <- mapM convAExpr as diff --git a/src/comp/SignalNaming.hs b/src/comp/SignalNaming.hs index 1f2c73004..fefd26c61 100644 --- a/src/comp/SignalNaming.hs +++ b/src/comp/SignalNaming.hs @@ -10,6 +10,7 @@ import ErrorUtil(internalError) import PPrint import Id import PreIds +import Util(itos) -- remember to allow a few characters for __d3222 etc suffix signal_length_limit :: Int @@ -67,6 +68,12 @@ signalNameFromAExpr' (expr@AMethCall { }) = connectWith "_" (map signalNameFromAExpr' (ae_args expr)) signalNameFromAExpr' (expr@AMethValue { }) = ppString (ae_objid expr) ++ "_" ++ ppString (unQualId (ameth_id expr)) +signalNameFromAExpr' (expr@ATuple { }) = + "TUPLE_" ++ + connectWith "_" (map signalNameFromAExpr' (ae_elems expr)) +signalNameFromAExpr' (expr@ATupleSel { }) = + signalNameFromAExpr' (ae_exp expr) ++ + "_" ++ itos (ae_index expr) signalNameFromAExpr' (expr@ANoInlineFunCall { }) = -- use the identifier name (it is the user-known function name); -- the string in ANoInlineFun is the module name diff --git a/src/comp/SimCCBlock.hs b/src/comp/SimCCBlock.hs index 78ff83fe0..ef6418276 100644 --- a/src/comp/SimCCBlock.hs +++ b/src/comp/SimCCBlock.hs @@ -66,7 +66,7 @@ import Eval import ErrorUtil(internalError) import Data.Maybe -import Data.List(partition, intersperse, intercalate, nub, sortBy) +import Data.List(partition, intersperse, intercalate, nub, sortBy, genericDrop) import Data.List.Split(wordsBy) import Numeric(showHex) import Control.Monad(when) @@ -367,6 +367,7 @@ aTypeToCType :: AType -> (CCFragment -> CCFragment) aTypeToCType (ATBit size) = (`ofType` (bitsType size CTunsigned)) aTypeToCType (ATString _) = (`ofType` (classType "std::string")) aTypeToCType (ATReal) = (`ofType` doubleType) +aTypeToCType (ATTuple ts) = userType "WideData" aTypeToCType (ATArray _ _) = internalError "Unexpected array" aTypeToCType (ATAbstract _ _) = internalError "Unexpected abstract type" @@ -638,8 +639,7 @@ getWDataTest = do return f isWideDef :: (AType, AId) -> Bool -isWideDef x@(ATBit sz, aid) | sz > 64 = True -isWideDef x = False +isWideDef (t, _) = wideDataType t mkUndetVal :: AType -> State ConvState CCExpr mkUndetVal ty = do @@ -874,6 +874,7 @@ mkPrimCall ret sz name args = mkArg expr = if (isConst expr) || (isStringType (aType expr)) || ((aType expr) == ATReal) || + (isTupleType (aType expr)) || ((aSize expr) > 64) then aExprToCExpr noRet expr else do cexpr <- aExprToCExpr noRet expr @@ -1068,6 +1069,11 @@ aExprToCExpr _ p@(APrim _ _ _ _) = aExprToCExpr _ (AMethCall _ id mid args) = do arg_list <- mapM (aExprToCExpr noRet) args return $ (aInstMethIdToC id mid) `cCall` arg_list +aExprToCExpr ret e@(ATuple _ exprs) = + wideConcatPrim ret (aSize e) exprs +aExprToCExpr ret (ATupleSel t e idx) = + wideExtractPrim ret (aSize t) e (aSize t + sizeAfter - 1) sizeAfter + where sizeAfter = sum $ map aSize $ genericDrop idx $ att_elem_types $ ae_type e aExprToCExpr _ e@(AMGate _ id clkid) = do gmap <- gets gate_map case (M.lookup e gmap) of @@ -1145,7 +1151,7 @@ simFnStmtToCStmt (SFSDef isPort (ty,aid) Nothing) = let w = aSize ty dst = if isPort then aPortIdToCLval aid else aDefIdToCLval aid typed_id = (aTypeToCType ty) dst - in if w > 64 -- for wide data, use (bits,false) constructor to avoid initialization penalty + in if w > 64 || isTupleType ty -- for wide data, use (bits,false) constructor to avoid initialization penalty then return $ construct typed_id [mkUInt32 w, mkBool False] else return $ decl typed_id simFnStmtToCStmt (SFSDef isPort (ty@(ATString (Just sz)),aid) (Just expr)) = @@ -1422,6 +1428,11 @@ mkPortInit ((ATBit n),_,vn) | n > 32 = [ assign (aPortIdToCLval (vName_to_id vn)) (mkUInt64 0) ] mkPortInit ((ATBit n),_,vn) = [ assign (aPortIdToCLval (vName_to_id vn)) (mkUInt32 0) ] +mkPortInit (t@(ATTuple _),_,vn) = + let p = aPortIdToC (vName_to_id vn) + in [ stmt $ p `cDot` "setSize" `cCall` [ mkUInt32 $ aSize t ] + , stmt $ p `cDot` "clear" `cCall` [] + ] mkPortInit p = internalError ("SimCCBlock.mkPortInit: " ++ ppReadable p) -- Create a call to the "set_reset_fn" for submodules with output resets @@ -1708,6 +1719,8 @@ mkCtorInit task_id_set (aty@(ATBit sz),aid) = let val = ASInt defaultAId aty (ilHex (aaaa sz)) in Just (aid,[val]) | otherwise = Nothing +mkCtorInit _ (aty@(ATTuple _),aid) = + Just (aid, [ aNat (aSize aty) ]) -- system tasks shouldn't be returning other types (like String), -- so no need to consult the task_id_set mkCtorInit _ _ = Nothing @@ -2142,11 +2155,11 @@ wideLocalDef (SFSDef _ (ty, aid) _) = if wideDataType ty else [] wideLocalDef _ = [] --- return True if this type is wider than 64 bits +-- return True if this type is represented as wide data +-- (i.e. it is larger than 64 bits, or it is a tuple) wideDataType :: AType -> Bool -wideDataType (ATBit sz) - | sz > 64 = True - | otherwise = False +wideDataType (ATBit sz) = sz > 64 +wideDataType (ATTuple ts) = True wideDataType _ = False diff --git a/src/comp/SimCOpt.hs b/src/comp/SimCOpt.hs index c5d3d0afb..024c53d28 100644 --- a/src/comp/SimCOpt.hs +++ b/src/comp/SimCOpt.hs @@ -157,6 +157,7 @@ moveDefsOntoStack flags instmodmap (blocks,scheds) = let sizeOkToMove = case (M.lookup (sbid,aid) btype_map) of (Just ty) -> (ty == ATReal) || ((not (isStringType ty)) && + (not (isTupleType ty)) && ((aSize ty) <= 64)) Nothing -> False -- don't move AV task defs diff --git a/src/comp/SimExpand.hs b/src/comp/SimExpand.hs index a23885156..501fc3c25 100644 --- a/src/comp/SimExpand.hs +++ b/src/comp/SimExpand.hs @@ -1040,7 +1040,7 @@ combineCombSchedInfo use_map domain_id_map parent_abi parent_csi -- schedule graph and conflicts (even the methods not used by -- any parent rules), so we need to know which are the method Ids child_apkg = abmi_apkg child_abi - child_meth_set = S.fromList $ map aIfaceName (apkg_interface child_apkg) + child_meth_set = S.fromList $ map aif_name (apkg_interface child_apkg) -- combine each part of the CSI comb_sched_map = combineSchedMap inst parent_uses @@ -1669,7 +1669,7 @@ mkRdyMap abi = mkPair (AIClock {}) = [] mkPair (AIReset {}) = [] mkPair ifc = - let name = aIfaceName ifc + let name = aif_name ifc pred_e = aIfacePred ifc in if (isRdyId name) then [] -- Rdy methods don't have Rdy methods @@ -1974,6 +1974,8 @@ eDomain m e@(AMethCall _ i mi es) = mergeUses ([(i, unQualId mi)] : map (eDomain m) es) -- don't count the return value uses of actionvalue, only the action part eDomain m (AMethValue _ _ _) = [] +eDomain m (ATupleSel _ e _) = eDomain m e +eDomain m (ATuple _ es) = mergeUses $ map (eDomain m) es eDomain m (ANoInlineFunCall _ _ _ es) = mergeUses $ map (eDomain m) es eDomain m (AFunCall _ _ _ _ es) = mergeUses $ map (eDomain m) es eDomain _ e@(ASPort _ i) = [] @@ -2210,10 +2212,11 @@ makeMethodTemps apkg = (AIDef {}) -> (True,False) (AIActionValue {}) -> (False,True) otherwise -> (False,False) + v = aif_value aif in if is_def || is_av - then case process is_av (aif_value aif) (aif_name aif) seqNo of + then case process is_av v (aif_name aif) seqNo of (Just t@(ADef tid ty e props)) -> - let aid = adef_objid (aif_value aif) + let aid = adef_objid v -- unclear if propagating the props is correct new_def = (ADef aid ty (ASDef ty tid) props) aif' = aif { aif_value = new_def } diff --git a/src/comp/SimMakeCBlocks.hs b/src/comp/SimMakeCBlocks.hs index 9ce858b5e..fe1047ade 100644 --- a/src/comp/SimMakeCBlocks.hs +++ b/src/comp/SimMakeCBlocks.hs @@ -40,7 +40,7 @@ type ModDefMap = M.Map String DefMap -- map from method names to method port info type MethMap = M.Map AId ( Maybe VName -- enable , [(AType, AId, VName)] -- args - , Maybe (AType, VName) -- return + , [(AType, VName)] -- return , Bool -- is action , [AId] -- rule Ids ) @@ -119,7 +119,7 @@ simMakeCBlocks flags sim_system = -- methods on the top-level module top_methods = sp_interface top_pkg (top_ameths, top_vmeths) = partition aIfaceHasAction top_methods - top_vmeth_set = S.fromList $ concatMap aIfaceResId top_vmeths + top_vmeth_set = S.fromList $ concatMap aIfaceResIds top_vmeths top_ameth_set = S.fromList $ map aRuleName $ concatMap aIfaceRules top_ameths -- input clocks to the top-level module @@ -132,7 +132,7 @@ simMakeCBlocks flags sim_system = , let p_name = getModuleName p , let ms = sp_interface p , m <- ms - , let m_name = aIfaceName m + , let m_name = aif_name m , let m_rules = aIfaceRules m , let sub_actions = concatMap arule_actions m_rules , let sub_names = [ (o,m) | (ACall o m _) <- sub_actions ] @@ -208,6 +208,10 @@ getExprIds in_sched def_map known ((APrim _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) getExprIds in_sched def_map known ((AMethCall _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) +getExprIds in_sched def_map known ((ATuple _ elems):es) = + getExprIds in_sched def_map known (elems ++ es) +getExprIds in_sched def_map known ((ATupleSel _ e _):es) = + getExprIds in_sched def_map known (e:es) getExprIds in_sched def_map known ((ANoInlineFunCall _ _ _ args):es) = getExprIds in_sched def_map known (args ++ es) getExprIds in_sched def_map known ((AFunCall _ _ _ _ args):es) = @@ -290,7 +294,8 @@ onePackageToBlock flags name_map full_meth_map ss pkg = ] meth_args = concat [ ins | (_,ins,_,_,_) <- M.elems meth_map ] meth_rets = [ (rt, n, vn) - | (n, (_,_,(Just (rt,vn)),_,_)) <- M.toList meth_map + | (n, (_,_,rts,_,_)) <- M.toList meth_map + , (rt,vn) <- rts ] ports = meth_ens ++ meth_args ++ meth_rets @@ -323,7 +328,7 @@ onePackageToBlock flags name_map full_meth_map ss pkg = dms = [ M.singleton clk [(aid, fromJust m')] | m <- iface - , let aid = aIfaceName m + , let aid = aif_name m , let m' = cvtIFace modId (sp_pps pkg) def_map meth_map method_order_map reset_list m , isJust m' @@ -517,7 +522,7 @@ cvtIFace :: Id -> [PProp] -> DefMap -> MethMap -> MethodOrderMap -> [(ResetId, AReset)] -> AIFace -> Maybe SimCCFn cvtIFace modId pps def_map meth_map method_order_map reset_list m = - do let name = aIfaceName m + do let name = aif_name m inputs = aIfaceArgs m args = [ (t,i) | (i,t) <- inputs ] -- always_enabled methods need to forcibly check their ready signal @@ -527,8 +532,8 @@ cvtIFace modId pps def_map meth_map method_order_map reset_list m = if ((isAlwaysEn pps name) && (aIfaceHasAction m)) then -- we have to find the name of the port associated -- with the RDY method - let rdy_id = mkRdyId (aIfaceName m) - mport = do (_,_,Just (_,vn),_,_) <- M.lookup rdy_id meth_map + let rdy_id = mkRdyId (aif_name m) + mport = do (_,_,[(_,vn)],_,_) <- M.lookup rdy_id meth_map return $ ASPort aTBool (vName_to_id vn) in case mport of (Just prt) -> [SFSCond prt ss []] @@ -543,15 +548,21 @@ cvtIFace modId pps def_map meth_map method_order_map reset_list m = wp = aIfaceProps m rst_ids = map (ae_objid . areset_wire) (mapMaybe (\n -> lookup n reset_list) (wpResets wp)) - (men, ins, mr, _, ifcrules) <- M.lookup name meth_map + (men, ins, rs, _, ifcrules) <- M.lookup name meth_map let prt vn = vName_to_id vn - rt = do { (t,_) <- mr; return t } + rt = + case rs of + [(t,_)] -> Just t + [] -> Nothing + _ -> internalError ("cvtIFace: multiple return values " + ++ "not supported in method " + ++ ppReadable name) en_stmts = maybe [] (\vn -> [SFSAssign True (prt vn) aTrue]) men wf_stmts = map (\i -> SFSAssign False (mkIdWillFire i) aTrue) ifcrules in_stmts = map (\(t,i,vn) -> SFSAssign True (prt vn) (ASPort t i)) ins body_stmts = - case mr of - Just (t,vn) -> + case rs of + [(t,vn)] -> -- account for the possible return of an actionvalue result let -- the return def ret_def = aif_value m @@ -584,9 +595,13 @@ cvtIFace modId pps def_map meth_map method_order_map reset_list m = -- ready is off (the user lied about it being always_en'd), -- but, at that point, all bets are off anyway check_rdy ss' ++ ret_stmts - Nothing -> check_rdy $ + [] -> check_rdy $ cvtActions modId name def_map method_order_map S.empty body rst_ids + -- TODO: Support methods with multiple return values + _ -> internalError ("cvtIFace: multiple return values " + ++ "not supported in method " + ++ ppReadable name) all_stmts = concat [en_stmts, wf_stmts, in_stmts, body_stmts] return $ SimCCFn (getIdBaseString name) args rt all_stmts @@ -1443,6 +1458,8 @@ tsortActionsAndDefs modId rId mmap ds acts reset_ids = -- function to substitute ASDef for AMethValue substAV (AMethValue ty obj meth) = ASDef ty (mkAVMethTmpId obj meth) + substAV (ATuple ts es) = ATuple ts (map substAV es) + substAV (ATupleSel t e i) = ATupleSel t (substAV e) i substAV (APrim i t o es) = (APrim i t o (map substAV es)) substAV (AMethCall t o m es) = (AMethCall t o m (map substAV es)) substAV (AFunCall t o f isC es) = (AFunCall t o f isC (map substAV es)) @@ -1620,6 +1637,10 @@ substGateReferences smap stmts = e { ae_args = map substInAExpr es } substInAExpr e@(AMethCall { ae_args = es }) = e { ae_args = map substInAExpr es } + substInAExpr e@(ATuple { ae_elems = es }) = + e { ae_elems = map substInAExpr es } + substInAExpr e@(ATupleSel { ae_exp = e1 }) = + e { ae_exp = substInAExpr e1 } substInAExpr e@(ANoInlineFunCall { ae_args = es }) = e { ae_args = map substInAExpr es } substInAExpr e@(AFunCall { ae_args = es }) = diff --git a/src/comp/SimPackage.hs b/src/comp/SimPackage.hs index f17e688d8..902441aa2 100644 --- a/src/comp/SimPackage.hs +++ b/src/comp/SimPackage.hs @@ -373,9 +373,9 @@ getSimPackageInputs spkg = -- ----- getPortInfo :: [PProp] -> AIFace - -> Maybe (AId, (Maybe VName, [(AType,AId,VName)], Maybe (AType,VName), Bool, [AId])) + -> Maybe (AId, (Maybe VName, [(AType,AId,VName)], [(AType,VName)], Bool, [AId])) getPortInfo pps aif = - let name = aIfaceName aif + let name = aif_name aif vfi = aif_fieldinfo aif en = do e <- vf_enable vfi -- always enabled implies enabled when ready @@ -384,17 +384,15 @@ getPortInfo pps aif = args = aIfaceArgs aif ps = map fst (vf_inputs vfi) ins = [ (t,i,vn) | ((i,t),vn) <- zip args ps ] - rt = aIfaceResType aif - ret = case (vf_output vfi) of - (Just (vn,_)) -> Just (rt,vn) - Nothing -> Nothing + rts = aIfaceResTypes aif + rets = zip rts $ map fst $ vf_outputs vfi isAction = case aif of (AIAction {}) -> True (AIActionValue {}) -> True otherwise -> False rules = map aRuleName (aIfaceRules aif) in case vfi of - (Method {}) -> Just (name, (en, ins, ret, isAction, rules)) + (Method {}) -> Just (name, (en, ins, rets, isAction, rules)) otherwise -> Nothing -- ----- diff --git a/src/comp/SimPackageOpt.hs b/src/comp/SimPackageOpt.hs index 82f966c88..cb00c867a 100644 --- a/src/comp/SimPackageOpt.hs +++ b/src/comp/SimPackageOpt.hs @@ -138,6 +138,7 @@ inlineDefs pkg = isNotOk d | isUnsized (adef_type d) = True | (aSize d > 64) = True + | isTupleType (adef_type d) = True | isTaskOrForeignFunc d = True | isCase d = True | otherwise = False @@ -230,6 +231,10 @@ optimizeConcats pkg = -- recurse for other optConcat (APrim i t o as) = APrim i t o (map optConcat as) optConcat (AMethCall t o m as) = AMethCall t o m (map optConcat as) + -- XXX There is maybe an opportunity to optimize tuple construction here, + -- since that basically turns into a concat as well. + optConcat (ATuple t as) = ATuple t (map optConcat as) + optConcat (ATupleSel t e idx) = ATupleSel t (optConcat e) idx optConcat (AFunCall t i f isC as) = AFunCall t i f isC (map optConcat as) optConcat e = e in mapAExprs optConcat pkg @@ -316,9 +321,15 @@ convertASAny errh flags apkg = do cvtASAnyExpr (APrim aid ty op args) = do args' <- mapM cvtASAnyExpr args return $ APrim aid ty op args' - cvtASAnyExpr (AMethCall ty aid mid args) = + cvtASAnyExpr (AMethCall ty aid mid args) = do args' <- mapM cvtASAnyExpr args return $ AMethCall ty aid mid args' + cvtASAnyExpr (ATuple ty elems) = + do elems' <- mapM cvtASAnyExpr elems + return $ ATuple ty elems' + cvtASAnyExpr (ATupleSel ty exp idx) = + do exp' <- cvtASAnyExpr exp + return $ ATupleSel ty exp' idx cvtASAnyExpr (ANoInlineFunCall ty aid fun args) = do args' <- mapM cvtASAnyExpr args return $ ANoInlineFunCall ty aid fun args' diff --git a/src/comp/SystemCWrapper.hs b/src/comp/SystemCWrapper.hs index b7fd88344..860f83b42 100644 --- a/src/comp/SystemCWrapper.hs +++ b/src/comp/SystemCWrapper.hs @@ -8,7 +8,7 @@ import Pragma(isAlwaysRdy, isEnWhenRdy) import FileNameUtil(mkCxxName, mkHName) import ASyntax(AAbstractInput(..), AIFace(..), AExpr(..), AClock(..), - aIfaceArgs, aIfaceName, aIfaceProps) + aIfaceArgs, aif_name, aIfaceProps) import ASyntaxUtil import VModInfo(vName_to_id, VPathInfo(..)) import Wires @@ -38,7 +38,7 @@ checkSystemCIfc errh flags sim_system = do isBad m@(AIActionValue {}) = -- we allow ActionValue methods only -- if they have no arguments and no enable not ((null (aIfaceArgs m)) && - (isEnWhenRdy pps (aIfaceName m))) + (isEnWhenRdy pps (aif_name m))) isBad _ = False bad_methods = [ getIdBaseString (aif_name m) | m <- sp_interface top_pkg @@ -131,7 +131,7 @@ wrapSystemC flags sim_system = do mk_port_map_entry (mid, (en, ins, ri, act, _)) = let en_list = maybe [] (\vn -> [(1,vName_to_id vn,True,False)]) en in_list = [ (aSize t,i,True,False) | (t,i,_) <- ins ] - ret_list = maybe [] (\(t,vn) -> [(aSize t,vName_to_id vn,False,act)]) ri + ret_list = map (\(t,vn) -> (aSize t,vName_to_id vn,False,act)) ri ports = filter (\(n,_,_,_) -> n>0) (en_list ++ in_list ++ ret_list) always_rdy = (isRdyId mid) && (isAlwaysRdy pps mid) @@ -157,7 +157,7 @@ wrapSystemC flags sim_system = do ] -- utility functions for grouping methods by domain - meth_domains = M.fromList [ (aIfaceName aif, dom) + meth_domains = M.fromList [ (aif_name aif, dom) | aif <- (sp_interface top_pkg) , let wp = aIfaceProps aif , let dom = wpClockDomain wp diff --git a/src/comp/TCheck.hs b/src/comp/TCheck.hs index 036cfcf67..a423f9481 100644 --- a/src/comp/TCheck.hs +++ b/src/comp/TCheck.hs @@ -707,43 +707,42 @@ tiExpr as td exp@(CmoduleVerilog name ui clks rsts args fields sch ps) = do -- matches the types. let -- XXX These errors should give more info - chkResType :: [VPort] -> Maybe VPort -> Maybe VPort -> Type -> - TI ([VPort], Maybe VPort, Maybe VPort) - chkResType ps me@(Just _) mo@Nothing t = - if (isActionWithoutValue t) then return (ps, me, mo) + chkResType :: [VPort] -> Maybe VPort -> [VPort] -> Type -> + TI ([VPort], Maybe VPort, [VPort]) + chkResType ps me@(Just _) [] t = + if (isActionWithoutValue t) then return (ps, me, []) else if (isActionWithValue t) then errMissingValue "ActionValue" t - else if (isBit t) + else if (isBitTuple t) then errUnexpectedEnable "value" t else errBadResType t - chkResType ps me@Nothing mo@(Just _) t = - if (isBit t) then return (ps, me, mo) + chkResType ps me@Nothing outs@(_:_) t = + if (isBitTuple t) then return (ps, me, outs) else if (isActionWithValue t) then errMissingEnable "ActionValue" t else if (isActionWithoutValue t) then errUnexpectedValue "Action" t else errBadResType t - chkResType ps me@(Just _) mo@(Just _) t = - if (isActionWithValue t) then return (ps, me, mo) + chkResType ps me@(Just _) outs@(_:_) t = + if (isActionWithValue t) then return (ps, me, outs) else if (isActionWithoutValue t) then errUnexpectedValue "Action" t - else if (isBit t) + else if (isBitTuple t) then errUnexpectedEnable "value" t else errBadResType t - chkResType ps Nothing Nothing t = do - -- must have more than 0 ports - when (null ps) $ - err (getPosition f, - EForeignModTooFewPorts (pfpString f)) + chkResType ps Nothing [] t = do -- update the Classic fieldinfo to BSV format let inputs = initOrErr "chkResType" ps let final_port = lastOrErr "chkResType" ps -- XXX kill PrimAction once imports in Prelude are converted over if (isActionWithoutValue t) || (isPrimAction t) - then return (inputs, Just final_port, Nothing) - else if (isBit t) - then return (inputs, Nothing, Just final_port) - else errBadResType t + then return (inputs, Just final_port, []) + else if (isBitTuple t) + -- XXX should have multiple output ports for bit tuples here? + then return (inputs, Nothing, [final_port]) + else if (t == tPrimUnit) + then return (ps, Nothing, []) + else errBadResType t errBadResType t = err (getPosition f, @@ -805,9 +804,9 @@ tiExpr as td exp@(CmoduleVerilog name ui clks rsts args fields sch ps) = do else if (null argTypes) then return vfi else errInoutHasArgs - Method { vf_inputs = inputs, vf_enable = me, vf_output = mo } -> + Method { vf_inputs = inputs, vf_enable = me, vf_outputs = outputs } -> do -- updates inputs, me and mo when processing Classic format - (inputs', me', mo') <- chkResType inputs me mo resType + (inputs', me', outputs') <- chkResType inputs me outputs resType -- check if any actions are SB with themselves when (((isActionWithValue resType) || (isActionWithoutValue resType) || @@ -815,7 +814,7 @@ tiExpr as td exp@(CmoduleVerilog name ui clks rsts args fields sch ps) = do (f `elem` self_sbs)) (errActionSelfSB f) chkArgs inputs' argTypes - return (vfi { vf_inputs = inputs', vf_enable = me', vf_output = mo' }) + return (vfi { vf_inputs = inputs', vf_enable = me', vf_outputs = outputs' }) -- paramResults <- mapM tiParam es qsses <- mapM tiArg args -- let (pses, tys) = unzip paramResults @@ -899,7 +898,7 @@ tiExpr as td exp@(CForeignFuncC link_id wrap_cqt) = do when (isTypeString av_arg) $ err (getPosition pos, EForeignFuncStringRes) (ctxs, prim_sz) <- findBitSize av_arg - let prim_t = TAp tActionValue_ prim_sz + let prim_t = TAp tActionValue_ $ TAp tBit prim_sz return (ctxs, prim_t, cexpr) -- anything else must be bitifiable else do let cexpr = \e -> cVApply idUnpack [e] @@ -1521,7 +1520,7 @@ finishSWriteAV as td v f es paramResults eq_ps = let (pss, es') = unzip pses -- v <- newTVar "XXX" KNum f - let tav = TAp tActionValue_ v + let tav = TAp tActionValue_ (TAp tBit v) let taskty = foldr fn tav tys -- XXX: quantifying in IConv instead so free type vars are caught correctly @@ -1583,7 +1582,7 @@ taskCheckFOpen as td f [filen] = (vp,filentc) <- tiExpr as tString filen -- let avfile = (TAp (tActionValueAt (getPosition f)) tFile) - tav32 = TAp (tActionValue_At (getPosition f)) t32 + tav32 = TAp (tActionValue_At (getPosition f)) bit32 fty = tString `fn` tav32 applied = (CTaskApplyT f fty [filentc]) let t = cVApply (setIdPosition (getPosition f) idFromActionValue_) [applied] @@ -1599,7 +1598,7 @@ taskCheckFOpen as td f [filen,mode] = -- -- let avfile = (TAp (tActionValueAt (getPosition f)) tFile) - tav32 = TAp (tActionValue_At (getPosition f)) t32 + tav32 = TAp (tActionValue_At (getPosition f)) bit32 fty = tString `fn` tString `fn` tav32 applied = (CTaskApplyT f fty [filentc,modetc]) let t = cVApply (setIdPosition (getPosition f) idFromActionValue_) [applied] diff --git a/src/comp/TopUtils.hs b/src/comp/TopUtils.hs index 45e0f0498..7f7794af7 100644 --- a/src/comp/TopUtils.hs +++ b/src/comp/TopUtils.hs @@ -27,7 +27,7 @@ import IdPrint import ISyntax(IPackage(..), IModule(..), IStateVar(..), IRules(..)) import ASyntax(APackage(..), ASPackage(..), ARule(..), - aIfaceName) + aif_name) import SystemVerilogTokens(SV_Token(..)) import Version(bluespec, bscVersionStr) @@ -253,7 +253,7 @@ instance Stats APackage where (showLen (apkg_rules apkg) "rules" <> if v then text "" <+>pPrint PDReadable 0 [ i | ARule { arule_id = i } <- apkg_rules apkg ] else text "") $+$ (showLen (apkg_interface apkg) "interface methods" <> - if v then text "" <+> pPrint PDReadable 0 (map aIfaceName (apkg_interface apkg)) else text "") + if v then text "" <+> pPrint PDReadable 0 (map aif_name (apkg_interface apkg)) else text "") )) instance Stats ASPackage where diff --git a/src/comp/Type.hs b/src/comp/Type.hs index c8d598ce3..014a1fbce 100644 --- a/src/comp/Type.hs +++ b/src/comp/Type.hs @@ -61,13 +61,13 @@ tSizeOf = TCon (TyCon idSizeOf (Just (Kfun KStar KNum)) TIabstract) tAction, tActionValue, tActionValue_, tAction_:: Type tAction = TCon (TyCon idAction (Just KStar) (TItype 0 (TAp tActionValue tPrimUnit))) tActionValue = TCon (TyCon idActionValue (Just (Kfun KStar KStar)) (TIstruct SStruct [id__value, id__action])) -tActionValue_ = TCon (TyCon idActionValue_ (Just (Kfun KNum KStar)) (TIstruct SStruct [id__value, id__action])) -tAction_ = TAp tActionValue_ (tOfSize 0 noPosition) +tActionValue_ = TCon (TyCon idActionValue_ (Just (Kfun KStar KStar)) (TIstruct SStruct [id__value, id__action])) +tAction_ = TAp tActionValue_ tPrimUnit tActionAt, tActionValueAt, tActionValue_At :: Position -> Type tActionAt pos = TCon (TyCon (idActionAt pos) (Just KStar) (TItype 0 (TAp (tActionValueAt pos) (tPrimUnitAt pos)))) tActionValueAt pos = TCon (TyCon (idActionValueAt pos) (Just (Kfun KStar KStar)) (TIstruct SStruct [id__value_at pos, id__action_at pos])) -tActionValue_At pos = TCon (TyCon (idActionValue_At pos) (Just (Kfun KNum KStar)) (TIstruct SStruct [id__value_at pos, id__action_at pos])) +tActionValue_At pos = TCon (TyCon (idActionValue_At pos) (Just (Kfun KStar KStar)) (TIstruct SStruct [id__value_at pos, id__action_at pos])) tPrimAction, tRules :: Type tPrimAction = TCon (TyCon idPrimAction (Just KStar) TIabstract) @@ -163,13 +163,21 @@ getAVType :: Type -> Type getAVType (TAp av t) | av == tActionValue = t getAVType t = internalError("getAVType not ActionValue: " ++ ppReadable t) +-- Note that we consider ActionValue_ (Bit 0) to be an action without a value, +-- as this is still created by foreign verilog module imports. +-- XXX should rework this to just yield ActionValue_ () for empty types. isActionWithoutValue :: Type -> Bool -isActionWithoutValue (TAp av (TCon (TyNum 0 _))) = av == tActionValue_ +isActionWithoutValue (TAp av (TAp (TCon (TyCon i _ _)) (TCon (TyNum 0 _)))) = + av == tActionValue_ && i == idBit +isActionWithoutValue (TAp av (TCon (TyCon i _ _))) = + av == tActionValue_ && i == idPrimUnit isActionWithoutValue _ = False isActionWithValue :: Type -> Bool -isActionWithValue (TAp av (TCon (TyNum n _))) = (av == tActionValue_) && (n > 0) isActionWithValue (TAp av (TVar _)) = av == tActionValue_ +isActionWithValue (TAp av (TAp (TCon (TyCon i _ _)) (TCon (TyNum 0 _)))) + | av == tActionValue_ && i == idBit = False +isActionWithValue (TAp av t) = (av == tActionValue_) && isBitTuple t isActionWithValue _ = False isClock, isReset, isInout, isInout_ :: Type -> Bool @@ -199,4 +207,9 @@ isChar t = t == tChar isReal t = t == tReal isFmt t = t == tFmt +isBitTuple :: Type -> Bool +isBitTuple (TAp (TAp (TCon (TyCon i _ _)) t1) t2) | i == idPrimPair = + isBit t1 && isBitTuple t2 +isBitTuple t = isBit t + -- ------------------------- diff --git a/src/comp/VIOProps.hs b/src/comp/VIOProps.hs index f9c88fdc5..5d3302b2a 100644 --- a/src/comp/VIOProps.hs +++ b/src/comp/VIOProps.hs @@ -10,7 +10,7 @@ import Flags import PPrint import ErrorUtil(internalError) import Id -import PreIds(idPrimAction, idInout_) +import PreIds(idPrimAction, idInout_, idPrimUnit) import VModInfo(vArgs, vFields, VName(..), VeriPortProp(..), VArgInfo(..), VFieldInfo(..), VPort) import Prim @@ -151,9 +151,12 @@ getIOProps flags ppp@(ASPackage _ _ _ os is ios vs _ ds io_ds fs _ _ _) = -- create the method name map let nmap = M.fromList $ createVerilogNameMapForAVInst flags v, - -- for each method that has an output port - vfi@(Method { vf_output = Just (vname,pprops) }) - <- vFields (avi_vmi v), + -- for each method (not clocks or resets) + vfi@(Method {}) <- vFields (avi_vmi v), + -- for each method output port + (methpart, (vname, pprops)) + <- zip (map MethodResult [1..]) (vf_outputs vfi), + -- for each port copy ino <- if (vf_mult vfi > 1) then map Just [0 .. vf_mult vfi] @@ -162,7 +165,7 @@ getIOProps flags ppp@(ASPackage _ _ _ os is ios vs _ ds io_ds fs _ _ _) = let meth_id = mkMethId (avi_vname v) (vf_name vfi) ino - MethodResult, + methpart, -- convert to Verilog signal name let veri_id = xLateIdUsingFStringMap nmap meth_id ] @@ -194,7 +197,8 @@ getIOProps flags ppp@(ASPackage _ _ _ os is ios vs _ ds io_ds fs _ _ _) = -- return empty-list here; but the internal check -- is nice to have (if it's not too expensive). internalError ("getOVProp: could not find method " ++ - ppString i) + ppString i ++ " in wireMap_out:\n" ++ + ppReadable wireMap_out) -- ---------- -- construct the VeriPortProp list for an input @@ -400,5 +404,6 @@ size :: AType -> Integer size (ATBit n) = n size (ATAbstract a _) | a == idPrimAction = 1 size (ATAbstract a [n]) | a == idInout_ = n +size (ATAbstract a _) | a == idPrimUnit = 0 size (ATString _ ) = 0 size t = internalError ("getIOProps.size: " ++ show t) diff --git a/src/comp/VModInfo.hs b/src/comp/VModInfo.hs index 6964602a1..ab96eb1b9 100644 --- a/src/comp/VModInfo.hs +++ b/src/comp/VModInfo.hs @@ -23,7 +23,7 @@ module VModInfo(VModInfo, mkVModInfo, getIfcIdPosition, str_to_vPort,getVPortString, mkNamedEnable, - mkNamedOutput, + mkNamedOutputs, mkNamedReady, mkNamedInout, extractNames @@ -274,7 +274,7 @@ data VFieldInfo = Method { vf_name :: Id, -- method name -- optional because the method may be independent of a reset signal vf_mult :: Integer, -- multiplicity vf_inputs :: [VPort], - vf_output :: Maybe VPort, + vf_outputs:: [VPort], vf_enable :: Maybe VPort } | Clock { vf_name :: Id } -- output clock name -- connection information is in the ClockInfo @@ -300,11 +300,12 @@ instance NFData VFieldInfo where instance PPrint VFieldInfo where pPrint d p (Method n c r m i o e) = - text "method " <> pout o <> pPrint d p n <> pmult m <> + text "method " <> pouts o <> pPrint d p n <> pmult m <> pins i <> pena e <+> ppMClk d c <+> ppMRst d r <> text ";" - where pout Nothing = empty - pout (Just po) = pPrint d p po + where pouts [] = empty + pouts [po] = pPrint d p po + pouts o = text "(" <> sepList (map (pPrint d p) o) (text ",") <> text ")" pmult 1 = empty pmult n = text "[" <> pPrint d p n <> text "]" pins [] = empty @@ -685,17 +686,16 @@ mkNamedEnable vfi = if (newStr == "") then baseid else setIdBaseString baseid ne where baseid = mkEnableId (vf_name vfi) newStr = maybe "" getVPortString (vf_enable vfi) -mkNamedOutput :: VFieldInfo -> Id -mkNamedOutput vfi = if (newStr == "") then baseid else setIdBaseString baseid newStr +mkNamedOutputs :: VFieldInfo -> [Id] +mkNamedOutputs vfi = map (setIdBaseString baseid) newStrs where baseid = (vf_name vfi) - newStr = maybe "" getVPortString (vf_output vfi) + newStrs = map getVPortString (vf_outputs vfi) -- VFieldInfo does not have a ready field, so we just use the default construction for the ready signal. -- in aState we merge method and RDY_method to do the right thing. mkNamedReady :: VFieldInfo -> Id mkNamedReady vfi = baseid -- if (newStr == "") then baseid else setIdBaseString baseid newStr where baseid = mkRdyId (vf_name vfi) - -- newStr = maybe "" getVPortString (vf_output vfi) mkNamedInout :: VFieldInfo -> Id mkNamedInout vfi = setIdBaseString baseid newStr @@ -705,8 +705,8 @@ mkNamedInout vfi = setIdBaseString baseid newStr --------------------------- Name extraction from VFieldInfo -- extract possible port Ids from a VField Info -- return value is result, ready, enable -extractNames :: VFieldInfo -> (Id, Id, Id ) +extractNames :: VFieldInfo -> ([Id], Id, Id ) extractNames vfi = (result, ready, enable) - where result = mkNamedOutput vfi + where result = mkNamedOutputs vfi ready = mkNamedReady vfi enable = mkNamedEnable vfi diff --git a/src/comp/bluetcl.hs b/src/comp/bluetcl.hs index 3edca23b7..dccab85fb 100644 --- a/src/comp/bluetcl.hs +++ b/src/comp/bluetcl.hs @@ -1118,7 +1118,7 @@ tclModule ["methods",modname] = do let apkg = abemi_apkg abmi pps = abemi_pps abmi ifc = apkg_interface apkg - ifc_map = [ (aIfaceName aif, rawIfcFieldFromAIFace pps aif) + ifc_map = [ (aif_name aif, rawIfcFieldFromAIFace pps aif) | aif <- ifc ] let tifc = getModuleIfc abmi fs <- getIfcHierarchy Nothing ifc_map tifc @@ -1639,7 +1639,7 @@ tclRule ["full",modname,rule] = Nothing -> Nothing Just (ARule i ps _ _ rPred _ _ _) -> Just (ps, getPosition i, aAnds [ifPred, rPred]) - cvtIfc (AIDef _ _ _ ifPred (ADef dId _ _ _) _ _) = + cvtIfc (AIDef dId _ _ ifPred _ _ _) = if (dId == rId) then Just ([], getPosition dId, ifPred) else Nothing @@ -1960,7 +1960,7 @@ instance ExpandInfoHelper BModView where -- flattened ifc names let ifc_names = map pfpString $ filter (not . isRdyId) $ - map (aIfaceName) (apkg_interface apkg) + map (aif_name) (apkg_interface apkg) -- rules let rule_names = map (pfpString . arule_id) (apkg_rules apkg) -- schedule @@ -3274,7 +3274,7 @@ data RawIfcField = (Maybe Id) (Maybe Id) -- associated clk and rst [(Maybe Id, AType)] -- arguments [VPort] -- argument ports - (Maybe (VPort, AType)) -- return value + [(VPort, AType)] -- return values (Maybe VPort) -- enable signal -- Note: no ready signal at this stage | RawClock Id @@ -3292,26 +3292,32 @@ rawIfcFieldName (RawInout i _ _ _ _) = i rawIfcFieldFromAIFace :: [PProp] -> AIFace -> RawIfcField rawIfcFieldFromAIFace _ (AIDef i args _ _ def - (Method _ clk rst mult ins mo@(Just out) Nothing) _) = - let -- include the type in the "mo" - mo' = Just (out, adef_type def) - in RawMethod i mult clk rst (mapFst Just args) ins mo' Nothing + (Method _ clk rst mult ins outs Nothing) _) = + let -- include the type in the "outs" + outs' = zip outs $ + case adef_type def of + ATTuple ts -> ts + t -> [t] + in RawMethod i mult clk rst (mapFst Just args) ins outs' Nothing rawIfcFieldFromAIFace pps (AIAction args _ _ i _ - (Method _ clk rst mult ins Nothing me@(Just _))) = + (Method _ clk rst mult ins [] me@(Just _))) = let -- filter out inhigh enable ports -- XXX is there a better way to do this? me' = if (isAlwaysEn pps i) then Nothing else me - in RawMethod i mult clk rst (mapFst Just args) ins Nothing me' + in RawMethod i mult clk rst (mapFst Just args) ins [] me' rawIfcFieldFromAIFace pps (AIActionValue args _ _ i _ def - (Method _ clk rst mult ins mo@(Just out) me@(Just _))) = + (Method _ clk rst mult ins outs me@(Just _))) = let -- filter out inhigh enable ports -- XXX is there a better way to do this? me' = if (isAlwaysEn pps i) then Nothing else me - -- include the type in the "mo" - mo' = Just (out, adef_type def) - in RawMethod i mult clk rst (mapFst Just args) ins mo' me' + -- include the type in the "outs" + outs' = zip outs $ + case adef_type def of + ATTuple ts -> ts + t -> [t] + in RawMethod i mult clk rst (mapFst Just args) ins outs' me' rawIfcFieldFromAIFace _ (AIClock i _ (Clock _)) = RawClock i rawIfcFieldFromAIFace _ (AIReset i _ (Reset _)) = RawReset i rawIfcFieldFromAIFace _ (AIInout i (AInout e) (Inout _ vn mclk mrst)) = @@ -3320,23 +3326,20 @@ rawIfcFieldFromAIFace _ aif = internalError ("rawIfcFieldFromAIFace: unexpected AIFace combo: " ++ ppReadable aif) -rawIfcFieldFromAVInst :: ([AType], Maybe AType, Maybe AType) -> +rawIfcFieldFromAVInst :: ([AType], Maybe AType, [AType]) -> VFieldInfo -> RawIfcField -rawIfcFieldFromAVInst (arg_tys,_,mo_type) (Method i clk rst mult ins mo me) = +rawIfcFieldFromAVInst (arg_tys,_,out_tys) (Method i clk rst mult ins outs me) = let -- XXX AVInst doesn't record argument names args = zip (repeat Nothing) arg_tys - -- add the return bit-type to the mo - mo' = case (mo, mo_type) of - (Just o, Just o_type) -> Just (o, o_type) - (Nothing, Nothing) -> Nothing - _ -> internalError ("rawIfcFieldFromAVInst: unexpected mo: " ++ - ppReadable (mo, mo_type)) - in RawMethod i mult clk rst args ins mo' me + -- add the return bit-type to the outs + outs' = zip outs out_tys + in RawMethod i mult clk rst args ins outs' me rawIfcFieldFromAVInst _ (Clock i) = RawClock i rawIfcFieldFromAVInst _ (Reset i) = RawReset i -rawIfcFieldFromAVInst (_,_,mt) (Inout i vn mclk mrst) = - let t = fromJustOrErr ("getIfc: no type for Inout") mt - in RawInout i t vn mclk mrst +rawIfcFieldFromAVInst (_,_,[t]) (Inout i vn mclk mrst) = RawInout i t vn mclk mrst +rawIfcFieldFromAVInst _ vfi = + internalError ("rawIfcFieldFromAVInst: unexpected VFieldInfo: " ++ + ppReadable vfi) -- --------------- @@ -3486,7 +3489,7 @@ data PortIfcInfo = PIMethod Id Id (Maybe Id) (Maybe Id) -- associated clk and rst [(Maybe Id, AType, (String, IType))] -- arguments - (Maybe (String, AType, IType)) -- return value + [(String, AType, IType)] -- return values (Maybe (String, IType)) -- enable signal (Maybe (String, IType)) -- ready signal | PIClock Id Id (Maybe ((String, IType), Maybe (String, IType))) @@ -3519,7 +3522,7 @@ getModPortInfo apkg pps tifc = do -- interface hierarchy let -- map from flattened ifc name to its raw info - ifc_map = [ (aIfaceName aif, rawIfcFieldFromAIFace pps aif) + ifc_map = [ (aif_name aif, rawIfcFieldFromAIFace pps aif) | aif <- ifc ] ifc_hier <- getIfcHierarchy Nothing ifc_map tifc @@ -3633,8 +3636,8 @@ getSubmodPortInfo mtifc avi = do concatMap getIfcHier ifc_hier) adjustPrimFields :: Maybe Type -> AVInst -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) + ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustPrimFields Nothing _ vfts = vfts adjustPrimFields (Just tifc) avi vfts = if (leftCon tifc == Just idReg) @@ -3678,8 +3681,8 @@ adjustPrimFields (Just tifc) avi vfts = else vfts -- This is a no-op but it does add some error checking -adjustRegAlignedFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRegAlignedFields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustRegAlignedFields (vfi, fts) = let renameField vf@(Method {vf_name = i }) | (i `qualEq` id_read noPosition) = vf @@ -3689,8 +3692,8 @@ adjustRegAlignedFields (vfi, fts) = in (map renameField vfi, fts) -adjustRegFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRegFields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustRegFields (vfi, fts) = let renameField vf@(Method {vf_name = i }) | (i `qualEq` idPreludeRead) = vf { vf_name = id_read noPosition } @@ -3699,8 +3702,8 @@ adjustRegFields (vfi, fts) = ppReadable (vf_name vf)) in (map renameField vfi, fts) -adjustFIFOFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustFIFOFields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustFIFOFields (vfi, fts) = let enq_rdy = mkRdyId idEnq deq_rdy = mkRdyId idDeq @@ -3712,8 +3715,8 @@ adjustFIFOFields (vfi, fts) = renameField vft = [vft] in unzip $ concatMap renameField $ zip vfi fts -adjustFIFO0Fields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustFIFO0Fields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustFIFO0Fields (vfi, fts) = let (clk, rst) = case vfi of @@ -3721,12 +3724,12 @@ adjustFIFO0Fields (vfi, fts) = (_:d@(Method _ c r _ _ _ _):_) -> (c, r) _ -> internalError ("adjustFIFO0Fields: vfi = " ++ ppReadable vfi) - first_vfi = Method idFirst clk rst 1 [] Nothing Nothing - first_fts = ([], Nothing, Nothing) + first_vfi = Method idFirst clk rst 1 [] [] Nothing + first_fts = ([], Nothing, []) in (first_vfi:vfi, first_fts:fts) -adjustSyncRegFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustSyncRegFields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustSyncRegFields (vfi, fts) = let renameField vf@(Method {vf_name = i }) -- XXX these are qualified Clock, not Prelude @@ -3738,28 +3741,28 @@ adjustSyncRegFields (vfi, fts) = ppReadable (vf_name vf)) in (map renameField vfi, fts) -adjustRWireFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRWireFields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustRWireFields (vfi, fts) = let renameField vf@(Method {vf_name = i }) | (i `qualEq` idWHas) = vf { vf_name = unQualId $ mkRdyId idWGet } renameField vf = vf in (map renameField vfi, fts) -adjustRWire0Fields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustRWire0Fields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustRWire0Fields (vfi, fts) = let (clk, rst) = case vfi of ((Method _ c r _ _ _ _):_) -> (c, r) _ -> internalError ("adjustRWire0Fields: vfi = " ++ ppReadable vfi) - wget_vfi = Method (unQualId idWGet) clk rst 1 [] Nothing Nothing - wget_fts = ([], Nothing, Nothing) + wget_vfi = Method (unQualId idWGet) clk rst 1 [] [] Nothing + wget_fts = ([], Nothing, []) in (wget_vfi:vfi, wget_fts:fts) -adjustWireFields :: ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) +adjustWireFields :: ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustWireFields (vfi, fts) = let readId = id_read noPosition writeId = id_write noPosition @@ -3772,8 +3775,8 @@ adjustWireFields (vfi, fts) = in (map renameField vfi, fts) adjustPulseWireFields :: - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) + ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustPulseWireFields (vfi, fts) = let renameField vf@(Method {vf_name = i }) | (i `qualEq` idWSet) = vf { vf_name = unQualId idSend } @@ -3784,8 +3787,8 @@ adjustPulseWireFields (vfi, fts) = in (map renameField vfi, fts) adjustBypassWireFields :: - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) -> - ([VFieldInfo], [([AType], Maybe AType, Maybe AType)]) + ([VFieldInfo], [([AType], Maybe AType, [AType])]) -> + ([VFieldInfo], [([AType], Maybe AType, [AType])]) adjustBypassWireFields (vfi, fts) = let renameField vf@(Method {vf_name = i }) | (i `qualEq` idWGet) = vf { vf_name = id_read noPosition } @@ -3873,19 +3876,19 @@ getPortsIfc ptmap out_clkinfo out_rstinfo (SubIfc fId fs) = then [] else [PISubIfc fId fs'] getPortsIfc ptmap _ _ - (Field fId (RawMethod i mult mclk mrst args ins mo me) mrdy_inf) = - getPortsIfcMethod ptmap fId i mult mclk mrst args ins mo me mr + (Field fId (RawMethod i mult mclk mrst args ins outs me) mrdy_inf) = + getPortsIfcMethod ptmap fId i mult mclk mrst args ins outs me mr where mr = case (mrdy_inf) of Nothing -> Nothing - (Just (RawMethod ri m _ _ [] [] (Just (vp@(vn,_), t)) Nothing)) + (Just (RawMethod ri m _ _ [] [] [(vp@(vn,_), t)] Nothing)) | ((m == 0) || (m == 1)) -> if (t == aTBool) then Just vp else internalError ("getPortsIfc: Rdy wrong size: " ++ ppReadable (ri,t)) - (Just (RawMethod ri m _ _ as is mout men)) -> + (Just (RawMethod ri m _ _ as is os men)) -> internalError ("getPortsIfc: not Rdy: " ++ - ppReadable (ri, m, as, is, mout, men)) + ppReadable (ri, m, as, is, os, men)) (Just d) -> internalError ("getPortsIfc: not Rdy: " ++ ppReadable (rawIfcFieldName d)) getPortsIfc _ out_clkinfo _ (Field fId (RawClock i) Nothing) = @@ -3902,10 +3905,10 @@ getPortsIfc _ _ _ (Field fId rf (Just rdy_rf)) = getPortsIfcMethod :: M.Map VName IType -> Id -> Id -> Integer -> Maybe Id -> Maybe Id -> - [(Maybe Id, AType)] -> [VPort] -> Maybe (VPort, AType) -> + [(Maybe Id, AType)] -> [VPort] -> [(VPort, AType)] -> Maybe VPort -> Maybe VPort -> [PortIfcInfo] -getPortsIfcMethod ptmap fId methId mult mClk mRst args ins mOut mEn mRdy = +getPortsIfcMethod ptmap fId methId mult mClk mRst args ins outs mEn mRdy = let -- get the port-type pair for an argument getPortsArg (mi, bit_type) (vn, _) = @@ -3913,8 +3916,7 @@ getPortsIfcMethod ptmap fId methId mult mClk mRst args ins mOut mEn mRdy = then [] else [(mi, bit_type, getVNameType ptmap vn)] -- get the port-type pair for the output - getPortsOut Nothing = Nothing - getPortsOut (Just ((vn, _), bit_type)) = + getPortsOut ((vn, _), bit_type) = if (isSizeZero bit_type) then Nothing else @@ -3937,7 +3939,7 @@ getPortsIfcMethod ptmap fId methId mult mClk mRst args ins mOut mEn mRdy = -- the default result (multiplicity of 1) def_res = PIMethod fId methId mClk mRst (concat (zipWith getPortsArg args ins)) - (getPortsOut mOut) (getPortsEn mEn) (getPortsRdy mRdy) + (mapMaybe getPortsOut outs) (getPortsEn mEn) (getPortsRdy mRdy) -- the result if multiplicity > 1 mkMulRes n = @@ -3946,7 +3948,7 @@ getPortsIfcMethod ptmap fId methId mult mClk mRst args ins mOut mEn mRdy = in PIMethod (dupId s fId) -- XXX handle mults differently? (dupId s methId) mClk mRst (concat (zipWith getPortsArg args ins')) - (getPortsOut (dupMVPortType s mOut)) + (mapMaybe (getPortsOut . dupMVPortType s) outs) (getPortsEn (dupMVPort s mEn)) (getPortsRdy (dupMVPort s mRdy)) @@ -3955,9 +3957,8 @@ getPortsIfcMethod ptmap fId methId mult mClk mRst args ins mOut mEn mRdy = dupVPort suf (vn, ps) = (dupVName suf vn, ps) dupMVPort :: String -> Maybe VPort -> Maybe VPort dupMVPort suf mvp = mvp >>= Just . dupVPort suf - dupMVPortType :: String -> Maybe (VPort, AType) -> Maybe (VPort, AType) - dupMVPortType suf mvpt = - mvpt >>= (\ (vp, t) -> Just (dupVPort suf vp, t) ) + dupMVPortType :: String -> (VPort, AType) -> (VPort, AType) + dupMVPortType suf (vp, t) = (dupVPort suf vp, t) in if (mult == 1) || (mult == 0) then [def_res] @@ -4020,13 +4021,6 @@ dispMPortWithType s mport = Nothing -> [] Just (p, _) -> [tagStr s p] -dispMPortWithTypes :: String -> Maybe (String, AType, IType) -> [HTclObj] -dispMPortWithTypes s mport = - case mport of - Nothing -> [] - Just (p, _, _) -> -- XXX we have the opportunity to display the size - [tagStr s p] - -- display AType dispSize :: AType -> [HTclObj] dispSize (ATBit sz) = [tagInt "size" (fromInteger sz)] @@ -4076,16 +4070,23 @@ dispMethodArgs as = dispSize bit_type in TLst (map dispArg as) +dispMethodResults :: [(String, AType, IType)] -> HTclObj +dispMethodResults outs = + let dispOut (port, bit_type, _) = + TLst $ [tagStr "port" port] ++ + dispSize bit_type + in TLst (map dispOut outs) + dispIfc :: PortIfcInfo -> HTclObj -dispIfc (PIMethod fId i mClk mRst ins mOut mEn mRdy) = +dispIfc (PIMethod fId i mClk mRst ins outs mEn mRdy) = TLst $ [TStr "method", TStr (getIdBaseString fId), TStr (pfpString i), dispClockedBy mClk, dispResetBy mRst, - tag "args" [dispMethodArgs ins]] ++ - dispMPortWithTypes "result" mOut ++ + tag "args" [dispMethodArgs ins], + tag "results" [dispMethodResults outs]] ++ dispMPortWithType "enable" mEn ++ dispMPortWithType "ready" mRdy dispIfc (PIClock fId i Nothing) = @@ -4115,6 +4116,9 @@ dispIfc (PISubIfc fId fs) = dispPortType :: (String, IType) -> HTclObj dispPortType (p,t) = TLst [TStr p, TStr (pfpString t)] +dispPortTypes :: (String, AType, IType) -> HTclObj +dispPortTypes (p,at,t) = dispPortType (p,t) + dispMPortType :: Maybe (String, IType) -> [HTclObj] dispMPortType Nothing = [] dispMPortType (Just pt) = [dispPortType pt] @@ -4135,9 +4139,10 @@ dispPortsModArg (PAInout _ _ pt _ _) = [dispPortType pt] dispPortsIfc :: PortIfcInfo -> [HTclObj] -dispPortsIfc (PIMethod _ _ _ _ ins mOut mEn mRdy) = +dispPortsIfc (PIMethod _ _ _ _ ins outs mEn mRdy) = (map (dispPortType . thd) ins) ++ - dispMPortTypes mOut ++ dispMPortType mEn ++ dispMPortType mRdy + (map dispPortTypes outs) ++ + dispMPortType mEn ++ dispMPortType mRdy dispPortsIfc (PIClock _ _ Nothing) = [] dispPortsIfc (PIClock _ _ (Just (osc, mgate))) = [dispPortType osc] ++ dispMPortType mgate @@ -4208,7 +4213,7 @@ get_method_to_signal_map vmod = do case f of Method {} -> return () _ -> mzero -- failure, as in the guard function - port <- (vf_inputs f) ++ (maybeToList $ vf_output f) ++ (maybeToList $ vf_enable f) + port <- (vf_inputs f) ++ (vf_outputs f) ++ (maybeToList $ vf_enable f) count <- case (vf_mult f) of 1 -> return Nothing k -> map Just [1..k] diff --git a/src/comp/showrules.hs b/src/comp/showrules.hs index fbb92ebb7..531d94410 100644 --- a/src/comp/showrules.hs +++ b/src/comp/showrules.hs @@ -455,7 +455,7 @@ mkMorphState opts instmap hiermap abmis_by_name top_mod = let methmap = M.fromList [ ((inst,name),rules) | (inst,abmi) <- user_modules , aif <- apkg_interface (abmi_apkg abmi) - , let name = aIfaceName aif + , let name = aif_name aif , let rules = aIfaceRules aif , not (null rules) ] diff --git a/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-bh-out.expected index b572a8ea5..784ac49b5 100644 --- a/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-bh-out.expected @@ -115,19 +115,19 @@ ios1_1 {Prelude.Inout Test.Bar} ---------- module ports mkT Command: module ports mkT -interface {{interface r {{method _write r__write {clock default_clock} {reset no_reset} {args {{{name r__write_1} {port r__write_1} {size 1}}}} {enable EN_r__write} {ready RDY_r__write}} {method _read r__read {clock no_clock} {reset no_reset} {args {}} {result r__read} {ready RDY_r__read}}}} {inout b b {port b} {clock default_clock} {reset default_reset}}} +interface {{interface r {{method _write r__write {clock default_clock} {reset no_reset} {args {{{name r__write_1} {port r__write_1} {size 1}}}} {results {}} {enable EN_r__write} {ready RDY_r__write}} {method _read r__read {clock no_clock} {reset no_reset} {args {}} {results {{{port r__read} {size 1}}}} {ready RDY_r__read}}}} {inout b b {port b} {clock default_clock} {reset default_reset}}} args {{inout i {port i} {clock default_clock} {reset default_reset} {size 2}} {clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}} --------- module ports mkM Command: module ports mkM -interface {{method _write _write {clock default_clock} {reset default_reset} {args {{{name _write_1} {port _write_1} {size 1}}}} {enable EN__write} {ready RDY__write}} {method _read _read {clock default_clock} {reset default_reset} {args {}} {result _read} {ready RDY__read}}} +interface {{method _write _write {clock default_clock} {reset default_reset} {args {{{name _write_1} {port _write_1} {size 1}}}} {results {}} {enable EN__write} {ready RDY__write}} {method _read _read {clock default_clock} {reset default_reset} {args {}} {results {{{port _read} {size 1}}}} {ready RDY__read}}} args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}} --------- module ports mkIfcWithVec Command: module ports mkIfcWithVec -interface {{interface vec1 {{interface 0 {{method _write vec1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec1_0__write_1} {port vec1_0__write_1} {size 1}}}} {enable EN_vec1_0__write} {ready RDY_vec1_0__write}} {method _read vec1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec1_0__read} {ready RDY_vec1_0__read}}}} {interface 1 {{method _write vec1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec1_1__write_1} {port vec1_1__write_1} {size 1}}}} {enable EN_vec1_1__write} {ready RDY_vec1_1__write}} {method _read vec1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec1_1__read} {ready RDY_vec1_1__read}}}}}} {interface vec2 {{interface 0 {{interface 0 {{method _write vec2_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_0__write_1} {port vec2_0_0__write_1} {size 1}}}} {enable EN_vec2_0_0__write} {ready RDY_vec2_0_0__write}} {method _read vec2_0_0__read {clock no_clock} {reset no_reset} {args {}} {result vec2_0_0__read} {ready RDY_vec2_0_0__read}}}} {interface 1 {{method _write vec2_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_1__write_1} {port vec2_0_1__write_1} {size 1}}}} {enable EN_vec2_0_1__write} {ready RDY_vec2_0_1__write}} {method _read vec2_0_1__read {clock no_clock} {reset no_reset} {args {}} {result vec2_0_1__read} {ready RDY_vec2_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec2_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_0__write_1} {port vec2_1_0__write_1} {size 1}}}} {enable EN_vec2_1_0__write} {ready RDY_vec2_1_0__write}} {method _read vec2_1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec2_1_0__read} {ready RDY_vec2_1_0__read}}}} {interface 1 {{method _write vec2_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_1__write_1} {port vec2_1_1__write_1} {size 1}}}} {enable EN_vec2_1_1__write} {ready RDY_vec2_1_1__write}} {method _read vec2_1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec2_1_1__read} {ready RDY_vec2_1_1__read}}}}}}}} {interface vec3 {{interface 0 {{interface 0 {{interface 0 {{method _write vec3_0_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_0__write_1} {port vec3_0_0_0__write_1} {size 1}}}} {enable EN_vec3_0_0_0__write} {ready RDY_vec3_0_0_0__write}} {method _read vec3_0_0_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_0_0__read} {ready RDY_vec3_0_0_0__read}}}} {interface 1 {{method _write vec3_0_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_1__write_1} {port vec3_0_0_1__write_1} {size 1}}}} {enable EN_vec3_0_0_1__write} {ready RDY_vec3_0_0_1__write}} {method _read vec3_0_0_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_0_1__read} {ready RDY_vec3_0_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_0_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_0__write_1} {port vec3_0_1_0__write_1} {size 1}}}} {enable EN_vec3_0_1_0__write} {ready RDY_vec3_0_1_0__write}} {method _read vec3_0_1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_1_0__read} {ready RDY_vec3_0_1_0__read}}}} {interface 1 {{method _write vec3_0_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_1__write_1} {port vec3_0_1_1__write_1} {size 1}}}} {enable EN_vec3_0_1_1__write} {ready RDY_vec3_0_1_1__write}} {method _read vec3_0_1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_1_1__read} {ready RDY_vec3_0_1_1__read}}}}}}}} {interface 1 {{interface 0 {{interface 0 {{method _write vec3_1_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_0__write_1} {port vec3_1_0_0__write_1} {size 1}}}} {enable EN_vec3_1_0_0__write} {ready RDY_vec3_1_0_0__write}} {method _read vec3_1_0_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_0_0__read} {ready RDY_vec3_1_0_0__read}}}} {interface 1 {{method _write vec3_1_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_1__write_1} {port vec3_1_0_1__write_1} {size 1}}}} {enable EN_vec3_1_0_1__write} {ready RDY_vec3_1_0_1__write}} {method _read vec3_1_0_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_0_1__read} {ready RDY_vec3_1_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_1_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_0__write_1} {port vec3_1_1_0__write_1} {size 1}}}} {enable EN_vec3_1_1_0__write} {ready RDY_vec3_1_1_0__write}} {method _read vec3_1_1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_1_0__read} {ready RDY_vec3_1_1_0__read}}}} {interface 1 {{method _write vec3_1_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_1__write_1} {port vec3_1_1_1__write_1} {size 1}}}} {enable EN_vec3_1_1_1__write} {ready RDY_vec3_1_1_1__write}} {method _read vec3_1_1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_1_1__read} {ready RDY_vec3_1_1_1__read}}}}}}}}}} {method data1 data1 {clock no_clock} {reset no_reset} {args {}} {result data1} {ready RDY_data1}} {method data2 data2 {clock no_clock} {reset no_reset} {args {}} {result data2} {ready RDY_data2}} {method data3 data3 {clock no_clock} {reset no_reset} {args {}} {result data3} {ready RDY_data3}} {interface clks1 {{interface 0 {{clock {} clks1_0 {osc CLK_clks1_0} {gate CLK_GATE_clks1_0}}}} {interface 1 {{clock {} clks1_1 {osc CLK_clks1_1} {gate CLK_GATE_clks1_1}}}}}} {interface rsts1 {{interface 0 {{reset {} rsts1_0 {port RST_N_rsts1_0} {clock default_clock}}}} {interface 1 {{reset {} rsts1_1 {port RST_N_rsts1_1} {clock default_clock}}}}}} {interface ios1 {{interface 0 {{inout {} ios1_0 {port ios1_0} {clock clks1_1} {reset rsts1_1}}}} {interface 1 {{inout {} ios1_1 {port ios1_1} {clock clks1_1} {reset rsts1_1}}}}}}} +interface {{interface vec1 {{interface 0 {{method _write vec1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec1_0__write_1} {port vec1_0__write_1} {size 1}}}} {results {}} {enable EN_vec1_0__write} {ready RDY_vec1_0__write}} {method _read vec1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec1_0__read} {size 1}}}} {ready RDY_vec1_0__read}}}} {interface 1 {{method _write vec1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec1_1__write_1} {port vec1_1__write_1} {size 1}}}} {results {}} {enable EN_vec1_1__write} {ready RDY_vec1_1__write}} {method _read vec1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec1_1__read} {size 1}}}} {ready RDY_vec1_1__read}}}}}} {interface vec2 {{interface 0 {{interface 0 {{method _write vec2_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_0__write_1} {port vec2_0_0__write_1} {size 1}}}} {results {}} {enable EN_vec2_0_0__write} {ready RDY_vec2_0_0__write}} {method _read vec2_0_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_0_0__read} {size 1}}}} {ready RDY_vec2_0_0__read}}}} {interface 1 {{method _write vec2_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_1__write_1} {port vec2_0_1__write_1} {size 1}}}} {results {}} {enable EN_vec2_0_1__write} {ready RDY_vec2_0_1__write}} {method _read vec2_0_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_0_1__read} {size 1}}}} {ready RDY_vec2_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec2_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_0__write_1} {port vec2_1_0__write_1} {size 1}}}} {results {}} {enable EN_vec2_1_0__write} {ready RDY_vec2_1_0__write}} {method _read vec2_1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_1_0__read} {size 1}}}} {ready RDY_vec2_1_0__read}}}} {interface 1 {{method _write vec2_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_1__write_1} {port vec2_1_1__write_1} {size 1}}}} {results {}} {enable EN_vec2_1_1__write} {ready RDY_vec2_1_1__write}} {method _read vec2_1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_1_1__read} {size 1}}}} {ready RDY_vec2_1_1__read}}}}}}}} {interface vec3 {{interface 0 {{interface 0 {{interface 0 {{method _write vec3_0_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_0__write_1} {port vec3_0_0_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_0_0__write} {ready RDY_vec3_0_0_0__write}} {method _read vec3_0_0_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_0_0__read} {size 1}}}} {ready RDY_vec3_0_0_0__read}}}} {interface 1 {{method _write vec3_0_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_1__write_1} {port vec3_0_0_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_0_1__write} {ready RDY_vec3_0_0_1__write}} {method _read vec3_0_0_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_0_1__read} {size 1}}}} {ready RDY_vec3_0_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_0_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_0__write_1} {port vec3_0_1_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_1_0__write} {ready RDY_vec3_0_1_0__write}} {method _read vec3_0_1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_1_0__read} {size 1}}}} {ready RDY_vec3_0_1_0__read}}}} {interface 1 {{method _write vec3_0_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_1__write_1} {port vec3_0_1_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_1_1__write} {ready RDY_vec3_0_1_1__write}} {method _read vec3_0_1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_1_1__read} {size 1}}}} {ready RDY_vec3_0_1_1__read}}}}}}}} {interface 1 {{interface 0 {{interface 0 {{method _write vec3_1_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_0__write_1} {port vec3_1_0_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_0_0__write} {ready RDY_vec3_1_0_0__write}} {method _read vec3_1_0_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_0_0__read} {size 1}}}} {ready RDY_vec3_1_0_0__read}}}} {interface 1 {{method _write vec3_1_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_1__write_1} {port vec3_1_0_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_0_1__write} {ready RDY_vec3_1_0_1__write}} {method _read vec3_1_0_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_0_1__read} {size 1}}}} {ready RDY_vec3_1_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_1_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_0__write_1} {port vec3_1_1_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_1_0__write} {ready RDY_vec3_1_1_0__write}} {method _read vec3_1_1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_1_0__read} {size 1}}}} {ready RDY_vec3_1_1_0__read}}}} {interface 1 {{method _write vec3_1_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_1__write_1} {port vec3_1_1_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_1_1__write} {ready RDY_vec3_1_1_1__write}} {method _read vec3_1_1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_1_1__read} {size 1}}}} {ready RDY_vec3_1_1_1__read}}}}}}}}}} {method data1 data1 {clock no_clock} {reset no_reset} {args {}} {results {{{port data1} {size 2}}}} {ready RDY_data1}} {method data2 data2 {clock no_clock} {reset no_reset} {args {}} {results {{{port data2} {size 4}}}} {ready RDY_data2}} {method data3 data3 {clock no_clock} {reset no_reset} {args {}} {results {{{port data3} {size 8}}}} {ready RDY_data3}} {interface clks1 {{interface 0 {{clock {} clks1_0 {osc CLK_clks1_0} {gate CLK_GATE_clks1_0}}}} {interface 1 {{clock {} clks1_1 {osc CLK_clks1_1} {gate CLK_GATE_clks1_1}}}}}} {interface rsts1 {{interface 0 {{reset {} rsts1_0 {port RST_N_rsts1_0} {clock default_clock}}}} {interface 1 {{reset {} rsts1_1 {port RST_N_rsts1_1} {clock default_clock}}}}}} {interface ios1 {{interface 0 {{inout {} ios1_0 {port ios1_0} {clock clks1_1} {reset rsts1_1}}}} {interface 1 {{inout {} ios1_1 {port ios1_1} {clock clks1_1} {reset rsts1_1}}}}}}} args {{inout io {port io} {clock default_clock} {reset default_reset} {size 2}} {clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}} --------- ---------- diff --git a/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-out.expected index d02606a21..32af9b611 100644 --- a/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/commands/module.tcl.bluetcl-out.expected @@ -115,19 +115,19 @@ ios1_1 Inout#(Test::Bar) ---------- module ports mkT Command: module ports mkT -interface {{interface r {{method _write r__write {clock default_clock} {reset no_reset} {args {{{name r__write_1} {port r__write_1} {size 1}}}} {enable EN_r__write} {ready RDY_r__write}} {method _read r__read {clock no_clock} {reset no_reset} {args {}} {result r__read} {ready RDY_r__read}}}} {inout b b {port b} {clock default_clock} {reset default_reset}}} +interface {{interface r {{method _write r__write {clock default_clock} {reset no_reset} {args {{{name r__write_1} {port r__write_1} {size 1}}}} {results {}} {enable EN_r__write} {ready RDY_r__write}} {method _read r__read {clock no_clock} {reset no_reset} {args {}} {results {{{port r__read} {size 1}}}} {ready RDY_r__read}}}} {inout b b {port b} {clock default_clock} {reset default_reset}}} args {{inout i {port i} {clock default_clock} {reset default_reset} {size 2}} {clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}} --------- module ports mkM Command: module ports mkM -interface {{method _write _write {clock default_clock} {reset default_reset} {args {{{name _write_1} {port _write_1} {size 1}}}} {enable EN__write} {ready RDY__write}} {method _read _read {clock default_clock} {reset default_reset} {args {}} {result _read} {ready RDY__read}}} +interface {{method _write _write {clock default_clock} {reset default_reset} {args {{{name _write_1} {port _write_1} {size 1}}}} {results {}} {enable EN__write} {ready RDY__write}} {method _read _read {clock default_clock} {reset default_reset} {args {}} {results {{{port _read} {size 1}}}} {ready RDY__read}}} args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}} --------- module ports mkIfcWithVec Command: module ports mkIfcWithVec -interface {{interface vec1 {{interface 0 {{method _write vec1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec1_0__write_1} {port vec1_0__write_1} {size 1}}}} {enable EN_vec1_0__write} {ready RDY_vec1_0__write}} {method _read vec1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec1_0__read} {ready RDY_vec1_0__read}}}} {interface 1 {{method _write vec1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec1_1__write_1} {port vec1_1__write_1} {size 1}}}} {enable EN_vec1_1__write} {ready RDY_vec1_1__write}} {method _read vec1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec1_1__read} {ready RDY_vec1_1__read}}}}}} {interface vec2 {{interface 0 {{interface 0 {{method _write vec2_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_0__write_1} {port vec2_0_0__write_1} {size 1}}}} {enable EN_vec2_0_0__write} {ready RDY_vec2_0_0__write}} {method _read vec2_0_0__read {clock no_clock} {reset no_reset} {args {}} {result vec2_0_0__read} {ready RDY_vec2_0_0__read}}}} {interface 1 {{method _write vec2_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_1__write_1} {port vec2_0_1__write_1} {size 1}}}} {enable EN_vec2_0_1__write} {ready RDY_vec2_0_1__write}} {method _read vec2_0_1__read {clock no_clock} {reset no_reset} {args {}} {result vec2_0_1__read} {ready RDY_vec2_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec2_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_0__write_1} {port vec2_1_0__write_1} {size 1}}}} {enable EN_vec2_1_0__write} {ready RDY_vec2_1_0__write}} {method _read vec2_1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec2_1_0__read} {ready RDY_vec2_1_0__read}}}} {interface 1 {{method _write vec2_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_1__write_1} {port vec2_1_1__write_1} {size 1}}}} {enable EN_vec2_1_1__write} {ready RDY_vec2_1_1__write}} {method _read vec2_1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec2_1_1__read} {ready RDY_vec2_1_1__read}}}}}}}} {interface vec3 {{interface 0 {{interface 0 {{interface 0 {{method _write vec3_0_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_0__write_1} {port vec3_0_0_0__write_1} {size 1}}}} {enable EN_vec3_0_0_0__write} {ready RDY_vec3_0_0_0__write}} {method _read vec3_0_0_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_0_0__read} {ready RDY_vec3_0_0_0__read}}}} {interface 1 {{method _write vec3_0_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_1__write_1} {port vec3_0_0_1__write_1} {size 1}}}} {enable EN_vec3_0_0_1__write} {ready RDY_vec3_0_0_1__write}} {method _read vec3_0_0_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_0_1__read} {ready RDY_vec3_0_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_0_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_0__write_1} {port vec3_0_1_0__write_1} {size 1}}}} {enable EN_vec3_0_1_0__write} {ready RDY_vec3_0_1_0__write}} {method _read vec3_0_1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_1_0__read} {ready RDY_vec3_0_1_0__read}}}} {interface 1 {{method _write vec3_0_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_1__write_1} {port vec3_0_1_1__write_1} {size 1}}}} {enable EN_vec3_0_1_1__write} {ready RDY_vec3_0_1_1__write}} {method _read vec3_0_1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_0_1_1__read} {ready RDY_vec3_0_1_1__read}}}}}}}} {interface 1 {{interface 0 {{interface 0 {{method _write vec3_1_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_0__write_1} {port vec3_1_0_0__write_1} {size 1}}}} {enable EN_vec3_1_0_0__write} {ready RDY_vec3_1_0_0__write}} {method _read vec3_1_0_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_0_0__read} {ready RDY_vec3_1_0_0__read}}}} {interface 1 {{method _write vec3_1_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_1__write_1} {port vec3_1_0_1__write_1} {size 1}}}} {enable EN_vec3_1_0_1__write} {ready RDY_vec3_1_0_1__write}} {method _read vec3_1_0_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_0_1__read} {ready RDY_vec3_1_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_1_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_0__write_1} {port vec3_1_1_0__write_1} {size 1}}}} {enable EN_vec3_1_1_0__write} {ready RDY_vec3_1_1_0__write}} {method _read vec3_1_1_0__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_1_0__read} {ready RDY_vec3_1_1_0__read}}}} {interface 1 {{method _write vec3_1_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_1__write_1} {port vec3_1_1_1__write_1} {size 1}}}} {enable EN_vec3_1_1_1__write} {ready RDY_vec3_1_1_1__write}} {method _read vec3_1_1_1__read {clock no_clock} {reset no_reset} {args {}} {result vec3_1_1_1__read} {ready RDY_vec3_1_1_1__read}}}}}}}}}} {method data1 data1 {clock no_clock} {reset no_reset} {args {}} {result data1} {ready RDY_data1}} {method data2 data2 {clock no_clock} {reset no_reset} {args {}} {result data2} {ready RDY_data2}} {method data3 data3 {clock no_clock} {reset no_reset} {args {}} {result data3} {ready RDY_data3}} {interface clks1 {{interface 0 {{clock {} clks1_0 {osc CLK_clks1_0} {gate CLK_GATE_clks1_0}}}} {interface 1 {{clock {} clks1_1 {osc CLK_clks1_1} {gate CLK_GATE_clks1_1}}}}}} {interface rsts1 {{interface 0 {{reset {} rsts1_0 {port RST_N_rsts1_0} {clock default_clock}}}} {interface 1 {{reset {} rsts1_1 {port RST_N_rsts1_1} {clock default_clock}}}}}} {interface ios1 {{interface 0 {{inout {} ios1_0 {port ios1_0} {clock clks1_1} {reset rsts1_1}}}} {interface 1 {{inout {} ios1_1 {port ios1_1} {clock clks1_1} {reset rsts1_1}}}}}}} +interface {{interface vec1 {{interface 0 {{method _write vec1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec1_0__write_1} {port vec1_0__write_1} {size 1}}}} {results {}} {enable EN_vec1_0__write} {ready RDY_vec1_0__write}} {method _read vec1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec1_0__read} {size 1}}}} {ready RDY_vec1_0__read}}}} {interface 1 {{method _write vec1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec1_1__write_1} {port vec1_1__write_1} {size 1}}}} {results {}} {enable EN_vec1_1__write} {ready RDY_vec1_1__write}} {method _read vec1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec1_1__read} {size 1}}}} {ready RDY_vec1_1__read}}}}}} {interface vec2 {{interface 0 {{interface 0 {{method _write vec2_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_0__write_1} {port vec2_0_0__write_1} {size 1}}}} {results {}} {enable EN_vec2_0_0__write} {ready RDY_vec2_0_0__write}} {method _read vec2_0_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_0_0__read} {size 1}}}} {ready RDY_vec2_0_0__read}}}} {interface 1 {{method _write vec2_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_0_1__write_1} {port vec2_0_1__write_1} {size 1}}}} {results {}} {enable EN_vec2_0_1__write} {ready RDY_vec2_0_1__write}} {method _read vec2_0_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_0_1__read} {size 1}}}} {ready RDY_vec2_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec2_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_0__write_1} {port vec2_1_0__write_1} {size 1}}}} {results {}} {enable EN_vec2_1_0__write} {ready RDY_vec2_1_0__write}} {method _read vec2_1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_1_0__read} {size 1}}}} {ready RDY_vec2_1_0__read}}}} {interface 1 {{method _write vec2_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec2_1_1__write_1} {port vec2_1_1__write_1} {size 1}}}} {results {}} {enable EN_vec2_1_1__write} {ready RDY_vec2_1_1__write}} {method _read vec2_1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec2_1_1__read} {size 1}}}} {ready RDY_vec2_1_1__read}}}}}}}} {interface vec3 {{interface 0 {{interface 0 {{interface 0 {{method _write vec3_0_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_0__write_1} {port vec3_0_0_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_0_0__write} {ready RDY_vec3_0_0_0__write}} {method _read vec3_0_0_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_0_0__read} {size 1}}}} {ready RDY_vec3_0_0_0__read}}}} {interface 1 {{method _write vec3_0_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_0_1__write_1} {port vec3_0_0_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_0_1__write} {ready RDY_vec3_0_0_1__write}} {method _read vec3_0_0_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_0_1__read} {size 1}}}} {ready RDY_vec3_0_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_0_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_0__write_1} {port vec3_0_1_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_1_0__write} {ready RDY_vec3_0_1_0__write}} {method _read vec3_0_1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_1_0__read} {size 1}}}} {ready RDY_vec3_0_1_0__read}}}} {interface 1 {{method _write vec3_0_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_0_1_1__write_1} {port vec3_0_1_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_0_1_1__write} {ready RDY_vec3_0_1_1__write}} {method _read vec3_0_1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_0_1_1__read} {size 1}}}} {ready RDY_vec3_0_1_1__read}}}}}}}} {interface 1 {{interface 0 {{interface 0 {{method _write vec3_1_0_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_0__write_1} {port vec3_1_0_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_0_0__write} {ready RDY_vec3_1_0_0__write}} {method _read vec3_1_0_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_0_0__read} {size 1}}}} {ready RDY_vec3_1_0_0__read}}}} {interface 1 {{method _write vec3_1_0_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_0_1__write_1} {port vec3_1_0_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_0_1__write} {ready RDY_vec3_1_0_1__write}} {method _read vec3_1_0_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_0_1__read} {size 1}}}} {ready RDY_vec3_1_0_1__read}}}}}} {interface 1 {{interface 0 {{method _write vec3_1_1_0__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_0__write_1} {port vec3_1_1_0__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_1_0__write} {ready RDY_vec3_1_1_0__write}} {method _read vec3_1_1_0__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_1_0__read} {size 1}}}} {ready RDY_vec3_1_1_0__read}}}} {interface 1 {{method _write vec3_1_1_1__write {clock clks1_1} {reset no_reset} {args {{{name vec3_1_1_1__write_1} {port vec3_1_1_1__write_1} {size 1}}}} {results {}} {enable EN_vec3_1_1_1__write} {ready RDY_vec3_1_1_1__write}} {method _read vec3_1_1_1__read {clock no_clock} {reset no_reset} {args {}} {results {{{port vec3_1_1_1__read} {size 1}}}} {ready RDY_vec3_1_1_1__read}}}}}}}}}} {method data1 data1 {clock no_clock} {reset no_reset} {args {}} {results {{{port data1} {size 2}}}} {ready RDY_data1}} {method data2 data2 {clock no_clock} {reset no_reset} {args {}} {results {{{port data2} {size 4}}}} {ready RDY_data2}} {method data3 data3 {clock no_clock} {reset no_reset} {args {}} {results {{{port data3} {size 8}}}} {ready RDY_data3}} {interface clks1 {{interface 0 {{clock {} clks1_0 {osc CLK_clks1_0} {gate CLK_GATE_clks1_0}}}} {interface 1 {{clock {} clks1_1 {osc CLK_clks1_1} {gate CLK_GATE_clks1_1}}}}}} {interface rsts1 {{interface 0 {{reset {} rsts1_0 {port RST_N_rsts1_0} {clock default_clock}}}} {interface 1 {{reset {} rsts1_1 {port RST_N_rsts1_1} {clock default_clock}}}}}} {interface ios1 {{interface 0 {{inout {} ios1_0 {port ios1_0} {clock clks1_1} {reset rsts1_1}}}} {interface 1 {{inout {} ios1_1 {port ios1_1} {clock clks1_1} {reset rsts1_1}}}}}}} args {{inout io {port io} {clock default_clock} {reset default_reset} {size 2}} {clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}} --------- ---------- diff --git a/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-bh-out.expected index 6f89b6109..fb719aa49 100644 --- a/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-bh-out.expected @@ -11,6 +11,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {{{port _write_1} {size 1}}} + results {} enable EN__write ready RDY__write method @@ -19,7 +20,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {} - result _read + results {{{port _read} {size 1}}} ready RDY__read args clock default_clock {osc CLK} @@ -36,6 +37,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {{{port _write_1} {size 1}}} + results {} enable EN__write ready RDY__write method @@ -44,7 +46,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {} - result _read + results {{{port _read} {size 1}}} ready RDY__read args clock default_clock {osc CLK} @@ -77,6 +79,7 @@ Command: submodule ports mkT clock clk reset rst args {{{port WVAL} {size 4}}} + results {} enable WSET method wget @@ -84,14 +87,14 @@ Command: submodule ports mkT clock clk reset rst args {} - result WGET + results {{{port WGET} {size 4}}} method whas whas clock clk reset rst args {} - result WHAS + results {{{port WHAS} {size 1}}} inout io_out io_out @@ -122,6 +125,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec1_0__write_1} {size 1}}} + results {} enable EN_vec1_0__write ready RDY_vec1_0__write method @@ -130,7 +134,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec1_0__read + results {{{port vec1_0__read} {size 1}}} ready RDY_vec1_0__read interface 1 @@ -140,6 +144,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec1_1__write_1} {size 1}}} + results {} enable EN_vec1_1__write ready RDY_vec1_1__write method @@ -148,7 +153,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec1_1__read + results {{{port vec1_1__read} {size 1}}} ready RDY_vec1_1__read interface vec2 @@ -162,6 +167,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_0_0__write_1} {size 1}}} + results {} enable EN_vec2_0_0__write ready RDY_vec2_0_0__write method @@ -170,7 +176,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_0_0__read + results {{{port vec2_0_0__read} {size 1}}} ready RDY_vec2_0_0__read interface 1 @@ -180,6 +186,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_0_1__write_1} {size 1}}} + results {} enable EN_vec2_0_1__write ready RDY_vec2_0_1__write method @@ -188,7 +195,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_0_1__read + results {{{port vec2_0_1__read} {size 1}}} ready RDY_vec2_0_1__read interface 1 @@ -200,6 +207,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_1_0__write_1} {size 1}}} + results {} enable EN_vec2_1_0__write ready RDY_vec2_1_0__write method @@ -208,7 +216,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_1_0__read + results {{{port vec2_1_0__read} {size 1}}} ready RDY_vec2_1_0__read interface 1 @@ -218,6 +226,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_1_1__write_1} {size 1}}} + results {} enable EN_vec2_1_1__write ready RDY_vec2_1_1__write method @@ -226,7 +235,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_1_1__read + results {{{port vec2_1_1__read} {size 1}}} ready RDY_vec2_1_1__read interface vec3 @@ -242,6 +251,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_0_0__write_1} {size 1}}} + results {} enable EN_vec3_0_0_0__write ready RDY_vec3_0_0_0__write method @@ -250,7 +260,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_0_0__read + results {{{port vec3_0_0_0__read} {size 1}}} ready RDY_vec3_0_0_0__read interface 1 @@ -260,6 +270,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_0_1__write_1} {size 1}}} + results {} enable EN_vec3_0_0_1__write ready RDY_vec3_0_0_1__write method @@ -268,7 +279,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_0_1__read + results {{{port vec3_0_0_1__read} {size 1}}} ready RDY_vec3_0_0_1__read interface 1 @@ -280,6 +291,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_1_0__write_1} {size 1}}} + results {} enable EN_vec3_0_1_0__write ready RDY_vec3_0_1_0__write method @@ -288,7 +300,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_1_0__read + results {{{port vec3_0_1_0__read} {size 1}}} ready RDY_vec3_0_1_0__read interface 1 @@ -298,6 +310,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_1_1__write_1} {size 1}}} + results {} enable EN_vec3_0_1_1__write ready RDY_vec3_0_1_1__write method @@ -306,7 +319,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_1_1__read + results {{{port vec3_0_1_1__read} {size 1}}} ready RDY_vec3_0_1_1__read interface 1 @@ -320,6 +333,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_0_0__write_1} {size 1}}} + results {} enable EN_vec3_1_0_0__write ready RDY_vec3_1_0_0__write method @@ -328,7 +342,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_0_0__read + results {{{port vec3_1_0_0__read} {size 1}}} ready RDY_vec3_1_0_0__read interface 1 @@ -338,6 +352,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_0_1__write_1} {size 1}}} + results {} enable EN_vec3_1_0_1__write ready RDY_vec3_1_0_1__write method @@ -346,7 +361,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_0_1__read + results {{{port vec3_1_0_1__read} {size 1}}} ready RDY_vec3_1_0_1__read interface 1 @@ -358,6 +373,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_1_0__write_1} {size 1}}} + results {} enable EN_vec3_1_1_0__write ready RDY_vec3_1_1_0__write method @@ -366,7 +382,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_1_0__read + results {{{port vec3_1_1_0__read} {size 1}}} ready RDY_vec3_1_1_0__read interface 1 @@ -376,6 +392,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_1_1__write_1} {size 1}}} + results {} enable EN_vec3_1_1_1__write ready RDY_vec3_1_1_1__write method @@ -384,7 +401,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_1_1__read + results {{{port vec3_1_1_1__read} {size 1}}} ready RDY_vec3_1_1_1__read method data1 @@ -392,7 +409,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result data1 + results {{{port data1} {size 2}}} ready RDY_data1 method data2 @@ -400,7 +417,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result data2 + results {{{port data2} {size 4}}} ready RDY_data2 method data3 @@ -408,7 +425,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result data3 + results {{{port data3} {size 8}}} ready RDY_data3 interface clks1 @@ -458,6 +475,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {{{port D_IN} {size 1}}} + results {} enable EN method _read @@ -465,7 +483,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {} - result Q_OUT + results {{{port Q_OUT} {size 1}}} args clock _clk__1 {osc CLK} reset _rst__1 {port RST} {clock _clk__1} @@ -480,6 +498,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {{{port D_IN} {size 1}}} + results {} enable EN method _read @@ -487,7 +506,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {} - result Q_OUT + results {{{port Q_OUT} {size 1}}} args clock _clk__1 {osc CLK} reset _rst__1 {port RST} {clock _clk__1} @@ -502,6 +521,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {{{port D_IN} {size 1}}} + results {} enable EN method _read @@ -509,7 +529,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {} - result Q_OUT + results {{{port Q_OUT} {size 1}}} args clock _clk__1 {osc CLK} reset _rst__1 {port RST} {clock _clk__1} diff --git a/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-out.expected index aaf292aaf..926e03cde 100644 --- a/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/commands/submodule.tcl.bluetcl-out.expected @@ -11,6 +11,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {{{port _write_1} {size 1}}} + results {} enable EN__write ready RDY__write method @@ -19,7 +20,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {} - result _read + results {{{port _read} {size 1}}} ready RDY__read args clock default_clock {osc CLK} @@ -36,6 +37,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {{{port _write_1} {size 1}}} + results {} enable EN__write ready RDY__write method @@ -44,7 +46,7 @@ Command: submodule ports mkT clock default_clock reset default_reset args {} - result _read + results {{{port _read} {size 1}}} ready RDY__read args clock default_clock {osc CLK} @@ -77,6 +79,7 @@ Command: submodule ports mkT clock clk reset rst args {{{port WVAL} {size 4}}} + results {} enable WSET method wget @@ -84,14 +87,14 @@ Command: submodule ports mkT clock clk reset rst args {} - result WGET + results {{{port WGET} {size 4}}} method whas whas clock clk reset rst args {} - result WHAS + results {{{port WHAS} {size 1}}} inout io_out io_out @@ -122,6 +125,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec1_0__write_1} {size 1}}} + results {} enable EN_vec1_0__write ready RDY_vec1_0__write method @@ -130,7 +134,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec1_0__read + results {{{port vec1_0__read} {size 1}}} ready RDY_vec1_0__read interface 1 @@ -140,6 +144,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec1_1__write_1} {size 1}}} + results {} enable EN_vec1_1__write ready RDY_vec1_1__write method @@ -148,7 +153,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec1_1__read + results {{{port vec1_1__read} {size 1}}} ready RDY_vec1_1__read interface vec2 @@ -162,6 +167,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_0_0__write_1} {size 1}}} + results {} enable EN_vec2_0_0__write ready RDY_vec2_0_0__write method @@ -170,7 +176,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_0_0__read + results {{{port vec2_0_0__read} {size 1}}} ready RDY_vec2_0_0__read interface 1 @@ -180,6 +186,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_0_1__write_1} {size 1}}} + results {} enable EN_vec2_0_1__write ready RDY_vec2_0_1__write method @@ -188,7 +195,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_0_1__read + results {{{port vec2_0_1__read} {size 1}}} ready RDY_vec2_0_1__read interface 1 @@ -200,6 +207,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_1_0__write_1} {size 1}}} + results {} enable EN_vec2_1_0__write ready RDY_vec2_1_0__write method @@ -208,7 +216,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_1_0__read + results {{{port vec2_1_0__read} {size 1}}} ready RDY_vec2_1_0__read interface 1 @@ -218,6 +226,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec2_1_1__write_1} {size 1}}} + results {} enable EN_vec2_1_1__write ready RDY_vec2_1_1__write method @@ -226,7 +235,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec2_1_1__read + results {{{port vec2_1_1__read} {size 1}}} ready RDY_vec2_1_1__read interface vec3 @@ -242,6 +251,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_0_0__write_1} {size 1}}} + results {} enable EN_vec3_0_0_0__write ready RDY_vec3_0_0_0__write method @@ -250,7 +260,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_0_0__read + results {{{port vec3_0_0_0__read} {size 1}}} ready RDY_vec3_0_0_0__read interface 1 @@ -260,6 +270,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_0_1__write_1} {size 1}}} + results {} enable EN_vec3_0_0_1__write ready RDY_vec3_0_0_1__write method @@ -268,7 +279,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_0_1__read + results {{{port vec3_0_0_1__read} {size 1}}} ready RDY_vec3_0_0_1__read interface 1 @@ -280,6 +291,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_1_0__write_1} {size 1}}} + results {} enable EN_vec3_0_1_0__write ready RDY_vec3_0_1_0__write method @@ -288,7 +300,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_1_0__read + results {{{port vec3_0_1_0__read} {size 1}}} ready RDY_vec3_0_1_0__read interface 1 @@ -298,6 +310,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_0_1_1__write_1} {size 1}}} + results {} enable EN_vec3_0_1_1__write ready RDY_vec3_0_1_1__write method @@ -306,7 +319,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_0_1_1__read + results {{{port vec3_0_1_1__read} {size 1}}} ready RDY_vec3_0_1_1__read interface 1 @@ -320,6 +333,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_0_0__write_1} {size 1}}} + results {} enable EN_vec3_1_0_0__write ready RDY_vec3_1_0_0__write method @@ -328,7 +342,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_0_0__read + results {{{port vec3_1_0_0__read} {size 1}}} ready RDY_vec3_1_0_0__read interface 1 @@ -338,6 +352,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_0_1__write_1} {size 1}}} + results {} enable EN_vec3_1_0_1__write ready RDY_vec3_1_0_1__write method @@ -346,7 +361,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_0_1__read + results {{{port vec3_1_0_1__read} {size 1}}} ready RDY_vec3_1_0_1__read interface 1 @@ -358,6 +373,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_1_0__write_1} {size 1}}} + results {} enable EN_vec3_1_1_0__write ready RDY_vec3_1_1_0__write method @@ -366,7 +382,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_1_0__read + results {{{port vec3_1_1_0__read} {size 1}}} ready RDY_vec3_1_1_0__read interface 1 @@ -376,6 +392,7 @@ Command: submodule ports mkT clock clks1_1 reset no_reset args {{{port vec3_1_1_1__write_1} {size 1}}} + results {} enable EN_vec3_1_1_1__write ready RDY_vec3_1_1_1__write method @@ -384,7 +401,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result vec3_1_1_1__read + results {{{port vec3_1_1_1__read} {size 1}}} ready RDY_vec3_1_1_1__read method data1 @@ -392,7 +409,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result data1 + results {{{port data1} {size 2}}} ready RDY_data1 method data2 @@ -400,7 +417,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result data2 + results {{{port data2} {size 4}}} ready RDY_data2 method data3 @@ -408,7 +425,7 @@ Command: submodule ports mkT clock no_clock reset no_reset args {} - result data3 + results {{{port data3} {size 8}}} ready RDY_data3 interface clks1 @@ -458,6 +475,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {{{port D_IN} {size 1}}} + results {} enable EN method _read @@ -465,7 +483,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {} - result Q_OUT + results {{{port Q_OUT} {size 1}}} args clock _clk__1 {osc CLK} reset _rst__1 {port RST} {clock _clk__1} @@ -480,6 +498,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {{{port D_IN} {size 1}}} + results {} enable EN method _read @@ -487,7 +506,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {} - result Q_OUT + results {{{port Q_OUT} {size 1}}} args clock _clk__1 {osc CLK} reset _rst__1 {port RST} {clock _clk__1} @@ -502,6 +521,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {{{port D_IN} {size 1}}} + results {} enable EN method _read @@ -509,7 +529,7 @@ Command: submodule ports mkM clock _clk__1 reset _rst__1 args {} - result Q_OUT + results {{{port Q_OUT} {size 1}}} args clock _clk__1 {osc CLK} reset _rst__1 {port RST} {clock _clk__1} diff --git a/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-bh-out.expected index f7972c0b8..dadadf149 100644 --- a/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-bh-out.expected @@ -1,11 +1,11 @@ -verilog mkInhighEnable_Sub sysInhighEnable ---------- -{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port Q_IN} {size 1}}}}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {result D_OUT}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkInhighEnable_Sub {interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{port _write_1} {size 1}}}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {result _read}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} +{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port Q_IN} {size 1}}}} {results {}}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 1}}}}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkInhighEnable_Sub {interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{port _write_1} {size 1}}}} {results {}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {results {{{port _read} {size 1}}}}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} {rg1 MOD {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {CLK_GATE Prelude.Bool} {Q_IN Prelude.Bool} {D_OUT Prelude.Bool}}}} {rg2 mkInhighEnable_Sub {ports {{CLK Prelude.Clock} {RST_N Prelude.Reset} {_write_1 Prelude.Bool} {_read Prelude.Bool}}}} ---------- -{interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{name _write_1} {port _write_1} {size 1}}}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {result _read}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} +{interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{name _write_1} {port _write_1} {size 1}}}} {results {}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {results {{{port _read} {size 1}}}}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} {CLK Prelude.Clock} {RST_N Prelude.Reset} {_write_1 Prelude.Bool} {_read Prelude.Bool} ---------- diff --git a/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-out.expected index 1bf3c6e11..127dc8996 100644 --- a/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/targeted/port_types/inhigh.tcl.bluetcl-out.expected @@ -1,11 +1,11 @@ -verilog mkInhighEnable_Sub sysInhighEnable ---------- -{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port Q_IN} {size 1}}}}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {result D_OUT}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkInhighEnable_Sub {interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{port _write_1} {size 1}}}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {result _read}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} +{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port Q_IN} {size 1}}}} {results {}}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 1}}}}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkInhighEnable_Sub {interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{port _write_1} {size 1}}}} {results {}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {results {{{port _read} {size 1}}}}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} {rg1 MOD {ports {{RST Reset} {CLK Clock} {CLK_GATE Bool} {Q_IN Bool} {D_OUT Bool}}}} {rg2 mkInhighEnable_Sub {ports {{CLK Clock} {RST_N Reset} {_write_1 Bool} {_read Bool}}}} ---------- -{interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{name _write_1} {port _write_1} {size 1}}}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {result _read}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} +{interface {{method _write _write {clock default_clock} {reset no_reset} {args {{{name _write_1} {port _write_1} {size 1}}}} {results {}}} {method _read _read {clock default_clock} {reset no_reset} {args {}} {results {{{port _read} {size 1}}}}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} {CLK Clock} {RST_N Reset} {_write_1 Bool} {_read Bool} ---------- diff --git a/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-bh-out.expected index 547da936a..59b75dd63 100644 --- a/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-bh-out.expected @@ -1,75 +1,75 @@ -verilog sysPrims ---------- -rg RegN {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {result Q_OUT}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} +rg RegN {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {{{port Q_OUT} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} rg RegN {ports {{CLK Prelude.Clock} {RST Prelude.Reset} {D_IN {Prelude.Int 32}} {EN Prelude.Bool} {Q_OUT {Prelude.Int 32}}}} ---------- -rgA RegA {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {result Q_OUT}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} +rgA RegA {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {{{port Q_OUT} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} rgA RegA {ports {{CLK Prelude.Clock} {RST Prelude.Reset} {D_IN {Prelude.Int 32}} {EN Prelude.Bool} {Q_OUT {Prelude.Int 32}}}} ---------- -rgU RegUN {interface {{method _write _write {clock _clk__1} {reset no_reset} {args {{{port D_IN} {size 32}}}} {enable EN}} {method _read _read {clock _clk__1} {reset no_reset} {args {}} {result Q_OUT}}}} {args {{clock _clk__1 {osc CLK}} {parameter width {param width}}}} +rgU RegUN {interface {{method _write _write {clock _clk__1} {reset no_reset} {args {{{port D_IN} {size 32}}}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset no_reset} {args {}} {results {{{port Q_OUT} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {parameter width {param width}}}} rgU RegUN {ports {{CLK Prelude.Clock} {D_IN {Prelude.Int 32}} {EN Prelude.Bool} {Q_OUT {Prelude.Int 32}}}} ---------- -rw RWire {interface {{method wset wset {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {result WGET} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +rw RWire {interface {{method wset wset {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} rw RWire {ports {{WVAL {Prelude.Int 32}} {WSET Prelude.Bool} {WGET {Prelude.Int 32}} {WHAS Prelude.Bool}}} ---------- -rw0 RWire0 {interface {{method wset wset {clock clk} {reset rst} {args {}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {ready WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} +rw0 RWire0 {interface {{method wset wset {clock clk} {reset rst} {args {}} {results {}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {results {}} {ready WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} rw0 RWire0 {ports {{WSET Prelude.Bool} {WHAS Prelude.Bool}}} ---------- -w RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WGET} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +w RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} w RWire {ports {{WVAL {Prelude.Int 32}} {WSET Prelude.Bool} {WGET {Prelude.Int 32}} {WHAS Prelude.Bool}}} ---------- -dw RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WGET} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +dw RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} dw RWire {ports {{WVAL {Prelude.Int 32}} {WSET Prelude.Bool} {WGET {Prelude.Int 32}} {WHAS Prelude.Bool}}} ---------- -bw BypassWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}}} {method _read _read {clock clk} {reset rst} {args {}} {result WGET}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +bw BypassWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} bw BypassWire {ports {{WVAL {Prelude.Int 32}} {WGET {Prelude.Int 32}}}} ---------- -pw RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} +pw RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WHAS} {size 1}}}}}}} {args {{clock clk} {reset rst {clock clk}}}} pw RWire0 {ports {{WSET Prelude.Bool} {WHAS Prelude.Bool}}} ---------- -pwo RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} +pwo RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WHAS} {size 1}}}}}}} {args {{clock clk} {reset rst {clock clk}}}} pwo RWire0 {ports {{WSET Prelude.Bool} {WHAS Prelude.Bool}}} ---------- -rf RegFile {interface {{method upd upd {clock _clk__1} {reset no_reset} {args {{{port ADDR_IN} {size 2}} {{port D_IN} {size 32}}}} {enable WE}} {method sub_1 sub_1 {clock _clk__1} {reset no_reset} {args {{{port ADDR_1} {size 2}}}} {result D_OUT_1}} {method sub_2 sub_2 {clock _clk__1} {reset no_reset} {args {{{port ADDR_2} {size 2}}}} {result D_OUT_2}} {method sub_3 sub_3 {clock _clk__1} {reset no_reset} {args {{{port ADDR_3} {size 2}}}} {result D_OUT_3}} {method sub_4 sub_4 {clock _clk__1} {reset no_reset} {args {{{port ADDR_4} {size 2}}}} {result D_OUT_4}} {method sub_5 sub_5 {clock _clk__1} {reset no_reset} {args {{{port ADDR_5} {size 2}}}} {result D_OUT_5}}}} {args {{clock _clk__1 {osc CLK}} {parameter addr_width {param addr_width}} {parameter data_width {param data_width}} {parameter lo {param lo}} {parameter hi {param hi}}}} +rf RegFile {interface {{method upd upd {clock _clk__1} {reset no_reset} {args {{{port ADDR_IN} {size 2}} {{port D_IN} {size 32}}}} {results {}} {enable WE}} {method sub_1 sub_1 {clock _clk__1} {reset no_reset} {args {{{port ADDR_1} {size 2}}}} {results {{{port D_OUT_1} {size 32}}}}} {method sub_2 sub_2 {clock _clk__1} {reset no_reset} {args {{{port ADDR_2} {size 2}}}} {results {{{port D_OUT_2} {size 32}}}}} {method sub_3 sub_3 {clock _clk__1} {reset no_reset} {args {{{port ADDR_3} {size 2}}}} {results {{{port D_OUT_3} {size 32}}}}} {method sub_4 sub_4 {clock _clk__1} {reset no_reset} {args {{{port ADDR_4} {size 2}}}} {results {{{port D_OUT_4} {size 32}}}}} {method sub_5 sub_5 {clock _clk__1} {reset no_reset} {args {{{port ADDR_5} {size 2}}}} {results {{{port D_OUT_5} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {parameter addr_width {param addr_width}} {parameter data_width {param data_width}} {parameter lo {param lo}} {parameter hi {param hi}}}} rf RegFile {ports {{CLK Prelude.Clock} {ADDR_IN {Prelude.Bit 2}} {D_IN {Prelude.Int 32}} {WE Prelude.Bool} {ADDR_1 {Prelude.Bit 2}} {D_OUT_1 {Prelude.Int 32}} {ADDR_2 {Prelude.Bit 2}} {D_OUT_2 {Prelude.Int 32}} {ADDR_3 {Prelude.Bit 2}} {D_OUT_3 {Prelude.Int 32}} {ADDR_4 {Prelude.Bit 2}} {D_OUT_4 {Prelude.Int 32}} {ADDR_5 {Prelude.Bit 2}} {D_OUT_5 {Prelude.Int 32}}}} ---------- -ff1 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method notFull notFull {clock clk} {reset _rst__1} {args {}} {result FULL_N}} {method notEmpty notEmpty {clock clk} {reset _rst__1} {args {}} {result EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} +ff1 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method notFull notFull {clock clk} {reset _rst__1} {args {}} {results {{{port FULL_N} {size 1}}}}} {method notEmpty notEmpty {clock clk} {reset _rst__1} {args {}} {results {{{port EMPTY_N} {size 1}}}}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} ff1 FIFO2 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {D_IN {Prelude.Int 32}} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {D_OUT {Prelude.Int 32}} {CLR Prelude.Bool}}} ---------- -f1 FIFO1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} +f1 FIFO1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} f1 FIFO1 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {D_IN {Prelude.Int 32}} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {D_OUT {Prelude.Int 32}} {CLR Prelude.Bool}}} ---------- -f10 FIFO10 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} +f10 FIFO10 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} f10 FIFO10 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {CLR Prelude.Bool}}} ---------- -f2 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} +f2 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} f2 FIFO2 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {D_IN {Prelude.Int 32}} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {D_OUT {Prelude.Int 32}} {CLR Prelude.Bool}}} ---------- -f20 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} +f20 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} f20 FIFO20 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {CLR Prelude.Bool}}} ---------- -fs SizedFIFO {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1width {param p1width}} {parameter p2depth {param p2depth}} {parameter p3cntr_width {param p3cntr_width}} {parameter guarded {param guarded}}}} +fs SizedFIFO {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1width {param p1width}} {parameter p2depth {param p2depth}} {parameter p3cntr_width {param p3cntr_width}} {parameter guarded {param guarded}}}} fs SizedFIFO {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {D_IN {Prelude.Int 32}} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {D_OUT {Prelude.Int 32}} {CLR Prelude.Bool}}} ---------- -fs0 SizedFIFO0 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1depth {param p1depth}} {parameter p2cntr_width {param p2cntr_width}} {parameter guarded {param guarded}}}} +fs0 SizedFIFO0 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1depth {param p1depth}} {parameter p2cntr_width {param p2cntr_width}} {parameter guarded {param guarded}}}} fs0 SizedFIFO0 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {CLR Prelude.Bool}}} ---------- -fL1 FIFOL1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}}}} +fL1 FIFOL1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}}}} fL1 FIFOL1 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {D_IN {Prelude.Int 32}} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {D_OUT {Prelude.Int 32}} {CLR Prelude.Bool}}} ---------- -fL10 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} +fL10 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} fL10 FIFO20 {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {ENQ Prelude.Bool} {FULL_N Prelude.Bool} {DEQ Prelude.Bool} {EMPTY_N Prelude.Bool} {CLR Prelude.Bool}}} ---------- dclk ClockGen {interface {{clock gen_clk gen_clk {osc CLK_OUT}}}} {args {{parameter v1Width {param v1Width}} {parameter v2Width {param v2Width}} {parameter initDelay {param initDelay}} {parameter initValue {param initValue}} {parameter otherValue {param otherValue}}}} dclk ClockGen {ports {{CLK_OUT Prelude.Clock}}} ---------- -sr SyncRegister {interface {{method _write _write {clock clk_src} {reset sRstIn} {args {{{port sD_IN} {size 32}}}} {enable sEN} {ready sRDY}} {method _read _read {clock clk_dst} {reset no_reset} {args {}} {result dD_OUT}}}} {args {{parameter width {param width}} {parameter init {param init}} {clock clk_src {osc sCLK}} {clock clk_dst {osc dCLK}} {reset sRstIn {port sRST} {clock clk_src}}}} +sr SyncRegister {interface {{method _write _write {clock clk_src} {reset sRstIn} {args {{{port sD_IN} {size 32}}}} {results {}} {enable sEN} {ready sRDY}} {method _read _read {clock clk_dst} {reset no_reset} {args {}} {results {{{port dD_OUT} {size 32}}}}}}} {args {{parameter width {param width}} {parameter init {param init}} {clock clk_src {osc sCLK}} {clock clk_dst {osc dCLK}} {reset sRstIn {port sRST} {clock clk_src}}}} sr SyncRegister {ports {{sCLK Prelude.Clock} {dCLK Prelude.Clock} {sRST Prelude.Reset} {sD_IN {Prelude.Int 32}} {sEN Prelude.Bool} {sRDY Prelude.Bool} {dD_OUT {Prelude.Int 32}}}} ---------- -bcw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {result WGET}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} +bcw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}} {results {}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {results {{{port WGET} {size 32}}}}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} bcw CrossingBypassWire {ports {{CLK Prelude.Clock} {WVAL {Prelude.Int 32}} {WGET {Prelude.Int 32}}}} ---------- -ncw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {result WGET}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} +ncw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}} {results {}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {results {{{port WGET} {size 32}}}}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} ncw CrossingBypassWire {ports {{CLK Prelude.Clock} {WVAL {Prelude.Int 32}} {WGET {Prelude.Int 32}}}} ---------- diff --git a/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-out.expected index 56f80bdcd..d1099dcef 100644 --- a/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/targeted/port_types/prims.tcl.bluetcl-out.expected @@ -1,75 +1,75 @@ -verilog sysPrims ---------- -rg RegN {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {result Q_OUT}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} +rg RegN {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {{{port Q_OUT} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} rg RegN {ports {{CLK Clock} {RST Reset} {D_IN Int#(32)} {EN Bool} {Q_OUT Int#(32)}}} ---------- -rgA RegA {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {result Q_OUT}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} +rgA RegA {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {{{port Q_OUT} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {reset _rst__1 {port RST} {clock _clk__1}} {parameter width {param width}} {parameter init {param init}}}} rgA RegA {ports {{CLK Clock} {RST Reset} {D_IN Int#(32)} {EN Bool} {Q_OUT Int#(32)}}} ---------- -rgU RegUN {interface {{method _write _write {clock _clk__1} {reset no_reset} {args {{{port D_IN} {size 32}}}} {enable EN}} {method _read _read {clock _clk__1} {reset no_reset} {args {}} {result Q_OUT}}}} {args {{clock _clk__1 {osc CLK}} {parameter width {param width}}}} +rgU RegUN {interface {{method _write _write {clock _clk__1} {reset no_reset} {args {{{port D_IN} {size 32}}}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset no_reset} {args {}} {results {{{port Q_OUT} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {parameter width {param width}}}} rgU RegUN {ports {{CLK Clock} {D_IN Int#(32)} {EN Bool} {Q_OUT Int#(32)}}} ---------- -rw RWire {interface {{method wset wset {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {result WGET} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +rw RWire {interface {{method wset wset {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} rw RWire {ports {{WVAL Int#(32)} {WSET Bool} {WGET Int#(32)} {WHAS Bool}}} ---------- -rw0 RWire0 {interface {{method wset wset {clock clk} {reset rst} {args {}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {ready WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} +rw0 RWire0 {interface {{method wset wset {clock clk} {reset rst} {args {}} {results {}} {enable WSET}} {method wget wget {clock clk} {reset rst} {args {}} {results {}} {ready WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} rw0 RWire0 {ports {{WSET Bool} {WHAS Bool}}} ---------- -w RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WGET} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +w RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} w RWire {ports {{WVAL Int#(32)} {WSET Bool} {WGET Int#(32)} {WHAS Bool}}} ---------- -dw RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WGET} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +dw RWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}} {ready WHAS}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} dw RWire {ports {{WVAL Int#(32)} {WSET Bool} {WGET Int#(32)} {WHAS Bool}}} ---------- -bw BypassWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}}} {method _read _read {clock clk} {reset rst} {args {}} {result WGET}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} +bw BypassWire {interface {{method _write _write {clock clk} {reset rst} {args {{{port WVAL} {size 32}}}} {results {}}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WGET} {size 32}}}}}}} {args {{parameter width {param width}} {clock clk} {reset rst {clock clk}}}} bw BypassWire {ports {{WVAL Int#(32)} {WGET Int#(32)}}} ---------- -pw RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} +pw RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WHAS} {size 1}}}}}}} {args {{clock clk} {reset rst {clock clk}}}} pw RWire0 {ports {{WSET Bool} {WHAS Bool}}} ---------- -pwo RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {result WHAS}}}} {args {{clock clk} {reset rst {clock clk}}}} +pwo RWire0 {interface {{method send send {clock clk} {reset rst} {args {}} {results {}} {enable WSET}} {method _read _read {clock clk} {reset rst} {args {}} {results {{{port WHAS} {size 1}}}}}}} {args {{clock clk} {reset rst {clock clk}}}} pwo RWire0 {ports {{WSET Bool} {WHAS Bool}}} ---------- -rf RegFile {interface {{method upd upd {clock _clk__1} {reset no_reset} {args {{{port ADDR_IN} {size 2}} {{port D_IN} {size 32}}}} {enable WE}} {method sub_1 sub_1 {clock _clk__1} {reset no_reset} {args {{{port ADDR_1} {size 2}}}} {result D_OUT_1}} {method sub_2 sub_2 {clock _clk__1} {reset no_reset} {args {{{port ADDR_2} {size 2}}}} {result D_OUT_2}} {method sub_3 sub_3 {clock _clk__1} {reset no_reset} {args {{{port ADDR_3} {size 2}}}} {result D_OUT_3}} {method sub_4 sub_4 {clock _clk__1} {reset no_reset} {args {{{port ADDR_4} {size 2}}}} {result D_OUT_4}} {method sub_5 sub_5 {clock _clk__1} {reset no_reset} {args {{{port ADDR_5} {size 2}}}} {result D_OUT_5}}}} {args {{clock _clk__1 {osc CLK}} {parameter addr_width {param addr_width}} {parameter data_width {param data_width}} {parameter lo {param lo}} {parameter hi {param hi}}}} +rf RegFile {interface {{method upd upd {clock _clk__1} {reset no_reset} {args {{{port ADDR_IN} {size 2}} {{port D_IN} {size 32}}}} {results {}} {enable WE}} {method sub_1 sub_1 {clock _clk__1} {reset no_reset} {args {{{port ADDR_1} {size 2}}}} {results {{{port D_OUT_1} {size 32}}}}} {method sub_2 sub_2 {clock _clk__1} {reset no_reset} {args {{{port ADDR_2} {size 2}}}} {results {{{port D_OUT_2} {size 32}}}}} {method sub_3 sub_3 {clock _clk__1} {reset no_reset} {args {{{port ADDR_3} {size 2}}}} {results {{{port D_OUT_3} {size 32}}}}} {method sub_4 sub_4 {clock _clk__1} {reset no_reset} {args {{{port ADDR_4} {size 2}}}} {results {{{port D_OUT_4} {size 32}}}}} {method sub_5 sub_5 {clock _clk__1} {reset no_reset} {args {{{port ADDR_5} {size 2}}}} {results {{{port D_OUT_5} {size 32}}}}}}} {args {{clock _clk__1 {osc CLK}} {parameter addr_width {param addr_width}} {parameter data_width {param data_width}} {parameter lo {param lo}} {parameter hi {param hi}}}} rf RegFile {ports {{CLK Clock} {ADDR_IN Bit#(2)} {D_IN Int#(32)} {WE Bool} {ADDR_1 Bit#(2)} {D_OUT_1 Int#(32)} {ADDR_2 Bit#(2)} {D_OUT_2 Int#(32)} {ADDR_3 Bit#(2)} {D_OUT_3 Int#(32)} {ADDR_4 Bit#(2)} {D_OUT_4 Int#(32)} {ADDR_5 Bit#(2)} {D_OUT_5 Int#(32)}}} ---------- -ff1 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method notFull notFull {clock clk} {reset _rst__1} {args {}} {result FULL_N}} {method notEmpty notEmpty {clock clk} {reset _rst__1} {args {}} {result EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} +ff1 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method notFull notFull {clock clk} {reset _rst__1} {args {}} {results {{{port FULL_N} {size 1}}}}} {method notEmpty notEmpty {clock clk} {reset _rst__1} {args {}} {results {{{port EMPTY_N} {size 1}}}}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} ff1 FIFO2 {ports {{RST Reset} {CLK Clock} {D_IN Int#(32)} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {D_OUT Int#(32)} {CLR Bool}}} ---------- -f1 FIFO1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} +f1 FIFO1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} f1 FIFO1 {ports {{RST Reset} {CLK Clock} {D_IN Int#(32)} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {D_OUT Int#(32)} {CLR Bool}}} ---------- -f10 FIFO10 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} +f10 FIFO10 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} f10 FIFO10 {ports {{RST Reset} {CLK Clock} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {CLR Bool}}} ---------- -f2 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} +f2 FIFO2 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}} {parameter guarded {param guarded}}}} f2 FIFO2 {ports {{RST Reset} {CLK Clock} {D_IN Int#(32)} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {D_OUT Int#(32)} {CLR Bool}}} ---------- -f20 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} +f20 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} f20 FIFO20 {ports {{RST Reset} {CLK Clock} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {CLR Bool}}} ---------- -fs SizedFIFO {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1width {param p1width}} {parameter p2depth {param p2depth}} {parameter p3cntr_width {param p3cntr_width}} {parameter guarded {param guarded}}}} +fs SizedFIFO {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1width {param p1width}} {parameter p2depth {param p2depth}} {parameter p3cntr_width {param p3cntr_width}} {parameter guarded {param guarded}}}} fs SizedFIFO {ports {{RST Reset} {CLK Clock} {D_IN Int#(32)} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {D_OUT Int#(32)} {CLR Bool}}} ---------- -fs0 SizedFIFO0 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1depth {param p1depth}} {parameter p2cntr_width {param p2cntr_width}} {parameter guarded {param guarded}}}} +fs0 SizedFIFO0 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter p1depth {param p1depth}} {parameter p2cntr_width {param p2cntr_width}} {parameter guarded {param guarded}}}} fs0 SizedFIFO0 {ports {{RST Reset} {CLK Clock} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {CLR Bool}}} ---------- -fL1 FIFOL1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {result D_OUT} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}}}} +fL1 FIFOL1 {interface {{method enq enq {clock clk} {reset _rst__1} {args {{{port D_IN} {size 32}}}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {{{port D_OUT} {size 32}}}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter width {param width}}}} fL1 FIFOL1 {ports {{RST Reset} {CLK Clock} {D_IN Int#(32)} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {D_OUT Int#(32)} {CLR Bool}}} ---------- -fL10 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} +fL10 FIFO20 {interface {{method enq enq {clock clk} {reset _rst__1} {args {}} {results {}} {enable ENQ} {ready FULL_N}} {method deq deq {clock clk} {reset _rst__1} {args {}} {results {}} {enable DEQ} {ready EMPTY_N}} {method first first {clock clk} {reset _rst__1} {args {}} {results {}} {ready EMPTY_N}} {method clear clear {clock clk} {reset _rst__1} {args {}} {results {}} {enable CLR}}}} {args {{reset _rst__1 {port RST} {clock clk}} {clock clk {osc CLK}} {parameter guarded {param guarded}}}} fL10 FIFO20 {ports {{RST Reset} {CLK Clock} {ENQ Bool} {FULL_N Bool} {DEQ Bool} {EMPTY_N Bool} {CLR Bool}}} ---------- dclk ClockGen {interface {{clock gen_clk gen_clk {osc CLK_OUT}}}} {args {{parameter v1Width {param v1Width}} {parameter v2Width {param v2Width}} {parameter initDelay {param initDelay}} {parameter initValue {param initValue}} {parameter otherValue {param otherValue}}}} dclk ClockGen {ports {{CLK_OUT Clock}}} ---------- -sr SyncRegister {interface {{method _write _write {clock clk_src} {reset sRstIn} {args {{{port sD_IN} {size 32}}}} {enable sEN} {ready sRDY}} {method _read _read {clock clk_dst} {reset no_reset} {args {}} {result dD_OUT}}}} {args {{parameter width {param width}} {parameter init {param init}} {clock clk_src {osc sCLK}} {clock clk_dst {osc dCLK}} {reset sRstIn {port sRST} {clock clk_src}}}} +sr SyncRegister {interface {{method _write _write {clock clk_src} {reset sRstIn} {args {{{port sD_IN} {size 32}}}} {results {}} {enable sEN} {ready sRDY}} {method _read _read {clock clk_dst} {reset no_reset} {args {}} {results {{{port dD_OUT} {size 32}}}}}}} {args {{parameter width {param width}} {parameter init {param init}} {clock clk_src {osc sCLK}} {clock clk_dst {osc dCLK}} {reset sRstIn {port sRST} {clock clk_src}}}} sr SyncRegister {ports {{sCLK Clock} {dCLK Clock} {sRST Reset} {sD_IN Int#(32)} {sEN Bool} {sRDY Bool} {dD_OUT Int#(32)}}} ---------- -bcw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {result WGET}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} +bcw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}} {results {}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {results {{{port WGET} {size 32}}}}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} bcw CrossingBypassWire {ports {{CLK Clock} {WVAL Int#(32)} {WGET Int#(32)}}} ---------- -ncw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {result WGET}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} +ncw CrossingBypassWire {interface {{method wset wset {clock clk} {reset no_reset} {args {{{port WVAL} {size 32}}}} {results {}}} {method wget wget {clock dstClk} {reset no_reset} {args {}} {results {{{port WGET} {size 32}}}}}}} {args {{parameter width {param width}} {clock clk {osc CLK}} {clock dstClk}}} ncw CrossingBypassWire {ports {{CLK Clock} {WVAL Int#(32)} {WGET Int#(32)}}} ---------- diff --git a/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-bh-out.expected b/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-bh-out.expected index e3facb44e..bb0527ecb 100644 --- a/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-bh-out.expected +++ b/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-bh-out.expected @@ -1,11 +1,11 @@ -verilog mkZeroSize_Sub sysZeroSize ---------- -{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkZeroSize_Sub {interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{port m2_y} {size 1}}}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} +{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {}}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkZeroSize_Sub {interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {results {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{port m2_y} {size 1}}}} {results {}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {results {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} {rg1 MOD {ports {{RST Prelude.Reset} {CLK Prelude.Clock} {CLK_GATE Prelude.Bool} {EN Prelude.Bool}}}} {rg2 mkZeroSize_Sub {ports {{CLK Prelude.Clock} {RST_N Prelude.Reset} {RDY_m1 Prelude.Bool} {m2_y Prelude.Bool} {EN_m2 Prelude.Bool} {RDY_m2 Prelude.Bool} {EN_m3 Prelude.Bool} {RDY_m3 Prelude.Bool}}}} ---------- -{interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{name m2_y} {port m2_y} {size 1}}}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} +{interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {results {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{name m2_y} {port m2_y} {size 1}}}} {results {}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {results {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} {CLK Prelude.Clock} {RST_N Prelude.Reset} {RDY_m1 Prelude.Bool} {m2_y Prelude.Bool} {EN_m2 Prelude.Bool} {RDY_m2 Prelude.Bool} {EN_m3 Prelude.Bool} {RDY_m3 Prelude.Bool} ---------- diff --git a/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-out.expected b/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-out.expected index 4d5264b9d..e62ad7fa7 100644 --- a/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-out.expected +++ b/testsuite/bsc.bluetcl/targeted/port_types/zero_size.tcl.bluetcl-out.expected @@ -1,11 +1,11 @@ -verilog mkZeroSize_Sub sysZeroSize ---------- -{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkZeroSize_Sub {interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{port m2_y} {size 1}}}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} +{rg1 MOD {interface {{method _write _write {clock _clk__1} {reset _rst__1} {args {}} {results {}} {enable EN}} {method _read _read {clock _clk__1} {reset _rst__1} {args {}} {results {}}}}} {args {{reset _rst__1 {port RST} {clock _clk__1}} {clock _clk__1 {osc CLK} {gate CLK_GATE}}}}} {rg2 mkZeroSize_Sub {interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {results {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{port m2_y} {size 1}}}} {results {}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {results {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}}} {rg1 MOD {ports {{RST Reset} {CLK Clock} {CLK_GATE Bool} {EN Bool}}}} {rg2 mkZeroSize_Sub {ports {{CLK Clock} {RST_N Reset} {RDY_m1 Bool} {m2_y Bool} {EN_m2 Bool} {RDY_m2 Bool} {EN_m3 Bool} {RDY_m3 Bool}}}} ---------- -{interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{name m2_y} {port m2_y} {size 1}}}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} +{interface {{method m1 m1 {clock no_clock} {reset no_reset} {args {}} {results {}} {ready RDY_m1}} {method m2 m2 {clock default_clock} {reset no_reset} {args {{{name m2_y} {port m2_y} {size 1}}}} {results {}} {enable EN_m2} {ready RDY_m2}} {method m3 m3 {clock default_clock} {reset no_reset} {args {}} {results {}} {enable EN_m3} {ready RDY_m3}}}} {args {{clock default_clock {osc CLK}} {reset default_reset {port RST_N} {clock default_clock}}}} {CLK Clock} {RST_N Reset} {RDY_m1 Bool} {m2_y Bool} {EN_m2 Bool} {RDY_m2 Bool} {EN_m3 Bool} {RDY_m3 Bool} ---------- diff --git a/testsuite/bsc.bugs/bluespec_inc/b1354/mkMulti.v.expected b/testsuite/bsc.bugs/bluespec_inc/b1354/mkMulti.v.expected index dc2fccd28..e8decbc3c 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1354/mkMulti.v.expected +++ b/testsuite/bsc.bugs/bluespec_inc/b1354/mkMulti.v.expected @@ -194,22 +194,22 @@ module mkMulti(CLK, wire rs_3$WE; // inputs to muxes for submodule ports - wire MUX_vec_0$write_1__SEL_1, - MUX_vec_1$write_1__SEL_1, - MUX_vec_10$write_1__SEL_1, - MUX_vec_11$write_1__SEL_1, - MUX_vec_12$write_1__SEL_1, - MUX_vec_13$write_1__SEL_1, - MUX_vec_14$write_1__SEL_1, - MUX_vec_15$write_1__SEL_1, - MUX_vec_2$write_1__SEL_1, - MUX_vec_3$write_1__SEL_1, - MUX_vec_4$write_1__SEL_1, - MUX_vec_5$write_1__SEL_1, - MUX_vec_6$write_1__SEL_1, - MUX_vec_7$write_1__SEL_1, - MUX_vec_8$write_1__SEL_1, - MUX_vec_9$write_1__SEL_1; + wire MUX_vec_0$write_ARG_1__SEL_1, + MUX_vec_1$write_ARG_1__SEL_1, + MUX_vec_10$write_ARG_1__SEL_1, + MUX_vec_11$write_ARG_1__SEL_1, + MUX_vec_12$write_ARG_1__SEL_1, + MUX_vec_13$write_ARG_1__SEL_1, + MUX_vec_14$write_ARG_1__SEL_1, + MUX_vec_15$write_ARG_1__SEL_1, + MUX_vec_2$write_ARG_1__SEL_1, + MUX_vec_3$write_ARG_1__SEL_1, + MUX_vec_4$write_ARG_1__SEL_1, + MUX_vec_5$write_ARG_1__SEL_1, + MUX_vec_6$write_ARG_1__SEL_1, + MUX_vec_7$write_ARG_1__SEL_1, + MUX_vec_8$write_ARG_1__SEL_1, + MUX_vec_9$write_ARG_1__SEL_1; // remaining internal signals reg SEL_ARR_vec_0_vec_1_vec_2_vec_3_vec_4_vec_5_ve_ETC___d18, @@ -312,115 +312,115 @@ module mkMulti(CLK, .D_OUT_5()); // inputs to muxes for submodule ports - assign MUX_vec_0$write_1__SEL_1 = EN_write2 && write2_addr == 4'd0 ; - assign MUX_vec_1$write_1__SEL_1 = EN_write2 && write2_addr == 4'd1 ; - assign MUX_vec_10$write_1__SEL_1 = EN_write2 && write2_addr == 4'd10 ; - assign MUX_vec_11$write_1__SEL_1 = EN_write2 && write2_addr == 4'd11 ; - assign MUX_vec_12$write_1__SEL_1 = EN_write2 && write2_addr == 4'd12 ; - assign MUX_vec_13$write_1__SEL_1 = EN_write2 && write2_addr == 4'd13 ; - assign MUX_vec_14$write_1__SEL_1 = EN_write2 && write2_addr == 4'd14 ; - assign MUX_vec_15$write_1__SEL_1 = EN_write2 && write2_addr == 4'd15 ; - assign MUX_vec_2$write_1__SEL_1 = EN_write2 && write2_addr == 4'd2 ; - assign MUX_vec_3$write_1__SEL_1 = EN_write2 && write2_addr == 4'd3 ; - assign MUX_vec_4$write_1__SEL_1 = EN_write2 && write2_addr == 4'd4 ; - assign MUX_vec_5$write_1__SEL_1 = EN_write2 && write2_addr == 4'd5 ; - assign MUX_vec_6$write_1__SEL_1 = EN_write2 && write2_addr == 4'd6 ; - assign MUX_vec_7$write_1__SEL_1 = EN_write2 && write2_addr == 4'd7 ; - assign MUX_vec_8$write_1__SEL_1 = EN_write2 && write2_addr == 4'd8 ; - assign MUX_vec_9$write_1__SEL_1 = EN_write2 && write2_addr == 4'd9 ; + assign MUX_vec_0$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd0 ; + assign MUX_vec_1$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd1 ; + assign MUX_vec_10$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd10 ; + assign MUX_vec_11$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd11 ; + assign MUX_vec_12$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd12 ; + assign MUX_vec_13$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd13 ; + assign MUX_vec_14$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd14 ; + assign MUX_vec_15$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd15 ; + assign MUX_vec_2$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd2 ; + assign MUX_vec_3$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd3 ; + assign MUX_vec_4$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd4 ; + assign MUX_vec_5$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd5 ; + assign MUX_vec_6$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd6 ; + assign MUX_vec_7$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd7 ; + assign MUX_vec_8$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd8 ; + assign MUX_vec_9$write_ARG_1__SEL_1 = EN_write2 && write2_addr == 4'd9 ; // register vec_0 - assign vec_0$D_IN = MUX_vec_0$write_1__SEL_1 ; + assign vec_0$D_IN = MUX_vec_0$write_ARG_1__SEL_1 ; assign vec_0$EN = EN_write1 && write1_addr == 4'd0 || EN_write2 && write2_addr == 4'd0 ; // register vec_1 - assign vec_1$D_IN = MUX_vec_1$write_1__SEL_1 ; + assign vec_1$D_IN = MUX_vec_1$write_ARG_1__SEL_1 ; assign vec_1$EN = EN_write1 && write1_addr == 4'd1 || EN_write2 && write2_addr == 4'd1 ; // register vec_10 - assign vec_10$D_IN = MUX_vec_10$write_1__SEL_1 ; + assign vec_10$D_IN = MUX_vec_10$write_ARG_1__SEL_1 ; assign vec_10$EN = EN_write1 && write1_addr == 4'd10 || EN_write2 && write2_addr == 4'd10 ; // register vec_11 - assign vec_11$D_IN = MUX_vec_11$write_1__SEL_1 ; + assign vec_11$D_IN = MUX_vec_11$write_ARG_1__SEL_1 ; assign vec_11$EN = EN_write1 && write1_addr == 4'd11 || EN_write2 && write2_addr == 4'd11 ; // register vec_12 - assign vec_12$D_IN = MUX_vec_12$write_1__SEL_1 ; + assign vec_12$D_IN = MUX_vec_12$write_ARG_1__SEL_1 ; assign vec_12$EN = EN_write1 && write1_addr == 4'd12 || EN_write2 && write2_addr == 4'd12 ; // register vec_13 - assign vec_13$D_IN = MUX_vec_13$write_1__SEL_1 ; + assign vec_13$D_IN = MUX_vec_13$write_ARG_1__SEL_1 ; assign vec_13$EN = EN_write1 && write1_addr == 4'd13 || EN_write2 && write2_addr == 4'd13 ; // register vec_14 - assign vec_14$D_IN = MUX_vec_14$write_1__SEL_1 ; + assign vec_14$D_IN = MUX_vec_14$write_ARG_1__SEL_1 ; assign vec_14$EN = EN_write1 && write1_addr == 4'd14 || EN_write2 && write2_addr == 4'd14 ; // register vec_15 - assign vec_15$D_IN = MUX_vec_15$write_1__SEL_1 ; + assign vec_15$D_IN = MUX_vec_15$write_ARG_1__SEL_1 ; assign vec_15$EN = EN_write1 && write1_addr == 4'd15 || EN_write2 && write2_addr == 4'd15 ; // register vec_2 - assign vec_2$D_IN = MUX_vec_2$write_1__SEL_1 ; + assign vec_2$D_IN = MUX_vec_2$write_ARG_1__SEL_1 ; assign vec_2$EN = EN_write1 && write1_addr == 4'd2 || EN_write2 && write2_addr == 4'd2 ; // register vec_3 - assign vec_3$D_IN = MUX_vec_3$write_1__SEL_1 ; + assign vec_3$D_IN = MUX_vec_3$write_ARG_1__SEL_1 ; assign vec_3$EN = EN_write1 && write1_addr == 4'd3 || EN_write2 && write2_addr == 4'd3 ; // register vec_4 - assign vec_4$D_IN = MUX_vec_4$write_1__SEL_1 ; + assign vec_4$D_IN = MUX_vec_4$write_ARG_1__SEL_1 ; assign vec_4$EN = EN_write1 && write1_addr == 4'd4 || EN_write2 && write2_addr == 4'd4 ; // register vec_5 - assign vec_5$D_IN = MUX_vec_5$write_1__SEL_1 ; + assign vec_5$D_IN = MUX_vec_5$write_ARG_1__SEL_1 ; assign vec_5$EN = EN_write1 && write1_addr == 4'd5 || EN_write2 && write2_addr == 4'd5 ; // register vec_6 - assign vec_6$D_IN = MUX_vec_6$write_1__SEL_1 ; + assign vec_6$D_IN = MUX_vec_6$write_ARG_1__SEL_1 ; assign vec_6$EN = EN_write1 && write1_addr == 4'd6 || EN_write2 && write2_addr == 4'd6 ; // register vec_7 - assign vec_7$D_IN = MUX_vec_7$write_1__SEL_1 ; + assign vec_7$D_IN = MUX_vec_7$write_ARG_1__SEL_1 ; assign vec_7$EN = EN_write1 && write1_addr == 4'd7 || EN_write2 && write2_addr == 4'd7 ; // register vec_8 - assign vec_8$D_IN = MUX_vec_8$write_1__SEL_1 ; + assign vec_8$D_IN = MUX_vec_8$write_ARG_1__SEL_1 ; assign vec_8$EN = EN_write1 && write1_addr == 4'd8 || EN_write2 && write2_addr == 4'd8 ; // register vec_9 - assign vec_9$D_IN = MUX_vec_9$write_1__SEL_1 ; + assign vec_9$D_IN = MUX_vec_9$write_ARG_1__SEL_1 ; assign vec_9$EN = EN_write1 && write1_addr == 4'd9 || EN_write2 && write2_addr == 4'd9 ; diff --git a/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp b/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp index 0982c1fa2..b529df206 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp +++ b/testsuite/bsc.bugs/bluespec_inc/b1490/b1490.exp @@ -9,7 +9,7 @@ proc rts_flags { heapsize } { # ----- compile_verilog_pass Bug1490Bool.bsv {} $rtsflags -compile_verilog_pass Bug1490MyBool.bsv {} $rtsflags +compile_verilog_pass Bug1490MyBool.bsv {} [rts_flags 300] compile_verilog_pass Bug1490MyUnion.bsv {} [rts_flags 272] compile_verilog_pass Bug1490MyEnum.bsv {} $rtsflags diff --git a/testsuite/bsc.bugs/bluespec_inc/b1610/Test2.bs b/testsuite/bsc.bugs/bluespec_inc/b1610/Test2.bs index 20b45d091..9eb201aa5 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1610/Test2.bs +++ b/testsuite/bsc.bugs/bluespec_inc/b1610/Test2.bs @@ -1,7 +1,7 @@ package Test2 where interface RegPrimPairBoolMaybeBitSizeOfBit32_ = - _write :: Bit 34 -> ActionValue_ 0 + _write :: Bit 34 -> ActionValue_ (Bit 0) fromRegPrimPairBoolMaybeBitSizeOfBit32_ :: (Bits (Bool, Maybe (Bit (SizeOf (Bit 32)))) 34) => diff --git a/testsuite/bsc.bugs/bluespec_inc/b1758/b1758.exp b/testsuite/bsc.bugs/bluespec_inc/b1758/b1758.exp index e9dcc3bca..5a00dd66b 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b1758/b1758.exp +++ b/testsuite/bsc.bugs/bluespec_inc/b1758/b1758.exp @@ -8,12 +8,10 @@ compile_verilog_pass ZeroBitValueMethod.bsv {} {-dexpanded -dATS} # Test that the method reference has been replaced by 0 in the evaluator if { $vtest == 1 } { - # XXX This still need to be fixed - find_regexp ZeroBitValueMethod.bsv.bsc-vcomp-out \ + find_regexp_fail ZeroBitValueMethod.bsv.bsc-vcomp-out \ {\= \.ZeroBitValueMethod\.getVal g} - # XXX AConv doesn't replace it either find_regexp ZeroBitValueMethod.bsv.bsc-vcomp-out \ - {\= g\.getVal} + {\=\=> Prelude\.\$display#0 "v \= %b" 0} } # ----- @@ -23,12 +21,10 @@ compile_verilog_pass ZeroBitActionValueMethod.bsv {} {-dexpanded -dATS} # Test that the method reference has been replaced by 0 in the evaluator if { $vtest == 1 } { - # XXX This still need to be fixed - find_regexp ZeroBitActionValueMethod.bsv.bsc-vcomp-out \ + find_regexp_fail ZeroBitActionValueMethod.bsv.bsc-vcomp-out \ {\= \.Prelude\.avValue_ ·0 \(\.ZeroBitActionValueMethod\.get g\)} - # At least AConv replaces it find_regexp ZeroBitActionValueMethod.bsv.bsc-vcomp-out \ - {g\.get\; p\.put 0\'d0\;} + {g\.get\; p\.put\;} } # ----- diff --git a/testsuite/bsc.bugs/bluespec_inc/b262/sysBug262Opt.v.expected b/testsuite/bsc.bugs/bluespec_inc/b262/sysBug262Opt.v.expected index 8c0f18456..c1b756af0 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b262/sysBug262Opt.v.expected +++ b/testsuite/bsc.bugs/bluespec_inc/b262/sysBug262Opt.v.expected @@ -39,10 +39,10 @@ module sysBug262Opt(CLK, wire r$EN; // inputs to muxes for submodule ports - wire [19 : 0] MUX_r$write_1__VAL_1; + wire [19 : 0] MUX_r$write_ARG_1__VAL_1; // inputs to muxes for submodule ports - assign MUX_r$write_1__VAL_1 = + assign MUX_r$write_ARG_1__VAL_1 = { 1'd0, 19'b0101010101010101010 /* unspecified value */ } ; // register done @@ -50,7 +50,7 @@ module sysBug262Opt(CLK, assign done$EN = !done ; // register r - assign r$D_IN = done ? MUX_r$write_1__VAL_1 : 20'd524293 ; + assign r$D_IN = done ? MUX_r$write_ARG_1__VAL_1 : 20'd524293 ; assign r$EN = 1'b1 ; // handling of inlined registers diff --git a/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected b/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected index 7d9339f4a..81ac871ff 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected +++ b/testsuite/bsc.bugs/bluespec_inc/b292/mkDesign.v.expected @@ -86,8 +86,8 @@ module mkDesign(clk, wire i_multiplicand$EN; // remaining internal signals - wire [7 : 0] x__h508, x__h592, x__h741; - wire [3 : 0] x__h704, x__h778; + wire [7 : 0] x__h1117, x__h825, x__h919; + wire [3 : 0] x__h1081, x__h1152; // value method done assign done = i_done_reg ; @@ -99,7 +99,7 @@ module mkDesign(clk, assign i_acc$D_IN = (shift_and_add_load && i_count == 4'd0) ? 8'd0 : - (i_mult[0] ? x__h508 : i_acc) ; + (i_mult[0] ? x__h825 : i_acc) ; assign i_acc$EN = shift_and_add_load && i_count == 4'd0 || i_enable && i_count != 4'd4 ; @@ -108,7 +108,7 @@ module mkDesign(clk, assign i_count$D_IN = (shift_and_add_load && i_count == 4'd0) ? 4'd0 : - ((i_enable && i_count != 4'd4) ? x__h778 : 4'd0) ; + ((i_enable && i_count != 4'd4) ? x__h1152 : 4'd0) ; assign i_count$EN = 1'd1 ; // register i_done_reg @@ -127,24 +127,24 @@ module mkDesign(clk, assign i_mult$D_IN = (shift_and_add_load && i_count == 4'd0) ? shift_and_add_b : - x__h704 ; + x__h1081 ; assign i_mult$EN = shift_and_add_load && i_count == 4'd0 || i_enable && i_count != 4'd4 ; // register i_multiplicand assign i_multiplicand$D_IN = - (shift_and_add_load && i_count == 4'd0) ? x__h592 : x__h741 ; + (shift_and_add_load && i_count == 4'd0) ? x__h919 : x__h1117 ; assign i_multiplicand$EN = shift_and_add_load && i_count == 4'd0 || i_enable && i_count != 4'd4 ; // remaining internal signals - assign x__h592 = { 4'b0, shift_and_add_a } ; - assign x__h508 = i_acc + i_multiplicand ; - assign x__h704 = { 1'd0, i_mult[3:1] } ; - assign x__h741 = { i_multiplicand[6:0], 1'd0 } ; - assign x__h778 = i_count + 4'd1 ; + assign x__h1081 = { 1'd0, i_mult[3:1] } ; + assign x__h1117 = { i_multiplicand[6:0], 1'd0 } ; + assign x__h1152 = i_count + 4'd1 ; + assign x__h825 = i_acc + i_multiplicand ; + assign x__h919 = { 4'b0, shift_and_add_a } ; // handling of inlined registers diff --git a/testsuite/bsc.bugs/bluespec_inc/b293/mkDesign1.v.expected b/testsuite/bsc.bugs/bluespec_inc/b293/mkDesign1.v.expected index f6ee37482..8002f04dc 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b293/mkDesign1.v.expected +++ b/testsuite/bsc.bugs/bluespec_inc/b293/mkDesign1.v.expected @@ -86,8 +86,8 @@ module mkDesign1(clk, wire multiplier$EN; // inputs to muxes for submodule ports - wire [7 : 0] MUX_multiplicand$write_1__VAL_1; - wire MUX_accumulator$write_1__SEL_1; + wire [7 : 0] MUX_multiplicand$write_ARG_1__VAL_1; + wire MUX_accumulator$write_ARG_1__SEL_1; // value method done assign done = done_reg ; @@ -96,13 +96,13 @@ module mkDesign1(clk, assign product = accumulator ; // inputs to muxes for submodule ports - assign MUX_accumulator$write_1__SEL_1 = + assign MUX_accumulator$write_ARG_1__SEL_1 = shift_and_add_load && count == 4'd0 ; - assign MUX_multiplicand$write_1__VAL_1 = { 4'b0, shift_and_add_a } ; + assign MUX_multiplicand$write_ARG_1__VAL_1 = { 4'b0, shift_and_add_a } ; // register accumulator assign accumulator$D_IN = 8'd0 ; - assign accumulator$EN = MUX_accumulator$write_1__SEL_1 ; + assign accumulator$EN = MUX_accumulator$write_ARG_1__SEL_1 ; // register count assign count$D_IN = 4'd0 ; @@ -117,12 +117,12 @@ module mkDesign1(clk, assign enable$EN = 1'b1 ; // register multiplicand - assign multiplicand$D_IN = MUX_multiplicand$write_1__VAL_1 ; - assign multiplicand$EN = MUX_accumulator$write_1__SEL_1 ; + assign multiplicand$D_IN = MUX_multiplicand$write_ARG_1__VAL_1 ; + assign multiplicand$EN = MUX_accumulator$write_ARG_1__SEL_1 ; // register multiplier assign multiplier$D_IN = shift_and_add_b ; - assign multiplier$EN = MUX_accumulator$write_1__SEL_1 ; + assign multiplier$EN = MUX_accumulator$write_ARG_1__SEL_1 ; // handling of inlined registers diff --git a/testsuite/bsc.bugs/bluespec_inc/b302/mkDesign.v.expected b/testsuite/bsc.bugs/bluespec_inc/b302/mkDesign.v.expected index 493ba1aa3..c8146ff36 100644 --- a/testsuite/bsc.bugs/bluespec_inc/b302/mkDesign.v.expected +++ b/testsuite/bsc.bugs/bluespec_inc/b302/mkDesign.v.expected @@ -46,23 +46,23 @@ module mkDesign(clk, wire [10 : 0] result; // remaining internal signals - wire [5 : 0] _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d55, - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_r_ETC___d56, - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_ETC___d57, - _0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_ETC___d58, - _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d59, - x__h144, - x__h146, - x__h240, - x__h242, - x__h336, - x__h338, - x__h432, - x__h434, - x__h528, - x__h530, - y__h147; - wire [4 : 0] IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d54, + wire [5 : 0] _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d45, + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_r_ETC___d36, + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_ETC___d27, + _0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_ETC___d18, + _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d9, + x__h353, + x__h355, + x__h431, + x__h433, + x__h509, + x__h511, + x__h587, + x__h589, + x__h665, + x__h667, + y__h356; + wire [4 : 0] IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d42, IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC__q4, IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_B_ETC___d53, IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_B_ETC__q3, @@ -70,15 +70,16 @@ module mkDesign(clk, IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_P_ETC__q2, IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_ETC___d51, IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_ETC__q1, - _theResult_____1_snd__h939, - notB__h48, - quotient__h63; + notB__h247, + quotient__h262; // value method result assign result = { result_a[9:5] >= result_b, - _theResult_____1_snd__h939, - quotient__h63 } ; + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d45[5] ? + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d45[4:0] : + IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d42, + quotient__h262 } ; // remaining internal signals assign IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d54 = @@ -109,45 +110,41 @@ module mkDesign(clk, _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d59[5] ? _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d59[4:0] : result_a[8:4] ; - assign _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d55 = - x__h144 + 6'd1 ; - assign _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_r_ETC___d56 = - x__h240 + 6'd1 ; - assign _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_ETC___d57 = - x__h336 + 6'd1 ; - assign _0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_ETC___d58 = - x__h432 + 6'd1 ; - assign _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d59 = - x__h528 + 6'd1 ; - assign _theResult_____1_snd__h939 = - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d55[5] ? - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d55[4:0] : - IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d54 ; - assign notB__h48 = ~result_b ; - assign quotient__h63 = - { _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d59[5], - _0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_ETC___d58[5], - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_ETC___d57[5], - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_r_ETC___d56[5], - _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d55[5] } ; - assign x__h144 = x__h146 + y__h147 ; - assign x__h146 = + assign _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d45 = + x__h353 + 6'd1 ; + assign _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_r_ETC___d36 = + x__h431 + 6'd1 ; + assign _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_ETC___d27 = + x__h509 + 6'd1 ; + assign _0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_ETC___d18 = + x__h587 + 6'd1 ; + assign _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d9 = + x__h665 + 6'd1 ; + assign notB__h247 = ~result_b ; + assign quotient__h262 = + { _0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_IN_ETC___d9[5], + _0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_ETC___d18[5], + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_ETC___d27[5], + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_r_ETC___d36[5], + _0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_I_ETC___d45[5] } ; + assign x__h353 = x__h355 + y__h356 ; + assign x__h355 = { 1'd0, - IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d54 } ; - assign x__h240 = x__h242 + y__h147 ; - assign x__h242 = + IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCA_ETC___d42 } ; + assign x__h431 = x__h433 + y__h356 ; + assign x__h433 = { 1'd0, - IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_B_ETC___d53 } ; - assign x__h336 = x__h338 + y__h147 ; - assign x__h338 = + IF_0_CONCAT_IF_0_CONCAT_IF_0_CONCAT_result_a_B_ETC___d33 } ; + assign x__h509 = x__h511 + y__h356 ; + assign x__h511 = { 1'd0, - IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_P_ETC___d52 } ; - assign x__h432 = x__h434 + y__h147 ; - assign x__h434 = + IF_0_CONCAT_IF_0_CONCAT_result_a_BITS_8_TO_4_P_ETC___d24 } ; + assign x__h587 = x__h589 + y__h356 ; + assign x__h589 = { 1'd0, - IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_ETC___d51 } ; - assign x__h528 = x__h530 + y__h147 ; - assign x__h530 = { 1'd0, result_a[8:4] } ; - assign y__h147 = { 1'd0, notB__h48 } ; + IF_0_CONCAT_result_a_BITS_8_TO_4_PLUS_0_CONCAT_ETC___d15 } ; + assign x__h665 = x__h667 + y__h356 ; + assign x__h667 = { 1'd0, result_a[8:4] } ; + assign y__h356 = { 1'd0, notB__h247 } ; endmodule // mkDesign diff --git a/testsuite/bsc.codegen/foreign/BDPIActionValue_.bsv b/testsuite/bsc.codegen/foreign/BDPIActionValue_.bsv index 6c4fba560..681ab00ad 100644 --- a/testsuite/bsc.codegen/foreign/BDPIActionValue_.bsv +++ b/testsuite/bsc.codegen/foreign/BDPIActionValue_.bsv @@ -1,4 +1,4 @@ -import "BDPI" function ActionValue_#(32) my_time (Bit#(8) x); +import "BDPI" function ActionValue_#(Bit#(32)) my_time (Bit#(8) x); function ActionValue#(Bit#(32)) my_time2(Bit#(8) x); let y = my_time(x); diff --git a/testsuite/bsc.doc/UserGuide_mkGCD.v.expected b/testsuite/bsc.doc/UserGuide_mkGCD.v.expected index 4882be5fa..97587b770 100644 --- a/testsuite/bsc.doc/UserGuide_mkGCD.v.expected +++ b/testsuite/bsc.doc/UserGuide_mkGCD.v.expected @@ -71,7 +71,7 @@ module mkGCD(CLK, wire WILL_FIRE_RL_flip, WILL_FIRE_RL_sub; // inputs to muxes for submodule ports - wire [50 : 0] MUX_reg_2$write_1__VAL_3; + wire [50 : 0] MUX_reg_2$write_ARG_1__VAL_3; // remaining internal signals wire reg_1_ULE_reg_2___d3; @@ -90,7 +90,7 @@ module mkGCD(CLK, assign WILL_FIRE_RL_sub = reg_1_ULE_reg_2___d3 && reg_2 != 51'd0 ; // inputs to muxes for submodule ports - assign MUX_reg_2$write_1__VAL_3 = reg_2 - reg_1 ; + assign MUX_reg_2$write_ARG_1__VAL_3 = reg_2 - reg_1 ; // register reg_1 assign reg_1$D_IN = EN_start ? start_num1 : reg_2 ; @@ -100,12 +100,12 @@ module mkGCD(CLK, always@(EN_start or start_num2 or WILL_FIRE_RL_flip or - reg_1 or WILL_FIRE_RL_sub or MUX_reg_2$write_1__VAL_3) + reg_1 or WILL_FIRE_RL_sub or MUX_reg_2$write_ARG_1__VAL_3) begin case (1'b1) // synopsys parallel_case EN_start: reg_2$D_IN = start_num2; WILL_FIRE_RL_flip: reg_2$D_IN = reg_1; - WILL_FIRE_RL_sub: reg_2$D_IN = MUX_reg_2$write_1__VAL_3; + WILL_FIRE_RL_sub: reg_2$D_IN = MUX_reg_2$write_ARG_1__VAL_3; default: reg_2$D_IN = 51'h2AAAAAAAAAAAA /* unspecified value */ ; endcase end diff --git a/testsuite/bsc.evaluator/mkTest.atsexpand.expected b/testsuite/bsc.evaluator/mkTest.atsexpand.expected index c51763160..a18e571f8 100644 --- a/testsuite/bsc.evaluator/mkTest.atsexpand.expected +++ b/testsuite/bsc.evaluator/mkTest.atsexpand.expected @@ -25,7 +25,7 @@ slots :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool slots_1 :: ABSTRACT: Prelude.VReg = RegUN @@ -40,7 +40,7 @@ slots_1 :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool ptr :: ABSTRACT: Prelude.VReg = RegUN @@ -55,7 +55,7 @@ ptr :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd5] [] - meth types=[([], Nothing, Just (Bit 5)), ([Bit 5], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 5]), ([Bit 5], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 5 Q_OUT -> Prelude.Bit 5 pred :: ABSTRACT: Prelude.VReg = RegUN @@ -70,7 +70,7 @@ pred :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool -- AP rules diff --git a/testsuite/bsc.evaluator/mkTest.atsexpand.nolift.expandif.expected b/testsuite/bsc.evaluator/mkTest.atsexpand.nolift.expandif.expected index 5fc0e2430..6f9dfc800 100644 --- a/testsuite/bsc.evaluator/mkTest.atsexpand.nolift.expandif.expected +++ b/testsuite/bsc.evaluator/mkTest.atsexpand.nolift.expandif.expected @@ -25,7 +25,7 @@ slots :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool slots_1 :: ABSTRACT: Prelude.VReg = RegUN @@ -40,7 +40,7 @@ slots_1 :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool ptr :: ABSTRACT: Prelude.VReg = RegUN @@ -55,7 +55,7 @@ ptr :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd5] [] - meth types=[([], Nothing, Just (Bit 5)), ([Bit 5], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 5]), ([Bit 5], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 5 Q_OUT -> Prelude.Bit 5 pred :: ABSTRACT: Prelude.VReg = RegUN @@ -70,7 +70,7 @@ pred :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool -- AP rules diff --git a/testsuite/bsc.evaluator/sysITransformConstantAcrossEquals.atsexpand.expected b/testsuite/bsc.evaluator/sysITransformConstantAcrossEquals.atsexpand.expected index 1254465ff..285e1a3f3 100644 --- a/testsuite/bsc.evaluator/sysITransformConstantAcrossEquals.atsexpand.expected +++ b/testsuite/bsc.evaluator/sysITransformConstantAcrossEquals.atsexpand.expected @@ -25,7 +25,7 @@ r :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd3] [] - meth types=[([], Nothing, Just (Bit 3)), ([Bit 3], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 3]), ([Bit 3], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 3 Q_OUT -> Prelude.Bit 3 x :: ABSTRACT: Prelude.VReg = RegUN @@ -40,7 +40,7 @@ x :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd2] [] - meth types=[([], Nothing, Just (Bit 2)), ([Bit 2], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 2]), ([Bit 2], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 2 Q_OUT -> Prelude.Bit 2 y :: ABSTRACT: Prelude.VReg = RegUN @@ -55,7 +55,7 @@ y :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd2] [] - meth types=[([], Nothing, Just (Bit 2)), ([Bit 2], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 2]), ([Bit 2], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 2 Q_OUT -> Prelude.Bit 2 z :: ABSTRACT: Prelude.VReg = RegUN @@ -70,7 +70,7 @@ z :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd2] [] - meth types=[([], Nothing, Just (Bit 2)), ([Bit 2], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 2]), ([Bit 2], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 2 Q_OUT -> Prelude.Bit 2 -- AP rules diff --git a/testsuite/bsc.evaluator/sysShiftMult.ats.expected b/testsuite/bsc.evaluator/sysShiftMult.ats.expected index 031a4133f..9ffec2982 100644 --- a/testsuite/bsc.evaluator/sysShiftMult.ats.expected +++ b/testsuite/bsc.evaluator/sysShiftMult.ats.expected @@ -25,7 +25,7 @@ x :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd32, 32'd17] [] - meth types=[([], Nothing, Just (Bit 32)), ([Bit 32], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 32]), ([Bit 32], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 32 Q_OUT -> Prelude.Bit 32 y :: ABSTRACT: Prelude.VReg = RegN @@ -40,29 +40,29 @@ y :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd32, 32'd24] [] - meth types=[([], Nothing, Just (Bit 32)), ([Bit 32], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 32]), ([Bit 32], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 32 Q_OUT -> Prelude.Bit 32 -- AP local definitions -x__h177 :: Bit 32; -x__h177 = x_BITS_28_TO_0___h184 ++ 3'd0; --- IdProp x__h177[IdP_keep] -x__h145 :: Bit 32; -x__h145 = x_BITS_29_TO_0___h174 ++ 2'd0; --- IdProp x__h145[IdP_keep] -x_BITS_28_TO_0___h184 :: Bit 29; -x_BITS_28_TO_0___h184 = extract x___d1 32'd28 32'd0; --- IdProp x_BITS_28_TO_0___h184[IdP_keep] -x_BITS_29_TO_0___h174 :: Bit 30; -x_BITS_29_TO_0___h174 = extract x___d1 32'd29 32'd0; --- IdProp x_BITS_29_TO_0___h174[IdP_keep] +x__h146 :: Bit 32; +x__h146 = x_BITS_28_TO_0___h153 ++ 3'd0; +-- IdProp x__h146[IdP_keep] +x__h105 :: Bit 32; +x__h105 = x_BITS_29_TO_0___h143 ++ 2'd0; +-- IdProp x__h105[IdP_keep] +x_BITS_28_TO_0___h153 :: Bit 29; +x_BITS_28_TO_0___h153 = extract x___d1 32'd28 32'd0; +-- IdProp x_BITS_28_TO_0___h153[IdP_keep] +x_BITS_29_TO_0___h143 :: Bit 30; +x_BITS_29_TO_0___h143 = extract x___d1 32'd29 32'd0; +-- IdProp x_BITS_29_TO_0___h143[IdP_keep] x___d1 :: Bit 32; x___d1 = x.read; -- IdProp x___d1[IdP_from_rhs] -- AP rules rule RL_unnamed "": when 1'd1 - ==> { x.write x__h145; y.write x__h177; } + ==> { x.write x__h105; y.write x__h146; } [] clock domain = Just (0), resets = [0] -- AP scheduling pragmas diff --git a/testsuite/bsc.interra/messages/EResources/EResources.bs.bsc-vcomp-out.expected b/testsuite/bsc.interra/messages/EResources/EResources.bs.bsc-vcomp-out.expected index 1ace575a0..6b022d6a2 100755 --- a/testsuite/bsc.interra/messages/EResources/EResources.bs.bsc-vcomp-out.expected +++ b/testsuite/bsc.interra/messages/EResources/EResources.bs.bsc-vcomp-out.expected @@ -5,5 +5,5 @@ Verilog file created: subtractor.v code generation for mkDifference starts Error: "EResources.bs", line 43, column 13: (G0002) `m.minus' needs more than 1 ports for the following uses: - `m.minus b__h230 b__h231' at "EResources.bs", line 43, column 13 - `m.minus b__h231 b__h230' at "EResources.bs", line 43, column 13 + `m.minus x___d1 y___d2' at "EResources.bs", line 43, column 13 + `m.minus y___d2 x___d1' at "EResources.bs", line 43, column 13 diff --git a/testsuite/bsc.misc/lambda_calculus/lc-sysMultiArityConcat.out.expected b/testsuite/bsc.misc/lambda_calculus/lc-sysMultiArityConcat.out.expected index 4f9606823..fa4e214b9 100644 --- a/testsuite/bsc.misc/lambda_calculus/lc-sysMultiArityConcat.out.expected +++ b/testsuite/bsc.misc/lambda_calculus/lc-sysMultiArityConcat.out.expected @@ -27,12 +27,12 @@ dim_sysMultiArityConcat = rule_RL_d_sysMultiArityConcat :: MOD_sysMultiArityConcat -> (Bool, MOD_sysMultiArityConcat, ()); rule_RL_d_sysMultiArityConcat = (\ (state0 :: MOD_sysMultiArityConcat) -> - let { (def__read__h44 :: Bit #3) = meth_read_RegUN (inst_src1__sysMultiArityConcat state0) - ; (def__read__h76 :: Bit #4) = meth_read_RegUN (inst_src2__sysMultiArityConcat state0) - ; (def__read__h108 :: Bit #5) = meth_read_RegUN (inst_src3__sysMultiArityConcat state0) + let { (def_src1___d1 :: Bit #3) = meth_read_RegUN (inst_src1__sysMultiArityConcat state0) + ; (def_src2___d2 :: Bit #4) = meth_read_RegUN (inst_src2__sysMultiArityConcat state0) + ; (def_src3___d3 :: Bit #5) = meth_read_RegUN (inst_src3__sysMultiArityConcat state0) ; (act1 :: (Bool, MOD_RegUN #12, ())) = meth_write_RegUN - (primConcat def__read__h44 (primConcat def__read__h76 def__read__h108)) + (primConcat def_src1___d1 (primConcat def_src2___d2 def_src3___d3)) (inst_snk__sysMultiArityConcat state0) ; (guard1 :: Bool) = fst3 act1 ; (state1 :: MOD_sysMultiArityConcat) = state0 { inst_snk__sysMultiArityConcat = snd3 act1 } diff --git a/testsuite/bsc.misc/lambda_calculus/lc-sysStructs.out.expected b/testsuite/bsc.misc/lambda_calculus/lc-sysStructs.out.expected index 6b74a042f..7078bcb77 100644 --- a/testsuite/bsc.misc/lambda_calculus/lc-sysStructs.out.expected +++ b/testsuite/bsc.misc/lambda_calculus/lc-sysStructs.out.expected @@ -45,25 +45,25 @@ dim_sysStructs = rule_RL_add_em_sysStructs :: MOD_sysStructs -> (Bool, MOD_sysStructs, ()); rule_RL_add_em_sysStructs = (\ (state0 :: MOD_sysStructs) -> - let { (def_x__h549 :: Bit #9) = meth_read_RegN (inst_a__sysStructs state0) - ; (def_x__h557 :: Bit #9) = meth_read_RegN (inst_b__sysStructs state0) - ; (def_x__h541 :: Bit #9) = primAdd def_x__h549 def_x__h557 - ; (def_x__h529 :: Bit #9) = primAdd def_x__h541 (4 :: Bit #9) - ; (def_s__h482 :: Bit #1) = meth_read_RegN (inst_s__sysStructs state0) - ; (act1 :: (Bool, MOD_RegN #9, ())) = meth_write_RegN def_x__h529 (inst_a__sysStructs state0) + let { (def_x__h542 :: Bit #9) = meth_read_RegN (inst_a__sysStructs state0) + ; (def_x__h550 :: Bit #9) = meth_read_RegN (inst_b__sysStructs state0) + ; (def_x__h534 :: Bit #9) = primAdd def_x__h542 def_x__h550 + ; (def_x__h522 :: Bit #9) = primAdd def_x__h534 (4 :: Bit #9) + ; (def_s__h463 :: Bit #1) = meth_read_RegN (inst_s__sysStructs state0) + ; (act1 :: (Bool, MOD_RegN #9, ())) = meth_write_RegN def_x__h522 (inst_a__sysStructs state0) ; (guard1 :: Bool) = fst3 act1 ; (state1 :: MOD_sysStructs) = state0 { inst_a__sysStructs = snd3 act1 } ; (act2 :: (Bool, MOD_RegN #1, ())) = meth_write_RegN (0 :: Bit #1) (inst_s__sysStructs state1) ; (guard2 :: Bool) = guard1 && (fst3 act2) ; (state2 :: MOD_sysStructs) = state1 { inst_s__sysStructs = snd3 act2 } } - in mktuple ((bitToBool def_s__h482) && guard2) state2 ()); + in mktuple ((bitToBool def_s__h463) && guard2) state2 ()); rule_RL_tss_sysStructs :: MOD_sysStructs -> (Bool, MOD_sysStructs, ()); rule_RL_tss_sysStructs = (\ (state0 :: MOD_sysStructs) -> - let { (def_t1___d8 :: Bit #12) = meth_read_RegUN (inst_t1__sysStructs state0) - ; (def_t2___d6 :: Bit #12) = meth_read_RegUN (inst_t2__sysStructs state0) + let { (def_t2___d6 :: Bit #12) = meth_read_RegUN (inst_t2__sysStructs state0) + ; (def_t1___d8 :: Bit #12) = meth_read_RegUN (inst_t1__sysStructs state0) ; (act1 :: (Bool, MOD_RegUN #12, ())) = meth_write_RegUN (primConcat diff --git a/testsuite/bsc.misc/lambda_calculus/lc-sysTb.out.expected b/testsuite/bsc.misc/lambda_calculus/lc-sysTb.out.expected index 2c6cde4f6..950d5f259 100644 --- a/testsuite/bsc.misc/lambda_calculus/lc-sysTb.out.expected +++ b/testsuite/bsc.misc/lambda_calculus/lc-sysTb.out.expected @@ -30,22 +30,22 @@ dim_sysTb = rule_RL_r0_sysTb :: MOD_sysTb -> (Bool, MOD_sysTb, ()); rule_RL_r0_sysTb = (\ (state0 :: MOD_sysTb) -> - let { (def_b__h284 :: Bit #51) = meth_read_RegN (inst_c1__sysTb state0) - ; (def_b__h285 :: Bit #51) = meth_read_RegN (inst_c2__sysTb state0) - ; (def_state__h244 :: Bit #2) = meth_read_RegN (inst_state__sysTb state0) - ; (def_b__h322 :: Bit #51) = noinline_add def_b__h284 (3 :: Bit #51) - ; (def_b__h345 :: Bit #51) = noinline_add def_b__h285 (2 :: Bit #51) + let { (def_state__h528 :: Bit #2) = meth_read_RegN (inst_state__sysTb state0) + ; (def_c2___d6 :: Bit #51) = meth_read_RegN (inst_c2__sysTb state0) + ; (def_b__h871 :: Bit #51) = noinline_add def_c2___d6 (2 :: Bit #51) + ; (def_c1___d5 :: Bit #51) = meth_read_RegN (inst_c1__sysTb state0) + ; (def_b__h747 :: Bit #51) = noinline_add def_c1___d5 (3 :: Bit #51) ; (def_gcd_RDY_start____d1 :: Bool) = meth_RDY_start_sysMethods (inst_gcd__sysTb state0) - ; (def_state_EQ_0___d3 :: Bool) = primEQ def_state__h244 (0 :: Bit #2) + ; (def_state_EQ_0___d3 :: Bool) = primEQ def_state__h528 (0 :: Bit #2) ; (def_gcd_RDY_start_AND_state_EQ_0___d4 :: Bool) = def_gcd_RDY_start____d1 && def_state_EQ_0___d3 ; (act1 :: (Bool, MOD_sysMethods, ())) = - meth_start_sysMethods def_b__h284 def_b__h285 (inst_gcd__sysTb state0) + meth_start_sysMethods def_c1___d5 def_c2___d6 (inst_gcd__sysTb state0) ; (guard1 :: Bool) = fst3 act1 ; (state1 :: MOD_sysTb) = state0 { inst_gcd__sysTb = snd3 act1 } - ; (act2 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h322 (inst_c1__sysTb state1) + ; (act2 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h747 (inst_c1__sysTb state1) ; (guard2 :: Bool) = guard1 && (fst3 act2) ; (state2 :: MOD_sysTb) = state1 { inst_c1__sysTb = snd3 act2 } - ; (act3 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h345 (inst_c2__sysTb state2) + ; (act3 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h871 (inst_c2__sysTb state2) ; (guard3 :: Bool) = guard2 && (fst3 act3) ; (state3 :: MOD_sysTb) = state2 { inst_c2__sysTb = snd3 act3 } ; (act4 :: (Bool, MOD_RegN #2, ())) = meth_write_RegN (1 :: Bit #2) (inst_state__sysTb state3) @@ -57,18 +57,18 @@ rule_RL_r0_sysTb = rule_RL_r1_sysTb :: MOD_sysTb -> (Bool, MOD_sysTb, ()); rule_RL_r1_sysTb = (\ (state0 :: MOD_sysTb) -> - let { (def_b__h284 :: Bit #51) = meth_read_RegN (inst_c1__sysTb state0) - ; (def_b__h285 :: Bit #51) = meth_read_RegN (inst_c2__sysTb state0) - ; (def_state__h244 :: Bit #2) = meth_read_RegN (inst_state__sysTb state0) - ; (def_b__h322 :: Bit #51) = noinline_add def_b__h284 (3 :: Bit #51) - ; (def_b__h345 :: Bit #51) = noinline_add def_b__h285 (2 :: Bit #51) - ; (def_state_EQ_1___d9 :: Bool) = primEQ def_state__h244 (1 :: Bit #2) + let { (def_state__h528 :: Bit #2) = meth_read_RegN (inst_state__sysTb state0) + ; (def_c2___d6 :: Bit #51) = meth_read_RegN (inst_c2__sysTb state0) + ; (def_b__h871 :: Bit #51) = noinline_add def_c2___d6 (2 :: Bit #51) + ; (def_c1___d5 :: Bit #51) = meth_read_RegN (inst_c1__sysTb state0) + ; (def_b__h747 :: Bit #51) = noinline_add def_c1___d5 (3 :: Bit #51) + ; (def_state_EQ_1___d9 :: Bool) = primEQ def_state__h528 (1 :: Bit #2) ; (act1 :: (Bool, MOD_sysMethods, Bit #51)) = - meth_start_and_result_sysMethods def_b__h284 def_b__h285 (inst_gcd__sysTb state0) + meth_start_and_result_sysMethods def_c1___d5 def_c2___d6 (inst_gcd__sysTb state0) ; (guard1 :: Bool) = fst3 act1 ; (state1 :: MOD_sysTb) = state0 { inst_gcd__sysTb = snd3 act1 } - ; (def_b__h381 :: Bit #51) = thd act1 - ; (def_gcd_start_and_result_0_PLUS_1___d11 :: Bit #51) = primAdd def_b__h381 (1 :: Bit #51) + ; (def_b__h1063 :: Bit #51) = thd act1 + ; (def_gcd_start_and_result_0_PLUS_1___d11 :: Bit #51) = primAdd def_b__h1063 (1 :: Bit #51) ; (act2 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN (primConcat @@ -80,10 +80,10 @@ rule_RL_r1_sysTb = (inst_rg__sysTb state1) ; (guard2 :: Bool) = guard1 && (fst3 act2) ; (state2 :: MOD_sysTb) = state1 { inst_rg__sysTb = snd3 act2 } - ; (act3 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h322 (inst_c1__sysTb state2) + ; (act3 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h747 (inst_c1__sysTb state2) ; (guard3 :: Bool) = guard2 && (fst3 act3) ; (state3 :: MOD_sysTb) = state2 { inst_c1__sysTb = snd3 act3 } - ; (act4 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h345 (inst_c2__sysTb state3) + ; (act4 :: (Bool, MOD_RegN #51, ())) = meth_write_RegN def_b__h871 (inst_c2__sysTb state3) ; (guard4 :: Bool) = guard3 && (fst3 act4) ; (state4 :: MOD_sysTb) = state3 { inst_c2__sysTb = snd3 act4 } ; (act5 :: (Bool, MOD_RegN #2, ())) = meth_write_RegN (2 :: Bit #2) (inst_state__sysTb state4) @@ -95,11 +95,11 @@ rule_RL_r1_sysTb = rule_RL_r2_sysTb :: MOD_sysTb -> (Bool, MOD_sysTb, ()); rule_RL_r2_sysTb = (\ (state0 :: MOD_sysTb) -> - let { (def_state__h244 :: Bit #2) = meth_read_RegN (inst_state__sysTb state0) + let { (def_state__h528 :: Bit #2) = meth_read_RegN (inst_state__sysTb state0) ; (def_gcd_RDY_result____d14 :: Bool) = meth_RDY_result_sysMethods (inst_gcd__sysTb state0) ; (def_gcd_result____d17 :: Bit #51) = meth_result_sysMethods (inst_gcd__sysTb state0) ; (def_gcd_result__7_PLUS_1___d18 :: Bit #51) = primAdd def_gcd_result____d17 (1 :: Bit #51) - ; (def_state_EQ_2___d15 :: Bool) = primEQ def_state__h244 (2 :: Bit #2) + ; (def_state_EQ_2___d15 :: Bool) = primEQ def_state__h528 (2 :: Bit #2) ; (def_gcd_RDY_result__4_AND_state_EQ_2_5___d16 :: Bool) = def_gcd_RDY_result____d14 && def_state_EQ_2___d15 ; (act1 :: (Bool, MOD_RegN #51, ())) = @@ -119,8 +119,8 @@ rule_RL_r2_sysTb = rule_RL_exit_sysTb :: MOD_sysTb -> (Bool, MOD_sysTb, ()); rule_RL_exit_sysTb = (\ (state0 :: MOD_sysTb) -> - let { (def_b__h284 :: Bit #51) = meth_read_RegN (inst_c1__sysTb state0) - ; (def_c1_ULE_100___d21 :: Bool) = primULE def_b__h284 (100 :: Bit #51) - ; (def_v__h538 :: Bit #64) = (primAny :: Bit #64) + let { (def_c1___d5 :: Bit #51) = meth_read_RegN (inst_c1__sysTb state0) + ; (def_c1_ULE_100___d21 :: Bool) = primULE def_c1___d5 (100 :: Bit #51) + ; (def_v__h1286 :: Bit #64) = (primAny :: Bit #64) } in mktuple (not def_c1_ULE_100___d21) state0 ()); diff --git a/testsuite/bsc.misc/sal/CTX_sysMultiArityConcat.sal.expected b/testsuite/bsc.misc/sal/CTX_sysMultiArityConcat.sal.expected index 7c2b10256..734908d60 100644 --- a/testsuite/bsc.misc/sal/CTX_sysMultiArityConcat.sal.expected +++ b/testsuite/bsc.misc/sal/CTX_sysMultiArityConcat.sal.expected @@ -16,12 +16,12 @@ BEGIN #) ; rule_RL_d (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def__read__h44 : Bit{3}!T = CTX_RegUN{3}!meth_read(state0.inst_src1) - IN LET def__read__h76 : Bit{4}!T = CTX_RegUN{4}!meth_read(state0.inst_src2) - IN LET def__read__h108 : Bit{5}!T = CTX_RegUN{5}!meth_read(state0.inst_src3) + LET def_src1___d1 : Bit{3}!T = CTX_RegUN{3}!meth_read(state0.inst_src1) + IN LET def_src2___d2 : Bit{4}!T = CTX_RegUN{4}!meth_read(state0.inst_src2) + IN LET def_src3___d3 : Bit{5}!T = CTX_RegUN{5}!meth_read(state0.inst_src3) IN LET act1 : [ CTX_RegUN{12}!STATE, Unit!T ] = - CTX_RegUN{12}!meth_write(Prim2{3,9}!primConcat(def__read__h44, - Prim2{4,5}!primConcat(def__read__h76, def__read__h108)), + CTX_RegUN{12}!meth_write(Prim2{3,9}!primConcat(def_src1___d1, + Prim2{4,5}!primConcat(def_src2___d2, def_src3___d3)), state0.inst_snk) IN LET state1 : STATE = state0 WITH .inst_snk := act1.1 IN ( TRUE, state1 ) ; diff --git a/testsuite/bsc.misc/sal/CTX_sysStructs.sal.expected b/testsuite/bsc.misc/sal/CTX_sysStructs.sal.expected index 8381f1ead..ff5e6350d 100644 --- a/testsuite/bsc.misc/sal/CTX_sysStructs.sal.expected +++ b/testsuite/bsc.misc/sal/CTX_sysStructs.sal.expected @@ -28,21 +28,21 @@ BEGIN #) ; rule_RL_add_em (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def_x__h549 : Bit{9}!T = CTX_RegN{9}!meth_read(state0.inst_a) - IN LET def_x__h557 : Bit{9}!T = CTX_RegN{9}!meth_read(state0.inst_b) - IN LET def_x__h541 : Bit{9}!T = Prim1{9}!primAdd(def_x__h549, def_x__h557) - IN LET def_x__h529 : Bit{9}!T = Prim1{9}!primAdd(def_x__h541, Bit{9}!mkConst(4)) - IN LET def_s__h482 : Bit{1}!T = CTX_RegN{1}!meth_read(state0.inst_s) - IN LET act1 : [ CTX_RegN{9}!STATE, Unit!T ] = CTX_RegN{9}!meth_write(def_x__h529, state0.inst_a) + LET def_x__h542 : Bit{9}!T = CTX_RegN{9}!meth_read(state0.inst_a) + IN LET def_x__h550 : Bit{9}!T = CTX_RegN{9}!meth_read(state0.inst_b) + IN LET def_x__h534 : Bit{9}!T = Prim1{9}!primAdd(def_x__h542, def_x__h550) + IN LET def_x__h522 : Bit{9}!T = Prim1{9}!primAdd(def_x__h534, Bit{9}!mkConst(4)) + IN LET def_s__h463 : Bit{1}!T = CTX_RegN{1}!meth_read(state0.inst_s) + IN LET act1 : [ CTX_RegN{9}!STATE, Unit!T ] = CTX_RegN{9}!meth_write(def_x__h522, state0.inst_a) IN LET state1 : STATE = state0 WITH .inst_a := act1.1 IN LET act2 : [ CTX_RegN{1}!STATE, Unit!T ] = CTX_RegN{1}!meth_write(Bit{1}!mkConst(0), state1.inst_s) IN LET state2 : STATE = state1 WITH .inst_s := act2.1 - IN ( Prim!bitToBool(def_s__h482), state2 ) ; + IN ( Prim!bitToBool(def_s__h463), state2 ) ; rule_RL_tss (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def_t1___d8 : Bit{12}!T = CTX_RegUN{12}!meth_read(state0.inst_t1) - IN LET def_t2___d6 : Bit{12}!T = CTX_RegUN{12}!meth_read(state0.inst_t2) + LET def_t2___d6 : Bit{12}!T = CTX_RegUN{12}!meth_read(state0.inst_t2) + IN LET def_t1___d8 : Bit{12}!T = CTX_RegUN{12}!meth_read(state0.inst_t1) IN LET act1 : [ CTX_RegUN{12}!STATE, Unit!T ] = CTX_RegUN{12}!meth_write(Prim2{8,4}!primConcat(Prim2{12,8}!primExtract(def_t2___d6), Prim2{12,4}!primExtract(def_t1___d8)), diff --git a/testsuite/bsc.misc/sal/CTX_sysTb.sal.expected b/testsuite/bsc.misc/sal/CTX_sysTb.sal.expected index de1a4e240..00de768b6 100644 --- a/testsuite/bsc.misc/sal/CTX_sysTb.sal.expected +++ b/testsuite/bsc.misc/sal/CTX_sysTb.sal.expected @@ -18,21 +18,21 @@ BEGIN #) ; rule_RL_r0 (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def_b__h284 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c1) - IN LET def_b__h285 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c2) - IN LET def_state__h244 : Bit{2}!T = CTX_RegN{2}!meth_read(state0.inst_state) - IN LET def_b__h322 : Bit{51}!T = CTX_module_add!fn(def_b__h284, Bit{51}!mkConst(3)) - IN LET def_b__h345 : Bit{51}!T = CTX_module_add!fn(def_b__h285, Bit{51}!mkConst(2)) + LET def_state__h528 : Bit{2}!T = CTX_RegN{2}!meth_read(state0.inst_state) + IN LET def_c2___d6 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c2) + IN LET def_b__h871 : Bit{51}!T = CTX_module_add!fn(def_c2___d6, Bit{51}!mkConst(2)) + IN LET def_c1___d5 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c1) + IN LET def_b__h747 : Bit{51}!T = CTX_module_add!fn(def_c1___d5, Bit{51}!mkConst(3)) IN LET def_gcd_RDY_start____d1 : BOOLEAN = CTX_sysMethods!meth_RDY_start(state0.inst_gcd) - IN LET def_state_EQ_0___d3 : BOOLEAN = Prim1{2}!primEQ(def_state__h244, Bit{2}!mkConst(0)) + IN LET def_state_EQ_0___d3 : BOOLEAN = Prim1{2}!primEQ(def_state__h528, Bit{2}!mkConst(0)) IN LET def_gcd_RDY_start_AND_state_EQ_0___d4 : BOOLEAN = def_gcd_RDY_start____d1 AND def_state_EQ_0___d3 IN LET act1 : [ CTX_sysMethods!STATE, Unit!T ] = - CTX_sysMethods!meth_start(def_b__h284, def_b__h285, state0.inst_gcd) + CTX_sysMethods!meth_start(def_c1___d5, def_c2___d6, state0.inst_gcd) IN LET state1 : STATE = state0 WITH .inst_gcd := act1.1 - IN LET act2 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h322, state1.inst_c1) + IN LET act2 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h747, state1.inst_c1) IN LET state2 : STATE = state1 WITH .inst_c1 := act2.1 - IN LET act3 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h345, state2.inst_c2) + IN LET act3 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h871, state2.inst_c2) IN LET state3 : STATE = state2 WITH .inst_c2 := act3.1 IN LET act4 : [ CTX_RegN{2}!STATE, Unit!T ] = CTX_RegN{2}!meth_write(Bit{2}!mkConst(1), state3.inst_state) @@ -40,26 +40,26 @@ BEGIN IN ( def_gcd_RDY_start_AND_state_EQ_0___d4, state4 ) ; rule_RL_r1 (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def_b__h284 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c1) - IN LET def_b__h285 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c2) - IN LET def_state__h244 : Bit{2}!T = CTX_RegN{2}!meth_read(state0.inst_state) - IN LET def_b__h322 : Bit{51}!T = CTX_module_add!fn(def_b__h284, Bit{51}!mkConst(3)) - IN LET def_b__h345 : Bit{51}!T = CTX_module_add!fn(def_b__h285, Bit{51}!mkConst(2)) - IN LET def_state_EQ_1___d9 : BOOLEAN = Prim1{2}!primEQ(def_state__h244, Bit{2}!mkConst(1)) + LET def_state__h528 : Bit{2}!T = CTX_RegN{2}!meth_read(state0.inst_state) + IN LET def_c2___d6 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c2) + IN LET def_b__h871 : Bit{51}!T = CTX_module_add!fn(def_c2___d6, Bit{51}!mkConst(2)) + IN LET def_c1___d5 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c1) + IN LET def_b__h747 : Bit{51}!T = CTX_module_add!fn(def_c1___d5, Bit{51}!mkConst(3)) + IN LET def_state_EQ_1___d9 : BOOLEAN = Prim1{2}!primEQ(def_state__h528, Bit{2}!mkConst(1)) IN LET act1 : [ CTX_sysMethods!STATE, Bit{51}!T ] = - CTX_sysMethods!meth_start_and_result(def_b__h284, def_b__h285, state0.inst_gcd) + CTX_sysMethods!meth_start_and_result(def_c1___d5, def_c2___d6, state0.inst_gcd) IN LET state1 : STATE = state0 WITH .inst_gcd := act1.1 - IN LET def_b__h381 : Bit{51}!T = act1.2 + IN LET def_b__h1063 : Bit{51}!T = act1.2 IN LET def_gcd_start_and_result_0_PLUS_1___d11 : Bit{51}!T = - Prim1{51}!primAdd(def_b__h381, Bit{51}!mkConst(1)) + Prim1{51}!primAdd(def_b__h1063, Bit{51}!mkConst(1)) IN LET act2 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(Prim2{50,1}!primConcat(Prim2{51,50}!primExtract(def_gcd_start_and_result_0_PLUS_1___d11), Bit{1}!mkConst(0)), state1.inst_rg) IN LET state2 : STATE = state1 WITH .inst_rg := act2.1 - IN LET act3 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h322, state2.inst_c1) + IN LET act3 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h747, state2.inst_c1) IN LET state3 : STATE = state2 WITH .inst_c1 := act3.1 - IN LET act4 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h345, state3.inst_c2) + IN LET act4 : [ CTX_RegN{51}!STATE, Unit!T ] = CTX_RegN{51}!meth_write(def_b__h871, state3.inst_c2) IN LET state4 : STATE = state3 WITH .inst_c2 := act4.1 IN LET act5 : [ CTX_RegN{2}!STATE, Unit!T ] = CTX_RegN{2}!meth_write(Bit{2}!mkConst(2), state4.inst_state) @@ -67,12 +67,12 @@ BEGIN IN ( def_state_EQ_1___d9, state5 ) ; rule_RL_r2 (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def_state__h244 : Bit{2}!T = CTX_RegN{2}!meth_read(state0.inst_state) + LET def_state__h528 : Bit{2}!T = CTX_RegN{2}!meth_read(state0.inst_state) IN LET def_gcd_RDY_result____d14 : BOOLEAN = CTX_sysMethods!meth_RDY_result(state0.inst_gcd) IN LET def_gcd_result____d17 : Bit{51}!T = CTX_sysMethods!meth_result(state0.inst_gcd) IN LET def_gcd_result__7_PLUS_1___d18 : Bit{51}!T = Prim1{51}!primAdd(def_gcd_result____d17, Bit{51}!mkConst(1)) - IN LET def_state_EQ_2___d15 : BOOLEAN = Prim1{2}!primEQ(def_state__h244, Bit{2}!mkConst(2)) + IN LET def_state_EQ_2___d15 : BOOLEAN = Prim1{2}!primEQ(def_state__h528, Bit{2}!mkConst(2)) IN LET def_gcd_RDY_result__4_AND_state_EQ_2_5___d16 : BOOLEAN = def_gcd_RDY_result____d14 AND def_state_EQ_2___d15 IN LET act1 : [ CTX_RegN{51}!STATE, Unit!T ] = @@ -86,9 +86,9 @@ BEGIN IN ( def_gcd_RDY_result__4_AND_state_EQ_2_5___d16, state2 ) ; rule_RL_exit (state0 : STATE) : [ BOOLEAN, STATE ] = - LET def_b__h284 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c1) - IN LET def_c1_ULE_100___d21 : BOOLEAN = Prim1{51}!primULE(def_b__h284, Bit{51}!mkConst(100)) - IN LET def_v__h538 : Bit{64}!T = Bit{64}!undef + LET def_c1___d5 : Bit{51}!T = CTX_RegN{51}!meth_read(state0.inst_c1) + IN LET def_c1_ULE_100___d21 : BOOLEAN = Prim1{51}!primULE(def_c1___d5, Bit{51}!mkConst(100)) + IN LET def_v__h1286 : Bit{64}!T = Bit{64}!undef IN ( NOT def_c1_ULE_100___d21, state0 ) ; END diff --git a/testsuite/bsc.names/signal_names/LiteralNum_ENotation.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/LiteralNum_ENotation.bsv.bsc-vcomp-out.expected index 2a9e805ae..5e2438935 100644 --- a/testsuite/bsc.names/signal_names/LiteralNum_ENotation.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/LiteralNum_ENotation.bsv.bsc-vcomp-out.expected @@ -30,7 +30,7 @@ rg_start :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd1, 1'd1] [] - meth types=[([], Nothing, Just (Bit 1)), ([Bit 1], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 1]), ([Bit 1], Just (Bit 1), [])] port types=D_IN -> Prelude.Bool Q_OUT -> Prelude.Bool -- AP local definitions diff --git a/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected index 451dbc6c4..2d9926515 100644 --- a/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/Method.bsv.bsc-vcomp-out.expected @@ -35,9 +35,9 @@ rg :: ABSTRACT: PreludeBSV._PreludeBSV.VRWire103 = RWire [(WSET, WHAS), (WVAL, WGET)]) [32'd8, clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }] [] - meth types=[([Bit 8], Just (Bit 1), Nothing), - ([], Nothing, Just (Bit 1)), - ([], Nothing, Just (Bit 8))] + meth types=[([Bit 8], Just (Bit 1), []), + ([], Nothing, [Bit 1]), + ([], Nothing, [Bit 8])] port types=WGET -> Prelude.Bit 8 WHAS -> Prelude.Bool WVAL -> Prelude.Bit 8 diff --git a/testsuite/bsc.names/signal_names/MethodActionValue.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/MethodActionValue.bsv.bsc-vcomp-out.expected index fbb8b66c2..e840f3161 100644 --- a/testsuite/bsc.names/signal_names/MethodActionValue.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/MethodActionValue.bsv.bsc-vcomp-out.expected @@ -81,18 +81,18 @@ i :: ABSTRACT: MethodActionValue.Ifc­ = mkMethodActionValue_Sub []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }] [] - meth types=[([], Just (Bit 1), Just (Bit 8)), ([], Nothing, Just (Bit 1))] + meth types=[([], Just (Bit 1), [Bit 8]), ([], Nothing, [Bit 1])] port types=m -> Prelude.Bit 8 -- AP local definitions i_m_PLUS_8___d2 :: Bit 8; -i_m_PLUS_8___d2 = v__h90 + 8'd8; +i_m_PLUS_8___d2 = v__h105 + 8'd8; -- IdProp i_m_PLUS_8___d2[IdP_from_rhs] i_m_MINUS_1___d3 :: Bit 8; -i_m_MINUS_1___d3 = v__h90 - 8'd1; +i_m_MINUS_1___d3 = v__h105 - 8'd1; -- IdProp i_m_MINUS_1___d3[IdP_from_rhs] -v__h90 :: Bit 8; -v__h90 = i.m; --- IdProp v__h90[IdP_keep] +v__h105 :: Bit 8; +v__h105 = i.m; +-- IdProp v__h105[IdP_keep] -- AP rules rule RL_r "r": when 1'd1 diff --git a/testsuite/bsc.names/signal_names/MethodRead.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/MethodRead.bsv.bsc-vcomp-out.expected index bdc7919c7..4175d0edd 100644 --- a/testsuite/bsc.names/signal_names/MethodRead.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/MethodRead.bsv.bsc-vcomp-out.expected @@ -29,19 +29,19 @@ rg :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd8] [] - meth types=[([], Nothing, Just (Bit 8)), ([Bit 8], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 8]), ([Bit 8], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 8 Q_OUT -> Prelude.Bit 8 -- AP local definitions rg_PLUS_8___d2 :: Bit 8; -rg_PLUS_8___d2 = x__h140 + 8'd8; +rg_PLUS_8___d2 = x__h115 + 8'd8; -- IdProp rg_PLUS_8___d2[IdP_from_rhs] rg_MINUS_1___d3 :: Bit 8; -rg_MINUS_1___d3 = x__h140 - 8'd1; +rg_MINUS_1___d3 = x__h115 - 8'd1; -- IdProp rg_MINUS_1___d3[IdP_from_rhs] -x__h140 :: Bit 8; -x__h140 = rg.read; --- IdProp x__h140[IdP_keep] +x__h115 :: Bit 8; +x__h115 = rg.read; +-- IdProp x__h115[IdP_keep] -- AP rules rule RL_r "r": when 1'd1 diff --git a/testsuite/bsc.names/signal_names/NoInline.bsv.bsc-vcomp-out.expected b/testsuite/bsc.names/signal_names/NoInline.bsv.bsc-vcomp-out.expected index 2b1f8c987..f986c4b8b 100644 --- a/testsuite/bsc.names/signal_names/NoInline.bsv.bsc-vcomp-out.expected +++ b/testsuite/bsc.names/signal_names/NoInline.bsv.bsc-vcomp-out.expected @@ -19,11 +19,11 @@ arg info [clockarg default_clock;, resetarg default_reset;] -- AP state elements -- AP local definitions fnNoInline_PLUS_8___d2 :: Bit 8; -fnNoInline_PLUS_8___d2 = x__h46 + 8'd8; +fnNoInline_PLUS_8___d2 = fnNoInline___d1 + 8'd8; -- IdProp fnNoInline_PLUS_8___d2[IdP_from_rhs] -x__h46 :: Bit 8; -x__h46 = NoInline.fnNoInline 8'd0; --- IdProp x__h46[IdP_keep] +fnNoInline___d1 :: Bit 8; +fnNoInline___d1 = NoInline.fnNoInline 8'd0; +-- IdProp fnNoInline___d1[IdP_from_rhs] -- AP rules rule RL_r "r": when 1'd1 diff --git a/testsuite/bsc.scheduler/SplitIf.bsv.bsc-sched-out.expected b/testsuite/bsc.scheduler/SplitIf.bsv.bsc-sched-out.expected index 609f5b7a0..a1e4f3cb5 100644 --- a/testsuite/bsc.scheduler/SplitIf.bsv.bsc-sched-out.expected +++ b/testsuite/bsc.scheduler/SplitIf.bsv.bsc-sched-out.expected @@ -25,7 +25,7 @@ order: [RL_toggle2, xfer_T, xfer_F, RL_toggle1] (r2.read, [(r2.read, 1)]), (r2.write, [(r2.write xfer_sel, 1), (r2.write NOT_r2___d4, 1)]), (w.whas, [(w.whas, 1)]), - (w.wset, [(w.wset r2__h256, 1)])] + (w.wset, [(w.wset r2__h277, 1)])] ----- @@ -70,7 +70,7 @@ order: [RL_r, RL_toggleDir, RL_done, RL_incr] (dir.read, [(dir.read, 1)]), (dir.write, [(dir.write NOT_dir___d2, 1)]), (test.RDY_xfer, [(test.RDY_xfer, 1)]), - (test.xfer, [(test.xfer dir__h205, 1)])] + (test.xfer, [(test.xfer dir___d1, 1)])] ----- diff --git a/testsuite/bsc.scheduler/SplitIf2.bsv.bsc-sched-out.expected b/testsuite/bsc.scheduler/SplitIf2.bsv.bsc-sched-out.expected index e836279c1..ed63926e8 100644 --- a/testsuite/bsc.scheduler/SplitIf2.bsv.bsc-sched-out.expected +++ b/testsuite/bsc.scheduler/SplitIf2.bsv.bsc-sched-out.expected @@ -20,11 +20,11 @@ order: [RL_toggle1, RL_toggle2, xfer] === resources: [(r1.read, [(r1.read, 1)]), - (r1.write, [(if xfer_sel then r1.write r2__h256, 1), (r1.write NOT_r1___d2, 1)]), + (r1.write, [(if xfer_sel then r1.write r2__h277, 1), (r1.write NOT_r1___d2, 1)]), (r2.read, [(r2.read, 1)]), - (r2.write, [(if NOT_xfer_sel___d5 then r2.write r1__h225, 1), (r2.write NOT_r2___d4, 1)]), + (r2.write, [(if NOT_xfer_sel___d5 then r2.write r1__h237, 1), (r2.write NOT_r2___d4, 1)]), (w.whas, [(w.whas, 1)]), - (w.wset, [(w.wset r2__h256, 1)])] + (w.wset, [(w.wset r2__h277, 1)])] ----- @@ -75,7 +75,7 @@ order: [RL_r, RL_toggleDir, RL_done, RL_incr] (dir.read, [(dir.read, 1)]), (dir.write, [(dir.write NOT_dir___d2, 1)]), (test.RDY_xfer, [(test.RDY_xfer, 1)]), - (test.xfer, [(test.xfer dir__h208, 1)])] + (test.xfer, [(test.xfer dir___d1, 1)])] ----- diff --git a/testsuite/bsc.scheduler/avmeth/AVArgUse_C.bsv.bsc-sched-out.expected b/testsuite/bsc.scheduler/avmeth/AVArgUse_C.bsv.bsc-sched-out.expected index 23677e3f3..9780b14fa 100644 --- a/testsuite/bsc.scheduler/avmeth/AVArgUse_C.bsv.bsc-sched-out.expected +++ b/testsuite/bsc.scheduler/avmeth/AVArgUse_C.bsv.bsc-sched-out.expected @@ -45,7 +45,7 @@ order: [RL_rA, RL_rB] ----- === resources: -[(dut.m, [(dut.m b__h178 32'd1, 1), (dut.m 32'd5 b__h178, 1)]), +[(dut.m, [(dut.m r1___d1 32'd1, 1), (dut.m 32'd5 r1___d1, 1)]), (r1.read, [(r1.read, 1)]), (r1.write, [(r1.write r1_PLUS_1___d4, 1)])] diff --git a/testsuite/bsc.scheduler/avmeth/AVArgUse_SBR.bsv.bsc-sched-out.expected b/testsuite/bsc.scheduler/avmeth/AVArgUse_SBR.bsv.bsc-sched-out.expected index 3d3ab3c0b..a4a61ef48 100644 --- a/testsuite/bsc.scheduler/avmeth/AVArgUse_SBR.bsv.bsc-sched-out.expected +++ b/testsuite/bsc.scheduler/avmeth/AVArgUse_SBR.bsv.bsc-sched-out.expected @@ -43,7 +43,7 @@ order: [RL_rB, RL_rA] ----- === resources: -[(dut.m, [(dut.m b__h178 32'd1, 1), (dut.m 32'd5 b__h178, 1)]), +[(dut.m, [(dut.m r1___d1 32'd1, 1), (dut.m 32'd5 r1___d1, 1)]), (r1.read, [(r1.read, 1)]), (r1.write, [(r1.write r1_PLUS_1___d4, 1)])] diff --git a/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest.atsexpand.expected b/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest.atsexpand.expected index b9ac53b34..7964c30bc 100644 --- a/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest.atsexpand.expected +++ b/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest.atsexpand.expected @@ -25,7 +25,7 @@ b :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd16, 16'd11] [] - meth types=[([], Nothing, Just (Bit 16)), ([Bit 16], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 16]), ([Bit 16], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 16 Q_OUT -> Prelude.Bit 16 -- AP rules diff --git a/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest2.atsexpand.expected b/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest2.atsexpand.expected index a5088811c..0aa1e913a 100644 --- a/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest2.atsexpand.expected +++ b/testsuite/bsc.syntax/bsv05/statename/sysStateNameTest2.atsexpand.expected @@ -25,7 +25,7 @@ b :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd16, 16'd11] [] - meth types=[([], Nothing, Just (Bit 16)), ([Bit 16], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 16]), ([Bit 16], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 16 Q_OUT -> Prelude.Bit 16 -- AP rules diff --git a/testsuite/bsc.syntax/bsv05/statename/sysUseMod2.atsexpand.expected b/testsuite/bsc.syntax/bsv05/statename/sysUseMod2.atsexpand.expected index bf9d2f8ff..9d747f2d5 100644 --- a/testsuite/bsc.syntax/bsv05/statename/sysUseMod2.atsexpand.expected +++ b/testsuite/bsc.syntax/bsv05/statename/sysUseMod2.atsexpand.expected @@ -26,7 +26,7 @@ the_e_the_r :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd32, 32'd0] [] - meth types=[([], Nothing, Just (Bit 32)), ([Bit 32], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 32]), ([Bit 32], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 32 Q_OUT -> Prelude.Bit 32 -- AP rules diff --git a/testsuite/bsc.syntax/bsv05/statename/sysUseMod2Arrow.atsexpand.expected b/testsuite/bsc.syntax/bsv05/statename/sysUseMod2Arrow.atsexpand.expected index 062972d8b..d885d56e0 100644 --- a/testsuite/bsc.syntax/bsv05/statename/sysUseMod2Arrow.atsexpand.expected +++ b/testsuite/bsc.syntax/bsv05/statename/sysUseMod2Arrow.atsexpand.expected @@ -26,7 +26,7 @@ e_r :: ABSTRACT: Prelude.VReg = RegN []) [clock { osc: CLK gate: 1'd1 }, reset { wire: RST_N }, 32'd32, 32'd0] [] - meth types=[([], Nothing, Just (Bit 32)), ([Bit 32], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 32]), ([Bit 32], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 32 Q_OUT -> Prelude.Bit 32 -- AP rules diff --git a/testsuite/bsc.typechecker/dontcare/DummyInRuleQual.bs.bsc-vcomp-out.expected b/testsuite/bsc.typechecker/dontcare/DummyInRuleQual.bs.bsc-vcomp-out.expected index 9145850f1..289b6fd14 100644 --- a/testsuite/bsc.typechecker/dontcare/DummyInRuleQual.bs.bsc-vcomp-out.expected +++ b/testsuite/bsc.typechecker/dontcare/DummyInRuleQual.bs.bsc-vcomp-out.expected @@ -33,7 +33,7 @@ r :: ABSTRACT: Prelude.VReg = RegUN []) [clock { osc: CLK gate: 1'd1 }, 32'd12] [] - meth types=[([], Nothing, Just (Bit 12)), ([Bit 12], Just (Bit 1), Nothing)] + meth types=[([], Nothing, [Bit 12]), ([Bit 12], Just (Bit 1), [])] port types=D_IN -> Prelude.Bit 12 Q_OUT -> Prelude.Bit 12 -- AP local definitions diff --git a/testsuite/bsc.verilog/astate/astate.exp b/testsuite/bsc.verilog/astate/astate.exp index 603ef0be2..af69d082b 100644 --- a/testsuite/bsc.verilog/astate/astate.exp +++ b/testsuite/bsc.verilog/astate/astate.exp @@ -29,9 +29,9 @@ set fname {sysPriMux_SharedValue.astate} compile_verilog_pass PriMux_SharedValue.bsv {} "-dastate=$fname" if { $vtest == 1 } { find_regexp $fname { -r\$write_1 \= primux \(WILL_FIRE_RL_rA, MUX_r\$write_1__VAL_1\) - \(WILL_FIRE_RL_rB, MUX_r\$write_1__VAL_2\) - \(WILL_FIRE_RL_rC, MUX_r\$write_1__VAL_3\)} +r\$write_ARG_1 \= primux \(WILL_FIRE_RL_rA, MUX_r\$write_ARG_1__VAL_1\) + \(WILL_FIRE_RL_rB, MUX_r\$write_ARG_1__VAL_2\) + \(WILL_FIRE_RL_rC, MUX_r\$write_ARG_1__VAL_3\)} } # ---------- diff --git a/testsuite/bsc.verilog/inline/inline.exp b/testsuite/bsc.verilog/inline/inline.exp index ac441269b..8396769df 100644 --- a/testsuite/bsc.verilog/inline/inline.exp +++ b/testsuite/bsc.verilog/inline/inline.exp @@ -4,8 +4,8 @@ # there is only one use. (Inlining for optimization is OK.) if {$vtest == 1} { compile_verilog_pass RWireOneUse.bsv "" -keep-inlined-boundaries - find_n_strings sysRWireOneUse.v {assign rw$wget = } 1 - find_n_strings sysRWireOneUse.v {assign rw$whas = } 1 + find_n_strings sysRWireOneUse.v {assign rw$wget_RES_1 = } 1 + find_n_strings sysRWireOneUse.v {assign rw$whas_RES_1 = } 1 } # Test that inlined registers with no_reset do not generate Verilog 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 d2fe133e0..3633a7724 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 @@ -10,9 +10,3 @@ Error: "NoInline_ResNotInBits.bsv", line 4, column 12: (T0043) 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) - Signature mismatch (given too general): - given: - function b__ f(Bit#(1) x1) provisos (Bits#(NoInline_ResNotInBits::L, a__)) - deduced: - function Bit#(c__) f(Bit#(1) x1) provisos (Bits#(NoInline_ResNotInBits::L, c__)) diff --git a/testsuite/bsc.verilog/splitports/DeepSplit.bs b/testsuite/bsc.verilog/splitports/DeepSplit.bs index 9cab5afea..4c4761167 100644 --- a/testsuite/bsc.verilog/splitports/DeepSplit.bs +++ b/testsuite/bsc.verilog/splitports/DeepSplit.bs @@ -47,11 +47,19 @@ interface SplitTest = putBaz :: DeepSplit Baz -> Action putZug :: DeepSplit Zug -> Action + getFoo :: DeepSplit Foo + getBar :: DeepSplit Foo -> DeepSplit Bar {-# result = "GET_BAR" #-} + getZug :: DeepSplit Zug + + update :: DeepSplit Foo -> ActionValue (DeepSplit Bar) + {-# synthesize mkDeepSplitTest #-} mkDeepSplitTest :: Module SplitTest mkDeepSplitTest = module + theCond <- mkReg False + theFoo <- mkReg (Foo { x = 0; y = 0; }) interface putFoo (DeepSplit x) = $display "putFoo: " (cshow x) putBar (DeepSplit x) = $display "putBar: " (cshow x) @@ -59,6 +67,13 @@ mkDeepSplitTest = putFoos (DeepSplit x) = $display "putFoos: " (cshow x) putBaz (DeepSplit x) = $display "putBaz: " (cshow x) putZug (DeepSplit x) = $display "putZug: " (cshow x) + getFoo = DeepSplit $ Foo { x = 42; y = 43; } + getBar (DeepSplit f) = DeepSplit $ Bar { v = vec True False True; w = (False, 0x4321); z = f; } + getZug = DeepSplit $ Zug { qs = vec (Quix { q = negate 2; v = True }) (Quix { q = 2; v = False }); blob = True; } + update (DeepSplit f) = do + theCond := not theCond + theFoo := f + return $ DeepSplit $ Bar { v = vec (f.x == 33) theCond (not theCond); w = (theCond, 0xDEAD); z = theFoo; } {-# synthesize sysDeepSplit #-} sysDeepSplit :: Module Empty @@ -74,4 +89,13 @@ sysDeepSplit = when i == 3 ==> s.putFoos $ DeepSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } when i == 4 ==> s.putBaz $ DeepSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } when i == 5 ==> s.putZug $ DeepSplit $ Zug { qs = vec (Quix { q = 1; v = True }) (Quix { q = 2; v = False }); blob = False; } - when i == 6 ==> $finish + when i == 6 ==> $display "getFoo: " (cshow s.getFoo) + when i == 7 ==> $display "getBar: " (cshow $ s.getBar s.getFoo) + when i == 8 ==> $display "getZug: " (cshow s.getZug) + when i == 9 ==> do + res <- s.update (DeepSplit $ Foo { x = 77; y = 88; }) + $display "update: " (cshow res) + when i == 10 ==> do + res <- s.update (DeepSplit $ Foo { x = 33; y = 44; }) + $display "update: " (cshow res) + when i == 11 ==> $finish \ No newline at end of file diff --git a/testsuite/bsc.verilog/splitports/InstanceSplit.bs b/testsuite/bsc.verilog/splitports/InstanceSplit.bs index 83c2ce7da..19a24e268 100644 --- a/testsuite/bsc.verilog/splitports/InstanceSplit.bs +++ b/testsuite/bsc.verilog/splitports/InstanceSplit.bs @@ -48,17 +48,30 @@ interface SplitTest = putFoos :: (Vector 50 Foo) -> Action putBaz :: Baz -> Action + getFoo :: Foo + getBar :: Foo -> Bar {-# result = "GET_BAR" #-} + + update :: Foo -> ActionValue Bar + {-# synthesize mkInstanceSplitTest #-} mkInstanceSplitTest :: Module SplitTest mkInstanceSplitTest = module + theCond <- mkReg False + theFoo <- mkReg (Foo { x = 0; y = 0; }) interface putFoo x = $display "putFoo: " (cshow x) putBar x = $display "putBar: " (cshow x) putFooBar x y = $display "putFooBar: " (cshow x) " " (cshow y) putFoos x = $display "putFoos: " (cshow x) putBaz x = $display "putBaz: " (cshow x) + getFoo = Foo { x = 42; y = 43; } + getBar f = Bar { v = vec True False True; w = (False, 0x4321); z = f; } + update f = do + theCond := not theCond + theFoo := f + return $ Bar { v = vec (f.x == 33) theCond (not theCond); w = (theCond, 0xDEAD); z = theFoo; } {-# synthesize sysInstanceSplit #-} sysInstanceSplit :: Module Empty @@ -73,4 +86,12 @@ sysInstanceSplit = when i == 2 ==> s.putFooBar (Foo { x = 5; y = 6; }) (Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) when i == 3 ==> s.putFoos $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } when i == 4 ==> s.putBaz $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } - when i == 5 ==> $finish + when i == 5 ==> $display "getFoo: " (cshow s.getFoo) + when i == 6 ==> $display "getBar: " (cshow $ s.getBar (s.getFoo)) + when i == 7 ==> do + res <- s.update (Foo { x = 77; y = 88; }) + $display "update: " (cshow res) + when i == 8 ==> do + res <- s.update (Foo { x = 33; y = 44; }) + $display "update: " (cshow res) + when i == 9 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/ShallowSplit.bs b/testsuite/bsc.verilog/splitports/ShallowSplit.bs index 1c96ac47b..9c7f9e294 100644 --- a/testsuite/bsc.verilog/splitports/ShallowSplit.bs +++ b/testsuite/bsc.verilog/splitports/ShallowSplit.bs @@ -31,17 +31,30 @@ interface SplitTest = putFoos :: ShallowSplit (Vector 50 Foo) -> Action putBaz :: ShallowSplit Baz -> Action + getFoo :: ShallowSplit Foo + getBar :: ShallowSplit Foo -> ShallowSplit Bar {-# result = "GET_BAR" #-} + + update :: ShallowSplit Foo -> ActionValue (ShallowSplit Bar) + {-# synthesize mkShallowSplitTest #-} mkShallowSplitTest :: Module SplitTest mkShallowSplitTest = module + theCond <- mkReg False + theFoo <- mkReg (Foo { x = 0; y = 0; }) interface putFoo (ShallowSplit x) = $display "putFoo: " (cshow x) putBar (ShallowSplit x) = $display "putBar: " (cshow x) putFooBar (ShallowSplit x) (ShallowSplit y) = $display "putFooBar: " (cshow x) " " (cshow y) putFoos (ShallowSplit x) = $display "putFoos: " (cshow x) putBaz (ShallowSplit x) = $display "putBaz: " (cshow x) + getFoo = ShallowSplit $ Foo { x = 42; y = 43; } + getBar (ShallowSplit f) = ShallowSplit $ Bar { v = vec True False True; w = (False, 0x4321); z = f; } + update (ShallowSplit f) = do + theCond := not theCond + theFoo := f + return $ ShallowSplit $ Bar { v = vec (f.x == 33) theCond (not theCond); w = (theCond, 0xDEAD); z = theFoo; } {-# synthesize sysShallowSplit #-} sysShallowSplit :: Module Empty @@ -56,4 +69,12 @@ sysShallowSplit = when i == 2 ==> s.putFooBar (ShallowSplit $ Foo { x = 5; y = 6; }) (ShallowSplit $ Bar { v = vec False True False; w = (False, 0x5678); z = Foo { x = 7; y = 8; } }) when i == 3 ==> s.putFoos $ ShallowSplit $ genWith $ \ j -> Foo { x = fromInteger $ 9 + j / 2; y = fromInteger $ 10 - 2*j / 3; } when i == 4 ==> s.putBaz $ ShallowSplit $ Baz { a = Just $ Foo { x = 9; y = 10; }; b = Bar { v = vec True False False; w = (True, 0x1234); z = Foo { x = 3; y = 4; }; }; c = vec (vec (Foo { x = 11; y = 12; }) (Foo { x = 13; y = 14; }) (Foo { x = 15; y = 16; }) (Foo { x = 17; y = 18; }) (Foo { x = 19; y = 20; }) (Foo { x = 21; y = 22; }) (Foo { x = 23; y = 24; }) (Foo { x = 25; y = 26; }), Bar { v = vec True False True; w = (True, 0xBEEF); z = Foo { x = 3; y = 4; } }) (vec (Foo { x = 27; y = 28; }) (Foo { x = 29; y = 30; }) (Foo { x = 31; y = 32; }) (Foo { x = 33; y = 34; }) (Foo { x = 35; y = 36; }) (Foo { x = 37; y = 38; }) (Foo { x = 39; y = 40; }) (Foo { x = 41; y = 42; }), Bar { v = vec True False True; w = (True, 0x4321); z = Foo { x = 123; y = 42; } }) (vec (Foo { x = 43; y = 44; }) (Foo { x = 45; y = 46; }) (Foo { x = 47; y = 48; }) (Foo { x = 49; y = 50; }) (Foo { x = 51; y = 52; }) (Foo { x = 53; y = 54; }) (Foo { x = 55; y = 56; }) (Foo { x = 57; y = 58; }), Bar { v = vec True True True; w = (True, 0xAABB); z = Foo { x = 3; y = 4; } }); d = (); e = nil; } - when i == 5 ==> $finish + when i == 5 ==> $display "getFoo: " (cshow s.getFoo) + when i == 6 ==> $display "getBar: " (cshow $ s.getBar s.getFoo) + when i == 7 ==> do + res <- s.update (ShallowSplit $ Foo { x = 77; y = 88; }) + $display "update: " (cshow res) + when i == 8 ==> do + res <- s.update (ShallowSplit $ Foo { x = 33; y = 44; }) + $display "update: " (cshow res) + when i == 9 ==> $finish diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp index 0987ba1ba..12c8fa783 100644 --- a/testsuite/bsc.verilog/splitports/splitports.exp +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -9,6 +9,17 @@ if { $vtest == 1 } { find_regexp mkShallowSplitTest.v {input \[15 : 0\] putFoos_1_49;} find_regexp mkShallowSplitTest.v {input \[16 : 0\] putBaz_1_a;} find_regexp mkShallowSplitTest.v {input \[491 : 0\] putBaz_1_c;} + find_regexp mkShallowSplitTest.v {output \[7 : 0\] getFoo_x;} + find_regexp mkShallowSplitTest.v {output \[7 : 0\] getFoo_y;} + find_regexp mkShallowSplitTest.v {output \[2 : 0\] GET_BAR_v;} + find_regexp mkShallowSplitTest.v {output \[15 : 0\] GET_BAR_z;} + find_regexp mkShallowSplitTest.v {input \[7 : 0\] update_1_x;} + find_regexp mkShallowSplitTest.v {input EN_update;} + find_regexp mkShallowSplitTest.v {output \[16 : 0\] update_w;} + find_regexp mkShallowSplitTest.v {output RDY_update;} + + find_regexp mkShallowSplitTest.v {\(getBar_1_x, getBar_1_y\) -> GET_BAR_z} + find_regexp mkShallowSplitTest.v {update_1_x -> update_v} } test_c_veri DeepSplit @@ -24,6 +35,23 @@ if { $vtest == 1 } { find_regexp mkDeepSplitTest.v {input \[7 : 0\] putBaz_1_c_2_1_7_y;} find_regexp mkDeepSplitTest.v {input \[15 : 0\] putBaz_1_c_2_2_w_2;} find_regexp mkDeepSplitTest.v {input \[3 : 0\] putZug_1_qs_1;} + find_regexp mkDeepSplitTest.v {output \[7 : 0\] getFoo_x;} + find_regexp mkDeepSplitTest.v {output \[7 : 0\] getFoo_y;} + find_regexp mkDeepSplitTest.v {output GET_BAR_v_0;} + find_regexp mkDeepSplitTest.v {output GET_BAR_v_2;} + find_regexp mkDeepSplitTest.v {output \[15 : 0\] GET_BAR_w_2;} + find_regexp mkDeepSplitTest.v {output \[7 : 0\] GET_BAR_z_y;} + find_regexp mkDeepSplitTest.v {output \[3 : 0\] getZug_qs_0;} + find_regexp mkDeepSplitTest.v {output \[3 : 0\] getZug_qs_1;} + find_regexp mkDeepSplitTest.v {output getZug_blob;} + find_regexp mkDeepSplitTest.v {input \[7 : 0\] update_1_x;} + find_regexp mkDeepSplitTest.v {input EN_update;} + find_regexp mkDeepSplitTest.v {output \[15 : 0\] update_w_2;} + find_regexp mkDeepSplitTest.v {output RDY_update;} + + find_regexp mkDeepSplitTest.v {getBar_1_x -> GET_BAR_z_x} + find_regexp mkDeepSplitTest.v {getBar_1_y -> GET_BAR_z_y} + find_regexp mkDeepSplitTest.v {update_1_x -> update_v_0} } test_c_veri InstanceSplit @@ -37,6 +65,20 @@ if { $vtest == 1 } { find_regexp mkInstanceSplitTest.v {input \[799 : 0\] putFoos_1;} find_regexp mkInstanceSplitTest.v {input \[16 : 0\] putBaz_1_a;} find_regexp mkInstanceSplitTest.v {input \[491 : 0\] putBaz_1_c;} + find_regexp mkInstanceSplitTest.v {output \[7 : 0\] getFoo_x;} + find_regexp mkInstanceSplitTest.v {output getFoo_ysign;} + find_regexp mkInstanceSplitTest.v {output \[6 : 0\] getFoo_yvalue;} + find_regexp mkInstanceSplitTest.v {output \[2 : 0\] GET_BAR_v;} + find_regexp mkInstanceSplitTest.v {output GET_BAR_z_ysign;} + find_regexp mkInstanceSplitTest.v {input \[7 : 0\] update_1_x;} + find_regexp mkInstanceSplitTest.v {input EN_update;} + find_regexp mkInstanceSplitTest.v {output \[6 : 0\] update_z_yvalue;} + find_regexp mkInstanceSplitTest.v {output RDY_update;} + + find_regexp mkInstanceSplitTest.v {getBar_1_x -> GET_BAR_z_x} + find_regexp mkInstanceSplitTest.v {\(getBar_1_ysign, getBar_1_yvalue\) -> GET_BAR_z_ysign} + find_regexp mkInstanceSplitTest.v {\(getBar_1_ysign, getBar_1_yvalue\) -> GET_BAR_z_yvalue} + find_regexp mkInstanceSplitTest.v {update_1_x -> update_v} } # Supplying an arg_names pragma that is shorter than the number of arguments diff --git a/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected index fa26cd6e1..af9d18ba2 100644 --- a/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected +++ b/testsuite/bsc.verilog/splitports/sysDeepSplit.out.expected @@ -4,3 +4,8 @@ putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} putZug: Zug {qs=[Quix {q= 1; v=True}, Quix {q= 2; v=False}]; blob=False} +getFoo: DeepSplit (Foo {x= 42; y= 43}) +getBar: DeepSplit (Bar {v=[True, False, True]; w=(False, 17185); z=Foo {x= 42; y= 43}}) +getZug: DeepSplit (Zug {qs=[Quix {q=-2; v=True}, Quix {q= 2; v=False}]; blob=True}) +update: DeepSplit (Bar {v=[False, False, True]; w=(False, 57005); z=Foo {x= 0; y= 0}}) +update: DeepSplit (Bar {v=[True, True, False]; w=(True, 57005); z=Foo {x= 77; y= 88}}) diff --git a/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected b/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected index bb4f2dc03..00bf5618c 100644 --- a/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected +++ b/testsuite/bsc.verilog/splitports/sysInstanceSplit.out.expected @@ -3,3 +3,7 @@ putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} +getFoo: Foo {x= 42; y= 43} +getBar: Bar {v=[True, False, True]; w=(False, 17185); z=Foo {x= 42; y= 43}} +update: Bar {v=[False, False, True]; w=(False, 57005); z=Foo {x= 0; y= 0}} +update: Bar {v=[True, True, False]; w=(True, 57005); z=Foo {x= 77; y= 88}} diff --git a/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected b/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected index bb4f2dc03..40e21a373 100644 --- a/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected +++ b/testsuite/bsc.verilog/splitports/sysShallowSplit.out.expected @@ -3,3 +3,7 @@ putBar: Bar {v=[True, False, True]; w=(True, 4660); z=Foo {x= 3; y= 4}} putFooBar: Foo {x= 5; y= 6} Bar {v=[False, True, False]; w=(False, 22136); z=Foo {x= 7; y= 8}} putFoos: [Foo {x= 9; y= 10}, Foo {x= 9; y= 10}, Foo {x= 10; y= 9}, Foo {x= 10; y= 8}, Foo {x= 11; y= 8}, Foo {x= 11; y= 7}, Foo {x= 12; y= 6}, Foo {x= 12; y= 6}, Foo {x= 13; y= 5}, Foo {x= 13; y= 4}, Foo {x= 14; y= 4}, Foo {x= 14; y= 3}, Foo {x= 15; y= 2}, Foo {x= 15; y= 2}, Foo {x= 16; y= 1}, Foo {x= 16; y= 0}, Foo {x= 17; y= 0}, Foo {x= 17; y= -1}, Foo {x= 18; y= -2}, Foo {x= 18; y= -2}, Foo {x= 19; y= -3}, Foo {x= 19; y= -4}, Foo {x= 20; y= -4}, Foo {x= 20; y= -5}, Foo {x= 21; y= -6}, Foo {x= 21; y= -6}, Foo {x= 22; y= -7}, Foo {x= 22; y= -8}, Foo {x= 23; y= -8}, Foo {x= 23; y= -9}, Foo {x= 24; y= -10}, Foo {x= 24; y= -10}, Foo {x= 25; y= -11}, Foo {x= 25; y= -12}, Foo {x= 26; y= -12}, Foo {x= 26; y= -13}, Foo {x= 27; y= -14}, Foo {x= 27; y= -14}, Foo {x= 28; y= -15}, Foo {x= 28; y= -16}, Foo {x= 29; y= -16}, Foo {x= 29; y= -17}, Foo {x= 30; y= -18}, Foo {x= 30; y= -18}, Foo {x= 31; y= -19}, Foo {x= 31; y= -20}, Foo {x= 32; y= -20}, Foo {x= 32; y= -21}, Foo {x= 33; y= -22}, Foo {x= 33; y= -22}] putBaz: Baz {a=Valid (Foo {x= 9; y= 10}); b=Bar {v=[True, False, False]; w=(True, 4660); z=Foo {x= 3; y= 4}}; c=[([Foo {x= 11; y= 12}, Foo {x= 13; y= 14}, Foo {x= 15; y= 16}, Foo {x= 17; y= 18}, Foo {x= 19; y= 20}, Foo {x= 21; y= 22}, Foo {x= 23; y= 24}, Foo {x= 25; y= 26}], Bar {v=[True, False, True]; w=(True, 48879); z=Foo {x= 3; y= 4}}), ([Foo {x= 27; y= 28}, Foo {x= 29; y= 30}, Foo {x= 31; y= 32}, Foo {x= 33; y= 34}, Foo {x= 35; y= 36}, Foo {x= 37; y= 38}, Foo {x= 39; y= 40}, Foo {x= 41; y= 42}], Bar {v=[True, False, True]; w=(True, 17185); z=Foo {x= 123; y= 42}}), ([Foo {x= 43; y= 44}, Foo {x= 45; y= 46}, Foo {x= 47; y= 48}, Foo {x= 49; y= 50}, Foo {x= 51; y= 52}, Foo {x= 53; y= 54}, Foo {x= 55; y= 56}, Foo {x= 57; y= 58}], Bar {v=[True, True, True]; w=(True, 43707); z=Foo {x= 3; y= 4}})]; d=(); e=[]} +getFoo: ShallowSplit (Foo {x= 42; y= 43}) +getBar: ShallowSplit (Bar {v=[True, False, True]; w=(False, 17185); z=Foo {x= 42; y= 43}}) +update: ShallowSplit (Bar {v=[False, False, True]; w=(False, 57005); z=Foo {x= 0; y= 0}}) +update: ShallowSplit (Bar {v=[True, True, False]; w=(True, 57005); z=Foo {x= 77; y= 88}}) From 0c374379a3ad5575dcfae738151fcbcf44f392c1 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 11:21:46 -0800 Subject: [PATCH 86/89] Fix findSupport demanding ae_objid and ameth_id on ATupleSel --- src/comp/DisjointTest.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/comp/DisjointTest.hs b/src/comp/DisjointTest.hs index 1de2481ce..896c3ac11 100644 --- a/src/comp/DisjointTest.hs +++ b/src/comp/DisjointTest.hs @@ -281,12 +281,12 @@ buildSupportMap adefs avis rs = --trace ("XXX support map:" ++ ppReadable res) $ [vlogport] -> [DMethod (ae_objid e) vlogport] ports -> internalError ("buildSupportMap: unexpected output ports: " ++ ppReadable (ae_objid e, ameth_id e, ports)) - findSupport e@(ATupleSel _ (AMethCall {ae_args = es}) idx) = + findSupport (ATupleSel _ e@(AMethCall {ae_args = es}) idx) = findAExprs findSupport es ++ [DMethod (ae_objid e) vlogport] where ports = getMethodOutputPorts portMap (ae_objid e) (ameth_id e) vlogport = genericIndex ports (idx - 1) - findSupport e@(ATupleSel _ (AMethValue {}) idx) = + findSupport (ATupleSel _ e@(AMethValue {}) idx) = [DMethod (ae_objid e) vlogport] where ports = getMethodOutputPorts portMap (ae_objid e) (ameth_id e) From 8e7f7bfcfc5d51c26ad8ad4fc93554fa0f2c8e95 Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Mon, 12 Jan 2026 11:27:24 -0800 Subject: [PATCH 87/89] Handle ATuple and ATupleSel in rankMethCalls --- src/comp/ARankMethCalls.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/comp/ARankMethCalls.hs b/src/comp/ARankMethCalls.hs index 9b6a946f6..6efc07bdb 100644 --- a/src/comp/ARankMethCalls.hs +++ b/src/comp/ARankMethCalls.hs @@ -121,13 +121,18 @@ class RankMethCalls ats_t where rankMethCalls :: Int -> ats_t -> (ats_t, [Id] {- local defs to rank -}) instance RankMethCalls AExpr where - -- TODO handle ATupleSel here? rankMethCalls ver expr@(AMethCall { ameth_id = name, ae_args = args }) = let (ranked_args, defs_to_rewrite) = rankMethCalls ver args in (expr { ameth_id = rankId ver name, ae_args = ranked_args }, defs_to_rewrite) rankMethCalls ver expr@(AMethValue { ameth_id = name }) = (expr { ameth_id = rankId ver name }, []) + rankMethCalls ver expr@(ATuple { ae_elems = elems }) = + let (ranked_elems, defs_to_rewrite) = rankMethCalls ver elems + in (expr { ae_elems = ranked_elems }, defs_to_rewrite) + rankMethCalls ver expr@(ATupleSel { ae_exp = e }) = + let (ranked_e, defs_to_rewrite) = rankMethCalls ver e + in (expr { ae_exp = ranked_e }, defs_to_rewrite) rankMethCalls ver expr@(ANoInlineFunCall { ae_args = args }) = let (ranked_args, defs_to_rewrite) = rankMethCalls ver args in (expr { ae_args = ranked_args }, defs_to_rewrite) From 6d3a36b0c054d3b68f68f559f381eaf23544c2fc Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Wed, 14 Jan 2026 19:52:35 -0800 Subject: [PATCH 88/89] Tuple operations can be wop --- src/comp/SimCCBlock.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/comp/SimCCBlock.hs b/src/comp/SimCCBlock.hs index ef6418276..ec15e634b 100644 --- a/src/comp/SimCCBlock.hs +++ b/src/comp/SimCCBlock.hs @@ -523,6 +523,8 @@ adjustInstQuals id = -- check if an aexpr is just a var id, or other situation not to deal by wop hasWop :: AExpr -> Bool hasWop (APrim { aprim_prim = p }) = (p /= PrimIf) +hasWop (ATuple _ _) = True +hasWop (ATupleSel _ _ _) = True hasWop _ = False -- --------------------- From 76a2d19b50e1da8ec9967cc14269372765dbeb0b Mon Sep 17 00:00:00 2001 From: Lucas Kramer Date: Wed, 14 Jan 2026 19:53:33 -0800 Subject: [PATCH 89/89] Fix wop_primExtractWide to accept a const reference --- src/bluesim/bs_prim_ops.h | 2 +- src/bluesim/bs_wide_data.h | 2 +- src/bluesim/wide_data.cxx | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/bluesim/bs_prim_ops.h b/src/bluesim/bs_prim_ops.h index 08e3d1fd7..2ed2ea9d4 100644 --- a/src/bluesim/bs_prim_ops.h +++ b/src/bluesim/bs_prim_ops.h @@ -1654,7 +1654,7 @@ static inline void wop_primExtractWide(unsigned int dst_sz, static inline void wop_primExtractWide(unsigned int dst_sz, unsigned int src_sz, - tUWide & src, + const tUWide & src, unsigned int high_sz, unsigned int high, unsigned int low_sz, unsigned int low, tUWide &dst) diff --git a/src/bluesim/bs_wide_data.h b/src/bluesim/bs_wide_data.h index 2c056b3f7..dd4496fa8 100644 --- a/src/bluesim/bs_wide_data.h +++ b/src/bluesim/bs_wide_data.h @@ -102,7 +102,7 @@ class WideData unsigned int extract32(unsigned int hi, unsigned int lo) const; unsigned long long extract64(unsigned int hi, unsigned int lo) const; WideData extractWide(unsigned int hi, unsigned int lo) const; - void wop_extractWide(unsigned int hi, unsigned int lo, WideData& result); + void wop_extractWide(unsigned int hi, unsigned int lo, WideData& result) const; void clear(unsigned int from = 0); void clear(unsigned int from, unsigned int to); void set(unsigned int from = 0); diff --git a/src/bluesim/wide_data.cxx b/src/bluesim/wide_data.cxx index f718ce233..f30f1169c 100644 --- a/src/bluesim/wide_data.cxx +++ b/src/bluesim/wide_data.cxx @@ -1755,7 +1755,7 @@ void wop_rem(const WideData& v1, const WideData& v2, WideData &result) /*** function calls ***/ /* maybe useful */ -void WideData::wop_extractWide(uint hi, uint lo, WideData& result) +void WideData::wop_extractWide(uint hi, uint lo, WideData& result) const { copy_bits_to_0(result.data, data, lo, (hi-lo+1)); clear_bits(result.data, (hi-lo+1), (result.numWords() * WORD_SIZE) - 1);