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

@@ 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)

@@ 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)

@@ 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 []
 

@@ 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 =

@@ 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])