From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Wed, 25 Nov 2009 13:01:31 +0000 (+0100)
Subject: Multiplications are now resized to mimic the behaviour in Haskell
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=a22be9b8daa77ed2da9b1d9046bdac1e7da932ca;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Multiplications are now resized to mimic the behaviour in Haskell
---

diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index 0141db4..897c22a 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -419,6 +419,26 @@ genResize' (Left res) f [arg] = do {
   }
 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
+genTimes :: BuiltinBuilder
+genTimes = genNoInsts $ genExprArgs $ genExprRes genTimes'
+genTimes' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
+genTimes' (Left res) f [arg1,arg2] = do {
+  ; let { ty = Var.varType res
+        ; (tycon, args) = Type.splitTyConApp ty
+        ; name = Name.getOccString (TyCon.tyConName tycon)
+        } ;
+  ; len <- case name of
+      "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+      "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+      "RangedWord" -> do {  ubound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
+                         ;  let bitsize = floor (logBase 2 (fromInteger (toInteger ubound)))
+                         ;  return bitsize
+                         }
+  ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
+             [Nothing AST.:=>: AST.ADExpr (arg1 AST.:*: arg2), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+  }
+genTimes' (Right name) _ _ = error $ "\nGenerate.genTimes': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
 -- FIXME: I'm calling genLitArgs which is very specific function,
 -- which needs to be fixed as well
 genFromInteger :: BuiltinBuilder
@@ -1539,7 +1559,7 @@ globalNameTable = Map.fromList
   , (boolOrId         , (2, genOperator2 AST.Or     ) )
   , (boolAndId        , (2, genOperator2 AST.And    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
-  , (timesId          , (2, genOperator2 (AST.:*:)  ) )
+  , (timesId          , (2, genTimes                ) )
   , (negateId         , (1, genNegation             ) )
   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
   , (fromSizedWordId  , (1, genFromSizedWord        ) )