X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=ecf6406f95e3f3f621b835d74497eb4feb5b2110;hb=4e34d6b1baa6e0754432254fabc2fa822b755f0b;hp=4db744528851559f789d0ba7ccb62ef05471fed6;hpb=d21c34b00b9041a146da89324e9dda6b22271b47;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index 4db7445..ecf6406 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -30,6 +30,7 @@ import qualified Var
 import qualified Id
 import qualified IdInfo
 import qualified TyCon
+import qualified TcType
 import qualified DataCon
 import qualified CoreSubst
 import qualified CoreUtils
@@ -56,7 +57,7 @@ createDesignFiles binds =
   map (Arrow.second $ AST.DesignFile full_context) units
   
   where
-    init_session = VHDLSession Map.empty Map.empty Map.empty builtin_funcs globalNameTable
+    init_session = VHDLSession Map.empty Map.empty Map.empty Map.empty globalNameTable
     (units, final_session) = 
       State.runState (createLibraryUnits binds) init_session
     tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
@@ -114,13 +115,14 @@ createEntity (fname, expr) = do
       -- There must be a let at top level 
       let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
       res' <- mkMap res
-      let ent_decl' = createEntityAST fname args' res'
+      let vhdl_id = mkVHDLBasicId $ bndrToString fname ++ "_" ++ varToStringUniq fname
+      let ent_decl' = createEntityAST vhdl_id args' res'
       let AST.EntityDec entity_id _ = ent_decl' 
       let signature = Entity entity_id args' res'
-      modA vsSignatures (Map.insert (bndrToString fname) signature)
+      modA vsSignatures (Map.insert fname signature)
       return ent_decl'
   where
-    mkMap :: 
+    mkMap ::
       --[(SignalId, SignalInfo)] 
       CoreSyn.CoreBndr 
       -> VHDLState VHDLSignalMapElement
@@ -144,16 +146,15 @@ createEntity (fname, expr) = do
 
   -- | Create the VHDL AST for an entity
 createEntityAST ::
-  CoreSyn.CoreBndr             -- | The name of the function
+  AST.VHDLId                   -- | The name of the function
   -> [VHDLSignalMapElement]    -- | The entity's arguments
   -> VHDLSignalMapElement      -- | The entity's result
   -> AST.EntityDec             -- | The entity with the ent_decl filled in as well
 
-createEntityAST name args res =
+createEntityAST vhdl_id args res =
   AST.EntityDec vhdl_id ports
   where
     -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
-    vhdl_id = mkVHDLBasicId $ bndrToString name
     ports = Maybe.catMaybes $ 
               map (mkIfaceSigDec AST.In) args
               ++ [mkIfaceSigDec AST.Out res]
@@ -187,11 +188,11 @@ createArchitecture ::
   -> VHDLState AST.ArchBody -- ^ The architecture for this function
 
 createArchitecture (fname, expr) = do
-  --signaturemap <- getA vsSignatures
-  --let signature = Maybe.fromMaybe 
-  --      (error $ "Generating architecture for function " ++ (prettyShow hsfunc) ++ "without signature? This should not happen!")
-  --      (Map.lookup hsfunc signaturemap)
-  let entity_id = mkVHDLBasicId $ bndrToString fname
+  signaturemap <- getA vsSignatures
+  let signature = Maybe.fromMaybe 
+        (error $ "Generating architecture for function " ++ (pprString fname) ++ "without signature? This should not happen!")
+        (Map.lookup fname signaturemap)
+  let entity_id = ent_id signature
   -- Strip off lambda's, these will be arguments
   let (args, letexpr) = CoreSyn.collectBinders expr
   -- There must be a let at top level 
@@ -259,13 +260,15 @@ mkConcSm ::
 
 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
+  let valargs' = filter isValArg args
+  let valargs = filter (\(CoreSyn.Var bndr) -> not (Id.isDictId bndr)) valargs'
   case Var.globalIdVarDetails f of
     IdInfo.DataConWorkId dc ->
         -- It's a datacon. Create a record from its arguments.
         -- First, filter out type args. TODO: Is this the best way to do this?
         -- The types should already have been taken into acocunt when creating
         -- the signal, so this should probably work...
-        let valargs = filter isValArg args in
+        --let valargs = filter isValArg args in
         if all is_var valargs then do
           labels <- getFieldLabels (CoreUtils.exprType app)
           let assigns = zipWith mkassign labels valargs
@@ -285,9 +288,9 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
       funSignatures <- getA vsNameTable
       case (Map.lookup (bndrToString f) funSignatures) of
         Just (arg_count, builder) ->
-          if length args == arg_count then
+          if length valargs == arg_count then
             let
-              sigs = map (bndrToString.varBndr) args
+              sigs = map (bndrToString.varBndr) valargs
               sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
               func = builder sigsNames
               src_wform = AST.Wform [AST.WformElem func Nothing]
@@ -296,7 +299,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
             in
               return $ AST.CSSASm assign
           else
-            error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString args
+            error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
         Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
     IdInfo.NotGlobalId -> do
       signatures <- getA vsSignatures
@@ -305,7 +308,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
       let  
         signature = Maybe.fromMaybe 
           (error $ "Using function '" ++ (bndrToString f) ++ "' without signature? This should not happen!") 
-          (Map.lookup (bndrToString f) signatures)
+          (Map.lookup f signatures)
         entity_id = ent_id signature
         label = bndrToString bndr
         -- Add a clk port if we have state
@@ -620,7 +623,7 @@ mk_vector_ty ::
 mk_vector_ty len el_ty ty = do
   elem_types_map <- getA vsElemTypes
   el_ty_tm <- vhdl_ty el_ty
-  let ty_id = mkVHDLExtId $ "vector_0_to_" ++ (show len) ++ "-" ++ (show el_ty_tm)
+  let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
   let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
   let existing_elem_ty = (fmap fst) $ Map.lookup (OrdType el_ty) elem_types_map
   case existing_elem_ty of
@@ -628,7 +631,7 @@ mk_vector_ty len el_ty ty = do
       let ty_def = AST.SubtypeIn t (Just range)
       return (ty_id, ty_def)
     Nothing -> do
-      let vec_id = mkVHDLExtId $ "vector_" ++ (show el_ty_tm)
+      let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
       let vec_def = AST.TDA $ AST.UnconsArrayDef [naturalTM] el_ty_tm
       modA vsElemTypes (Map.insert (OrdType el_ty) (vec_id, vec_def))
       modA vsTypeFuns (Map.insert (OrdType ty) (genUnconsVectorFuns el_ty_tm vec_id)) 
@@ -695,35 +698,15 @@ bndrToVHDLId = mkVHDLExtId . OccName.occNameString . Name.nameOccName . Var.varN
 bndrToString ::
   CoreSyn.CoreBndr
   -> String
-
 bndrToString = OccName.occNameString . Name.nameOccName . Var.varName
 
+-- Get the string version a Var's unique
+varToStringUniq = show . Var.varUnique
+
 -- Extracts the string version of the name
 nameToString :: Name.Name -> String
 nameToString = OccName.occNameString . Name.nameOccName
 
--- | A consise representation of a (set of) ports on a builtin function
---type PortMap = HsValueMap (String, AST.TypeMark)
--- | A consise representation of a builtin function
-data BuiltIn = BuiltIn String [(String, AST.TypeMark)] (String, AST.TypeMark)
-
--- | Translate a list of concise representation of builtin functions to a
---   SignatureMap
-mkBuiltins :: [BuiltIn] -> SignatureMap
-mkBuiltins = Map.fromList . map (\(BuiltIn name args res) ->
-    (name,
-     Entity (VHDL.mkVHDLBasicId name) (map toVHDLSignalMapElement args) (toVHDLSignalMapElement res))
-  )
-
-builtin_hsfuncs = Map.keys builtin_funcs
-builtin_funcs = mkBuiltins
-  [ 
-    BuiltIn "hwxor" [("a", VHDL.bit_ty), ("b", VHDL.bit_ty)] ("o", VHDL.bit_ty),
-    BuiltIn "hwand" [("a", VHDL.bit_ty), ("b", VHDL.bit_ty)] ("o", VHDL.bit_ty),
-    BuiltIn "hwor" [("a", VHDL.bit_ty), ("b", VHDL.bit_ty)] ("o", VHDL.bit_ty),
-    BuiltIn "hwnot" [("a", VHDL.bit_ty)] ("o", VHDL.bit_ty)
-  ]
-
 recordlabels = map (\c -> mkVHDLBasicId [c]) ['A'..'Z']
 
 -- | Map a port specification of a builtin function to a VHDL Signal to put in