~jojo/Carth

b29388e4750e873406e37b50605ac0ea6d24225c — JoJo 1 year, 2 months ago 994d023
Make (i8*) the generic ptr type instead of ({}*)

I just think it will play nicer with LLVM. Everything gets messy when
zero-sized types are involved.
5 files changed, 18 insertions(+), 17 deletions(-)

M src/Codegen.hs
M src/Extern.hs
M src/Gen.hs
M src/Inferred.hs
M src/TypeAst.hs
M src/Codegen.hs => src/Codegen.hs +3 -5
@@ 194,16 194,15 @@ defineDataTypes datasEnums = do

genMain :: Gen' Definition
genMain = do
    let tDummyCaptures = LLType.ptr typeUnit
    let tDummyParam = typeUnit
    let init_ = ConstantOperand $ LLConst.GlobalReference
            (LLType.ptr (FunctionType LLType.void [tDummyCaptures, tDummyParam] False))
            (LLType.ptr (FunctionType LLType.void [typeGenericPtr, tDummyParam] False))
            (mkName "carth_init")
    assign currentBlockLabel (mkName "entry")
    assign currentBlockInstrs []
    Out basicBlocks _ _ _ <- execWriterT $ do
        emitDo' =<< callBuiltin "install_stackoverflow_handler" []
        emitDo (callIntern Nothing init_ [(null' tDummyCaptures, []), (litUnit, [])])
        emitDo (callIntern Nothing init_ [(null' typeGenericPtr, []), (litUnit, [])])
        f <- lookupVar (TypedVar "main" mainType)
        _ <- app Nothing f (VLocal litUnit)
        commitFinalFuncBlock (ret (litI32 0))


@@ 245,8 244,7 @@ genGlobFunDef (TypedVar v _, WithPos dpos (ts, (p, (body, rt)))) = do
    let fName = mkName (name ++ "_func")
    (f, gs) <- genFunDef (fName, [], dpos, p, genTailExpr body *> genRetType rt)
    let fRef = LLConst.GlobalReference (LLType.ptr (typeOf f)) fName
    let capturesType = LLType.ptr typeUnit
    let captures = LLConst.Null capturesType
    let captures = LLConst.Null typeGenericPtr
    let closure = litStruct [captures, fRef]
    let closureDef = simpleGlobConst (mkName name) (typeOf closure) closure
    pure (GlobalDefinition closureDef : GlobalDefinition f : gs)

M src/Extern.hs => src/Extern.hs +1 -1
@@ 101,7 101,7 @@ genWrapper pos externName rt = \case
        (f, gs) <- locallySet srcPos (Just pos)
            $ genFunDef (fname, [], pos, firstParam, genWrapper' [firstParam] restParamTs)
        let fref = LLConst.GlobalReference (LLType.ptr (typeOf f)) fname
        let captures = LLConst.Null (LLType.ptr typeUnit)
        let captures = LLConst.Null typeGenericPtr
        let closure = litStruct [captures, fref]
        let closureDef = simpleGlobConst (mkName ("_wrapper_" ++ externName))
                                         (typeOf closure)

M src/Gen.hs => src/Gen.hs +10 -10
@@ 158,16 158,15 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
            defInner =
                simpleGlobConst name_inner tInner (LLConst.Array i8 (map litI8' bytes))
            inner = LLConst.GlobalReference (LLType.ptr tInner) name_inner
            ptrBytes = LLConst.BitCast inner (LLType.ptr i8)
            ptrBytes = LLConst.BitCast inner typeGenericPtr
            array = litStructNamed ("Array", [M.TPrim (TNat 8)]) [ptrBytes, litI64' len]
            str = litStructNamed ("Str", []) [array]
            defStr = simpleGlobConst strName typeStr str
        pure (map GlobalDefinition [defInner, defStr])
    genExtractCaptures = do
        capturesName <- newName "captures"
        let capturesPtrGenericType = LLType.ptr typeUnit
        let capturesPtrGeneric = LocalReference capturesPtrGenericType capturesName
        let capturesParam = (capturesPtrGenericType, capturesName)
        let capturesPtrGeneric = LocalReference typeGenericPtr capturesName
        let capturesParam = (typeGenericPtr, capturesName)
        fmap (capturesParam, ) $ if null fvs
            then pure []
            else do


@@ 260,7 259,7 @@ genWrapInLambdas rt fvs pts genBody = case pts of
genLambda :: [TypedVar] -> TypedVar -> (Gen (), Type) -> Gen Val
genLambda fvXs p body = do
    captures <- if null fvXs
        then pure (null' (LLType.ptr typeUnit))
        then pure (null' typeGenericPtr)
        else do
            tcaptures <- fmap typeStruct (mapM (\(TypedVar _ t) -> genType t) fvXs)
            captures' <- genHeapAllocGeneric tcaptures


@@ 851,14 850,12 @@ genDatatypeRef = NamedTypeReference . mkName . mangleTConst
--   actual function, which takes as first parameter the captures-pointer, and
--   as second parameter the argument.
closureType :: Type -> Type -> Type
closureType a r = typeStruct [LLType.ptr typeUnit, LLType.ptr (closureFunType a r)]
closureType a r = typeStruct [typeGenericPtr, LLType.ptr (closureFunType a r)]

-- The type of the function itself within the closure
closureFunType :: Type -> Type -> Type
closureFunType a r = FunctionType { resultType = r
                                  , argumentTypes = [LLType.ptr typeUnit, a]
                                  , isVarArg = False
                                  }
closureFunType a r =
    FunctionType { resultType = r, argumentTypes = [typeGenericPtr, a], isVarArg = False }

genCapturesType :: [M.TypedVar] -> Gen Type
genCapturesType = fmap typeStruct . mapM (\(M.TypedVar _ t) -> genType t)


@@ 1205,6 1202,9 @@ typeStr = NamedTypeReference (mkName (mangleTConst TypeAst.tStr'))
typeBool :: Type
typeBool = i8

typeGenericPtr :: Type
typeGenericPtr = LLType.ptr i8

typeUnit :: Type
typeUnit = typeStruct []


M src/Inferred.hs => src/Inferred.hs +1 -1
@@ 135,7 135,7 @@ ftv = \case
builtinExterns :: Map String (Type, SrcPos)
builtinExterns = Map.fromList $ map
    (second (, SrcPos "<builtin>" 0 0))
    [("GC_malloc", tfun (TPrim TIntSize) (TBox tUnit))]
    [("GC_malloc", tfun (TPrim TIntSize) (TBox tByte))]

builtinVirtuals :: Map String Scheme
builtinVirtuals =

M src/TypeAst.hs => src/TypeAst.hs +3 -0
@@ 30,6 30,9 @@ class TypeAst t where
mainType :: TypeAst t => t
mainType = tfun tUnit tUnit

tByte :: TypeAst t => t
tByte = tprim (TNat 8)

tBox' :: t -> TConst t
tBox' t = ("Box", [t])