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

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

diff --git a/Generate.hs b/Generate.hs
index 1c3edaa4d8bea20aea4134e29090ecf9b50a2c56..b1aa491ccd1975e238bcde2022ad6a2eeaad7fb5 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -135,6 +135,9 @@ genZipWith' (Left res) f args@[zipped_f, arg1, arg2] =
 genFoldl :: BuiltinBuilder
 genFoldl = genVarArgs genFoldl'
 genFoldl' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+-- Special case for an empty input vector, just assign start to res
+genFoldl' (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) (varToVHDLExpr start)]
+    where len = (tfvec_len . Var.varType) vec
 genFoldl' (Left res) f [folded_f, start, vec] = do
   -- evec is (TFVec n), so it still needs an element type
   let (nvec, _) = splitAppTy (Var.varType vec)
@@ -199,6 +202,83 @@ genFoldl' (Left res) f [folded_f, start, vec] = do
       -- Return the conditional generate part
       return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
 
+{-
+genFoldr :: BuiltinBuilder
+genFoldr = genVarArgs genFoldr'
+genFoldr' resVal f [folded_f, startVal, inVec] = do
+  signatures <- getA vsSignatures
+  let entity = Maybe.fromMaybe
+        (error $ "Using function '" ++ (varToString folded_f) ++ "' without signature? This should not happen!") 
+        (Map.lookup folded_f signatures)
+  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 ("foldrVector" ++ (varToString inVec))
+  let  blockLabel = mkVHDLExtId ("foldrVector" ++ (varToString startVal))
+  let  range      = AST.DownRange (AST.PrimLit $ show (len-1)) (AST.PrimLit "0")
+  let  genScheme  = AST.ForGn (AST.unsafeVHDLBasicId "n") range
+  -- Make the intermediate vector
+  let tmpId       = mkVHDLExtId "tmp"
+  let  tmpVec     = AST.BDISD $ AST.SigDec tmpId vecType Nothing
+  -- Get the entity name and port names
+  let entity_id   = ent_id entity
+  let argports    = map (Monad.liftM fst) (ent_args entity)
+  let resport     = (Monad.liftM fst) (ent_res entity)
+  -- Generate the output assignment
+  let assign      = [mkUncondAssign (Left resVal) (AST.PrimName (AST.NIndexed (AST.IndexedName 
+                        (AST.NSimple tmpId) [AST.PrimLit "0"])))]
+  -- Return the generate functions
+  let genSm       = AST.CSGSm $ AST.GenerateSm genlabel genScheme [] 
+                      [ AST.CSGSm (genFirstCell len (entity_id, argports, resport) 
+                                    [startVal, inVec, resVal])
+                      , AST.CSGSm (genOtherCell len (entity_id, argports, resport) 
+                                    [startVal, inVec, resVal])
+                      ]
+  return $  if len > 0 then
+              [AST.CSBSm $ AST.BlockSm blockLabel [] (AST.PMapAspect []) [tmpVec] (genSm : assign)]
+            else
+              [mkUncondAssign (Left resVal) (AST.PrimName $ AST.NSimple (varToVHDLId startVal))]
+  where
+    genFirstCell len (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
+      where
+        cellLabel   = mkVHDLExtId "firstcell"
+        cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar)  AST.:=: (AST.PrimLit $ show (len-1)))
+        tmpId       = mkVHDLExtId "tmp"
+        nPar        = AST.unsafeVHDLBasicId "n"
+        -- Assign the ports
+        inport1     = mkAssocElem (argports!!0) (varToString startVal)
+        inport2     = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar 
+        outport     = mkAssocElemIndexed resport tmpId nPar
+        portassigns = Maybe.catMaybes [inport1,inport2,outport]
+        -- 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 len (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
+      where
+        len         = (tfvec_len . Var.varType) inVec
+        cellLabel   = mkVHDLExtId "othercell"
+        cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar)  AST.:/=: (AST.PrimLit $ show (len-1)))
+                                -- ((AST.PrimName $ AST.NSimple nPar)  AST.:<: (AST.PrimLit $ show (len-1)))
+        tmpId       = mkVHDLExtId "tmp"
+        nPar        = AST.unsafeVHDLBasicId "n"
+        -- Assign the ports
+        inport1     = mkAssocElemIndexed (argports!!0) tmpId (AST.unsafeVHDLBasicId "n+1")
+        inport2     = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar 
+        outport     = mkAssocElemIndexed resport tmpId nPar
+        portassigns = Maybe.catMaybes [inport1,inport2,outport]
+        -- 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]
+
+-}
+
+
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
 -----------------------------------------------------------------------------
@@ -484,6 +564,7 @@ globalNameTable = Map.fromList
   , (mapId            , (2, genMap                  ) )
   , (zipWithId        , (3, genZipWith              ) )
   , (foldlId          , (3, genFoldl                ) )
+  --, (foldrId          , (3, genFoldr                ) )
   , (emptyId          , (0, genFCall                ) )
   , (singletonId      , (1, genFCall                ) )
   , (copyId           , (2, genFCall                ) )