Propagate state names through ModuleContext's bind

src/Libraries/Base3-Contexts/ModuleContextCore.bs

@@ -15,8 +15,9 @@ instance Applicative (ModuleContext c) where
 
 instance Monad (ModuleContext c) where
   bind (M _x) _f = M (\_c ->
-                        (_x _c) `bind`
-                          (\ _node -> unM (_f _node.snd) _node.fst)
+                        let _n = primGetParamName _f
+                        in  (setStateName _n (_x _c)) `bind`
+                              (\ _node -> unM (_f _node.snd) _node.fst)
                    )
 
 getCompleteContext  :: ModuleContext c c

src/comp/IExpandUtils.hs

@@ -1030,10 +1030,54 @@ pushModuleSchedNameScope ns resTy = do
                     Just ifcName -> getIfcFlatMethodNames symt ifcName
       newNameMap = M.fromList [ (m, SNI_Method False) | m <- methNames ]
       newFrame = SchedNameFrame ns 0 newNameMap Nothing
+      -- Two naming layers can wrap the same module: for example, the
+      -- name wrapper that a module monad's bind inserts (via
+      -- primGetParamName/setStateName, carrying the bound variable's
+      -- name) around the setStateName that BSV's typechecker already
+      -- inserted (carrying the declared instance name).  Each layer's
+      -- PrimStateName handler REPLACES the head of the IStateLoc -- a
+      -- sibling, not a child -- so instance naming collapses the layers
+      -- and the inner name wins.  Collapse them here, too: if the new ns
+      -- is a head-replacement of the frame on top of the stack (same
+      -- tail) and no rules have been registered yet, rename the top
+      -- frame instead of pushing a second frame, and bump its ignore
+      -- count to account for the extra pop.  Otherwise rule names, which
+      -- are qualified by the final IStateLoc, would not extend the stale
+      -- frame's prefix and would poison the name map when dequalified
+      -- (see remIStateLocPrefix).
+      -- The push is a re-naming exactly when: it is at the same parent
+      -- position (equal, NON-empty tails -- primBuildModule starts fresh
+      -- singleton stacks, so empty tails mean two unrelated build-module
+      -- scopes, which can nest dynamically because primBuildModule is
+      -- forced lazily); it re-names the same binding (equal head
+      -- isl_ifc_id, which the PrimStateName handler preserves when it
+      -- re-heads the stack -- a genuine child that reaches the same tail
+      -- carries its own ifc id); and the scope owns no rule yet (no
+      -- rules registered, no rule/ifc elaboration in progress, and no
+      -- rules saved for deferred registration).  Rule names only reach
+      -- the map in addRules, after rule bodies elaborate, so the
+      -- elabProgress check covers immediate registration; under
+      -- moduleFix, however, addRules only saves the rules (saveRules)
+      -- and replays them after the body finishes, so a saved rule is
+      -- already named under the current prefix while both frame-local
+      -- checks still pass -- renaming the frame would orphan it.
+      isSiblingRename top =
+          case (ns, snf_istateloc top) of
+            (new_h:ns_rest@(_:_), top_h:top_rest) ->
+                ns_rest == top_rest &&
+                isl_ifc_id new_h == isl_ifc_id top_h &&
+                isNothing (snf_elabProgress top) &&
+                null [ () | SNI_Rule _ <- M.elems (snf_nameMap top) ] &&
+                null (savedRules s)
+            _ -> False
       -- if this is an "ignore" level, just update the old scope
       newScope = if ign
                  then incrSNFIgnoreCount oldScope
-                 else (newFrame:oldScope)
+                 else case oldScope of
+                        (top:frames) | isSiblingRename top ->
+                            (SchedNameFrame ns (snf_ignoreCount top + 1)
+                                 newNameMap Nothing) : frames
+                        _ -> (newFrame:oldScope)
   --traceM("PUSH: " ++ (ppReadable ((toTF ign, toTF (hasIgnore ns)), head newScope)))
   --traceM("PUSH: " ++ ppReadable (M.toList (snf_nameMap (head newScope))))
   put (s { schedNameScope = newScope })

testsuite/bsc.evaluator/prims/name/ElementsBinder.bsv

@@ -0,0 +1,25 @@
+module mkEBSub(Empty);
+   Reg#(Bool) r <- mkReg(False);
+endmodule
+
+module mkEBSub2(Empty);
+   Reg#(Bool) q <- mkReg(False);
+   rule upd;
+      q <= !q;
+   endrule
+endmodule
+
+module mkEBInner(Empty);
+   Reg#(Bool) x <- mkReg(False);
+   Empty _elements <- mkEBSub;
+   Empty s <- mkEBSub2;
+   (* descending_urgency = "tick,s.upd" *)
+   rule tick;
+      x <= !x;
+   endrule
+endmodule
+
+(* synthesize *)
+module sysElementsBinder(Empty);
+   Empty i <- mkEBInner;
+endmodule

testsuite/bsc.evaluator/prims/name/FixNameDeferred.bsv

@@ -0,0 +1,17 @@
+import FixNameMid::*;
+
+// mid is inlined (not synthesized), so its internal rule "poison"
+// bubbles up into sysFixNameDeferred's scope.  The descending_urgency attribute
+// references the bubbled rule name, forcing a lookup in the poisoned
+// name map (checkAddRulesAttributes -> M.lookup), which forces the
+// remIStateLocPrefix computation over the collapsed (renamed) frame.
+
+(* synthesize *)
+(* descending_urgency = "drive, mid_z_poison" *)
+module sysFixNameDeferred(Empty);
+   Reg#(Bool) t <- mkReg(False);
+   Reg#(Bool) mid <- mkMid;
+   rule drive;
+      t <= mid;
+   endrule
+endmodule

testsuite/bsc.evaluator/prims/name/FixNameMid.bs

@@ -0,0 +1,13 @@
+package FixNameMid(mkMid) where
+
+bodyFn :: Reg Bool -> Module (Reg Bool)
+bodyFn self =
+  do
+    addRules $ rules "poison": when True ==> self := not self
+    setStateName (primMakeName "z" noPosition) (mkReg False)
+
+mkMid :: Module (Reg Bool)
+mkMid =
+  module
+    x :: Reg Bool <- moduleFix bodyFn
+    return x

testsuite/bsc.evaluator/prims/name/ModuleCollectNames.bs

@@ -0,0 +1,28 @@
+package ModuleCollectNames where
+
+import ModuleCollect
+
+type CollectM i = ModuleCollect (Bit 8) i
+
+interface CounterC =
+   value :: Bit 16
+
+innerC :: CollectM CounterC
+innerC =
+  module
+    count :: Reg (Bit 16) <- mkReg 0
+    flag :: Reg Bool <- mkReg False
+    addToCollection (5 :: Bit 8)
+    interface CounterC
+      value = count
+    rules
+      "step": when True ==> action
+        count := count + 1
+
+{-# verilog sysModuleCollectNames #-}
+sysModuleCollectNames :: Module Empty
+sysModuleCollectNames =
+  module
+    ec :: IWithCollection (Bit 8) CounterC <- exposeCollection innerC
+    rules
+      "observe": when (ec.device.value == 99) ==> $finish 0

testsuite/bsc.evaluator/prims/name/ModuleCollectUrgency.bsv

@@ -0,0 +1,23 @@
+import ModuleCollect::*;
+
+module [ModuleCollect#(Bool)] mkMCUSub(Empty);
+   Reg#(Bool) r <- mkReg(False);
+   rule updatePosition;
+      r <= !r;
+   endrule
+endmodule
+
+module [ModuleCollect#(Bool)] mkMCUInner(Empty);
+   Reg#(Bool) x <- mkReg(False);
+   Empty controller();
+   mkMCUSub the_controller(controller);
+   (* descending_urgency = "tick,the_controller.updatePosition" *)
+   rule tick;
+      x <= !x;
+   endrule
+endmodule
+
+(* synthesize *)
+module sysModuleCollectUrgency(Empty);
+   IWithCollection#(Bool, Empty) ecs <- exposeCollection(mkMCUInner);
+endmodule

testsuite/bsc.evaluator/prims/name/NestedBuildModule.bsv

@@ -0,0 +1,34 @@
+// False-collapse candidate: primBuildModule forced inside another
+// primBuildModule's rule body.  Outer frame: ns = ["outerHist"] (singleton,
+// tail []), elabProgress = Just (EPRule shift), no rules registered yet.
+// Inner (ProbeWire keepType) pushes ns = ["x"] (singleton, tail []).
+// Equal (empty) tails + no rules => collapse renames the outer frame and
+// DROPS its rule progress.
+// Pattern copied from SVA.bsv valueFunctionSVA / ProbeWire.bsv keepType,
+// both of which use the exported Prelude primitive primBuildModule.
+
+import ProbeWire::*;
+
+function Bool nestedProbe(Reg#(Bool) r);
+   let c = clockOf(r);
+   let rst = noReset;
+   let v = primBuildModule(primGetName(outerHist), c, rst,
+      module#(Bool);
+         Bool cur = r;
+         Reg#(Bool) q <- mkRegU;
+         rule shift;
+            q <= keepType(cur);
+         endrule
+         return q;
+      endmodule);
+   return v;
+endfunction
+
+(* synthesize *)
+module sysNestedBuildModule(Empty);
+   Reg#(Bool) sig <- mkReg(False);
+   Reg#(Bool) dst <- mkReg(False);
+   rule consume;
+      dst <= nestedProbe(asReg(sig));
+   endrule
+endmodule

testsuite/bsc.evaluator/prims/name/name.exp

@@ -31,3 +31,40 @@ find_n_strings mkReaderModuleTestOuter.v {mkReaderModuleTestInner inner(} 1
 
 # -----
 
+
+# -----
+
+# Test that state naming propagates through a module monad whose bind
+# uses primGetParamName/setStateName (ModuleContext, and therefore
+# ModuleCollect): registers bound in Classic code, where there is no
+# parser-inserted naming, get their binder names in the output.
+
+compile_verilog_pass ModuleCollectNames.bs
+if { $vtest == 1 } {
+find_n_strings sysModuleCollectNames.v {reg [15 : 0] ec_count;} 1
+find_n_strings sysModuleCollectNames.v {reg ec_flag;} 1
+}
+
+# The bind's naming layer wraps the setStateName that BSV's typechecker
+# already inserts, so one module can carry two stacked naming layers;
+# the schedule name scope collapses them (see pushModuleSchedNameScope).
+# This is bsc.bsv_examples/pong distilled: the instance name differs
+# from the binder, and the urgency attribute forces the name maps.
+compile_verilog_pass ModuleCollectUrgency.bsv
+
+# Pins for the collapse condition itself:
+# a primBuildModule forced inside another primBuildModule's rule -- two
+# unrelated fresh singleton IStateLocs that must NOT collapse (the
+# non-empty-tail condition)
+compile_verilog_pass NestedBuildModule.bsv
+# a user binder named "_elements" makes elaboration escape a naming
+# level, so a genuine child push shares the still-open frame's tail;
+# the same-ifc-id condition must keep it from collapsing
+compile_verilog_pass ElementsBinder.bsv
+# a rule saved for deferred registration by moduleFix is already named
+# under the current prefix while the frame-local checks still pass; a
+# tail-position setStateName in the fix body must NOT collapse (the
+# saved-rules condition).  The attribute references a name that does
+# not exist (the rule is registered under the binder's name), which is
+# a user error -- not an internal one.
+compile_verilog_fail_error FixNameDeferred.bsv G0054