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

README.md

@@ -95,9 +95,10 @@ For the following systems, the Bluespec toolchain is available
 as a package that can be installed with the standard package manager:
 
 * ArchLinux AUR: [`bluespec-git`](https://aur.archlinux.org/packages/bluespec-git/) ([among others](https://aur.archlinux.org/packages/?K=bluespec))
+* Fedora ([Terra Repository](https://terrapkg.com/)): [`bsc`](https://github.com/terrapkg/packages/tree/frawhide/anda/buildsys/bsc)
 * Gentoo GURU and LiGurOS: [`sci-electronics/bluespec`](https://gitweb.gentoo.org/repo/proj/guru.git/tree/sci-electronics/bluespec)
+* Homebrew: [`bsc`](https://formulae.brew.sh/formula/bsc)
 * Nix/NixOS: [`bluespec`](https://search.nixos.org/packages?channel=20.09&from=0&size=50&sort=relevance&query=bluespec)
-* Fedora ([Terra Repository](https://terrapkg.com/)): [`bsc`](https://github.com/terrapkg/packages/tree/frawhide/anda/buildsys/bsc)
 
 You can also use the [Repology search engine](https://repology.org/project/bluespec/versions)
 to check for Bluespec packages for your system.

src/Libraries/Base1/Foldable.bs

@@ -0,0 +1,185 @@
+package Foldable where
+
+import qualified Array
+import qualified List
+import qualified ListN
+import qualified Vector
+
+--@ \index{Foldable@\te{Foldable} (type class)}
+--@ The class of container types that can be folded to a summary value.
+--@ A minimal complete definition need only implement \te{foldr}; all
+--@ other methods have defaults derived from \te{foldr}, but instances
+--@ may override them for efficiency.
+--@ \begin{libverbatim}
+--@ typeclass Foldable #(type t);
+--@   function b foldr(function b fn(a x, b z), b z, t#(a) xs);
+--@   function b foldl(function b fn(b z, a x), b z, t#(a) xs);
+--@   function m#(b) foldrM(function m#(b) fn(a x, b z), b z, t#(a) xs)
+--@     provisos (Monad#(m));
+--@   function m#(b) foldlM(function m#(b) fn(b z, a x), b z, t#(a) xs)
+--@     provisos (Monad#(m));
+--@   function f#(void) traverse_(function f#(b) fn(a x), t#(a) xs)
+--@     provisos (Applicative#(f));
+--@   function f#(void) sequenceA_(t#(f#(a)) xs)
+--@     provisos (Applicative#(f));
+--@   function m#(void) mapM_(function m#(b) fn(a x), t#(a) xs)
+--@     provisos (Monad#(m));
+--@   function m#(void) sequence_(t#(m#(a)) xs)
+--@     provisos (Monad#(m));
+--@   function List#(a) toList(t#(a) xs);
+--@   function Bool elem(a x, t#(a) xs)
+--@     provisos (Eq#(a));
+--@   function Integer length(t#(a) xs);
+--@   function Bool null(t#(a) xs);
+--@ endtypeclass
+--@ \end{libverbatim}
+class Foldable t where
+  foldr :: (a -> b -> b) -> b -> t a -> b
+
+  foldl :: (b -> a -> b) -> b -> t a -> b
+  foldl f z0 xs = foldr (\ x k z -> k (f z x)) id xs z0
+
+  -- Monadic right fold: like \te{foldr} but the step function returns
+  -- an action and the accumulator threads through the monadic context.
+  foldrM :: (Monad m) => (a -> b -> m b) -> b -> t a -> m b
+  foldrM f z0 xs = foldr (\ x k z -> f x z `bind` k) pure xs z0
+
+  -- Monadic left fold: like \te{foldl} but the step function returns
+  -- an action and the accumulator threads through the monadic context.
+  foldlM :: (Monad m) => (b -> a -> m b) -> b -> t a -> m b
+  foldlM f z0 xs = foldr (\ x k z -> f z x `bind` k) pure xs z0
+
+  -- The `_` traversal helpers sequence the actions left-to-right and
+  -- discard the rebuilt container. They only need \te{Foldable} (no
+  -- \te{Traversable}) because the action sequencing can be expressed
+  -- via \te{foldr}.
+  traverse_ :: (Applicative f) => (a -> f b) -> t a -> f ()
+  traverse_ f = foldr (\ x acc -> f x *> acc) (pure ())
+
+  sequenceA_ :: (Applicative f) => t (f a) -> f ()
+  sequenceA_ = foldr (*>) (pure ())
+
+  mapM_ :: (Monad m) => (a -> m b) -> t a -> m ()
+  mapM_ = traverse_
+
+  sequence_ :: (Monad m) => t (m a) -> m ()
+  sequence_ = sequenceA_
+
+  toList :: t a -> List a
+  toList = foldr Cons Nil
+
+  elem :: (Eq a) => a -> t a -> Bool
+  elem x = foldr (\ y acc -> y == x || acc) False
+
+  length :: t a -> Integer
+  length = foldr (\ _ n -> n + 1) 0
+
+  null :: t a -> Bool
+  null = foldr (\ _ _ -> False) True
+
+instance Foldable Array where
+  foldr = Array.foldr
+  foldl = Array.foldl
+  toList = Array.arrayToList
+
+instance Foldable List where
+  foldr = List.foldr
+  foldl = List.foldl
+  mapM_ = List.mapM_
+  toList = id
+  length = List.length
+  null = List.null
+
+instance Foldable (ListN.ListN n) where
+  foldr = ListN.foldr
+  foldl = ListN.foldl
+  mapM_ = ListN.mapM_
+  toList = ListN.toList
+  length _ = valueOf n
+  null _ = valueOf n == 0
+
+instance Foldable (Vector.Vector n) where
+  foldr = Vector.foldr
+  foldl = Vector.foldl
+  mapM_ = Vector.mapM_
+  toList = Vector.toList
+  length _ = valueOf n
+  null _ = valueOf n == 0
+
+instance Foldable Maybe where
+  foldr _ z Invalid   = z
+  foldr f z (Valid x) = f x z
+  foldl _ z Invalid   = z
+  foldl f z (Valid x) = f z x
+  toList Invalid   = Nil
+  toList (Valid x) = Cons x Nil
+  length Invalid   = 0
+  length (Valid _) = 1
+  null Invalid   = True
+  null (Valid _) = False
+
+--@ \index{Foldable1@\te{Foldable1} (type class)}
+--@ Fold operations that require the container to be non-empty.
+--@ This is seperated from \te{Foldable} because fixed-size containers
+--@ (e.g.\ \te{Vector n}, \te{ListN n}) may require an extra proviso to
+--@ assert non-zero size, not needed by the corresponding \te{Foldable}
+--@ instances.
+--@ \begin{libverbatim}
+--@ typeclass Foldable1 #(type t)
+--@   provisos (Foldable#(t));
+--@   function a foldr1(function a fn(a x, a y), t#(a) xs);
+--@   function a foldl1(function a fn(a x, a y), t#(a) xs);
+--@   function a fold(function a fn(a x, a y), t#(a) xs);
+--@   function m#(a) foldM(function m#(a) f(a x, a y), t#(a) xs)
+--@     provisos (Monad#(m));
+--@   function m#(a) folduM(function m#(a) f(a x, a y),
+--@                         function m#(a) g(a x), t#(a) xs)
+--@     provisos (Monad#(m));
+--@ endtypeclass
+--@ \end{libverbatim}
+class (Foldable t) => Foldable1 t where
+  foldr1 :: (a -> a -> a) -> t a -> a
+  foldl1 :: (a -> a -> a) -> t a -> a
+
+  -- Tree redunction over a non-empty container.
+  fold :: (a -> a -> a) -> t a -> a
+  fold = foldr1
+
+  -- Monadic tree reduction over a non-empty container.
+  -- First argument combines pairs of leaves.
+  -- No transformation at singleton leaves.
+  foldM :: (Functor t, Monad m) => (a -> a -> m a) -> t a -> m a
+  foldM f xs =
+    let liftF ma mb = ma `bind` \ a -> mb `bind` \ b -> f a b
+    in fold liftF $ fmap pure xs
+
+  -- Monadic tree reduction over a non-empty container.
+  -- First argument combines pairs of leaves.
+  -- Second argument is applied to singleton leaves.
+  folduM :: (Functor t, Monad m) =>
+            (a -> a -> m a) -> (a -> m a) -> t a -> m a
+  folduM f g xs = folduM f g $ toList xs
+
+instance (Add 1 m n) => Foldable1 (ListN.ListN n) where
+  foldr1 = ListN.foldr1
+  foldl1 = ListN.foldl1
+  fold = ListN.fold
+  foldM = ListN.foldM
+
+instance (Add 1 m n) => Foldable1 (Vector.Vector n) where
+  foldr1 = Vector.foldr1
+  foldl1 = Vector.foldl1
+  fold = Vector.fold
+  foldM = Vector.foldM
+
+instance Foldable1 List where
+  foldr1 = List.foldr1
+  foldl1 = List.foldl1
+  fold = List.fold
+  foldM = List.foldM
+  folduM = List.folduM
+
+instance Foldable1 Array where
+  foldr1 = Array.foldr1
+  foldl1 = Array.foldl1
+  fold = Array.fold

src/Libraries/Base1/ListN.bs

@@ -83,6 +83,15 @@ instance (Bits a sa, Mul n sa nsa) => Bits (ListN n a) nsa
 --X    provisos( Eq#( a_type ) ) ;
 --X \end{libverbatim}
 
+--X A ListN is a Functor: it can be mapped over.
+instance Functor (ListN n) where
+  fmap = map
+
+--X Applicative for a ListN corresponds to zipping.
+instance Applicative (ListN n) where
+  pure = replicate
+  liftA2 = zipWith
+
 {-
 flatN :: (Add k x m) => Integer -> List (Bit k) -> Bit m
 flatN n Nil = 0

src/Libraries/Base1/Traversable.bs

@@ -0,0 +1,46 @@
+package Traversable where
+
+import qualified List
+import qualified ListN
+import qualified Vector
+
+import Foldable
+
+--@ \index{Traversable@\te{Traversable} (type class)}
+--@ The class of containers that can be traversed in an \te{Applicative}
+--@ context. Mirrors Haskell's \te{Data.Traversable}. \te{mapM} and
+--@ \te{sequence} are the conventional \te{Monad}-specialised aliases;
+--@ instances may override them to dispatch directly to the per-type
+--@ monadic helpers (\te{Vector.mapM}, \te{ListN.sequence}, ...) when
+--@ that's preferable.
+class (Functor t, Foldable t) => Traversable t where
+  traverse :: (Applicative f) => (a -> f b) -> t a -> f (t b)
+  sequenceA :: (Applicative f) => t (f a) -> f (t a)
+  sequenceA = traverse id
+  mapM :: (Monad m) => (a -> m b) -> t a -> m (t b)
+  mapM = traverse
+  sequence :: (Monad m) => t (m a) -> m (t a)
+  sequence = traverse id
+
+instance Traversable List where
+  traverse _ Nil = pure Nil
+  traverse f (Cons x rest) = liftA2 Cons (f x) (traverse f rest)
+  mapM = List.mapM
+
+instance Traversable (ListN.ListN n) where
+  traverse f xs = fmap ListN.toListN (traverse f (ListN.toList xs))
+  mapM = ListN.mapM
+  sequence = ListN.sequence
+
+instance Traversable (Vector.Vector n) where
+  traverse f v = fmap Vector.toVector (traverse f (Vector.toList v))
+  mapM = Vector.mapM
+  sequence = Vector.sequence
+
+instance Traversable Maybe where
+  traverse _ Invalid   = pure Invalid
+  traverse f (Valid x) = fmap Valid (f x)
+
+-- The `_` variants of these helpers (\te{traverse_}, \te{sequenceA_},
+-- \te{mapM_}, \te{sequence_}) live in \te{Foldable}: they only need
+-- \te{Foldable} since they don't rebuild the container.

src/Libraries/Base1/Vector.bs

@@ -89,6 +89,15 @@ instance (FShow a) => FShow (Vector n a)
             elements = Vector.foldr insertSpace (fshow "") fmts
         in  $format "<V " elements " >"
 
+--@ A vector is a Functor: it can be mapped over.
+instance Functor (Vector n) where
+  fmap = map
+
+--@ Applicative for a vector corresponds to zipping.
+instance Applicative (Vector n) where
+  pure = replicate
+  liftA2 = zipWith
+
 -- This is used to construct an array with uninitialized elements
 -- and still mark the array as uninitialized until the user updates
 -- it with real values (since the update to insert the uninit elems
@@ -463,8 +472,6 @@ unzip (V v) = letseq (as, bs) = Array.unzip v
 map :: (a -> b) -> Vector n a -> Vector n b
 map f (V v) = V (Array.map f v)
 
-instance Functor (Vector n) where
-  fmap = map
 
 --@ The ``fold'' family of functions reduces a vector by applying a
 --@ function over all its elements.

src/Libraries/Base1/depends.mk

@@ -5,7 +5,7 @@
 $(BUILDDIR)/ActionSeq.bo:	ActionSeq.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Array.bo:	Array.bsv $(BUILDDIR)/List.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Assert.bo:	Assert.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
-$(BUILDDIR)/CShow.bo:	CShow.bs $(BUILDDIR)/ListN.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
+$(BUILDDIR)/CShow.bo:	CShow.bs $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Clocks.bo:	Clocks.bsv $(BUILDDIR)/List.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/ConfigReg.bo:	ConfigReg.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Connectable.bo:	Connectable.bs $(BUILDDIR)/Vector.bo $(BUILDDIR)/ListN.bo $(BUILDDIR)/Inout.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
@@ -19,6 +19,7 @@ $(BUILDDIR)/FIFOLevel.bo:	FIFOLevel.bsv $(BUILDDIR)/FIFOF_.bo $(BUILDDIR)/GetPut
 $(BUILDDIR)/FShow.bo:	FShow.bsv $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/FoldFIFO.bo:	FoldFIFO.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/FoldFIFOF.bo:	FoldFIFOF.bs $(BUILDDIR)/FIFOF.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
+$(BUILDDIR)/Foldable.bo:	Foldable.bs $(BUILDDIR)/Array.bo $(BUILDDIR)/List.bo $(BUILDDIR)/ListN.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Fork.bo:	Fork.bs $(BUILDDIR)/Vector.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/GetPut.bo:	GetPut.bs $(BUILDDIR)/FIFO.bo $(BUILDDIR)/FIFOF.bo $(BUILDDIR)/Connectable.bo $(BUILDDIR)/Clocks.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Inout.bo:	Inout.bsv $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
@@ -36,7 +37,8 @@ $(BUILDDIR)/Real.bo:	Real.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/RegFile.bo:	RegFile.bs $(BUILDDIR)/ConfigReg.bo $(BUILDDIR)/List.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.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)/SShow.bo:	SShow.bs $(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)/Traversable.bo:	Traversable.bs $(BUILDDIR)/List.bo $(BUILDDIR)/ListN.bo $(BUILDDIR)/Vector.bo $(BUILDDIR)/Foldable.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/TreeMap.bo:	TreeMap.bs $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo
 $(BUILDDIR)/Vector.bo:	Vector.bs $(BUILDDIR)/List.bo $(BUILDDIR)/Array.bo $(BUILDDIR)/Prelude.bo $(BUILDDIR)/PreludeBSV.bo

src/comp/AVeriQuirks.hs

@@ -286,14 +286,26 @@ aQExp top (APrim aid t p es) | p == PrimAdd || p == PrimSub = do
 -- All multipliers should already be assigned directly to a
 -- def, and they should all have output size equal to the
 -- sum of the input sizes.  We check those properties here.
+-- The arguments must be in named defs (via mkDefS) so that Verilog
+-- evaluates their width-sensitive subexpressions (e.g. negation in
+-- sign-magnitude arithmetic) in the correct narrow context rather than
+-- the wider result context.
 aQExp top x@(APrim aid t p es) | p == PrimMul =
     if top
     then if ((aSize t) == (sum (map aSize es)))
-         then do es' <- mapM (aQExp False) es
+         then do es' <- mapM mkDefS es
                  return (APrim aid t p es')
          else internalError $ "aQExp: PrimMul result size is ill-typed: " ++ (show x)
     else internalError $ "aQExp: PrimMul does not feed into a def: " ++ (show x)
 
+-- PrimQuot and PrimRem have the same width-context issue as PrimMul:
+-- when arguments are complex expressions (e.g. sign-magnitude negations),
+-- Verilog evaluates them in the result width rather than the operand width.
+-- Forcing arguments into named defs gives each the correct narrow context.
+aQExp top x@(APrim aid t p es) | p == PrimQuot || p == PrimRem = do
+    es' <- mapM mkDefS es
+    return (APrim aid t p es')
+
 -- For PrimMux and PrimPriMux operators,
 aQExp top x@(APrim aid t p es) | p == PrimMux || p == PrimPriMux = do
     when debug $ traceM("aQExp PrimMux PrimPriMux: " ++ ppReadable x)

src/comp/FlagsDecode.hs

@@ -511,7 +511,7 @@ traceflags = [
 
 defaultFlags :: String -> Flags
 defaultFlags bluespecdir = Flags {
-        aggImpConds = False,
+        aggImpConds = True,
         allowIncoherentMatches = False,
         backend = Nothing,
         bdir = Nothing,
@@ -611,7 +611,7 @@ defaultFlags bluespecdir = Flags {
         rstGate = False,
         ruleNameCheck = True,
         satBackend = SAT_Yices,
-        schedConds = False,
+        schedConds = True,
         schedDOT = False,
         schedQueries = [],
         showCSyntax = False,

src/comp/IExpandUtils.hs

@@ -2444,6 +2444,11 @@ extendHeap = do s <- get
                 mapM_ copycell ((uncurry enumFromTo) (bounds oldheap))
 -}
 
+improveCellName :: HExpr -> Maybe Id -> G (Maybe Id)
+improveCellName _ mi@(Just i)
+  | not $ isPreludePosition $ getPosition i = return mi
+improveCellName e _ = inferName e
+
 addHeapCell :: String -> HeapCell -> G (HeapPointer, HeapData)
 addHeapCell tag cell = do
   s <- get
@@ -2454,7 +2459,8 @@ addHeapCell tag cell = do
   return (p, HeapData ref)
 
 addHeapUnev :: String -> IType -> HExpr -> Maybe Id -> G HExpr
-addHeapUnev tag t e cell_name = do
+addHeapUnev tag t e cell_name_orig = do
+ cell_name <- improveCellName e cell_name_orig
  let newcell = (HUnev { hc_hexpr = e, hc_name = cell_name })
  cross <- getCross
  (p, r) <- addHeapCell tag newcell
@@ -2467,7 +2473,8 @@ addHeapUnev tag t e cell_name = do
 
 -- add an expression to the heap, noting it is WHNF
 addHeapWHNF :: String -> IType -> PExpr -> Maybe Id -> G HExpr
-addHeapWHNF tag t pe cell_name = do
+addHeapWHNF tag t pe@(P _ e) cell_name_orig = do
+  cell_name <- improveCellName e cell_name_orig
   let newcell = (HWHNF { hc_pexpr = pe, hc_name = cell_name })
   (p, r) <- addHeapCell tag newcell
   let result = IRefT t p r