X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Flatten.hs;h=74b3232a338640a1372d120ce164b6b388be6b12;hb=6808406c77307ba110ec5fc7e03fa7359fdf4646;hp=8d2d5b62b50053c96afb4b384b0ebd6ce3b66341;hpb=cba9bc73cb53261fd0a60dc90b3b470e541de608;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Flatten.hs b/Flatten.hs
index 8d2d5b6..74b3232 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).
@@ -168,7 +169,7 @@ flattenExpr binds var@(Var id) =
           sig_id <- genSignalId SigInternal ty
           -- Add a name hint to the signal
           addNameHint (Name.getOccString id) sig_id
-          addDef (UncondDef (Right $ Literal lit) sig_id)
+          addDef (UncondDef (Right $ Literal lit Nothing) sig_id)
           return ([], Single sig_id)
     IdInfo.VanillaGlobal ->
       -- Treat references to globals as an application with zero elements
@@ -207,6 +208,23 @@ 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
+        -- Use a to_unsigned to translate the number (a natural) to an unsiged
+        -- (array of bits)
+        let lit_str = "to_unsigned(" ++ (show int) ++ ", " ++ (show len) ++ ")"
+        -- Set the signal to our literal unconditionally, but add the type so
+        -- the literal will be typecast to the proper type.
+        addDef $ UncondDef (Right $ Literal lit_str (Just ty)) sig_id
+        return ([], Single sig_id)
       else
         flattenApplicationExpr binds (CoreUtils.exprType app) f args
   where