Commit 86d6b8af authored by Pavel Zakopaylo's avatar Pavel Zakopaylo

Commented out enough code for it to compile

parent 6d920c5d
Pipeline #481 failed with stages
......@@ -35,12 +35,12 @@ import DataCon (DataCon, dataConWrapId, dataConRepRepArity, dataConTag, isUnboxe
import BasicTypes (RecFlag(..))
import Outputable (Outputable, pprTraceIt)
import Language.Haskell.GHC.Simple (ModMetadata(..))
import GHC (ModSummary(..))
import GHC (ModSummary(..), Id)
import DynFlags (DynFlags)
import TyCon (TyCon, isEnumerationTyCon, tyConDataCons)
import StgSyn
(StgBinding, GenStgBinding(..), StgRhs, GenStgRhs(..), StgArg,
GenStgArg(..), StgExpr, GenStgExpr(..), UpdateFlag(..))
--(StgBinding, GenStgBinding(..), StgRhs, GenStgRhs(..), StgArg,
--GenStgArg(..), StgExpr, GenStgExpr(..), UpdateFlag(..), AltType)
import qualified GHC as GHC
import qualified Literal as Lit
......@@ -81,7 +81,8 @@ codegenType tycon = do
-- | Generate the static reference code for the entries of enumerated data
-- types.
codegenEnumerations :: TyCon -> Mu ()
codegenEnumerations _tycon = mapM_ go (tyConDataCons tycon)
-- TODO: The lambda was previously a function called "go".
codegenEnumerations _tycon = mapM_ (\x -> return ()) (tyConDataCons _tycon)
-- | Generate the static closures for data constructor fields.
......@@ -101,53 +102,53 @@ codegenDataCon dcon = do
entry = funcName `dot` "entry"
this = entry `dot` "this"
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 ()
--mucgCase :: StgExpr -> Id -> AltType -> [StgAlt] -> Mu ()
--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 ()
-- 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")]
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
cgTopRhsCon :: DataCon -> [StgArg] -> (MuBindInfo, MuCode ())
cgTopRhsCon 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"]
-- _ <- 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")]
--genBinding :: RecFlag -> Id -> StgRhs -> Mu ()
--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
--cgTopRhsCon :: DataCon -> [StgArg] -> (MuBindInfo, Mu ())
--cgTopRhsCon 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"]
-------------------------------------------------- Utilities
......@@ -202,9 +203,10 @@ closureBody name vars body = do
funcName = entryNameOf name
mucgExpr :: StgExpr -> MuCode ()
mucgExpr :: StgExpr -> Mu ()
mucgExpr body = void $ case body of
StgApp fun args -> do
return () -- TODO: Fix, obviously..
-- -- _ <- muEmitBlock $ toOL [MuStmt (MuComment "StgApp")]
-- -- _ <- muEmitBlock $ toOL [MuStmt (MuFunCall fun args)]
-- -- return ""
......@@ -297,20 +299,20 @@ mkClosure' target args = do
-- | Generate code for constructor applications at the top level.
cgTopRhsCon :: DataCon -> Id -> [StgArg] -> (MuBindInfo, MuCode ())
cgTopRhsCon con bndr args = (info, code)
where
info = MuBindInfo bndr
get_lit arg =
seq (pprTraceIt "cgTopRhsCon" bndr) $
case arg of
StgVarArg var -> MuLabel var
StgLitArg lit ->
case cgLit lit of
MuLit l -> l
code = do
let payload = map get_lit args
emitGroup bndr [] (dataConWrapId con) payload
--cgTopRhsCon' :: DataCon -> Id -> [StgArg] -> (MuBindInfo, Mu ())
--cgTopRhsCon' con bndr args = (info, code)
-- where
-- info = MuBindInfo bndr
-- get_lit arg =
-- seq (pprTraceIt "cgTopRhsCon" bndr) $
-- case arg of
-- StgVarArg var -> MuLabel var
-- StgLitArg lit ->
-- case cgLit lit of
-- MuLit l -> l
-- code = do
-- let payload = map get_lit args
-- emitGroup bndr [] (dataConWrapId con) payload
instance Show Var.Var where
......@@ -381,7 +383,7 @@ placeholderBlocks n = do
retVal = bbName `dot` "ret"
-- -- | Generate code for constructor applications at the top level.
-- cgTopRhsCon :: DataCon -> Id -> [StgArg] -> (MuBindInfo, MuCode ())
-- cgTopRhsCon :: DataCon -> Id -> [StgArg] -> (MuBindInfo, MuBuilder ())
-- cgTopRhsCon con bndr args = (info, code)
-- where
-- info = MuBindInfo bndr
......@@ -402,21 +404,21 @@ placeholderBlocks n = do
-- -> UpdateFlag
-- -> [Id]
-- -> StgExpr
-- -> (MuBindInfo, MuCode ())
-- -> (MuBindInfo, MuBuilder ())
-- cgTopRhsClosure flag bndr updateflag args body =
-- seq (pprTraceIt "cgTopRhsClosure" bndr) $ (bindInfo, genCode)
-- where
-- bindInfo = MuBindInfo bndr
-- genCode = forkMuClosure bndr (cgExpr body)
--
-- cgExpr :: StgExpr -> MuCode ()
-- cgExpr :: StgExpr -> MuBuilder ()
-- cgExpr expr =
-- case expr of
-- StgLit lit -> void $ emitReturn (cgLit lit)
-- StgApp fn args -> error "StgApp not implemented"
-- _ -> error "not implemented"
--
-- emitReturn :: MuExpr -> MuCode Id
-- emitReturn :: MuExpr -> MuBuilder Id
-- emitReturn results = emitBlock [] (MuReturn results)
--
-- -- | Convert literals into Mu literals.
......
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