diff --git a/src/Libraries/Base1/Prelude.bs b/src/Libraries/Base1/Prelude.bs index bcdcf3987..f9353096e 100644 --- a/src/Libraries/Base1/Prelude.bs +++ b/src/Libraries/Base1/Prelude.bs @@ -4718,7 +4718,8 @@ class WrapMethod m w | m -> w where -- 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 (WrapPorts (PortsOf a) pb, PrimSeqTupleBits pb, WrapMethod b v) => +instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n, + PrimSeqTupleBits pb, WrapMethod b v) => WrapMethod (a -> b) (pb -> v) where -- deep-seq the packed argument so its per-port fields are evaluated before -- they reach walkNF (mirroring the deep-seq already done on method results) @@ -4747,7 +4748,8 @@ instance (WrapPorts (PortsOf a) pb, PrimSeqTupleBits pb, WrapMethod b v) => saveMethodPortTypes (_ :: b) modName t result saveMethodPortTypes _ _ Nil _ = error "saveMethodPortTypes: empty arg names list" -instance (WrapPorts (PortsOf a) pb, PrimSeqTupleBits pb) => +instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n, + PrimSeqTupleBits pb) => WrapMethod (ActionValue a) (ActionValue_ pb) where toWrapMethod = bitsToActionValue_ ∘ fmap (primDeepSeqTupleBits ∘ packPorts ∘ splitPorts) fromWrapMethod = fmap (unsplitPorts ∘ unpackPorts) ∘ bitsFromActionValue_ @@ -4761,7 +4763,8 @@ instance (WrapPorts (PortsOf a) pb, PrimSeqTupleBits pb) => saveMethodPortTypes _ modName _ result = savePortTypes (_ :: PortsOf a) modName $ checkPortNames (_ :: a) result -instance (WrapPorts (PortsOf a) pb, PrimSeqTupleBits pb) => +instance (WrapPorts (PortsOf a) pb, TupleSize (PortsOf a) n, + PrimSeqTupleBits pb) => WrapMethod a pb where toWrapMethod = primDeepSeqTupleBits ∘ packPorts ∘ splitPorts fromWrapMethod = unsplitPorts ∘ unpackPorts @@ -4851,14 +4854,13 @@ instance PrimSeqTupleBits () where -- Compute the list port names for type 'a' given a base name. -- Check that the number of port names matches the number of ports. -- This error should only occur if there is an error in a SplitPorts instance. -checkPortNames :: (SplitPorts a p) => a -> String -> List String +checkPortNames :: (SplitPorts a p, TupleSize p n) => a -> String -> List String checkPortNames proxy base = let pn = portNames proxy base - n = valueOf (TTupleSize p) in - if listLength pn /= n + if listLength pn /= valueOf n then primError (getEvalPosition proxy) $ - "SplitPorts: " +++ base +++ " has " +++ integerToString n +++ + "SplitPorts: " +++ base +++ " has " +++ integerToString (valueOf n) +++ " ports, but " +++ integerToString (listLength pn) +++ " port names were given" else pn diff --git a/src/comp/ACleanup.hs b/src/comp/ACleanup.hs index 68ea9e0c3..8614e6f37 100644 --- a/src/comp/ACleanup.hs +++ b/src/comp/ACleanup.hs @@ -142,8 +142,12 @@ cleanupActions flags pred as = newid <- newName addDef (ADef newid aTBool (APrim newid aTBool PrimBOr [cond, cond']) []) - -- For SplitPorts args (ATuple), merge per element so - -- the resulting AExpr keeps the source-arg shape. + -- A tuple-typed arg (SplitPorts) must stay a + -- literal ATuple all the way to the backend + -- (AVerilog only renders literal tuple defs), so + -- merge per element, selecting from a non-literal + -- side with ATupleSel -- the form AState already + -- emits and AVerilog lowers. let mergeOne arg arg' = do argid <- newName let argtyp = (aType arg) @@ -151,9 +155,14 @@ cleanupActions flags pred as = (APrim argid argtyp PrimIf [cond, arg, arg']) []) return (ASDef argtyp argid) - mergeArg (ATuple ty es) (ATuple _ es') = do - es'' <- zipWithM mergeOne es es' - return (ATuple ty es'') + tupleElems (ATuple _ es) _ = es + tupleElems e ts = + [ ATupleSel t e i | (i, t) <- zip [1..] ts ] + mergeArg arg arg' + | ATTuple ts <- aType arg = do + es'' <- zipWithM mergeArg (tupleElems arg ts) + (tupleElems arg' ts) + return (ATuple (aType arg) es'') mergeArg arg arg' = mergeOne arg arg' newargs <- zipWithM mergeArg args args' let newcall = ACall id methodid diff --git a/src/comp/ILift.hs b/src/comp/ILift.hs index 92ab7dcd0..3c9f91f90 100644 --- a/src/comp/ILift.hs +++ b/src/comp/ILift.hs @@ -9,7 +9,7 @@ import ISyntaxUtil(ieNot, iGetType, ieIf, ieIfx, flatAction, joinActions, notIf, isTAction, isTrue, isFalse, ieAndOpt, ieOrOpt, - iDefMap + iDefMap, isPairType ) import ITransform(iTransExpr, iTransBoolExpr) import PreIds(idActionValue_, idAVAction_) @@ -160,7 +160,8 @@ lift1 errh flags ifexp@(IAps (ICon id (ICPrim {primOp = PrimIf, iConType = conty -- the length check is for things like $display so we do not lift when there are different numbers of arguments loopF scanned ((firstF@(IActionCond {action = firstFaction@(IAps expF _ ((icsvF@(ICon _ (svF@(ICStateVar _ _)))):argsF)), condition = firstFcond})):restF) | (expF == expT) && (svF == svT) && - ((length argsT) == (length argsF)) = + ((length argsT) == (length argsF)), + Just newargs <- mapM (uncurry (mergeLiftArg errh c)) (zip argsT argsF) = -- just make an ActionCond out of this when it matches -- eventual conversion back into IExpr will force simplification -- c is used as the predicate to determine the argument value because when c is true the T branch should be executed @@ -169,11 +170,7 @@ lift1 errh flags ifexp@(IAps (ICon id (ICPrim {primOp = PrimIf, iConType = conty (iTransExpr errh (IAps expT tsT - (icsvT:[(fst (iTransExpr errh - (ieIf (iGetType argT) - c - (fst (iTransExpr errh argT)) - (fst (iTransExpr errh argF))))) | (argT, argF) <- (zip argsT argsF)])))), + (icsvT:newargs)))), condition = genLiftCond flags c firstTcond firstFcond } ):lifted) @@ -206,7 +203,8 @@ lift1 errh flags ifexp@(IAps (ICon id (ICPrim {primOp = PrimIf, iConType = conty [firstFaction@(IAps expF _ ((icsvF@(ICon _ (svF@(ICStateVar _ _)))):argsF))], condition = firstFcond})):restF) | (i_sel == idAVAction_) && (expF == expT) && (svF == svT) && - ((length argsT) == (length argsF)) = + ((length argsT) == (length argsF)), + Just newargs <- mapM (uncurry (mergeLiftArg errh c)) (zip argsT argsF) = -- just make an ActionCond out of this when it matches -- eventual conversion back into IExpr will force simplification -- c is used as the predicate to determine the argument value because when c is true the T branch should be executed @@ -216,11 +214,7 @@ lift1 errh flags ifexp@(IAps (ICon id (ICPrim {primOp = PrimIf, iConType = conty (iTransExpr errh (IAps expT tsT - (icsvT:[(fst (iTransExpr errh - (ieIf (iGetType argT) - c - (fst (iTransExpr errh argT)) - (fst (iTransExpr errh argF))))) | (argT, argF) <- (zip argsT argsF)]))))], + (icsvT:newargs))))], condition = genLiftCond flags c firstTcond firstFcond } ):lifted) @@ -283,3 +277,33 @@ genLiftCond flags cond otrue ofalse | isTrue otrue, isTrue ofalse = iTrue | isFalse cond = ofalse genLiftCond flags cond otrue ofalse = (iTransBoolExpr flags) $ (cond `ieAndOpt` otrue) `ieOrOpt` ( (ieNot cond) `ieAndOpt` ofalse) + + +-- Merge one argument pair of two mutually exclusive calls to the same +-- method into (if c then argT else argF), distributing the mux over +-- PrimPair structure. Since the port-splitting rework, tuple-typed +-- method arguments must remain tuple constructions all the way to the +-- backend (AVerilogUtil.vDefMpd only renders literal tuple defs), so a +-- whole-tuple mux def would be an internal error there. Returns +-- Nothing when a tuple-typed argument does not expose a tuple literal +-- on both sides (looking through ICValue definition references); the +-- caller then skips lifting that call pair and leaves the two calls +-- for ACleanup, which merges per element at the ASyntax level where an +-- opaque tuple reference can be selected with ATupleSel. +mergeLiftArg :: ErrorHandle -> IExpr a -> IExpr a -> IExpr a -> Maybe (IExpr a) +mergeLiftArg errh c argT argF + | isPairType (iGetType argT) = + case (unwrap argT, unwrap argF) of + (IAps conT@(ICon i (ICTuple {})) tsT esT, + IAps (ICon i' (ICTuple {})) _ esF) + | i == i' && length esT == length esF -> do + es <- sequence (zipWith (mergeLiftArg errh c) esT esF) + return (IAps conT tsT es) + _ -> Nothing + | otherwise = + Just $ fst $ iTransExpr errh $ + ieIf (iGetType argT) c (fst (iTransExpr errh argT)) + (fst (iTransExpr errh argF)) + where + unwrap (ICon _ (ICValue { iValDef = e })) = unwrap e + unwrap e = e diff --git a/testsuite/bsc.verilog/splitports/CrossRule.bsv b/testsuite/bsc.verilog/splitports/CrossRule.bsv new file mode 100644 index 000000000..7127c2cd9 --- /dev/null +++ b/testsuite/bsc.verilog/splitports/CrossRule.bsv @@ -0,0 +1,27 @@ +interface Sub; + method Action put(Tuple2#(Bit#(4), Bit#(8)) x); +endinterface + +(* synthesize *) +module mkCrossRuleSub(Sub); + Reg#(Bit#(4)) r1 <- mkReg(0); + Reg#(Bit#(8)) r2 <- mkReg(0); + method Action put(Tuple2#(Bit#(4), Bit#(8)) x); + r1 <= tpl_1(x); + r2 <= tpl_2(x); + endmethod +endmodule + +(* synthesize *) +module sysCrossRule(Empty); + Sub s <- mkCrossRuleSub; + Reg#(Bool) c <- mkReg(False); + Reg#(Bit#(4)) a <- mkReg(0); + Reg#(Bit#(8)) b <- mkReg(0); + rule r1 (c); + s.put(tuple2(a, 8'h11)); + endrule + rule r2 (!c); + s.put(tuple2(a, b)); + endrule +endmodule diff --git a/testsuite/bsc.verilog/splitports/SplitIfTuple.bsv b/testsuite/bsc.verilog/splitports/SplitIfTuple.bsv new file mode 100644 index 000000000..c8cd5914c --- /dev/null +++ b/testsuite/bsc.verilog/splitports/SplitIfTuple.bsv @@ -0,0 +1,31 @@ +// Minimal reproducer for the AVerilog vDefMpd tuple ICE: +// two conditional calls to the same tuple-argument Action method in one +// rule are merged by ILift into one call with an if-of-tuple argument, +// which nothing downstream can lower. +interface Sub; + method Action put(Tuple2#(Bit#(4), Bit#(8)) x); +endinterface + +(* synthesize *) +module mkSplitIfTupleSub(Sub); + Reg#(Bit#(4)) r1 <- mkReg(0); + Reg#(Bit#(8)) r2 <- mkReg(0); + method Action put(Tuple2#(Bit#(4), Bit#(8)) x); + r1 <= tpl_1(x); + r2 <= tpl_2(x); + endmethod +endmodule + +(* synthesize *) +module sysSplitIfTuple(Empty); + Sub s <- mkSplitIfTupleSub; + Reg#(Bool) c <- mkReg(False); + Reg#(Bit#(4)) a <- mkReg(0); + Reg#(Bit#(8)) b <- mkReg(0); + rule go; + if (c) + s.put(tuple2(a, 8'h11)); + else + s.put(tuple2(a, b)); + endrule +endmodule diff --git a/testsuite/bsc.verilog/splitports/splitports.exp b/testsuite/bsc.verilog/splitports/splitports.exp index d3b772805..f8172d0ca 100644 --- a/testsuite/bsc.verilog/splitports/splitports.exp +++ b/testsuite/bsc.verilog/splitports/splitports.exp @@ -288,3 +288,13 @@ compare_file BadSplitInst_PortNameConflict.bs.bsc-vcomp-out compile_verilog_fail_error BadSplitInst_TooManyPortNames.bs S0015 compare_file BadSplitInst_TooManyPortNames.bs.bsc-vcomp-out + +# Two mutually exclusive calls to the same tuple-argument Action method in +# ONE rule are merged into a single call (ILift under the default -lift, +# ACleanup under -no-lift). The merged argument must stay a per-element +# tuple construction: a whole-tuple mux def is an internal error in +# AVerilog (vDefMpd), which only renders literal tuple defs. +compile_verilog_pass SplitIfTuple.bsv +compile_verilog_pass SplitIfTuple.bsv {} {-no-lift} +# The cross-rule variant exercises AState's per-port muxing of tuple args. +compile_verilog_pass CrossRule.bsv