From: Christiaan Baaij Date: Thu, 25 Jun 2009 09:16:27 +0000 (+0200) Subject: Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=ede1f399f096569d1305cd75cb21f037bd4162dc;hp=-c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Merge branch 'cλash' of git.stderr.nl/matthijs/projects/master-project * 'cλash' of http://git.stderr.nl/matthijs/projects/master-project: Unify all BuiltinBuilder functions. Give HighOrdAlu an and operation. Let tfvec_len and tfvec_elem give a proper error message. No longer use a view pattern in HsTools. Conflicts: Generate.hs --- ede1f399f096569d1305cd75cb21f037bd4162dc diff --combined Generate.hs index 17c3d49,7de2161..7b8dcf0 --- a/Generate.hs +++ b/Generate.hs @@@ -5,6 -5,7 +5,7 @@@ import qualified Control.Monad as Mona import qualified Data.Map as Map import qualified Maybe import Data.Accessor + import Debug.Trace -- ForSyDe import qualified ForSyDe.Backend.VHDL.AST as AST @@@ -19,32 -20,67 +20,67 @@@ import Constant import VHDLTypes import VHDLTools import CoreTools + import Pretty + + -- | A function to wrap a builder-like function that expects its arguments to + -- be expressions. + genExprArgs :: + (dst -> func -> [AST.Expr] -> res) + -> (dst -> func -> [CoreSyn.CoreExpr] -> res) + genExprArgs wrap dst func args = wrap dst func args' + where args' = map (varToVHDLExpr.exprToVar) args + + -- | A function to wrap a builder-like function that expects its arguments to + -- be variables. + genVarArgs :: + (dst -> func -> [Var.Var] -> res) + -> (dst -> func -> [CoreSyn.CoreExpr] -> res) + genVarArgs wrap dst func args = wrap dst func args' + where args' = map exprToVar args + + -- | A function to wrap a builder-like function that produces an expression + -- and expects it to be assigned to the destination. + genExprRes :: + (CoreSyn.CoreBndr -> func -> [arg] -> VHDLSession AST.Expr) + -> (CoreSyn.CoreBndr -> func -> [arg] -> VHDLSession [AST.ConcSm]) + genExprRes wrap dst func args = do + expr <- wrap dst func args + return $ [mkUncondAssign (Left dst) expr] -- | Generate a binary operator application. The first argument should be a -- constructor from the AST.Expr type, e.g. AST.And. - genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr - genExprOp2 op res [arg1, arg2] = return $ op arg1 arg2 + genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder + genOperator2 op = genExprArgs $ genExprRes (genOperator2' op) + genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> CoreSyn.CoreBndr -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr + genOperator2' op res f [arg1, arg2] = return $ op arg1 arg2 -- | Generate a unary operator application - genExprOp1 :: (AST.Expr -> AST.Expr) -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr - genExprOp1 op res [arg] = return $ op arg + genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder + genOperator1 op = genExprArgs $ genExprRes (genOperator1' op) + genOperator1' :: (AST.Expr -> AST.Expr) -> CoreSyn.CoreBndr -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr + genOperator1' op res f [arg] = return $ op arg -- | Generate a function call from the destination binder, function name and a -- list of expressions (its arguments) - genExprFCall :: String -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr - genExprFCall fname res args = do + genFCall :: BuiltinBuilder + genFCall = genExprArgs $ genExprRes genFCall' + genFCall' :: CoreSyn.CoreBndr -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr + genFCall' res f args = do + let fname = varToString f let el_ty = (tfvec_elem . Var.varType) res id <- vectorFunId el_ty fname return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $ map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args -- | Generate a generate statement for the builtin function "map" - genMapCall :: - Entity -- | The entity to map - -> [CoreSyn.CoreBndr] -- | The vectors - -> VHDLSession AST.ConcSm -- | The resulting generate statement - genMapCall entity [arg, res] = return $ genSm - where + genMap :: BuiltinBuilder + genMap = genVarArgs genMap' + genMap' res f [mapped_f, arg] = do + signatures <- getA vsSignatures + let entity = Maybe.fromMaybe + (error $ "Using function '" ++ (varToString mapped_f) ++ "' without signature? This should not happen!") + (Map.lookup mapped_f signatures) + let -- Setup the generate scheme len = (tfvec_len . Var.varType) res label = mkVHDLExtId ("mapVector" ++ (varToString res)) @@@ -56,21 -92,26 +92,25 @@@ argports = map (Monad.liftM fst) (ent_args entity) resport = (Monad.liftM fst) (ent_res entity) -- Assign the ports - inport = mkAssocElemIndexed (argports!!0) (varToString arg) nPar - outport = mkAssocElemIndexed resport (varToString res) nPar - clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk" - portassigns = Maybe.catMaybes [inport,outport,clk_port] + inport = mkAssocElemIndexed (argports!!0) (varToVHDLId arg) nPar + outport = mkAssocElemIndexed resport (varToVHDLId res) nPar + portassigns = Maybe.catMaybes [inport,outport] -- Generate the portmap mapLabel = "map" ++ (AST.fromVHDLId entity_id) compins = mkComponentInst mapLabel entity_id portassigns -- Return the generate functions genSm = AST.CSGSm $ AST.GenerateSm label genScheme [] [compins] + in + return $ [genSm] - genZipWithCall :: - Entity - -> [CoreSyn.CoreBndr] - -> VHDLSession AST.ConcSm - genZipWithCall entity [arg1, arg2, res] = return $ genSm - where + genZipWith :: BuiltinBuilder + genZipWith = genVarArgs genZipWith' + genZipWith' res f args@[zipped_f, arg1, arg2] = do + signatures <- getA vsSignatures + let entity = Maybe.fromMaybe + (error $ "Using function '" ++ (varToString zipped_f) ++ "' without signature? This should not happen!") + (Map.lookup zipped_f signatures) + let -- Setup the generate scheme len = (tfvec_len . Var.varType) res label = mkVHDLExtId ("zipWithVector" ++ (varToString res)) @@@ -82,21 -123,26 +122,25 @@@ argports = map (Monad.liftM fst) (ent_args entity) resport = (Monad.liftM fst) (ent_res entity) -- Assign the ports - inport1 = mkAssocElemIndexed (argports!!0) (varToString arg1) nPar - inport2 = mkAssocElemIndexed (argports!!1) (varToString arg2) nPar - outport = mkAssocElemIndexed resport (varToString res) nPar - clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk" - portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port] + inport1 = mkAssocElemIndexed (argports!!0) (varToVHDLId arg1) nPar + inport2 = mkAssocElemIndexed (argports!!1) (varToVHDLId arg2) nPar + outport = mkAssocElemIndexed resport (varToVHDLId res) nPar + portassigns = Maybe.catMaybes [inport1,inport2,outport] -- Generate the portmap mapLabel = "zipWith" ++ (AST.fromVHDLId entity_id) compins = mkComponentInst mapLabel entity_id portassigns -- Return the generate functions genSm = AST.CSGSm $ AST.GenerateSm label genScheme [] [compins] + in + return $ [genSm] - genFoldlCall :: - Entity - -> [CoreSyn.CoreBndr] - -> VHDLSession AST.ConcSm - genFoldlCall entity [startVal, inVec, resVal] = do + genFoldl :: BuiltinBuilder + genFoldl = genVarArgs genFoldl' + genFoldl' 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 @@@ -104,77 -150,85 +148,77 @@@ 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 + let genScheme = AST.ForGn (AST.unsafeVHDLBasicId "n") 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]] + -- 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) - -- Return the generate functions ++ -- Return the generate functions + let genSm = AST.GenerateSm genlabel genScheme [] + [ AST.CSGSm (genFirstCell (entity_id, argports, resport) + [startVal, inVec, resVal]) + , AST.CSGSm (genOtherCell (entity_id, argports, resport) + [startVal, inVec, resVal]) + , AST.CSGSm (genLastCell (entity_id, argports, resport) + [startVal, inVec, resVal]) + ] - return $ AST.CSBSm $ AST.BlockSm blockLabel [] (AST.PMapAspect []) [tmpVec] [AST.CSGSm genSm] ++ 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 + genFirstCell (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn where cellLabel = mkVHDLExtId "firstcell" cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar) AST.:=: (AST.PrimLit "0")) + tmpId = mkVHDLExtId "tmp" 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] + 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 :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm - genOtherCell entity [startVal, inVec, resVal] = cellGn + genOtherCell (entity_id, argports, resport) [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))) + tmpId = mkVHDLExtId "tmp" 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] + 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] - genLastCell :: Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm - genLastCell entity [startVal, inVec, resVal] = cellGn + genLastCell (entity_id, argports, resport) [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))) + tmpId = mkVHDLExtId "tmp" 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] + 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 -- Generate the output assignment assign = mkUncondAssign (Left resVal) (AST.PrimName (AST.NIndexed (AST.IndexedName - (AST.NSimple (mkVHDLExtId "tmp")) [AST.PrimLit $ show (len-1)]))) + (AST.NSimple tmpId) [AST.PrimLit $ show (len-1)]))) -- Return the generate functions cellGn = AST.GenerateSm cellLabel cellGenScheme [] [compins,assign] diff --combined VHDL.hs index 998efb4,920b83e..4b69df5 --- a/VHDL.hs +++ b/VHDL.hs @@@ -12,6 -12,7 +12,7 @@@ import qualified Control.Arrow as Arro import qualified Control.Monad.Trans.State as State import qualified Data.Monoid as Monoid import Data.Accessor + import Debug.Trace -- ForSyDe import qualified ForSyDe.Backend.VHDL.AST as AST @@@ -298,22 -299,7 +299,7 @@@ mkConcSm (bndr, app@(CoreSyn.App _ _)) case (Map.lookup (varToString f) globalNameTable) of Just (arg_count, builder) -> if length valargs == arg_count then - case builder of - Left funBuilder -> do - let sigs = map (varToVHDLExpr.exprToVar) valargs - func <- funBuilder bndr sigs - let src_wform = AST.Wform [AST.WformElem func Nothing] - let dst_name = AST.NSimple (mkVHDLExtId (varToString bndr)) - let assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing) - return [AST.CSSASm assign] - Right genBuilder -> do - let sigs = map exprToVar valargs - let signature = Maybe.fromMaybe - (error $ "Using function '" ++ (varToString (head sigs)) ++ "' without signature? This should not happen!") - (Map.lookup (head sigs) signatures) - let arg = tail sigs - genSm <- genBuilder signature (arg ++ [bndr]) - return [genSm] + builder bndr f valargs 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 @@@ -329,9 -315,9 +315,9 @@@ label = "comp_ins_" ++ varToString bndr -- Add a clk port if we have state --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk" - clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk" + --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk" --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else []) - portmaps = clk_port : mkAssocElems args bndr signature + portmaps = mkAssocElems args bndr signature in return [mkComponentInst label entity_id portmaps] details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details