content: module VPrims(viWidth, vMux, vPriMux, vPriEnc, verilogInstancePrefix) where
  import Util(itos)
  import Verilog
  
  verilogInstancePrefix :: String
  verilogInstancePrefix = ""
  
  vMux :: Integer -> VModule
  vMux = vMuxP True
  
  
  vPriMux :: Integer -> VModule
  vPriMux = vMuxP False
  
  vPriEnc :: Bool -> Integer -> VModule
  vPriEnc _ = vMuxP False
  
  
  
  vMuxP :: Bool -> Integer -> VModule
  vMuxP parallel n = VModule { vm_name = (mkVId ("Mux_" ++ itos n)),
                               vm_comments = comments,
                               vm_ports = [(args,[])],
                               vm_body = [regdecl,outassign,body] }
    where
          comments = [] -- XXX room to add comments
          args = param : out : iss
          param = VAParameter viWidth Nothing (VEConst 1)
          out = VAOutput viOut rng
          iss = concatMap (\ n -> [VAInput (i n) rng, VAInput (s n) Nothing]) ns
          hi = mkVEOp w VSub one
          lo = zero
          w = VEVar viWidth
          rng = Just (hi, lo)
          i n = mkVId ("in_" ++ itos n)
          s n = mkVId ("s_" ++ itos n)
          outassign = VMAssign (VLId viOut) (VEVar viOutReg)
          regdecl = VMDecl (VVDecl VDReg rng [(VVar viOutReg)])
          body = VMStmt{ vi_translate_off = False,
                         vi_body = Valways $ VAt (slist (ins ++ (init sels)))  $
                                   Vcase { vs_case_expr = onetickbone,
                                           vs_case_arms = arms (VLId viOutReg) (zip (map VEVar sels) (map VEVar ins)),
                                           vs_parallel = parallel,
                                           vs_full = True
                                         }
                       }
          ns = [0..n-1]
          sels = map s ns
          ins = map i ns
  
  
  
  onetickbone :: VExpr
  onetickbone = VEWConst (mkVId "1") 1 2 1
  
  arms :: VLValue -> [(VExpr,VExpr)] -> [VCaseArm]
  arms x [] = []  -- shouldn't happen
  arms lhs [(c,e)] = [VDefault (VAssign lhs e)]
  arms lhs ((c,e) : ces) =
      (VCaseArm  [c] (VAssign lhs e)) : arms lhs ces
  
  slist :: [VId] -> VEventExpr
  slist vars = foldr1 VEEOr (map (VEE . VEVar) vars)
  
  viWidth :: VId
  viWidth = mkVId "width"
  
  viOut :: VId
  viOut = mkVId "out"
  
  viOutReg :: VId
  viOutReg = mkVId "outreg"
  
  
  zero, one :: VExpr
  zero = VEConst 0
  one = VEConst 1
  