From aa03222c571e37a1a05b6fbf4e09c748cf786286 Mon Sep 17 00:00:00 2001
From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Tue, 23 Jun 2009 15:10:05 +0200
Subject: [PATCH] Added singleton

---
 Generate.hs        | 18 +++++++++++++++---
 GlobalNameTable.hs |  1 +
 VHDL.hs            | 10 +++++-----
 3 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/Generate.hs b/Generate.hs
index f81d769..637ef27 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -31,7 +31,7 @@ genMapCall ::
   -> AST.GenerateSm -- | The resulting generate statement
 genMapCall len entity [arg, res] = genSm
   where
-    label = AST.unsafeVHDLBasicId "mapVector"
+    label = AST.unsafeVHDLBasicId ("mapVector" ++ (AST.fromVHDLId res))
     nPar  = AST.unsafeVHDLBasicId "n"
     range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
     genScheme = AST.ForGn nPar range
@@ -62,7 +62,8 @@ genUnconsVectorFuns elemTM vectorTM  =
   , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]         
   , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]    
   , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
-  , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]    
+  , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]
+  , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet] 
   ]
   where 
     ixPar   = AST.unsafeVHDLBasicId "ix"
@@ -209,4 +210,15 @@ genUnconsVectorFuns elemTM vectorTM  =
                  [AST.ToRange (AST.PrimLit "0")
                           (AST.PrimLit "-1")]))
               Nothing
-    emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
\ No newline at end of file
+    emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
+    singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ] 
+                                         vectorTM
+    -- variable res : fsvec_x (0 to 0) := (others => a);
+    singletonVar = 
+      AST.VarDec resId 
+             (AST.SubtypeIn vectorTM
+               (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
+             (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
+                                          (AST.PrimName $ AST.NSimple aPar)])
+    singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
\ No newline at end of file
diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs
index 8d38f6c..429b966 100644
--- a/GlobalNameTable.hs
+++ b/GlobalNameTable.hs
@@ -28,6 +28,7 @@ globalNameTable = mkGlobalNameTable
   , ("+>"             , (2, Left $ genExprFCall plusgtId                  ) )
   , ("map"            , (2, Right $ genMapCall                            ) )
   , ("empty"          , (0, Left $ genExprFCall emptyId                   ) )
+  , ("singleton"      , (1, Left $ genExprFCall singletonId               ) )
   , ("hwxor"          , (2, Left $ genExprOp2 AST.Xor                     ) )
   , ("hwand"          , (2, Left $ genExprOp2 AST.And                     ) )
   , ("hwor"           , (2, Left $ genExprOp2 AST.Or                      ) )
diff --git a/VHDL.hs b/VHDL.hs
index a40ad00..24c4eb0 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -289,7 +289,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
       -- It's a global value imported from elsewhere. These can be builtin
       -- functions.
       funSignatures <- getA vsNameTable
-      entSignatures <- getA vsSignatures
+      signatures <- getA vsSignatures
       case (Map.lookup (bndrToString f) funSignatures) of
         Just (arg_count, builder) ->
           if length valargs == arg_count then
@@ -306,13 +306,13 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
                   return [AST.CSSASm assign]
               Right genBuilder ->
                 let
-                  sigs = map (varBndr) valargs
+                  sigs = map varBndr valargs
                   signature = Maybe.fromMaybe
                     (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!") 
-                    (Map.lookup (head sigs) entSignatures)
-                  arg_name = mkVHDLExtId (bndrToString (last sigs))
+                    (Map.lookup (head sigs) signatures)
+                  arg_names = map (mkVHDLExtId . bndrToString) (tail sigs)
                   dst_name = mkVHDLExtId (bndrToString bndr)
-                  genSm = genBuilder 4 signature [arg_name, dst_name]  
+                  genSm = genBuilder 4 signature (arg_names ++ [dst_name])  
                 in return [AST.CSGSm genSm]
           else
             error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
-- 
2.30.2