From: Matthijs Kooijman Date: Thu, 25 Jun 2009 14:58:57 +0000 (+0200) Subject: Merge git://github.com/darchon/clash into cλash X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=59b710f483534efd4a293f880235f444a5156451;hp=85a89721bf286e8bef30f845d5c1067b64c73249;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Merge git://github.com/darchon/clash into cλash Disabled foldr generation again, it should either be updated to the shorter form from my last commits, but preferably foldl should be abstracted to handle both. * git://github.com/darchon/clash: Added builtin function foldr Foldl correctly handles empty vectors Conflicts: Generate.hs GlobalNameTable.hs --- diff --git a/Constants.hs b/Constants.hs index d941e13..380a745 100644 --- a/Constants.hs +++ b/Constants.hs @@ -168,6 +168,9 @@ zipWithId = "zipWith" foldlId :: String foldlId = "foldl" +foldrId :: String +foldrId = "foldr" + -- | hwxor function identifier hwxorId :: String hwxorId = "hwxor" diff --git a/Generate.hs b/Generate.hs index 1c3edaa..b1aa491 100644 --- 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 ) )