Added function calls

[matthijs/master-project/cλash.git] / VHDL.hs

diff --git a/VHDL.hs b/VHDL.hs
index d177a10b934dc8004425a150552de5df83c12e4e..319b5b7ef900062f9a6c809f3645ba3fae18f08f 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -246,19 +246,32 @@ mkConcSm ::
 
 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   signatures <- getA vsSignatures
-  let 
-      (CoreSyn.Var f, args) = CoreSyn.collectArgs app
-      signature = Maybe.fromMaybe
-          (error $ "Using function '" ++ (bndrToString f) ++ "' without signature? This should not happen!")
+  funSignatures <- getA vsNameTable
+  let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
+  case (Map.lookup (bndrToString f) funSignatures) of
+    Just funSignature ->
+      let
+        sigs = map (bndrToString.varBndr) args
+        sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
+        func = (snd funSignature) sigsNames
+        src_wform = AST.Wform [AST.WformElem func Nothing]
+        dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
+        assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+      in
+        return $ AST.CSSASm assign
+    Nothing ->
+      let  
+        signature = Maybe.fromMaybe 
+          (error $ "Using function '" ++ (bndrToString f) ++ "' without signature? This should not happen!") 
           (Map.lookup (bndrToString f) signatures)
-      entity_id = ent_id signature
-      label = bndrToString bndr
+        entity_id = ent_id signature
+        label = bndrToString bndr
       -- Add a clk port if we have state
       --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
       --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else [])
-      portmaps = mkAssocElems args bndr signature
-    in
-      return $ AST.CSISm $ AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+        portmaps = mkAssocElems args bndr signature
+      in
+        return $ AST.CSISm $ AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
 
 -- GHC generates some funny "r = r" bindings in let statements before
 -- simplification. This outputs some dummy ConcSM for these, so things will at