GitLab will continue to be upgraded from 11.4.5-ce.0 on November 25th 2019 at 4.00pm (AEDT) to 5.00pm (AEDT) due to Critical Security Patch Availability. During the update, GitLab and Mattermost services will not be available.

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