import qualified Var
import qualified IdInfo
import qualified Literal
+import qualified Name
+import qualified TyCon
-- Local imports
import Constants
genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
genOperator1' op _ f [arg] = return $ op arg
+-- | Generate a unary operator application
+genNegation :: BuiltinBuilder
+genNegation = genVarArgs $ genExprRes genNegation'
+genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession AST.Expr
+genNegation' _ f [arg] = return $ op (varToVHDLExpr arg)
+ where
+ ty = Var.varType arg
+ (tycon, args) = Type.splitTyConApp ty
+ name = Name.getOccString (TyCon.tyConName tycon)
+ op = case name of
+ "SizedInt" -> AST.Neg
+ otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name
+
-- | Generate a function call from the destination binder, function name and a
-- list of expressions (its arguments)
genFCall :: Bool -> BuiltinBuilder
genFromInteger :: BuiltinBuilder
genFromInteger = genLitArgs $ genExprRes genFromInteger'
genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> VHDLSession AST.Expr
-genFromInteger' (Left res) f args = do
- return $ AST.PrimLit (pprString (last args))
+genFromInteger' (Left res) f lits =
+ return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+ where
+ ty = Var.varType res
+ (tycon, args) = Type.splitTyConApp ty
+ name = Name.getOccString (TyCon.tyConName tycon)
+ len = case name of
+ "SizedInt" -> sized_int_len ty
+ "SizedWord" -> sized_word_len ty
+ fname = case name of
+ "SizedInt" -> toSignedId
+ "SizedWord" -> toUnsignedId
+
genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
, (hwnotId , (1, genOperator1 AST.Not ) )
, (plusId , (2, genOperator2 (AST.:+:) ) )
, (timesId , (2, genOperator2 (AST.:*:) ) )
- , (negateId , (1, genOperator1 AST.Not ) )
+ , (negateId , (1, genNegation ) )
, (minusId , (2, genOperator2 (AST.:-:) ) )
, (fromSizedWordId , (1, genFromSizedWord ) )
, (fromIntegerId , (1, genFromInteger ) )