Don't rotate alternatives when there is no default case and there are no binders

[matthijs/master-project/cλash.git] / clash / CLasH / VHDL / Generate.hs

diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs
index e546821ceb8b9d0b36589a0a1072774d5f46c129..2fea7a3a38565a09866276b7b4a0a307e3fa01c7 100644 (file)
--- a/clash/CLasH/VHDL/Generate.hs
+++ b/clash/CLasH/VHDL/Generate.hs
@@ -291,12 +291,12 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) _ _ alts)) = do
   (enums, cmp) <- case htype of
     EnumType _ enums -> do
       -- Enumeration type, compare with the scrutinee directly
-      return (map stringToVHDLExpr enums, scrut_expr)
+      return (map (AST.PrimLit . show) [0..(length enums)-1], scrut_expr)
     AggrType _ (Just (name, EnumType _ enums)) _ -> do
       -- Extract the enumeration field from the aggregation
       let sel_name = mkSelectedName (varToVHDLName scrut) (mkVHDLBasicId name)
       let sel_expr = AST.PrimName sel_name
-      return (map stringToVHDLExpr enums, sel_expr)
+      return (map (AST.PrimLit . show) [0..(length enums)-1], sel_expr)
     (BuiltinType "Bit") -> do
       let enums = [AST.PrimLit "'1'", AST.PrimLit "'0'"]
       return (enums, scrut_expr)
@@ -310,8 +310,13 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) _ _ alts)) = do
   -- Compare the (constructor field of the) scrutinee with each of the
   -- alternatives.
   let cond_exprs = map (\x -> cmp AST.:=: x) altcons
-  -- Rotate expressions to the left, so that the expression related to the default case is the last
-  exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) ((tail alts) ++ [head alts])
+  -- Rotate expressions to the leftso that the expression related to the default case is the last
+  -- Does NOT apply when there is no DEFAULT case and there are no binders
+  let alts' = if ((any (\(_,x,_) -> not (null x)) alts) || ((\(x,_,_)->x) (head alts)) == CoreSyn.DEFAULT ) then
+                  ((tail alts) ++ [head alts])
+              else
+                  alts
+  exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) alts' --((tail alts) ++ [head alts])
   return ([mkAltsAssign (Left bndr) cond_exprs exprs], [])
 
 mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement does not have a simple variable as scrutinee"
@@ -496,7 +501,7 @@ genFromInteger' (Left res) f args = do
     "Unsigned" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
     "Index" -> do
       bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
-      return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1
+      return $ (ceiling (logBase 2 (fromInteger (toInteger (bound)))))
   let fname = case name of "Signed" -> toSignedId ; "Unsigned" -> toUnsignedId ; "Index" -> toUnsignedId
   case args of
     [integer] -> do -- The type and dictionary arguments are removed by genApplication
@@ -596,7 +601,7 @@ genMap (Left res) f [(Left mapped_f, _), (Left (CoreSyn.Var arg), _)] = do {
   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
   ; let res_type = (tfvec_elem . Var.varType) res
           -- TODO: Use something better than varToString
-  ; let { label       = mkVHDLExtId ("mapVector" ++ (varToString res))
+  ; let { label       = mkVHDLExtId ("mapVector" ++ (varToUniqString res))
         ; n_id        = mkVHDLBasicId "n"
         ; n_expr      = idToVHDLExpr n_id
         ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
@@ -621,7 +626,7 @@ genZipWith (Left res) f args@[(Left zipped_f, _), (Left (CoreSyn.Var arg1), _),
   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
   ; let res_type = (tfvec_elem . Var.varType) res
           -- TODO: Use something better than varToString
-  ; let { label       = mkVHDLExtId ("zipWithVector" ++ (varToString res))
+  ; let { label       = mkVHDLExtId ("zipWithVector" ++ (varToUniqString res))
         ; n_id        = mkVHDLBasicId "n"
         ; n_expr      = idToVHDLExpr n_id
         ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
@@ -672,7 +677,7 @@ genFold' len left (Left res) f [(Left folded_f,_), (start,startType), (vec,vecTy
   Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdlTy error_msg tmp_ty
   -- Setup the generate scheme
   let gen_label = mkVHDLExtId ("foldlVector" ++ (show vecExpr))
-  let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
+  let block_label = mkVHDLExtId ("foldlVector" ++ (varToUniqString res))
   let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr
                   else AST.DownRange len_min_expr (AST.PrimLit "0")
   let gen_scheme   = AST.ForGn n_id gen_range
@@ -758,7 +763,7 @@ genZip' (Left res) f args@[(arg1,_), (arg2,_)] = do {
   ; res_htype <- MonadState.lift tsType $ mkHType "\nGenerate.genZip: Invalid result type" (tfvec_elem (Var.varType res))
   ; [AST.PrimName argName1, AST.PrimName argName2] <- argsToVHDLExprs [arg1,arg2] 
           -- TODO: Use something better than varToString
-  ; let { label           = mkVHDLExtId ("zipVector" ++ (varToString res))
+  ; let { label           = mkVHDLExtId ("zipVector" ++ (varToUniqString res))
         ; n_id            = mkVHDLBasicId "n"
         ; n_expr          = idToVHDLExpr n_id
         ; range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
@@ -828,7 +833,7 @@ genUnzip' (Left res) f args@[(arg,argType)] = do
       ; res_htype <- MonadState.lift tsType $ mkHType "\nGenerate.genUnzip: Invalid result type" (Var.varType res)
       ; [AST.PrimName arg'] <- argsToVHDLExprs [arg]
         -- TODO: Use something better than varToString
-      ; let { label           = mkVHDLExtId ("unzipVector" ++ (varToString res))
+      ; let { label           = mkVHDLExtId ("unzipVector" ++ (varToUniqString res))
             ; n_id            = mkVHDLBasicId "n"
             ; n_expr          = idToVHDLExpr n_id
             ; range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
@@ -882,7 +887,7 @@ genConcat' (Left res) f args@[(arg,argType)] = do {
   ; len2 <- MonadState.lift tsType $ tfp_to_int $ tfvec_len_ty nvec
   ; [AST.PrimName argName] <- argsToVHDLExprs [arg]
           -- TODO: Use something better than varToString
-  ; let { label       = mkVHDLExtId ("concatVector" ++ (varToString res))
+  ; let { label       = mkVHDLExtId ("concatVector" ++ (varToUniqString res))
         ; n_id        = mkVHDLBasicId "n"
         ; n_expr      = idToVHDLExpr n_id
         ; fromRange   = n_expr AST.:*: (AST.PrimLit $ show len2)
@@ -939,7 +944,7 @@ genIterateOrGenerate' len iter (Left res) f [(Left app_f,_), (start,startType)]
   -- Setup the generate scheme
   [startExpr] <- argsToVHDLExprs [start]
   let gen_label = mkVHDLExtId ("iterateVector" ++ (show startExpr))
-  let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
+  let block_label = mkVHDLExtId ("iterateVector" ++ (varToUniqString res))
   let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
   let gen_scheme   = AST.ForGn n_id gen_range
   -- Make the intermediate vector
@@ -1019,7 +1024,7 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
   let rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) $ fst rdaddr
   let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int
   let assign = mkUncondAssign (Right resname) argexpr
-  let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res))
+  let block_label = mkVHDLExtId ("blockRAM" ++ (varToUniqString res))
   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm]
   return [AST.CSBSm block]
   where