Commit b8a4abf4 authored by nathyong's avatar nathyong

Implement creation of data types with tags

parent 0bbe7fff
Pipeline #4 failed with stage
in 8 minutes and 54 seconds
......@@ -30,6 +30,8 @@ module Compiler.Mu.CodeGen
, runBlocks
, basicBlock
, assign
, emit
, upTag
, upValue
-- * Code generation
, UnboxedData (..)
......@@ -56,6 +58,8 @@ module Compiler.Mu.CodeGen
, closureTR
, muClosure
, muClosureRef
, muClosureMetadata
, muClosureTag
, muClosureFunction
, muClosureFunctionSig
, haskellData
......@@ -166,7 +170,6 @@ type BlocksWriter = WriterT [Assigned Expression] Blocks
runBlocks :: Blocks a -> Mu (a, Seq BasicBlock)
runBlocks (Blocks code) = do
(a, bstate) <- runStateT code $ BlockState mempty
-- TODO: allocate upvalues
return (a, _blocks bstate)
......@@ -191,18 +194,32 @@ basicBlock n params exprs = do
assign :: Expression -> BlocksWriter VarName
assign expr = do
uid <- lift $ liftBlocks nextMuUnique
let n = fromString ("var" ++ show uid)
let n = fromString ("@var" ++ show uid)
tell $ [[n] := expr]
return n
-- | Run a Mu 'Expression' without binding to anything.
emit :: Expression -> BlocksWriter ()
emit expr = tell $ [[] := expr]
-- | Declare a (constant) tag to be defined at the top level, without
-- clobbering any other upvalues.
upTag :: Int -> BlocksWriter VarName
upTag i = lift . liftBlocks $ do
let n = fromString ("@tag_const_" ++ show i)
constant n muClosureTag (IntCtor (fromIntegral i))
return (VarName $ toName n)
-- | Declare a (constant) value to be defined at the top level.
upValue :: ConstConstructor -> TypedefName -> BlocksWriter ConstantName
upValue :: ConstConstructor -> TypedefName -> BlocksWriter VarName
upValue ctor ty = lift . liftBlocks $ do
uid <- nextMuUnique
let n = fromString ("@upvar" ++ show uid)
constant n ty ctor
return n
return (VarName $ toName n)
-------------------------------------------------- * Code generation
......@@ -379,6 +396,7 @@ loadTypes = do
typedef muString $ Hybrid [] i8
typedef muStringRef $ Ref muString
typedef muClosureMetadata $ MuInt 8
typedef muClosureTag $ MuInt 6
typedef muClosureFunction $ FuncRef muClosureFunctionSig
typedef muClosure $
Hybrid [muClosureFunction, muClosureMetadata, muClosureMetadata]
......@@ -407,6 +425,10 @@ closureTR = "@_closure_tagref"
muClosureMetadata :: TypedefName
muClosureMetadata = "@_closure_metadata"
-- | A tag that can be put on the end of a tagged reference.
muClosureTag :: TypedefName
muClosureTag = "@_closure_tag"
-- | The Mu closure itself.
muClosure :: TypedefName
muClosure = "@_closure"
......
......@@ -25,7 +25,7 @@ import Data.String (fromString)
import Data.Monoid ((<>))
import Literal (Literal(..))
import DataCon (DataCon, dataConWrapId)
import DataCon (DataCon, dataConWrapId, dataConRepRepArity, dataConTag)
import BasicTypes (RecFlag(..))
import Outputable (Outputable, pprTraceIt)
import Language.Haskell.GHC.Simple (ModMetadata(..))
......@@ -78,28 +78,22 @@ codegenEnumerations _tycon = return ()
-- | Generate the static closures for data constructor fields.
codegenDataCon :: DataCon -> Mu ()
codegenDataCon dcon = do
traceShowM ("data con entry", (dataConEntry dcon))
traceShowM ("data con static entry", (dataConEntry dcon))
closure dcon [] $ do
funcdef funcName (Version "1") muClosureFunctionSig $ do
_ <- basicBlock mkClosure
[(mkClosure `dot` "ref", muClosureRef)] $ do
-- TODO: allocate the length of the closure cleanly
cLen <- upValue (IntCtor 7) i64
c <- assign $ NewHybrid muClosure i64 (VarName $ toName cLen) Nothing
cRef <- assign $ GetIRef muClosure c
return $ Return [cRef]
-- The undersaturated and exact application cases are exactly the same,
-- just return the same closure with the arity updated
funcdef funcName (Version "1") muClosureFunctionSig $
basicBlock entry
[(paramName, muClosureRef)] $ do
return $ Return [paramName]
[(this, muClosureRef)] $ do
tag <- upTag (dataConTag dcon)
ref <- assign $ Comminst CiUvmTr64FromRef [] [] [this, tag] Nothing Nothing
return $ Return [ref]
return funcName
where
funcName = dataConEntry dcon
entry = funcName `dot` "entry"
mkClosure = funcName `dot` "mkClosure"
paramName = entry `dot` "param"
exact = funcName `dot` "exact"
this = entry `dot` "this"
-------------------------------------------------- Utilities
......
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