X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=e375e457b171d85f2927691ed0900773e29ee508;hb=acb620510e3623e8dfd979a8b732babd19086a9b;hp=98380606884c24ba953a07216d1bb788d1747d22;hpb=1e30fe04f4c285970ad2d5e23930dd935b4214fa;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Translator.hs b/Translator.hs index 9838060..e375e45 100644 --- a/Translator.hs +++ b/Translator.hs @@ -1,5 +1,5 @@ module Translator where -import GHC hiding (loadModule) +import GHC hiding (loadModule, sigName) import CoreSyn import qualified CoreUtils import qualified Var @@ -42,10 +42,14 @@ import VHDLTypes import qualified VHDL main = do + makeVHDL "Alu.hs" "register_bank" + +makeVHDL :: String -> String -> IO () +makeVHDL filename name = do -- Load the module - core <- loadModule "Alu.hs" + core <- loadModule filename -- Translate to VHDL - vhdl <- moduleToVHDL core ["salu"] + vhdl <- moduleToVHDL core [name] -- Write VHDL to file writeVHDL vhdl "../vhdl/vhdl/output.vhdl" @@ -56,6 +60,7 @@ listBind filename name = do let binds = findBinds core [name] putStr "\n" putStr $ prettyShow binds + putStr $ showSDoc $ ppr binds putStr "\n\n" -- | Translate the binds with the given names from the given core module to @@ -216,9 +221,16 @@ nameFlatFunction hsfunc fdata = -- Name the signals in all other functions Just flatfunc -> let s = flat_sigs flatfunc in - let s' = map (\(id, (SignalInfo Nothing use ty)) -> (id, SignalInfo (Just $ "sig_" ++ (show id)) use ty)) s in + let s' = map nameSignal s in let flatfunc' = flatfunc { flat_sigs = s' } in setFlatFunc hsfunc flatfunc' + where + nameSignal :: (SignalId, SignalInfo) -> (SignalId, SignalInfo) + nameSignal (id, info) = + let hints = nameHints info in + let parts = ("sig" : hints) ++ [show id] in + let name = concat $ List.intersperse "_" parts in + (id, info {sigName = Just name}) -- | Splits a tuple type into a list of element types, or Nothing if the type -- is not a tuple type.