X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=998efb476669c8518fa2b29dc904e2bd93cfc6c3;hb=a44db062ae75b4fe3ce28368e07323130a14fe58;hp=f9367ef66da93f5a7217a7701d8fe40d1b296dee;hpb=4d96e10ba2805470597642cf4c2ba797eda1b1f9;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index f9367ef..998efb4 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -50,7 +50,7 @@ createDesignFiles binds =
     init_session = VHDLState Map.empty Map.empty Map.empty Map.empty
     (units, final_session) = 
       State.runState (createLibraryUnits binds) init_session
-    tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
+    tyfun_decls = map snd $ Map.elems (final_session ^.vsTypeFuns)
     ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
     vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
     tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def
@@ -66,9 +66,9 @@ createDesignFiles binds =
       : (mkUseAll ["work"]
       : ieee_context)
     type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ vec_decls ++ ty_decls ++ subProgSpecs)
-    type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
-    subProgSpecs = concat (map subProgSpec tyfun_decls)
-    subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
+    type_package_body = AST.LUPackageBody $ AST.PackageBody typesId tyfun_decls
+    subProgSpecs = map subProgSpec tyfun_decls
+    subProgSpec = \(AST.SubProgBody spec _ _) -> AST.PDISS spec
     mktydecl :: (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn) -> AST.PackageDecItem
     mktydecl (ty_id, Left ty_def) = AST.PDITD $ AST.TypeDec ty_id ty_def
     mktydecl (ty_id, Right ty_def) = AST.PDISD $ AST.SubtypeDec ty_id ty_def
@@ -301,7 +301,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
             case builder of
               Left funBuilder -> do
                 let sigs = map (varToVHDLExpr.exprToVar) valargs
-                func <- funBuilder sigs
+                func <- funBuilder bndr sigs
                 let src_wform = AST.Wform [AST.WformElem func Nothing]
                 let dst_name = AST.NSimple (mkVHDLExtId (varToString bndr))
                 let assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
@@ -313,7 +313,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
                       (Map.lookup (head sigs) signatures)
                 let arg = tail sigs
                 genSm <- genBuilder signature (arg ++ [bndr])  
-                return [AST.CSGSm genSm]
+                return [genSm]
           else
             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
@@ -329,9 +329,9 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
         label = "comp_ins_" ++ varToString bndr
         -- Add a clk port if we have state
         --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
-        clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+        --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
         --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else [])
-        portmaps = clk_port : mkAssocElems args bndr signature
+        portmaps = mkAssocElems args bndr signature
         in
           return [mkComponentInst label entity_id portmaps]
     details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details