X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=88a8b1691846e3776fac6de47a52aeb3800b6f02;hb=cd5b8d1205f3ef1aacd95b332c5e450121c01d5a;hp=13c0ac7bcadff4732cebed3608c46c61e228ae44;hpb=0ebb1e486484787bbf1c923f4d0006044a827632;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Translator.hs b/Translator.hs index 13c0ac7..88a8b16 100644 --- a/Translator.hs +++ b/Translator.hs @@ -26,6 +26,7 @@ import qualified Monad -- ForSyDe to get access to these modules. import qualified ForSyDe.Backend.VHDL.AST as AST import qualified ForSyDe.Backend.VHDL.Ppr +import qualified ForSyDe.Backend.VHDL.FileIO import qualified ForSyDe.Backend.Ppr -- This is needed for rendering the pretty printed VHDL import Text.PrettyPrint.HughesPJ (render) @@ -49,6 +50,7 @@ main = -- Turn bind into VHDL let vhdl = State.evalState (mkVHDL binds) (VHDLSession 0 []) liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl + liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl" return () where -- Turns the given bind into VHDL @@ -108,90 +110,6 @@ getPortMapEntry :: -- Returns the appropriate line for in the port map getPortMapEntry (Signal portname _) (Signal signame _) = (Just portname) AST.:=>: (AST.ADName (AST.NSimple signame)) - -getInstantiations :: - [SignalNameMap] -- The arguments that need to be applied to the - -- expression. - -> SignalNameMap -- The output ports that the expression should generate. - -> [(CoreBndr, SignalNameMap)] - -- A list of bindings in effect - -> CoreSyn.CoreExpr -- The expression to generate an architecture for - -> 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) = - getInstantiations as outs ((b, a):binds) expr - --- A case expression that checks a single variable and has a single --- alternative, can be used to take tuples apart -getInstantiations args outs binds (Case (Var v) b _ [res]) = - -- Split out the type of alternative constructor, the variables it binds - -- and the expression to evaluate with the variables bound. - let (altcon, bind_vars, expr) = res in - case altcon of - DataAlt datacon -> - if (DataCon.isTupleCon datacon) then - let - -- Lookup the scrutinee (which must be a variable bound to a tuple) in - -- the existing bindings list and get the portname map for each of - -- it's elements. - Tuple tuple_ports = Maybe.fromMaybe - (error $ "Case expression uses unknown scrutinee " ++ getOccString v) - (lookup v binds) - -- Merge our existing binds with the new binds. - binds' = (zip bind_vars tuple_ports) ++ binds - in - -- Evaluate the expression with the new binds list - getInstantiations args outs binds' expr - else - error "Data constructors other than tuples not supported" - otherwise -> - error "Case binders other than tuples not supported" - --- An application is an instantiation of a component -getInstantiations args outs binds app@(App expr arg) = do - let ((Var f), fargs) = collectArgs app - name = getOccString f - if isTupleConstructor f - then do - -- Get the signals we should bind our results to - let Tuple outports = outs - -- Split the tuple constructor arguments into types and actual values. - let (_, vals) = splitTupleConstructorArgs fargs - -- Bind each argument to each output signal - res <- sequence $ zipWith - (\outs' expr' -> getInstantiations args outs' binds expr') - outports vals - -- 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. - -- Lookup the hwfunction to instantiate - HWFunction vhdl_id inports outport <- getHWFunc name - -- Generate a unique name for the application - appname <- uniqueName "app" - -- 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 - let comp = AST.CompInsSm - (AST.unsafeVHDLBasicId appname) - (AST.IUEntity (AST.NSimple vhdl_id)) - (AST.PMapAspect (inmaps ++ outmaps)) - return (sigs, (AST.CSISm comp) : comps) - -getInstantiations args outs binds expr = - error $ "Unsupported expression" ++ (showSDoc $ ppr $ expr) - expandExpr :: [(CoreBndr, SignalNameMap)] -- A list of bindings in effect @@ -206,7 +124,7 @@ expandExpr :: -- the expression's result. expandExpr binds lam@(Lam b expr) = do -- Generate a new signal to which we will expect this argument to be bound. - signal_name <- uniqueName ("arg-" ++ getOccString b) + signal_name <- uniqueName ("arg_" ++ getOccString b) -- Find the type of the binder let (arg_ty, _) = Type.splitFunTy (CoreUtils.exprType lam) -- Create signal names for the binder @@ -329,7 +247,7 @@ expandApplicationExpr :: expandApplicationExpr binds ty f args = do let name = getOccString f -- Generate a unique name for the application - appname <- uniqueName ("app-" ++ name) + appname <- uniqueName ("app_" ++ name) -- Lookup the hwfunction to instantiate HWFunction vhdl_id inports outport <- getHWFunc name -- Expand each of the args, so each of them is reduced to output signals @@ -337,7 +255,7 @@ expandApplicationExpr binds ty f args = do -- Bind each of the input ports to the expanded arguments let inmaps = concat $ zipWith createAssocElems inports arg_res_signals -- Create signal names for our result - let res_signal = getPortNameMapForTy (appname ++ "-out") ty + let res_signal = getPortNameMapForTy (appname ++ "_out") ty -- Create the corresponding signal declarations let signal_decls = mkSignalsFromMap res_signal -- Bind each of the output ports to our output signals @@ -594,7 +512,7 @@ uniqueName :: String -> VHDLState String uniqueName name = do count <- State.gets nameCount -- Get the funcs element from the session State.modify (\s -> s {nameCount = count + 1}) - return $ name ++ "-" ++ (show count) + return $ name ++ "_" ++ (show count) -- Shortcut mkVHDLId :: String -> AST.VHDLId