From: Matthijs Kooijman Date: Thu, 9 Apr 2009 16:19:59 +0000 (+0200) Subject: Add (non-working) support for SizedWord literals. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=6093a850e28df3e081a80a73995e3b7279c106d5;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Add (non-working) support for SizedWord literals. The VHDL produced by this commit does not compile due to type incompatibility, some thought is needed here. --- diff --git a/Flatten.hs b/Flatten.hs index 8d2d5b6..e434f2e 100644 --- a/Flatten.hs +++ b/Flatten.hs @@ -21,6 +21,7 @@ import qualified Control.Monad.Trans.State as State import HsValueMap import TranslatorTypes import FlattenTypes +import CoreTools -- Extract the arguments from a data constructor application (that is, the -- normal args, leaving out the type args). @@ -207,6 +208,20 @@ flattenExpr binds app@(App _ _) = do ([], b) <- flattenExpr binds (last args) res <- mkEqComparisons a b return ([], res) + else if fname == "fromInteger" then do + let [to_ty, to_dict, val] = args + -- We assume this is an application of the GHC.Integer.smallInteger + -- function to a literal + let App smallint (Lit lit) = val + let (Literal.MachInt int) = lit + let ty = CoreUtils.exprType app + sig_id <- genSignalId SigInternal ty + -- TODO: fromInteger is defined for more types than just SizedWord + let len = sized_word_len ty + -- TODO: to_stdlogicvector doesn't work here, since SizedWord + -- translates to a different type... + addDef (UncondDef (Right $ Literal $ "to_stdlogicvector(to_unsigned(" ++ (show int) ++ ", " ++ (show len) ++ "))") sig_id) + return ([], Single sig_id) else flattenApplicationExpr binds (CoreUtils.exprType app) f args where diff --git a/VHDL.hs b/VHDL.hs index 1d605ea..8ae3516 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -50,7 +50,8 @@ createDesignFiles flatfuncmap = ty_decls = Map.elems (final_session ^. vsTypes) ieee_context = [ AST.Library $ mkVHDLBasicId "IEEE", - mkUseAll ["IEEE", "std_logic_1164"] + mkUseAll ["IEEE", "std_logic_1164"], + mkUseAll ["IEEE", "numeric_std"] ] full_context = mkUseAll ["work", "types"]