content: module InlineReg (
                    vInlineReg,
                    RegInstInfo
                    ) where
  
  import Data.List(partition)
  import qualified Data.Map as M
  import IntLit
  import IntegerUtil(aaaa)
  import Util(itos)
  import PPrint
  import Error
  import Flags(Flags)
  import Id
  import ASyntax
  import VModInfo
  import Verilog
  import AVerilogUtil
  import BackendNamingConventions
  
  -- ==============================
  -- Inline registers
  
  -- returns:
  --  * the always blocks for handling the inlined registers, and
  --  * info on the signals for each register (used by AVerilog):
  --      * the name of the instance
  --      * the list of inputs and their sizes
  --      * the output, to be declared "Reg" and its size
  vInlineReg :: ErrorHandle -> Flags -> [AVInst] -> ([VMItem], [RegInstInfo])
  vInlineReg errh flags avis =
      let
          vco = flagsToVco flags
          -- separate the RegAs from the RegN and RegUN
          (regas, regns_and_reguns) = partition isRegA avis
  
          -- make a map from clock to the RegNs and RegUNs in that clock
          ns_and_uns_by_clock = M.toList (partitionByClock errh regns_and_reguns)
  
          -- translate the partitioned RegN/RegUNs into always blocks
          ns_and_uns_items = map (vInlineN errh vco) ns_and_uns_by_clock
  
          -- make a map from clock and reset to the RegAs for that pair
          as_by_clock_and_reset = M.toList (partitionByClockAndReset errh regas)
  
          -- translate the partitioned RegAs into always blocks
          as_items = map (vInlineA vco) as_by_clock_and_reset
  
          -- All the registers should all be set in an initial block --
          -- there is no guarantee that they will be reset properly
          initial = mkInitialAssignments flags avis
  
          -- the list of items to return
          items =  ns_and_uns_items ++ as_items ++ initial
  
          -- the register I/O info for AVerilog grouping
          reg_infos = map (mkRegInstInfo errh flags) avis
      in
          (items, reg_infos)
  
  
  -- ==============================
  
  -- The name of the instance,
  -- its clk and reset port expressions,
  -- its inputs and their types, and
  -- the output signal (to be declared "reg") and its type.
  type RegInstInfo = (VId, String, [VExpr], [(VId, Maybe VRange)], (VId, Maybe VRange))
  
  -- XXX We can either return enough info to AVerilog for it to create
  -- XXX the instantiation group for the inlined register (declare the
  -- XXX IO signals and the reg), or we can just do it ourselves here.
  -- XXX We do the former:
  mkRegInstInfo :: ErrorHandle -> Flags -> AVInst -> RegInstInfo
  mkRegInstInfo errh flags avi =
      let vco = flagsToVco flags
          reg_id = vId (mkQOUT avi)
          din_id = vId (mkDIN avi)
          en_id = vId (mkEN avi)
          reg_size = case (getRegWidth avi) of
                         (ASInt _ _ (IntLit _ _ n)) -> vSize (ATBit n)
                         -- the parameter expression should be constant
                         e -> internalError ("mkRegInstInfo: " ++ ppReadable e)
          en_size = Nothing  -- no range means one bit
          -- find the special inputs (note that RegUN doesn't have a RST)
          clk_expr = vExpr vco (getRegClock errh avi)
          rstn_expr = vExpr vco (getRegReset errh avi)
          non_method_ports = if (isRegUN avi)
                             then [clk_expr]
                             else [clk_expr, rstn_expr]
          inst_id = avi_vname avi
      in
          ((VId (getIdString inst_id) inst_id Nothing),
           (getVNameString (vName (avi_vmi avi))),  -- name of the def (RegN, RegUN etc.)
           non_method_ports,
           [(din_id, reg_size), (en_id, en_size)],
           (reg_id, reg_size))
  
  -- ==============================
  
  -- Generate an always block for RegN and RegUN on the same clock
  vInlineN :: ErrorHandle -> VConvtOpts -> (AExpr, [AVInst]) -> VMItem
  vInlineN errh vco (clk, avis) =
      let
          -- partition the avis into those with resets and those without
          (regns, reguns) = partition isRegN avis
  
          -- partition the RegNs by reset
          regns_by_reset = partitionByReset errh regns
  
          -- translate into statements inside the always block
          body_items =
              -- put a comment here "initialized registers"
              map (translateRegN vco) (M.toList regns_by_reset) ++
              -- put a comment here "uninitialized registers"
              map (translateRegUN vco) reguns
  
          -- event for the surrounding always block
          ev = VEEposedge (vExpr vco clk)
  
          -- use VSeq (not vSeq) so that the always block always has
          -- begin/end, even when there is only one item inside it
          stmt = Valways $ VAt ev $ VSeq body_items
      in
          VMStmt { vi_translate_off = False, vi_body = stmt }
  
  
  -- generate an always block for all RegA on the same clock and reset
  vInlineA :: VConvtOpts -> ((AExpr, AExpr), [AVInst]) -> VMItem
  vInlineA vco ((clk, rstn), avis) =
      let
          -- create the conditional inside the always block
          -- (same body item as RegN!)
          body_item = translateRegN vco (rstn, avis)
  
          -- event for the surrounding always block
          ev = let v_rstn = vExpr vco rstn
                   v_clk  = vExpr vco clk
               in  case (v_rstn) of
                       VEWConst _ _ _ v ->
                           if (v == 1)
                           then VEEposedge v_clk
                           else internalError
                                    "vInlineA: unexpected constant rstn value"
                       _ -> VEEOr (VEEposedge v_clk) (mkEdgeReset v_rstn)
  
          -- this body has no begin/end because it is an if-stmt;
          stmt =         Valways $ VAt ev $ body_item
      in
          VMStmt { vi_translate_off = False, vi_body = stmt }
  
  
  -- Assign an initial (debug) value to all RegUN
  mkInitialAssignments :: Flags -> [AVInst] -> [VMItem]
  mkInitialAssignments flags [] = []
  mkInitialAssignments flags avis =
      let
          -- make the assignment for one reg
          mkInit :: AVInst -> VStmt
          mkInit avi =
              let id = (mkQOUT avi)
                  -- tag the VId with the instance that would have existed without inlining.
                  -- XXX we pass in an empty rewiring map because registers have no inouts
                  (_, vminst, _) = vState flags M.empty avi
                  qout = VLId (VId (getIdString id) id (Just vminst))
                  val = case (getRegWidth avi) of
                          ASInt { ae_ival = IntLit { ilValue = width } }
                            -> let val = aaaa width
                                   -- XXX use the ASInt ae_objid?
                                   id = mkVId (itos val)
                               in  VEWConst id width 16 val
                          e -> internalError ("mkInit: " ++ ppDebug e)
              in  VAssign qout val
  
          -- use VSeq (not vSeq) so that the initial block always has
          -- begin/end, even when there is only one item inside it
          stmt = Vinitial $ VSeq $ map mkInit avis
      in
          [VMStmt { vi_translate_off = True, vi_body = stmt }]
  
  
  -- make the conditional enable assignment to a register
  mkENAssignment :: AVInst -> VStmt
  mkENAssignment avi =
      let en = VEVar (vId (mkEN avi))
          qout = VLId (vId (mkQOUT avi))
          din = VEVar (vId (mkDIN avi))
      in
          Vif en (VAssignA qout din)
  
  -- make the assignment on reset (to be put inside a conditional)
  mkRSTAssignment :: VConvtOpts -> AVInst -> VStmt
  mkRSTAssignment vco avi =
      let qout = VLId (vId (mkQOUT avi))
          init_val = vExpr vco (getRegInit avi)
      in
          VAssignA qout init_val
  
  translateRegN :: VConvtOpts -> (AExpr, [AVInst]) -> VStmt
  translateRegN vco (rstn, avis) =
      let
          -- the assignments on reset
          rstn_items = map (mkRSTAssignment vco) avis
  
          -- the assignments on enable
          en_items = map mkENAssignment avis
  
          -- RST == `BSV_RESET_VALUE
          v_rstn = vExpr vco rstn
          v_rst = mkEqualsReset v_rstn
      in
          case (v_rstn) of
              VEWConst _ _ _ v ->
                  if (v == 1)
                  then vSeq en_items
                  else internalError
                           "translateRegN: unexpected constant rstn value"
              _ -> Vifelse v_rst (vSeq rstn_items) (vSeq en_items)
  
  translateRegUN :: VConvtOpts -> AVInst -> VStmt
  translateRegUN vco avi = mkENAssignment avi
  
  
  -- ==============================
  -- partition reg instances by their clock
  
  partitionByClock :: ErrorHandle -> [AVInst] -> M.Map AExpr [AVInst]
  partitionByClock errh avis =
      let mkPair avi = (getRegClock errh avi, [avi])
      in  M.fromListWith (flip (++)) (map mkPair avis)
  
  
  -- ==============================
  -- partition reg instances by their reset
  
  partitionByReset :: ErrorHandle -> [AVInst] -> M.Map AExpr [AVInst]
  partitionByReset errh avis =
      let mkPair avi = (getRegReset errh avi, [avi])
      in  M.fromListWith (flip (++)) (map mkPair avis)
  
  
  -- ==============================
  -- partition reg instances by their clock and reset (for RegA)
  
  partitionByClockAndReset :: ErrorHandle -> [AVInst] -> M.Map (AExpr, AExpr) [AVInst]
  partitionByClockAndReset errh avis =
      let mkPair avi = let clk_rst = (getRegClock errh avi, getRegReset errh avi)
                       in  (clk_rst, [avi])
      in  M.fromListWith (flip (++)) (map mkPair avis)
  
  
  -- ==============================
  