Merge git://github.com/darchon/clash into cλash

* git://github.com/darchon/clash:
  Added singleton
  Almost finished support for 'map'

Conflicts:
	VHDL.hs

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..637ef27a0186847712f1c2a8303f7f16c3f72c1e 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -27,12 +27,11 @@ 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"
+    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
@@ -63,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"
@@ -210,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 49b717cfb37994133d0e9470cf25640b46e2890e..429b9660d7e38434657635f1e97208e2452938c2 100644 (file)
--- a/GlobalNameTable.hs
+++ b/GlobalNameTable.hs
@@ -12,23 +12,25 @@ 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                   ) )
+  , ("singleton"      , (1, Left $ genExprFCall singletonId               ) )
+  , ("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 15eb4c59330327e7f82fac05e5aa4391c50b1fbe..6a89930bf57c1d21d0a3c5bfb69f61923b225a88 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -294,17 +294,30 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
       -- It's a global value imported from elsewhere. These can be builtin
       -- functions.
       funSignatures <- getA vsNameTable
+      signatures <- getA vsSignatures
       case (Map.lookup (bndrToString f) funSignatures) of
         Just (arg_count, builder) ->
           if length valargs == arg_count then
-            let
-              sigs = map (varToVHDLExpr.varBndr) valargs
-              func = builder sigs
-              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 (varToVHDLExpr.varBndr) valargs
+                  func = funBuilder sigs
+                  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) signatures)
+                  arg_names = map (mkVHDLExtId . bndrToString) (tail sigs)
+                  dst_name = mkVHDLExtId (bndrToString bndr)
+                  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
         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