X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Generate.hs;h=a72cc62d409205bdd6a36d2c11b64af46cef5330;hb=7eb34cb0e082185b256b7231ee84cb04e006f51c;hp=bd7b482714438a63834234d95433a643b5a08248;hpb=c0b63b2aae039cecafb06bbcf63e50ee0359709b;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Generate.hs b/Generate.hs index bd7b482..a72cc62 100644 --- a/Generate.hs +++ b/Generate.hs @@ -18,6 +18,8 @@ import Type import qualified Var import qualified IdInfo import qualified Literal +import qualified Name +import qualified TyCon -- Local imports import Constants @@ -83,6 +85,19 @@ genOperator1 op = genExprArgs $ genExprRes (genOperator1' op) 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 @@ -110,8 +125,20 @@ genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cann 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 @@ -957,7 +984,7 @@ globalNameTable = Map.fromList , (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 ) )