X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Generate.hs;h=f4cab36460d4f1b1b9e39ce5dc8819a582c68102;hb=149fc422a264f8cbb90af36e3f4926977bdcf35b;hp=4846d58690011e3e3b8d82083feecc67e91c2a19;hpb=bf59dcfb13123d9ce146742e15e7b1a128d9c4e9;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Generate.hs b/Generate.hs
index 4846d58..f4cab36 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -42,17 +42,8 @@ genExprArgs wrap dst func args = do
   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.
@@ -134,6 +125,22 @@ genFromSizedWord' (Left res) f args = do
              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
@@ -1026,4 +1033,5 @@ globalNameTable = Map.fromList
   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
   , (fromSizedWordId  , (1, genFromSizedWord        ) )
   , (fromIntegerId    , (1, genFromInteger          ) )
+  , (resizeId         , (1, genResize               ) )
   ]