From: christiaanb Date: Tue, 30 Mar 2010 09:50:10 +0000 (+0200) Subject: add fromRangedWord function, and add error message to genVarArgs X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=0e45b79dac5dd4bf4b340a515b61a03953f673a2;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git add fromRangedWord function, and add error message to genVarArgs --- diff --git "a/c\316\273ash/CLasH/VHDL/Constants.hs" "b/c\316\273ash/CLasH/VHDL/Constants.hs" index e6381fd..6051d9b 100644 --- "a/c\316\273ash/CLasH/VHDL/Constants.hs" +++ "b/c\316\273ash/CLasH/VHDL/Constants.hs" @@ -15,7 +15,7 @@ builtinIds = [ exId, replaceId, headId, lastId, tailId, initId, takeId, dropId , lteqId, gtId, gteqId, boolOrId, boolAndId, plusId, timesId , negateId, minusId, fromSizedWordId, fromIntegerId, resizeWordId , resizeIntId, sizedIntId, smallIntegerId, fstId, sndId, blockRAMId - , splitId, minimumId + , splitId, minimumId, fromRangedWordId ] -------------- -- Identifiers @@ -303,6 +303,9 @@ minusId = "-" fromSizedWordId :: String fromSizedWordId = "fromSizedWord" +fromRangedWordId :: String +fromRangedWordId = "fromRangedWord" + toIntegerId :: String toIntegerId = "to_integer" diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 2258d97..46f2067 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -344,9 +344,11 @@ genVarArgs :: -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res) genVarArgs wrap dst func args = wrap dst func args' where - args' = map exprToVar exprargs + args' = map exprToVar args'' -- Check (rather crudely) that all arguments are CoreExprs - (exprargs, []) = Either.partitionEithers args + args'' = case Either.partitionEithers args of + (exprargs, []) -> exprargs + (exprsargs, rest) -> error $ "\nGenerate.genVarArgs: expect varargs but found ast exprs:" ++ (show rest) -- | A function to wrap a builder-like function that expects its arguments to -- be Literals @@ -419,6 +421,20 @@ genFromSizedWord' (Left res) f args@[arg] = -- map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name +genFromRangedWord :: BuiltinBuilder +genFromRangedWord = genNoInsts $ genExprArgs $ genExprRes genFromRangedWord' +genFromRangedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr +genFromRangedWord' (Left res) f [arg] = do { + ; let { ty = Var.varType res + ; (tycon, args) = Type.splitTyConApp ty + ; name = Name.getOccString (TyCon.tyConName tycon) + } ; + ; len <- MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty) + ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId)) + [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))] + } +genFromRangedWord' (Right name) _ _ = error $ "\nGenerate.genFromRangedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name + genResize :: BuiltinBuilder genResize = genNoInsts $ genExprArgs $ genExprRes genResize' genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr @@ -1610,6 +1626,7 @@ globalNameTable = Map.fromList , (negateId , (1, genNegation ) ) , (minusId , (2, genOperator2 (AST.:-:) ) ) , (fromSizedWordId , (1, genFromSizedWord ) ) + , (fromRangedWordId , (1, genFromRangedWord ) ) , (fromIntegerId , (1, genFromInteger ) ) , (resizeWordId , (1, genResize ) ) , (resizeIntId , (1, genResize ) )