X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=fa5802823939d34ee77ac9cfc05c7ac3723a7177;hb=9167228f9fafba958723fa5a450b5966027127df;hp=ce4e074e8cfbe553413d6bbd0b8e15731866ba06;hpb=6752b2c9c16fc0802c35be9c80ecc6952ab81d5c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Translator.hs b/Translator.hs index ce4e074..fa58028 100644 --- a/Translator.hs +++ b/Translator.hs @@ -91,24 +91,25 @@ findBind lookfor = NonRec var _ -> lookfor == (occNameString $ nameOccName $ getName var) ) +getPortMapEntry :: + SignalNameMap String -- The port name to bind to + -> AST.VHDLName -- The signal or port to bind to it + -> AST.AssocElem -- The resulting port map entry + -- Accepts a port name and an argument to map to it. -- Returns the appropriate line for in the port map -getPortMapEntry binds (Port portname) (Var id) = - (Just (AST.unsafeVHDLBasicId portname)) AST.:=>: (AST.ADName (AST.NSimple (AST.unsafeVHDLBasicId signalname))) - where - Port signalname = Maybe.fromMaybe - (error $ "Argument " ++ getOccString id ++ "is unknown") - (lookup id binds) - -getPortMapEntry binds _ a = error $ "Unsupported argument: " ++ (showSDoc $ ppr a) +getPortMapEntry (Signal portname) signame = + (Just (AST.unsafeVHDLBasicId portname)) AST.:=>: (AST.ADName signame) getInstantiations :: - [PortNameMap] -- The arguments that need to be applied to the + [SignalNameMap String] -- The arguments that need to be applied to the -- expression. - -> PortNameMap -- The output ports that the expression should generate. - -> [(CoreBndr, PortNameMap)] -- A list of bindings in effect + -> SignalNameMap String -- The output ports that the expression should generate. + -> [(CoreBndr, SignalNameMap String)] + -- A list of bindings in effect -> CoreSyn.CoreExpr -- The expression to generate an architecture for - -> VHDLState [AST.ConcSm] -- The resulting VHDL code + -> VHDLState ([AST.SigDec], [AST.ConcSm]) + -- The resulting VHDL code -- A lambda expression binds the first argument (a) to the binder b. getInstantiations (a:as) outs binds (Lam b expr) = @@ -151,11 +152,14 @@ getInstantiations args outs binds app@(App expr arg) = do -- Split the tuple constructor arguments into types and actual values. let (_, vals) = splitTupleConstructorArgs fargs -- Bind each argument to each output signal - insts <- sequence $ zipWith + res <- sequence $ zipWith (\outs' expr' -> getInstantiations args outs' binds expr') outports vals - -- And join all the component instantiations together - return $ concat insts + -- res is a list of pairs of lists, so split out the signals and + -- components into separate lists of lists + let (sigs, comps) = unzip res + -- And join all the signals and component instantiations together + return $ (concat sigs, concat comps) else do -- This is an normal function application, which maps to a component -- instantiation. @@ -163,8 +167,11 @@ getInstantiations args outs binds app@(App expr arg) = do HWFunction inports outport <- getHWFunc name -- Generate a unique name for the application appname <- uniqueName "app" - -- Bind each of the input ports to an argument - let inmaps = zipWith (getPortMapEntry binds) inports fargs + -- Expand each argument to a signal or port name, possibly generating + -- new signals and component instantiations + (sigs, comps, args) <- expandArgs binds fargs + -- Bind each of the input ports to the expanded signal or port + let inmaps = zipWith getPortMapEntry inports args -- Bind each of the output ports to our output signals let outmaps = mapOutputPorts outport outs -- Build and return a component instantiation @@ -172,10 +179,39 @@ getInstantiations args outs binds app@(App expr arg) = do (AST.unsafeVHDLBasicId appname) (AST.IUEntity (AST.NSimple (AST.unsafeVHDLBasicId name))) (AST.PMapAspect (inmaps ++ outmaps)) - return [AST.CSISm comp] + return (sigs, (AST.CSISm comp) : comps) getInstantiations args outs binds expr = error $ "Unsupported expression" ++ (showSDoc $ ppr $ expr) + +expandArgs :: + [(CoreBndr, SignalNameMap String)] -- A list of bindings in effect + -> [CoreExpr] -- The arguments to expand + -> VHDLState ([AST.SigDec], [AST.ConcSm], [AST.VHDLName]) + -- The resulting signal declarations, + -- component instantiations and a + -- VHDLName for each of the + -- expressions passed in. +expandArgs binds (e:exprs) = do + -- Expand the first expression + arg <- case e of + -- A simple variable reference should be in our binds map + Var id -> return $ let + -- Lookup the id in our binds map + Signal signalname = Maybe.fromMaybe + (error $ "Argument " ++ getOccString id ++ "is unknown") + (lookup id binds) + in + -- Create a VHDL name from the signal name + AST.NSimple (AST.unsafeVHDLBasicId signalname) + -- Other expressions are unsupported + otherwise -> error ("Unsupported expression used as argument: " ++ (showSDoc $ ppr e)) + -- Expand the rest + (sigs, comps, args) <- expandArgs binds exprs + -- Return all results + return (sigs, comps, arg:args) + +expandArgs _ [] = return ([], [], []) -- Is the given name a (binary) tuple constructor isTupleConstructor :: Var.Var -> Bool @@ -200,13 +236,13 @@ splitTupleConstructorArgs (e:es) = (tys, vals) = splitTupleConstructorArgs es mapOutputPorts :: - PortNameMap -- The output portnames of the component - -> PortNameMap -- The output portnames and/or signals to map these to - -> [AST.AssocElem] -- The resulting output ports + SignalNameMap String -- The output portnames of the component + -> SignalNameMap String -- The output portnames and/or signals to map these to + -> [AST.AssocElem] -- The resulting output ports -- Map the output port of a component to the output port of the containing -- entity. -mapOutputPorts (Port portname) (Port signalname) = +mapOutputPorts (Signal portname) (Signal signalname) = [(Just (AST.unsafeVHDLBasicId portname)) AST.:=>: (AST.ADName (AST.NSimple (AST.unsafeVHDLBasicId signalname)))] -- Map matching output ports in the tuple @@ -223,40 +259,40 @@ getArchitecture (NonRec var expr) = do let name = (getOccString var) HWFunction inports outport <- getHWFunc name sess <- State.get - insts <- getInstantiations inports outport [] expr + (sigs, comps) <- getInstantiations inports outport [] expr return $ AST.ArchBody (AST.unsafeVHDLBasicId "structural") -- Use unsafe for now, to prevent pulling in ForSyDe error handling (AST.NSimple (AST.unsafeVHDLBasicId name)) - [] - (insts) + (map AST.BDISD sigs) + comps -data PortNameMap = - Tuple [PortNameMap] - | Port String +data SignalNameMap t = + Tuple [SignalNameMap t] + | Signal t deriving (Show) -- Generate a port name map (or multiple for tuple types) in the given direction for -- each type given. -getPortNameMapForTys :: String -> Int -> [Type] -> [PortNameMap] +getPortNameMapForTys :: String -> Int -> [Type] -> [SignalNameMap String] getPortNameMapForTys prefix num [] = [] getPortNameMapForTys prefix num (t:ts) = (getPortNameMapForTy (prefix ++ show num) t) : getPortNameMapForTys prefix (num + 1) ts -getPortNameMapForTy :: String -> Type -> PortNameMap +getPortNameMapForTy :: String -> Type -> SignalNameMap String getPortNameMapForTy name ty = if (TyCon.isTupleTyCon tycon) then -- Expand tuples we find Tuple (getPortNameMapForTys name 0 args) else -- Assume it's a type constructor application, ie simple data type -- TODO: Add type? - Port name + Signal name where (tycon, args) = Type.splitTyConApp ty data HWFunction = HWFunction { -- A function that is available in hardware - inPorts :: [PortNameMap], - outPort :: PortNameMap + inPorts :: [SignalNameMap String], + outPort :: SignalNameMap String --entity :: AST.EntityDec } deriving (Show) @@ -316,8 +352,8 @@ uniqueName name = do builtin_funcs = [ - ("hwxor", HWFunction [Port "a", Port "b"] (Port "o")), - ("hwand", HWFunction [Port "a", Port "b"] (Port "o")) + ("hwxor", HWFunction [Signal "a", Signal "b"] (Signal "o")), + ("hwand", HWFunction [Signal "a", Signal "b"] (Signal "o")) ] -- vim: set ts=8 sw=2 sts=2 expandtab: