Commit 18834f48 authored by nathyong's avatar nathyong

Move code to new module structure

parent 54c9a9b6
......@@ -15,8 +15,17 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Lib
exposed-modules: Compiler.Mu
, Compiler.Mu.FromSTG
, Compiler.Mu.Types
, Compiler.Mu.PprMu
build-depends: base >= 4.7 && < 5
, text
, ghc
, ghc-simple
, containers
, bytestring
, hoopl
default-language: Haskell2010
executable anuhc-exe
......@@ -24,8 +33,7 @@ executable anuhc-exe
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, ghc
, ghc-paths
, text
, ghc-simple
, anuhc
default-language: Haskell2010
......
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module : Main
-- Copyright : nathyong 2016
--
-- Maintainer : nathan.yong@anu.edu.au
-- Stability : experimental
-- Portability : unknown
--
-- Main module for ANU Haskell Compiler.
--
module Main where
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Char8 as BS8
import System.Environment (getArgs)
import Language.Haskell.GHC.Simple
import Language.Haskell.GHC.Simple as GHC.Simple
import Language.Haskell.GHC.Simple (CompResult (..), CompiledModule (..))
targetFile = "B.hs"
import Compiler.Mu (compileMu)
main :: IO ()
main = do getDynFlagsForConfig defaultConfig
mod <- compile stgToMu [targetFile]
case mod of
Success results _ _ -> let printModule (CompiledModule txt _ _) = putStrLn txt
main = do _ <- GHC.Simple.getDynFlagsForConfig GHC.Simple.defaultConfig
inputFiles <- getArgs
compiledModules <- GHC.Simple.compile compileMu inputFiles
case compiledModules of
Success results _ _ -> let printModule (CompiledModule str _ _) = putStrLn str
in mapM_ printModule results
Failure _ _ -> putStrLn "Noooo"
stgToMu :: ModMetadata -> [StgBinding] -> IO String
stgToMu _ _ = return "Hello, world!"
-- example = defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
-- runGhc (Just libdir) $ do
-- dflags <- getSessionDynFlags
-- -- let dflags' = foldl xopt_set dflags
-- -- [Opt_Cpp, Opt_ImplicitPrelude, Opt_MagicHash]
-- setSessionDynFlags dflags
-- target <- guessTarget targetFile Nothing
-- setTargets [target]
-- load LoadAllTargets
-- modSum <- getModSummary $ mkModuleName "B"
-- p <- parseModule modSum
-- t <- typecheckModule p
-- d <- desugarModule t
-- l <- loadModule d
-- n <- getNamesInScope
-- let core_modguts = coreModule d
-- stg <- liftIO $ myCoreToStg dflags modSum core_modguts
-- return stg
-- --
-- -- g <- getModuleGraph
-- -- mapM showModule g
-- -- return $ (parsedSource d,"/n-----/n", typecheckedSource d)
--
--
-- myCoreToStg :: DynFlags -> ModSummary -> ModGuts -> IO ([StgBinding], CollectedCCs)
-- myCoreToStg dflags guts summary = do
-- env <- gg
-- liftIO $ do
-- stg_binds <- coreToStg dflags this_mod prepd_binds
-- return $ stg2stg dflags this_mod stg_binds
--
-- -- myCoreToStg :: DynFlags -> Module -> CoreProgram
-- -- -> IO ( [StgBinding] -- output program
-- -- , CollectedCCs) -- cost centre info (declared and used)
-- -- myCoreToStg dflags this_mod prepd_binds = do
-- -- stg_binds
-- -- <- {-# SCC "Core2Stg" #-}
-- -- coreToStg dflags this_mod prepd_binds
-- --
-- -- (stg_binds2, cost_centre_info)
-- -- <- {-# SCC "Stg2Stg" #-}
-- -- stg2stg dflags this_mod stg_binds
-- --
-- -- return (stg_binds2, cost_centre_info)
Failure _ _ -> BS8.putStrLn "Noooo"
-- |
-- Module : Compiler.Mu
-- Copyright : nathyong 2016
--
-- Maintainer : nathan.yong@anu.edu.au
-- Stability : experimental
-- Portability : unknown
--
-- Code generation facilities for the Mu Micro Virtual Machine
--
module Compiler.Mu
( compileMu
) where
import Language.Haskell.GHC.Simple.Types
import StgSyn (StgBinding)
import Compiler.Mu.FromSTG (stgToMu)
import Compiler.Mu.PprMu (showMu)
compileMu :: ModMetadata -> [StgBinding] -> IO String
compileMu metadata bindings = return . showMu $ stgToMu metadata bindings
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module : MuCodeGen
-- Copyright : nathyong 2016
--
-- Maintainer : nathan.yong@anu.edu.au
-- Stability : experimental
-- Portability : unknown
--
-- Code generation facilities for the Mu Micro Virtual Machine
--
module Compiler.Mu.FromSTG
(
-- * Main entry points
stgToMu
) where
import Language.Haskell.GHC.Simple (ModMetadata)
import StgSyn (StgBinding)
import Compiler.Mu.Types
stgToMu :: ModMetadata -> [StgBinding] -> MuBundle
stgToMu modInfo stgBindings = undefined
--
--
-- import StgSyn
--
-- import Util (unzipWith)
-- import BasicTypes (RecFlag (..))
-- import DynFlags
-- import OrdList
-- import OccName
-- import FastString
-- import Literal
-- import Outputable (pprTraceIt)
--
-- import CmmExpr
-- import HscTypes
-- import CostCentre
-- import Id
-- import IdInfo
-- import DataCon
-- import Name
-- import TyCon
-- import Module
-- import PrelInfo (maybeIntLikeCon, maybeCharLikeCon)
--
-- import MuCodeGen.Types
--
-- import Data.Char (ord)
-- import Control.Monad (when, void, ap)
-- import Control.Monad.Trans.Writer.Strict
-- import Data.ByteString (ByteString)
-- import qualified Data.ByteString as BS
--
--
-- --------------------------------------------------------------------------------
--
-- muCodeGen :: HscEnv
-- -> Module
-- -> [TyCon]
-- -> CollectedCCs
-- -> [StgBinding]
-- -> HpcInfo
-- -> IO MuBundle
-- muCodeGen hsc_env this_mod type_constructors _cost_centre_info stg_binds _hpc_info
-- = return $ execWriter output
-- where
-- output = muCodeGen' dflags this_mod type_constructors stg_binds
-- dflags = hsc_dflags hsc_env
--
--
-- muCodeGen' :: DynFlags -> Module -> [TyCon] -> [StgBinding] -> Writer MuBundle ()
-- muCodeGen' dflags _this_mod _type_constructors stg_binds = do
-- let cg :: MuCode () -> Writer MuBundle ()
-- cg muCode = tell $ evalMuCode (muCode >> extractBundle) (initialMuState dflags)
--
-- seq (pprTraceIt "MuCodeGen STG" stg_binds) (return ())
-- mapM_ (cg . muBindings) stg_binds
--
-- -- let do_tycon tycon = do
-- -- mapM_ (cg . genDataConstructor) (tyConDataCons tycon)
-- -- mapM_ do_tycon type_constructors
-- -- add information about the module
-- -- cg $ genModuleInfo this_mod
--
--
-- muBindings :: StgBinding -> MuCode ()
-- muBindings stg = case stg of
-- StgNonRec id rhs -> do
-- let (binder, code) = muTopBinding NonRecursive id rhs
-- muBind binder
-- code
-- StgRec pairs -> do
-- let (binders, codes) = unzip $ unzipWith (muTopBinding Recursive) pairs
-- mapM_ muBind binders
-- sequence_ codes
--
--
-- muTopBinding :: RecFlag -> Id -> StgRhs -> (MuBindInfo, MuCode ())
-- muTopBinding rec bndr rhs = case rhs of
-- StgRhsCon _cc con arg -> muCgTopRhsCon con bndr arg
-- StgRhsClosure _cc _bindinfo _nonfrees updateflag vars body ->
-- (MuBindInfo bndr, return ())
--
--
-- -- genBinding :: RecFlag -> Id -> StgRhs -> MuCode ()
-- -- genBinding rec bndr rhs = do
-- -- muBind bndr
-- -- case rhs of
-- -- StgRhsCon _cc con arg ->
-- -- genConstructor con arg
-- -- StgRhsClosure _cc _bindinfo _nonfrees updateflag vars body ->
-- -- genClosure rec updateflag vars body
-- -- muBlockToFunction bndr
--
--
-- muCgTopRhsCon :: DataCon -> Id -> [StgArg] -> (MuBindInfo, MuCode ())
-- muCgTopRhsCon con bndr args = (info, code)
-- where
-- info = MuBindInfo bndr
-- get_lit arg = seq (pprTraceIt "muCgTopRhsCon" bndr) $ case arg of
-- StgVarArg var -> MuLabel var
-- StgLitArg lit -> muCgLit lit
-- code = do let payload = map get_lit args
-- emitGroup bndr [] (dataConWrapId con) payload
--
--
-- muCgLit :: Literal -> MuLit
-- MachInt64 i -> MuInt i 64
-- MachWord i -> MuInt i 64
-- MachWord64 i -> MuInt i 64
-- MachFloat r -> MuFloat r
-- MachDouble r -> MuDouble r
-- -- MachStr s -> MuVector
-- _ -> seq (pprTraceIt "muCgLit" lit) $ error "Not implemented"
--
--
--
-- -- muCgTopRhsCon :: DataCon -> [StgArg] -> (MuBindInfo, MuCode ())
-- -- muCgTopRhsCon con args = case args of
-- -- [] -> return () -- generate no code at all!
-- -- [StgLitArg (MachInt val)]
-- -- | maybeIntLikeCon con -> do
-- -- -- TODO: add more checks
-- -- muEmitTop $ ConstructorHeader (dataConName con)
-- -- muEmitTop $ LiteralInt (fromIntegral val)
-- -- [StgLitArg (MachChar val)]
-- -- | maybeCharLikeCon con -> do
-- -- -- TODO: add more checks
-- -- muEmitTop $ ConstructorHeader (dataConName con)
-- -- muEmitTop $ LiteralChar (fromIntegral (ord val))
-- -- _ -> void $ muEmitBlock $ toOL [MuStmt $ MuComment "StgRhsCon binding"]
--
--
-- -- -- | Generate the function body for a closure
-- -- genClosure :: RecFlag -> UpdateFlag -> [Id] -> StgExpr -> MuCode ()
-- -- genClosure _rec _updateflag vars body = do
-- -- -- need to emit a closure header somewhere
-- -- mucgExpr body
--
--
-- -- mucgExpr :: StgExpr -> MuCode ()
-- -- mucgExpr body = void $ case body of
-- -- StgApp fun args -> do
-- -- _ <- muEmitBlock $ toOL [MuStmt (MuComment "StgApp")]
-- -- _ <- muEmitBlock $ toOL [MuStmt (MuFunCall fun args)]
-- -- return ""
-- -- StgLit {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLit")]
-- -- StgConApp con args -> muEmitBlock $ toOL [MuStmt (MuComment "StgConApp")]
-- -- StgOpApp {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgOpApp")]
-- -- StgLam {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLam")]
-- -- StgCase scrut bndr alt_type alts -> do
-- -- mucgCase scrut bndr alt_type alts
-- -- return ""
-- -- StgLet {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLet")]
-- -- StgLetNoEscape {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLetNoEscape")]
-- -- StgTick {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgTick")]
-- --
-- --
-- -- mucgCase :: StgExpr -> Id -> AltType -> [StgAlt] -> MuCode ()
-- -- mucgCase scrut bndr alt_type alts = do
-- -- muEmitBlock' [scrut] $ toOL [MuStmt (MuComment "StgCase")]
-- -- seq (pprTraceIt "some case" scrut) $ return ()
-- -- seq (pprTraceIt "bind it to" bndr) $ return ()
-- -- seq (pprTraceIt "some results" alts) $ return ()
-- --
-- -- -- force scrut
-- -- -- bind it to bndr
-- -- -- generate alts
-- --
-- -- -- scrutinise: evaluate @scrut@ and bind it to @bndr@
-- -- -- case-jump: branch on the value of the @bndr@
-- --
-- -- -- evaluate scrut and bind it sowhere
-- -- _ <- muEvalAndBind scrut bndr
-- -- mucgAlts bndr alt_type alts
-- -- return ()
-- -- where
-- -- muEvalAndBind scrut bndr = do
-- -- mucgExpr scrut
-- -- muEmitBlock $ toOL [MuStmt (MuComment "bind the thing somewhere")]
-- --
-- -- mucgAlts bndr alt_type alts = void $ case alt_type of
-- -- PolyAlt -> muEmitBlock $ toOL [MuStmt (MuComment "PolyAlt")]
-- -- UbxTupAlt _ -> muEmitBlock $ toOL [MuStmt (MuComment "UbxAlt")]
-- -- PrimAlt _ -> muEmitBlock $ toOL [MuStmt (MuComment "PrimAlt")]
-- -- AlgAlt tycon -> muEmitBlock $ toOL [MuStmt (MuComment "AlgAlt")]
-- --
-- --
-- -- -- Generate the entry code, info tables, and (for niladic constructor)
-- -- -- the static closure, for a constructor.
-- -- genDataConstructor :: DataCon -> MuCode ()
-- -- genDataConstructor _datacon = void $ muEmitBlock $ toOL [MuStmt (MuComment "Inside the data constructor now")]
-- --
-- --
-- -- genTypeConstructors :: TyCon -> MuCode ()
-- -- genTypeConstructors _tycon = do
-- -- void $ muEmitBlock $ toOL [MuStmt $ MuComment "Type constructor"]
-- --
-- --
-- -- genModuleInfo :: Module -> MuCode ()
-- -- genModuleInfo mod = do
-- -- muEmitTop (ModuleDecl name)
-- -- where
-- -- name = moduleNameFS $ moduleName mod
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module MuCodeGen.PprMu () where
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Compiler.Mu.PprMu (showMu) where
import Data.Foldable (foldl')
import Compiler.Hoopl
import DynFlags
import FastString
import Id
import MuCodeGen.Types
import Name
import Compiler.Mu.Types
import Numeric ( fromRat )
import OrdList
import Outputable
import StgSyn
import UniqSupply
showMu :: MuBundle -> String
showMu = showSDocUnsafe . ppr
instance Outputable MuBundle where
......@@ -46,7 +42,7 @@ pprMuLit :: MuLit -> SDoc
pprMuGroup group = hang' header 4 (decls $+$ codes) $+$ empty
where
header = ppr (mgLabel group) <> "_closure:"
decls = hang' "declarations:" 4 $ (ppr $ entryFunction group) $+$ (vcat2 $ entryArgs group)
decls = hang' "declarations:" 4 $ ppr (entryFunction group) $+$ vcat2 (entryArgs group)
codes = hang' "codes:" 4 $ vcat2 (mgClosures group)
pprMuClosure closure = hang' header 4 body
......@@ -56,7 +52,7 @@ pprMuClosure closure = hang' header 4 body
pprMuBlock block = hang' header 4 body
where
header = ppr (blockName block) <> ":"
body = (vcat2 (blockCode block)) $+$ ppr (blockTerminator block)
body = vcat2 (blockCode block) $+$ ppr (blockTerminator block)
pprMuNode node = case node of
MuComment fs -> "//" <+> ppr fs
......@@ -66,10 +62,10 @@ pprMuLit lit = case lit of
MuFloat r -> double $ fromRat r
MuDouble r -> double $ fromRat r
MuLabel l -> ppr l
MuLabelOff l off -> ppr l <> ppr_offset off
MuLabelOff l off -> ppr l <> pprOffset off
ppr_offset :: Int -> SDoc
ppr_offset i
pprOffset :: Int -> SDoc
pprOffset i
| i==0 = empty
| i>=0 = char '+' <> int i
| otherwise = char '-' <> int (-i)
......
-- |
-- Module : MuCodeGen.Types
-- Module : Compiler.Mu.Types
-- Copyright : nathyong 2016
-- License : BSD3
--
......@@ -12,9 +12,8 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module MuCodeGen.Types where
module Compiler.Mu.Types where
import Control.Monad (ap, liftM)
import Data.Map (Map)
......
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"
-- |
-- Module : MuCodeGen
-- Copyright : nathyong 2016
--
-- Maintainer : nathan.yong@anu.edu.au
-- Stability : experimental
-- Portability : unknown
--
-- Code generation facilities for the Mu Micro Virtual Machine
--
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module MuCodeGen (
muCodeGen
) where
import StgSyn
import Util (unzipWith)
import BasicTypes (RecFlag (..))
import DynFlags
import OrdList
import OccName
import FastString
import Literal
import Outputable (pprTraceIt)
import CmmExpr
import HscTypes
import CostCentre
import Id
import IdInfo
import Type
import DataCon
import Name
import TyCon
import Module
import PrelInfo (maybeIntLikeCon, maybeCharLikeCon)
import MuCodeGen.Types
import Data.Char (ord)
import Control.Monad (when, void, ap)
import Control.Monad.Trans.Writer.Strict
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
--------------------------------------------------------------------------------
muCodeGen :: HscEnv
-> Module
-> [TyCon]
-> CollectedCCs
-> [StgBinding]
-> HpcInfo
-> IO MuBundle
muCodeGen hsc_env this_mod type_constructors _cost_centre_info stg_binds _hpc_info
= return $ execWriter output
where
output = muCodeGen' dflags this_mod type_constructors stg_binds
dflags = hsc_dflags hsc_env
muCodeGen' :: DynFlags -> Module -> [TyCon] -> [StgBinding] -> Writer MuBundle ()
muCodeGen' dflags _this_mod _type_constructors stg_binds = do
let cg :: MuCode () -> Writer MuBundle ()
cg muCode = tell $ evalMuCode (muCode >> extractBundle) (initialMuState dflags)
seq (pprTraceIt "MuCodeGen STG" stg_binds) (return ())
mapM_ (cg . muBindings) stg_binds
-- let do_tycon tycon = do
-- mapM_ (cg . genDataConstructor) (tyConDataCons tycon)
-- mapM_ do_tycon type_constructors
-- add information about the module
-- cg $ genModuleInfo this_mod
muBindings :: StgBinding -> MuCode ()
muBindings stg = case stg of
StgNonRec id rhs -> do
let (binder, code) = muTopBinding NonRecursive id rhs
muBind binder
code
StgRec pairs -> do
let (binders, codes) = unzip $ unzipWith (muTopBinding Recursive) pairs
mapM_ muBind binders
sequence_ codes
muTopBinding :: RecFlag -> Id -> StgRhs -> (MuBindInfo, MuCode ())
muTopBinding rec bndr rhs = case rhs of
StgRhsCon _cc con arg -> muCgTopRhsCon con bndr arg
StgRhsClosure _cc _bindinfo _nonfrees updateflag vars body ->
(MuBindInfo bndr, return ())
-- genBinding :: RecFlag -> Id -> StgRhs -> MuCode ()
-- genBinding rec bndr rhs = do
-- muBind bndr
-- case rhs of
-- StgRhsCon _cc con arg ->
-- genConstructor con arg
-- StgRhsClosure _cc _bindinfo _nonfrees updateflag vars body ->
-- genClosure rec updateflag vars body
-- muBlockToFunction bndr
muCgTopRhsCon :: DataCon -> Id -> [StgArg] -> (MuBindInfo, MuCode ())
muCgTopRhsCon con bndr args = (info, code)
where
info = MuBindInfo bndr
get_lit arg = seq (pprTraceIt "muCgTopRhsCon" bndr) $ case arg of
StgVarArg var -> MuLabel var
StgLitArg lit -> muCgLit lit
code = do let payload = map get_lit args
emitGroup bndr [] (dataConWrapId con) payload
muCgLit :: Literal -> MuLit
muCgLit lit = case lit of
MachInt i -> MuInt i 64
MachInt64 i -> MuInt i 64
MachWord i -> MuInt i 64
MachWord64 i -> MuInt i 64
MachFloat r -> MuFloat r
MachDouble r -> MuDouble r
-- MachStr s -> MuVector
_ -> seq (pprTraceIt "muCgLit" lit) $ error "Not implemented"
-- muCgTopRhsCon :: DataCon -> [StgArg] -> (MuBindInfo, MuCode ())
-- muCgTopRhsCon con args = case args of
-- [] -> return () -- generate no code at all!
-- [StgLitArg (MachInt val)]
-- | maybeIntLikeCon con -> do
-- -- TODO: add more checks
-- muEmitTop $ ConstructorHeader (dataConName con)
-- muEmitTop $ LiteralInt (fromIntegral val)
-- [StgLitArg (MachChar val)]
-- | maybeCharLikeCon con -> do
-- -- TODO: add more checks
-- muEmitTop $ ConstructorHeader (dataConName con)
-- muEmitTop $ LiteralChar (fromIntegral (ord val))
-- _ -> void $ muEmitBlock $ toOL [MuStmt $ MuComment "StgRhsCon binding"]
-- -- | Generate the function body for a closure
-- genClosure :: RecFlag -> UpdateFlag -> [Id] -> StgExpr -> MuCode ()
-- genClosure _rec _updateflag vars body = do
-- -- need to emit a closure header somewhere
-- mucgExpr body
-- mucgExpr :: StgExpr -> MuCode ()
-- mucgExpr body = void $ case body of
-- StgApp fun args -> do
-- _ <- muEmitBlock $ toOL [MuStmt (MuComment "StgApp")]
-- _ <- muEmitBlock $ toOL [MuStmt (MuFunCall fun args)]
-- return ""
-- StgLit {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLit")]
-- StgConApp con args -> muEmitBlock $ toOL [MuStmt (MuComment "StgConApp")]
-- StgOpApp {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgOpApp")]
-- StgLam {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLam")]
-- StgCase scrut bndr alt_type alts -> do
-- mucgCase scrut bndr alt_type alts
-- return ""
-- StgLet {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLet")]
-- StgLetNoEscape {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgLetNoEscape")]
-- StgTick {} -> muEmitBlock $ toOL [MuStmt (MuComment "StgTick")]
--
--
-- mucgCase :: StgExpr -> Id -> AltType -> [StgAlt] -> MuCode ()
-- mucgCase scrut bndr alt_type alts = do
-- muEmitBlock' [scrut] $ toOL [MuStmt (MuComment "StgCase")]
-- seq (pprTraceIt "some case" scrut) $ return ()
-- seq (pprTraceIt "bind it to" bndr) $ return ()
-- seq (pprTraceIt "some results" alts) $ return ()
--
-- -- force scrut
-- -- bind it to bndr
-- -- generate alts
--
-- -- scrutinise: evaluate @scrut@ and bind it to @bndr@
-- -- case-jump: branch on the value of the @bndr@
--
-- -- evaluate scrut and bind it sowhere
-- _ <- muEvalAndBind scrut bndr
-- mucgAlts bndr alt_type alts
-- return ()
-- where
-- muEvalAndBind scrut bndr = do
-- mucgExpr scrut
-- muEmitBlock $ toOL [MuStmt (MuComment "bind the thing somewhere")]
--
-- mucgAlts bndr alt_type alts = void $ case alt_type of
-- PolyAlt -> muEmitBlock $ toOL [MuStmt (MuComment "PolyAlt")]
-- UbxTupAlt _ -> muEmitBlock $ toOL [MuStmt (MuComment "UbxAlt")]
-- PrimAlt _ -> muEmitBlock $ toOL [MuStmt (MuComment "PrimAlt")]
-- AlgAlt tycon -> muEmitBlock $ toOL [MuStmt (MuComment "AlgAlt")]
--
--
-- -- Generate the entry code, info tables, and (for niladic constructor)
-- -- the static closure, for a constructor.
-- genDataConstructor :: DataCon -> MuCode ()
-- genDataConstructor _datacon = void $ muEmitBlock $ toOL [MuStmt (MuComment "Inside the data constructor now")]
--
--
-- genTypeConstructors :: TyCon -> MuCode ()
-- genTypeConstructors _tycon = do
-- void $ muEmitBlock $ toOL [MuStmt $ MuComment "Type constructor"]
--
--
-- genModuleInfo :: Module -> MuCode ()
-- genModuleInfo mod = do
-- muEmitTop (ModuleDecl name)
-- where
-- name = moduleNameFS $ moduleName mod
-- |
-- Module : MuCode.CodeGenerator
-- Copyright : nathyong 2016
--
-- Maintainer : nathyong@gmail.com
-- Stability : experimental
-- Portability : unknown
--
-- Code generator monad from Mu Intermediate Representation.
--
-- Uses a "final tagless" DSL for code generation that maps to either a testing
-- semantics built on top of some pure monad, or the real code generation
-- semantics that is used for the compilation process.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module MuCodeGen.CodeGenerator (
) where
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment