Almost finished support for 'map'

Currently it only supports vectors of lenght 4

diff --git a/Adders.hs b/Adders.hs
index c4389147c28726e1f1a9486f4cfe44f44a360309..3afb82fae22e6ecebd6349ac23da944ebbec95f5 100644 (file)
--- a/Adders.hs
+++ b/Adders.hs
@@ -175,6 +175,11 @@ highordtest = \x ->
 functiontest :: TFVec D4 Bit -> TFVec D5 Bit -> RangedWord D3 -> RangedWord D4 -> (Bit, Bit)
 functiontest = \v1 v2 i1 i2 -> let r1 = v1!i1 ; r2 = v2!i2 in (r1,r2)
 
+xhwnot x = hwnot x
+
+maptest :: TFVec D4 Bit -> TFVec D4 Bit
+maptest = \v -> let r = map xhwnot v in r
+
 highordtest2 = \a b ->
          case a of
            High -> \c d -> d

diff --git a/Generate.hs b/Generate.hs
index 6405a6e620fb18e78ff41978f11e4370f2064eff..f81d7692434a7247325f1d1fdc3f1292d23df9b7 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -27,10 +27,9 @@ genExprFCall fName args =
 genMapCall :: 
   Int -- | The length of the vector 
   -> Entity -- | The entity to map
-  -> AST.VHDLId -- | The input vector
-  -> AST.VHDLId -- | The output vector
+  -> [AST.VHDLId] -- | The vectors
   -> AST.GenerateSm -- | The resulting generate statement
-genMapCall len entity arg res = genSm
+genMapCall len entity [arg, res] = genSm
   where
     label = AST.unsafeVHDLBasicId "mapVector"
     nPar  = AST.unsafeVHDLBasicId "n"

diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs
index 49b717cfb37994133d0e9470cf25640b46e2890e..8d38f6c34bc2bbe72d21e2b58427af1c70828c17 100644 (file)
--- a/GlobalNameTable.hs
+++ b/GlobalNameTable.hs
@@ -12,23 +12,24 @@ import VHDLTypes
 import Constants
 import Generate
 
-mkGlobalNameTable :: [(String, (Int, [AST.Expr] -> AST.Expr ) )] -> NameTable
+mkGlobalNameTable :: [(String, (Int, Builder) )] -> NameTable
 mkGlobalNameTable = Map.fromList
 
 globalNameTable :: NameTable
 globalNameTable = mkGlobalNameTable
-  [ ("!"              , (2, genExprFCall exId                             ) )
-  , ("replace"        , (3, genExprFCall replaceId                        ) )
-  , ("head"           , (1, genExprFCall headId                           ) )
-  , ("last"           , (1, genExprFCall lastId                           ) )
-  , ("tail"           , (1, genExprFCall tailId                           ) )
-  , ("init"           , (1, genExprFCall initId                           ) )
-  , ("take"           , (2, genExprFCall takeId                           ) )
-  , ("drop"           , (2, genExprFCall dropId                           ) )
-  , ("+>"             , (2, genExprFCall plusgtId                         ) )
-  , ("empty"          , (0, genExprFCall emptyId                          ) )
-  , ("hwxor"          , (2, genExprOp2 AST.Xor                            ) )
-  , ("hwand"          , (2, genExprOp2 AST.And                            ) )
-  , ("hwor"           , (2, genExprOp2 AST.Or                             ) )
-  , ("hwnot"          , (1, genExprOp1 AST.Not                            ) )
+  [ ("!"              , (2, Left $ genExprFCall exId                      ) )
+  , ("replace"        , (3, Left $ genExprFCall replaceId                 ) )
+  , ("head"           , (1, Left $ genExprFCall headId                    ) )
+  , ("last"           , (1, Left $ genExprFCall lastId                    ) )
+  , ("tail"           , (1, Left $ genExprFCall tailId                    ) )
+  , ("init"           , (1, Left $ genExprFCall initId                    ) )
+  , ("take"           , (2, Left $ genExprFCall takeId                    ) )
+  , ("drop"           , (2, Left $ genExprFCall dropId                    ) )
+  , ("+>"             , (2, Left $ genExprFCall plusgtId                  ) )
+  , ("map"            , (2, Right $ genMapCall                            ) )
+  , ("empty"          , (0, Left $ genExprFCall emptyId                   ) )
+  , ("hwxor"          , (2, Left $ genExprOp2 AST.Xor                     ) )
+  , ("hwand"          , (2, Left $ genExprOp2 AST.And                     ) )
+  , ("hwor"           , (2, Left $ genExprOp2 AST.Or                      ) )
+  , ("hwnot"          , (1, Left $ genExprOp1 AST.Not                     ) )
   ]

diff --git a/VHDL.hs b/VHDL.hs
index eb454203ebeda699ebcc9c595f4a6f395dbdfee7..a40ad00311c7bf5338f7c5537e98422feb48ba3f 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -289,18 +289,31 @@ 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
       case (Map.lookup (bndrToString f) funSignatures) of
         Just (arg_count, builder) ->
           if length valargs == arg_count then
-            let
-              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]
-              dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
-              assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
-            in
-              return [AST.CSSASm assign]
+            case builder of
+              Left funBuilder ->
+                let
+                  sigs = map (bndrToString.varBndr) valargs
+                  sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
+                  func = funBuilder 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]
+              Right genBuilder ->
+                let
+                  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))
+                  dst_name = mkVHDLExtId (bndrToString bndr)
+                  genSm = genBuilder 4 signature [arg_name, dst_name]  
+                in return [AST.CSGSm 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

diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index 6f6625b9727b5f497d14aba7d99c6eefef91b5af..2538158d10a1c31117f28c30812ee4d9017571e5 100644 (file)
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -54,8 +54,10 @@ type TypeFunMap = Map.Map OrdType [AST.SubProgBody]
 -- A map of a Haskell function to a hardware signature
 type SignatureMap = Map.Map CoreSyn.CoreBndr Entity
 
+type Builder = Either ([AST.Expr] -> AST.Expr) (Int -> Entity -> [AST.VHDLId] -> AST.GenerateSm)
+
 -- A map of a builtin function to VHDL function builder 
-type NameTable = Map.Map String (Int, [AST.Expr] -> AST.Expr )
+type NameTable = Map.Map String (Int, Builder )
 
 data VHDLSession = VHDLSession {
   -- | A map of Core type -> VHDL Type