From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
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"]