From: Christiaan Baaij Date: Thu, 9 Jul 2009 14:22:24 +0000 (+0200) Subject: Correctly handle negate for unsigned integers X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=7eb34cb0e082185b256b7231ee84cb04e006f51c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Correctly handle negate for unsigned integers --- diff --git a/Generate.hs b/Generate.hs index 947c222..a72cc62 100644 --- a/Generate.hs +++ b/Generate.hs @@ -85,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 @@ -971,7 +984,7 @@ globalNameTable = Map.fromList , (hwnotId , (1, genOperator1 AST.Not ) ) , (plusId , (2, genOperator2 (AST.:+:) ) ) , (timesId , (2, genOperator2 (AST.:*:) ) ) - , (negateId , (1, genOperator1 AST.Neg ) ) + , (negateId , (1, genNegation ) ) , (minusId , (2, genOperator2 (AST.:-:) ) ) , (fromSizedWordId , (1, genFromSizedWord ) ) , (fromIntegerId , (1, genFromInteger ) ) diff --git a/Normalize.hs b/Normalize.hs index 2ecf2fa..a299fd3 100644 --- a/Normalize.hs +++ b/Normalize.hs @@ -21,9 +21,11 @@ import CoreSyn import qualified UniqSupply import qualified CoreUtils import qualified Type +import qualified TcType import qualified Id import qualified Var import qualified VarSet +import qualified NameSet import qualified CoreFVs import qualified CoreUtils import qualified MkCore @@ -512,6 +514,25 @@ normalizeBind bndr = let used_funcs = VarSet.varSetElems used_funcs_set -- Process each of the used functions recursively mapM normalizeBind used_funcs + -- FIXME: Can't we inline these 'implicit' function calls or something? + -- TODO: Add an extra let expression to the current finding, so the VHDL + -- Will make a signa assignment for this 'implicit' function call + -- + -- Find all the other free variables used that are used. This applies to + -- variables that are actually a reference to a Class function. Example: + -- + -- functiontest :: SizedInt D8 -> SizedInt D8 + -- functiontest = \a -> let r = a + 1 in r + -- + -- The literal(Lit) '1' will be turned into a variable (Var) + -- As it will call the 'fromInteger' class function that belongs + -- to the Num class. So we need to translate the refenced function + -- let used_vars_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isAlgType . snd . Type.splitForAllTys . Id.idType) v) expr' + -- let used_vars = VarSet.varSetElems used_vars_set + -- -- Filter for dictionary args, they should not be translated + -- -- FIXME: check for other non-translatable stuff as well + -- let trans_vars = filter (\v -> (not . TcType.isDictTy . Id.idType) v) used_vars + -- mapM normalizeBind trans_vars return () -- We don't have a value for this binder. This really shouldn't -- happen for local id's... diff --git "a/c\316\273ash.cabal" "b/c\316\273ash.cabal" index 802557a..b5f497a 100644 --- "a/c\316\273ash.cabal" +++ "b/c\316\273ash.cabal" @@ -13,7 +13,7 @@ stability: alpha maintainer: christiaan.baaij@gmail.com & matthijs@stdin.nl build-depends: base > 4, syb, ghc, ghc-paths, transformers, haskell98, ForSyDe > 3.0, regex-posix ,data-accessor-template, pretty, - data-accessor, containers, prettyclass, tfp > 0.3, + data-accessor, containers, prettyclass, tfp > 0.3.1, tfvec > 0.1.2, QuickCheck, template-haskell, filepath executable: clash