From: Christiaan Baaij 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 ) )