From d3305d889f7776f98205ab60c958e13fed68d528 Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Fri, 30 Jan 2009 13:21:07 +0100
Subject: [PATCH] Store the type of a signal in a SignalNameMap.

Note that the type is still always filled with vhdl_bit_ty, but this moves
this hardcoding from two seperate places to one place (where we can remove
it next).
---
 Translator.hs | 36 +++++++++++++++++-------------------
 1 file changed, 17 insertions(+), 19 deletions(-)

diff --git a/Translator.hs b/Translator.hs
index 78b1466..769708f 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -106,7 +106,7 @@ getPortMapEntry ::
   
 -- Accepts a port name and an argument to map to it.
 -- Returns the appropriate line for in the port map
-getPortMapEntry (Signal portname) (Signal signame) = 
+getPortMapEntry (Signal portname _) (Signal signame _) = 
   (Just portname) AST.:=>: (AST.ADName (AST.NSimple signame))
 
 getInstantiations ::
@@ -224,10 +224,10 @@ expandExpr binds lam@(Lam b expr) = do
           res_signal')
 
 expandExpr binds (Var id) =
-  return ([], [], [], Signal signal_id)
+  return ([], [], [], Signal signal_id ty)
   where
     -- Lookup the id in our binds map
-    Signal signal_id = Maybe.fromMaybe
+    Signal signal_id ty = Maybe.fromMaybe
       (error $ "Argument " ++ getOccString id ++ "is unknown")
       (lookup id binds)
 
@@ -361,7 +361,7 @@ createAssocElems ::
   -> SignalNameMap   -- The signals to bind to it
   -> [AST.AssocElem]            -- The resulting port map lines
   
-createAssocElems (Signal port_id) (Signal signal_id) = 
+createAssocElems (Signal port_id _) (Signal signal_id _) = 
   [(Just port_id) AST.:=>: (AST.ADName (AST.NSimple signal_id))]
 
 createAssocElems (Tuple ports) (Tuple signals) = 
@@ -384,9 +384,8 @@ mkSignalsFromMap ::
   SignalNameMap 
   -> [AST.SigDec]
 
-mkSignalsFromMap (Signal id) =
-  -- TODO: This uses the bit type hardcoded
-  [mkSignalFromId id vhdl_bit_ty]
+mkSignalsFromMap (Signal id ty) =
+  [mkSignalFromId id ty]
 
 mkSignalsFromMap (Tuple signals) =
   concat $ map mkSignalsFromMap signals
@@ -444,7 +443,7 @@ mapOutputPorts ::
 
 -- Map the output port of a component to the output port of the containing
 -- entity.
-mapOutputPorts (Signal portname) (Signal signalname) =
+mapOutputPorts (Signal portname _) (Signal signalname _) =
   [(Just portname) AST.:=>: (AST.ADName (AST.NSimple signalname))]
 
 -- Map matching output ports in the tuple
@@ -484,9 +483,8 @@ mkIfaceSigDecs ::
   -> SignalNameMap        -- The ports to generate a map for
   -> [AST.IfaceSigDec]            -- The resulting ports
   
-mkIfaceSigDecs mode (Signal port_id) =
-  -- TODO: Remove hardcoded type
-  [AST.IfaceSigDec port_id mode vhdl_bit_ty]
+mkIfaceSigDecs mode (Signal port_id ty) =
+  [AST.IfaceSigDec port_id mode ty]
 
 mkIfaceSigDecs mode (Tuple ports) =
   concat $ map (mkIfaceSigDecs mode) ports
@@ -500,7 +498,7 @@ createSignalAssignments ::
 
 -- A simple assignment of one signal to another (greatly complicated because
 -- signal assignments can be conditional with multiple conditions in VHDL).
-createSignalAssignments (Signal dst) (Signal src) =
+createSignalAssignments (Signal dst _) (Signal src _) =
     [AST.CSSASm assign]
   where
     src_name  = AST.NSimple src
@@ -517,7 +515,7 @@ createSignalAssignments dst src =
 
 data SignalNameMap =
   Tuple [SignalNameMap]
-  | Signal AST.VHDLId
+  | Signal AST.VHDLId AST.TypeMark   -- A signal (or port) of the given (VDHL) type
   deriving (Show)
 
 -- Generate a port name map (or multiple for tuple types) in the given direction for
@@ -533,8 +531,8 @@ getPortNameMapForTy name ty =
     -- Expand tuples we find
     Tuple (getPortNameMapForTys name 0 args)
   else -- Assume it's a type constructor application, ie simple data type
-    -- TODO: Add type?
-    Signal (AST.unsafeVHDLBasicId name)
+    -- TODO: Don't hardcode the type here
+    Signal (AST.unsafeVHDLBasicId name) vhdl_bit_ty
   where
     (tycon, args) = Type.splitTyConApp ty 
 
@@ -605,10 +603,10 @@ mkVHDLId = AST.unsafeVHDLBasicId
 
 builtin_funcs = 
   [ 
-    ("hwxor", HWFunction (mkVHDLId "hwxor") [Signal $ mkVHDLId "a", Signal $ mkVHDLId "b"] (Signal $ mkVHDLId "o")),
-    ("hwand", HWFunction (mkVHDLId "hwand") [Signal $ mkVHDLId "a", Signal $ mkVHDLId "b"] (Signal $ mkVHDLId "o")),
-    ("hwor", HWFunction (mkVHDLId "hwor") [Signal $ mkVHDLId "a", Signal $ mkVHDLId "b"] (Signal $ mkVHDLId "o")),
-    ("hwnot", HWFunction (mkVHDLId "hwnot") [Signal $ mkVHDLId "i"] (Signal $ mkVHDLId "o"))
+    ("hwxor", HWFunction (mkVHDLId "hwxor") [Signal (mkVHDLId "a") vhdl_bit_ty, Signal (mkVHDLId "b") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty)),
+    ("hwand", HWFunction (mkVHDLId "hwand") [Signal (mkVHDLId "a") vhdl_bit_ty, Signal (mkVHDLId "b") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty)),
+    ("hwor", HWFunction (mkVHDLId "hwor") [Signal (mkVHDLId "a") vhdl_bit_ty, Signal (mkVHDLId "b") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty)),
+    ("hwnot", HWFunction (mkVHDLId "hwnot") [Signal (mkVHDLId "i") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty))
   ]
 
 vhdl_bit_ty :: AST.TypeMark
-- 
2.30.2