From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Tue, 14 Jul 2009 11:00:13 +0000 (+0200)
Subject: Merge git://github.com/darchon/clash into cλash
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=149fc422a264f8cbb90af36e3f4926977bdcf35b;hp=-c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Merge git://github.com/darchon/clash into cλash

* git://github.com/darchon/clash:
  Added resize function
---

149fc422a264f8cbb90af36e3f4926977bdcf35b
diff --combined Generate.hs
index 66dca92,1af1be3..f4cab36
--- a/Generate.hs
+++ b/Generate.hs
@@@ -42,8 -42,17 +42,8 @@@ genExprArgs wrap dst func args = d
    args' <- eitherCoreOrExprArgs args
    wrap dst func args'
  
 -idM :: a -> VHDLSession a
 -idM e = return e
 -
 -eitherM :: (a -> m c) -> (b -> m c) -> Either a b -> m c
 -eitherM f1 f2 e = do
 -  case e of
 -    Left e1 -> f1 e1
 -    Right e2 -> f2 e2
 -    
  eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> VHDLSession [AST.Expr]
 -eitherCoreOrExprArgs args = mapM (eitherM (\x -> MonadState.lift vsType $ (varToVHDLExpr (exprToVar x))) idM) args
 +eitherCoreOrExprArgs args = mapM (Either.either ((MonadState.lift vsType) . varToVHDLExpr . exprToVar) return) args
  
  -- | A function to wrap a builder-like function that expects its arguments to
  -- be variables.
@@@ -125,6 -134,22 +125,22 @@@ genFromSizedWord' (Left res) f args = d
               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
  
+ genResize :: BuiltinBuilder
+ genResize = genExprArgs $ genExprRes genResize'
+ genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+ genResize' (Left res) f [arg] = do {
+   ; let { ty = Var.varType res
+         ; (tycon, args) = Type.splitTyConApp ty
+         ; name = Name.getOccString (TyCon.tyConName tycon)
+         } ;
+   ; len <- case name of
+       "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty)
+       "SizedWord" -> MonadState.lift vsType $ 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))]
+   }
+ genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': 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
@@@ -1017,4 -1042,5 +1033,5 @@@ globalNameTable = Map.fromLis
    , (minusId          , (2, genOperator2 (AST.:-:)  ) )
    , (fromSizedWordId  , (1, genFromSizedWord        ) )
    , (fromIntegerId    , (1, genFromInteger          ) )
+   , (resizeId         , (1, genResize               ) )
    ]