[pull] main from B-Lang-org:main

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
 

src/comp/ACleanup.hs

@@ -142,18 +142,27 @@ 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)
                                 addDef (ADef argid argtyp
                                     (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

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

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

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

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