X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=071e9d296dc5f416b6da9d1bfc2ed93a00e07742;hb=6e1beb07825c53ab0da16b815d58c24a1b4ea449;hp=a94e3f44c39d0a7b8fcdbc99c232e76f52ef0bfa;hpb=b98d46bc13dc17a8783dbf844fb34fb9b0f2be49;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Translator.hs b/Translator.hs index a94e3f4..071e9d2 100644 --- a/Translator.hs +++ b/Translator.hs @@ -8,6 +8,9 @@ import qualified Var import qualified Type import qualified TyCon import qualified DataCon +import qualified HscMain +import qualified SrcLoc +import qualified FastString import qualified Maybe import qualified Module import qualified Data.Foldable as Foldable @@ -46,7 +49,7 @@ import VHDLTypes import qualified VHDL main = do - makeVHDL "Alu.hs" "register_bank" True + makeVHDL "Alu.hs" "exec" True makeVHDL :: String -> String -> Bool -> IO () makeVHDL filename name stateful = do @@ -63,12 +66,17 @@ makeVHDL filename name stateful = do listBind :: String -> String -> IO () listBind filename name = do core <- loadModule filename - let binds = findBinds core [name] + let [bind] = findBinds core [name] putStr "\n" - putStr $ prettyShow binds + putStr $ prettyShow bind putStr "\n\n" - putStr $ showSDoc $ ppr binds + putStr $ showSDoc $ ppr bind putStr "\n\n" + case bind of + NonRec b expr -> do + putStr $ showSDoc $ ppr $ CoreUtils.exprType expr + putStr "\n\n" + otherwise -> return () -- | Translate the binds with the given names from the given core module to -- VHDL. The Bool in the tuple makes the function stateful (True) or @@ -168,7 +176,7 @@ flattenBind hsfunc bind@(NonRec var expr) = do -- Propagate state variables let flatfunc' = propagateState hsfunc flatfunc -- Store the flat function in the session - modA tsFlatFuncs (Map.insert hsfunc flatfunc) + modA tsFlatFuncs (Map.insert hsfunc flatfunc') -- Flatten any functions used let used_hsfuncs = Maybe.mapMaybe usedHsFunc (flat_defs flatfunc') mapM_ resolvFunc used_hsfuncs @@ -272,7 +280,6 @@ resolvFunc hsfunc = do -- when it is a builtin function. Monad.unless (Map.member hsfunc flatfuncmap) $ do Monad.unless (elem hsfunc VHDL.builtin_hsfuncs) $ do - -- TODO: Builtin functions -- New function, resolve it core <- getA tsCoreModule -- Find the named function