Added builtin foldl function

Also use mkVhdlBasicId for length attributes. Attributes can not have slashes

diff --git a/Adders.hs b/Adders.hs
index 3afb82fae22e6ecebd6349ac23da944ebbec95f5..d64331f0499f899f715a4a0464c722b7c7685b2a 100644 (file)
--- a/Adders.hs
+++ b/Adders.hs
@@ -172,8 +172,10 @@ highordtest = \x ->
              in
                 \c d -> op' d c
 
-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)
+xand a b = hwand a b
+
+functiontest :: TFVec D4 Bit -> Bit -> Bit
+functiontest = \v s -> let r = foldl xand s v in r
 
 xhwnot x = hwnot x
 

diff --git a/Constants.hs b/Constants.hs
index 43cc189557b923e276e8afde9c8ad66dc83df668..d941e13671697b88c4103cbaa0e11c925583c542 100644 (file)
--- a/Constants.hs
+++ b/Constants.hs
@@ -165,6 +165,9 @@ mapId = "map"
 zipWithId :: String
 zipWithId = "zipWith"
 
+foldlId :: String
+foldlId = "foldl"
+
 -- | hwxor function identifier
 hwxorId :: String
 hwxorId = "hwxor"

diff --git a/Generate.hs b/Generate.hs
index cc3cb675b3a405fd7a10cb1d1d973c86195f3742..515197822677063cd04d26e2ffffe6fe2fc04e7e 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -42,7 +42,7 @@ genExprFCall fname res args = do
 genMapCall :: 
   Entity -- | The entity to map
   -> [CoreSyn.CoreBndr] -- | The vectors
-  -> VHDLSession AST.GenerateSm -- | The resulting generate statement
+  -> VHDLSession AST.ConcSm -- | The resulting generate statement
 genMapCall entity [arg, res] = return $ genSm
   where
     -- Setup the generate scheme
@@ -64,12 +64,12 @@ genMapCall entity [arg, res] = return $ genSm
     mapLabel    = "map" ++ (AST.fromVHDLId entity_id)
     compins     = mkComponentInst mapLabel entity_id portassigns
     -- Return the generate functions
-    genSm       = AST.GenerateSm label genScheme [] [compins]
+    genSm       = AST.CSGSm $ AST.GenerateSm label genScheme [] [compins]
     
 genZipWithCall ::
   Entity
   -> [CoreSyn.CoreBndr]
-  -> VHDLSession AST.GenerateSm
+  -> VHDLSession AST.ConcSm
 genZipWithCall entity [arg1, arg2, res] = return $ genSm
   where
     -- Setup the generate scheme
@@ -92,7 +92,102 @@ genZipWithCall entity [arg1, arg2, res] = return $ genSm
     mapLabel    = "zipWith" ++ (AST.fromVHDLId entity_id)
     compins     = mkComponentInst mapLabel entity_id portassigns
     -- Return the generate functions
-    genSm       = AST.GenerateSm label genScheme [] [compins]
+    genSm       = AST.CSGSm $ AST.GenerateSm label genScheme [] [compins]
+
+genFoldlCall ::
+  Entity
+  -> [CoreSyn.CoreBndr]
+  -> VHDLSession AST.ConcSm
+genFoldlCall entity [startVal, inVec, resVal] = do
+  let (vec, _) = splitAppTy (Var.varType inVec)
+  let vecty = Type.mkAppTy vec (Var.varType startVal)
+  vecType <- vhdl_ty vecty
+  -- Setup the generate scheme
+  let  len         = (tfvec_len . Var.varType) inVec
+  let  genlabel       = mkVHDLExtId ("foldlVector" ++ (varToString inVec))
+  let  blockLabel  = mkVHDLExtId ("foldlVector" ++ (varToString startVal))
+  let  nPar        = AST.unsafeVHDLBasicId "n"
+  let  range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+  let  genScheme   = AST.ForGn nPar range
+  -- Make the intermediate vector
+  let  tmpVec      = AST.BDISD $ AST.SigDec (mkVHDLExtId "tmp") vecType Nothing
+    -- Return the generate functions
+  let genSm       = AST.GenerateSm genlabel genScheme []  [ AST.CSGSm (genFirstCell entity [startVal, inVec, resVal])
+                                                          , AST.CSGSm (genOtherCell entity [startVal, inVec, resVal])
+                                                          , AST.CSGSm (genLastCell entity [startVal, inVec, resVal])
+                                                          ]
+  return $ AST.CSBSm $ AST.BlockSm blockLabel [] (AST.PMapAspect []) [tmpVec] [AST.CSGSm genSm]
+  where
+    genFirstCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm 
+    genFirstCell entity [startVal, inVec, resVal] = cellGn
+      where
+        cellLabel    = mkVHDLExtId "firstcell"
+        cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar)  AST.:=: (AST.PrimLit "0"))
+        nPar        = AST.unsafeVHDLBasicId "n"
+        -- Get the entity name and port names
+        entity_id   = ent_id entity
+        argports    = map (Monad.liftM fst) (ent_args entity)
+        resport     = (Monad.liftM fst) (ent_res entity)
+        -- Assign the ports
+        inport1     = mkAssocElem (argports!!0) (varToString startVal)
+        inport2     = mkAssocElemIndexed (argports!!1) (varToString inVec) nPar 
+        outport     = mkAssocElemIndexed resport "tmp" nPar
+        clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+        portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+        -- Generate the portmap
+        mapLabel    = "cell" ++ (AST.fromVHDLId entity_id)
+        compins     = mkComponentInst mapLabel entity_id portassigns
+        -- Return the generate functions
+        cellGn       = AST.GenerateSm cellLabel cellGenScheme [] [compins]
+    genOtherCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm
+    genOtherCell entity [startVal, inVec, resVal] = cellGn
+      where
+        len         = (tfvec_len . Var.varType) inVec
+        cellLabel    = mkVHDLExtId "othercell"
+        cellGenScheme = AST.IfGn $ AST.And ((AST.PrimName $ AST.NSimple nPar)  AST.:>: (AST.PrimLit "0"))
+                                ((AST.PrimName $ AST.NSimple nPar)  AST.:<: (AST.PrimLit $ show (len-1)))
+        nPar        = AST.unsafeVHDLBasicId "n"
+        -- Get the entity name and port names
+        entity_id   = ent_id entity
+        argports    = map (Monad.liftM fst) (ent_args entity)
+        resport     = (Monad.liftM fst) (ent_res entity)
+        -- Assign the ports
+        inport1     = mkAssocElemIndexed (argports!!0) "tmp" (AST.unsafeVHDLBasicId "n-1")
+        inport2     = mkAssocElemIndexed (argports!!1) (varToString inVec) nPar 
+        outport     = mkAssocElemIndexed resport "tmp" nPar
+        clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+        portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+        -- Generate the portmap
+        mapLabel    = "cell" ++ (AST.fromVHDLId entity_id)
+        compins     = mkComponentInst mapLabel entity_id portassigns
+        -- Return the generate functions
+        cellGn      = AST.GenerateSm cellLabel cellGenScheme [] [compins]
+    genLastCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm
+    genLastCell entity [startVal, inVec, resVal] = cellGn
+      where
+        len         = (tfvec_len . Var.varType) inVec
+        cellLabel    = mkVHDLExtId "lastCell"
+        cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar)  AST.:=: (AST.PrimLit $ show (len-1)))
+        nPar        = AST.unsafeVHDLBasicId "n"
+        -- Get the entity name and port names
+        entity_id   = ent_id entity
+        argports    = map (Monad.liftM fst) (ent_args entity)
+        resport     = (Monad.liftM fst) (ent_res entity)
+        -- Assign the ports
+        inport1     = mkAssocElemIndexed (argports!!0) "tmp" (AST.unsafeVHDLBasicId "n-1")
+        inport2     = mkAssocElemIndexed (argports!!1) (varToString inVec) nPar 
+        outport     = mkAssocElemIndexed resport "tmp" nPar
+        clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+        portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+        -- Generate the portmap
+        mapLabel    = "cell" ++ (AST.fromVHDLId entity_id)
+        compins     = mkComponentInst mapLabel entity_id portassigns
+        -- Generate the output assignment
+        assign      = mkUncondAssign (Left resVal) (AST.PrimName (AST.NIndexed (AST.IndexedName 
+                              (AST.NSimple (mkVHDLExtId "tmp")) [AST.PrimLit $ show (len-1)])))
+        -- Return the generate functions
+        cellGn      = AST.GenerateSm cellLabel cellGenScheme [] [compins,assign]
+
 
 -- Returns the VHDLId of the vector function with the given name for the given
 -- element type. Generates -- this function if needed.
@@ -158,7 +253,7 @@ genUnconsVectorFuns elemTM vectorTM  =
                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
-                              AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) AST.:-:
+                              AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
                                 (AST.PrimLit "1"))   ]))
                 Nothing
        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
@@ -167,7 +262,7 @@ genUnconsVectorFuns elemTM vectorTM  =
             AST.PrimName (AST.NSimple aPar) AST.:&: 
              vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
                       ((AST.PrimName (AST.NAttribute $ 
-                                AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing)) 
+                                AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing)) 
                                                               AST.:-: AST.PrimLit "1"))
     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     vecSlice init last =  AST.PrimName (AST.NSlice 
@@ -183,7 +278,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
                     (AST.NSimple vecPar) 
                     [AST.PrimName (AST.NAttribute $ 
-                                AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) 
+                                AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) 
                                                              AST.:-: AST.PrimLit "1"])))
     initSpec = AST.Function (mkVHDLExtId initId) [AST.IfaceVarDec vecPar vectorTM] vectorTM 
        -- variable res : fsvec_x (0 to vec'length-2);
@@ -193,14 +288,14 @@ genUnconsVectorFuns elemTM vectorTM  =
                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
-                              AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) AST.:-:
+                              AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
                                 (AST.PrimLit "2"))   ]))
                 Nothing
        -- resAST.:= vec(0 to vec'length-2)
     initExpr = AST.NSimple resId AST.:= (vecSlice 
                                (AST.PrimLit "0") 
                                (AST.PrimName (AST.NAttribute $ 
-                                  AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) 
+                                  AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) 
                                                              AST.:-: AST.PrimLit "2"))
     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     tailSpec = AST.Function (mkVHDLExtId tailId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
@@ -211,14 +306,14 @@ genUnconsVectorFuns elemTM vectorTM  =
                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
-                              AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) AST.:-:
+                              AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
                                 (AST.PrimLit "2"))   ]))
                 Nothing       
        -- res AST.:= vec(1 to vec'length-1)
     tailExpr = AST.NSimple resId AST.:= (vecSlice 
                                (AST.PrimLit "1") 
                                (AST.PrimName (AST.NAttribute $ 
-                                  AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) 
+                                  AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) 
                                                              AST.:-: AST.PrimLit "1"))
     tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar   naturalTM,
@@ -246,14 +341,14 @@ genUnconsVectorFuns elemTM vectorTM  =
                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
-                              AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) AST.:-:
+                              AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
                                (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
                Nothing
        -- res AST.:= vec(n to vec'length-1)
     dropExpr = AST.NSimple resId AST.:= (vecSlice 
                                (AST.PrimName $ AST.NSimple nPar) 
                                (AST.PrimName (AST.NAttribute $ 
-                                  AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing) 
+                                  AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) 
                                                              AST.:-: AST.PrimLit "1"))
     dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     plusgtSpec = AST.Function (mkVHDLExtId plusgtId) [AST.IfaceVarDec aPar   elemTM,
@@ -265,7 +360,7 @@ genUnconsVectorFuns elemTM vectorTM  =
                (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                 [AST.ToRange (AST.PrimLit "0")
                         (AST.PrimName (AST.NAttribute $ 
-                          AST.AttribName (AST.NSimple vecPar) (mkVHDLExtId lengthId) Nothing))]))
+                          AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))]))
              Nothing
     plusgtExpr = AST.NSimple resId AST.:= 
                    ((AST.PrimName $ AST.NSimple aPar) AST.:&: 

diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs
index feea40170e750e69ec32390abda99bbaa33ed68d..9a6122778e91aee8a11a5d6180769c71f1208366 100644 (file)
--- a/GlobalNameTable.hs
+++ b/GlobalNameTable.hs
@@ -28,6 +28,7 @@ globalNameTable = mkGlobalNameTable
   , (plusgtId         , (2, Left $ genExprFCall plusgtId                  ) )
   , (mapId            , (2, Right $ genMapCall                            ) )
   , (zipWithId        , (3, Right $ genZipWithCall                        ) )
+  , (foldlId          , (3, Right $ genFoldlCall                          ) )
   , (emptyId          , (0, Left $ genExprFCall emptyId                   ) )
   , (singletonId      , (1, Left $ genExprFCall singletonId               ) )
   , (copyId           , (2, Left $ genExprFCall copyId                    ) )

diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs
index 11636f2c8ba8e6c20242d2c1e4fba061085a2af3..cdef7710c206a817b1bedcfa030bdbfefdd6bfe3 100644 (file)
--- a/HighOrdAlu.hs
+++ b/HighOrdAlu.hs
@@ -10,7 +10,7 @@ import Data.RangedWord
 
 constant :: e -> Op D4 e
 constant e a b =
-  e +> (e +> (e +> singleton e))
+  e +> (e +> (e +> (e +> empty)))
 
 inv = hwnot
 

diff --git a/VHDL.hs b/VHDL.hs
index 76cb62f827d87c24faa2e48df4af4f7527566499..3bd2fe218faf182ca6e63ceeb701948e7aee3606 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -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

diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index d23daea033d77b38710b5fe6c09fcbfaae2be62f..a533bf5989c0367ac5c62bf473299287df163127 100644 (file)
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -76,7 +76,7 @@ type VHDLSession = State.State VHDLState
 -- | A substate containing just the types
 type TypeState = State.State TypeMap
 
-type Builder = Either (CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr) (Entity -> [CoreSyn.CoreBndr] -> VHDLSession AST.GenerateSm)
+type Builder = Either (CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr) (Entity -> [CoreSyn.CoreBndr] -> VHDLSession AST.ConcSm)
 
 -- A map of a builtin function to VHDL function builder 
 type NameTable = Map.Map String (Int, Builder )