From: christiaanb <christiaan.baaij@gmail.com>
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               ) )