~jojo/Carth

426a43633839ccaefee948f4278cb33dc77920f8 — JoJo 1 year, 6 months ago 65d26a1
Use i8* for generic pointer instead of {}*

I haven't actually had any problems due to {}* yet, but LLVM seems to
encourage not pointing to unsized types, so we'll do that.
3 files changed, 19 insertions(+), 21 deletions(-)

M src/Codegen.hs
M src/Extern.hs
M src/Gen.hs
M src/Codegen.hs => src/Codegen.hs +5 -9
@@ 14,7 14,7 @@ import qualified LLVM.AST.Type as LLType
import qualified LLVM.AST.Constant as LLConst
import Data.String
import System.FilePath
import Control.Monad.Writer
import Control.Monad.Writer hiding (void)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set


@@ 23,7 23,7 @@ import Data.Maybe
import Data.Foldable
import Data.List
import Data.Function
import Data.Functor
import Data.Functor hiding (void)
import Data.Bifunctor
import Control.Applicative
import Lens.Micro.Platform (use, assign)


@@ 187,8 187,7 @@ genGlobDef (TypedVar v _, WithPos dpos (ts, (Expr _ e))) = case e of
        (f, gs) <- genFunDef
            (fName, [], dpos, p, genTailExpr body *> genType 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 = simpleGlobVar (mkName name) (typeOf closure) closure
        pure (GlobalDefinition closureDef : GlobalDefinition f : gs)


@@ 279,11 278,8 @@ app tailkind closure a = do
    f <- emitReg "function" =<< extractvalue closure' [1]
    a' <- getLocal a
    let args = [(captures, []), (a', [])]
    fmap VLocal (emitAnonReg (call' f args))
  where
    call' f as = WithRetType
        (callIntern tailkind f as)
        (getFunRet (getPointee (typeOf f)))
    let rt = getFunRet (getPointee (typeOf f))
    fmap VLocal (emitAnonReg (WithRetType (callIntern tailkind f args) rt))

genTailIf :: Expr -> Expr -> Expr -> Gen ()
genTailIf pred' conseq alt = do

M src/Extern.hs => src/Extern.hs +1 -1
@@ 135,7 135,7 @@ genWrapper pos externName rt paramTs =
                        , genWrapper' [firstParam] restParams
                        )
            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 = simpleGlobVar
                    (mkName ("_wrapper_" ++ externName))

M src/Gen.hs => src/Gen.hs +13 -11
@@ 7,15 7,15 @@
--   situations.
module Gen where

import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer hiding (void)
import Control.Monad.State hiding (void)
import Control.Monad.Reader hiding (void)
import Control.Applicative
import qualified Codec.Binary.UTF8.String as UTF8.String
import Data.Map (Map)
import Data.Word
import Data.Foldable
import Data.Functor
import Data.Functor hiding (void)
import Data.List
import Data.String
import Data.Maybe


@@ 159,7 159,7 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
        pure (map GlobalDefinition [defInner, defStr])
    genExtractCaptures = do
        capturesName <- newName "captures"
        let capturesPtrGenericType = LLType.ptr typeUnit
        let capturesPtrGenericType = typeGenericPtr
        let capturesPtrGeneric =
                LocalReference capturesPtrGenericType capturesName
        let capturesParam = (capturesPtrGenericType, capturesName)


@@ 246,7 246,7 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
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


@@ 494,7 494,7 @@ genBuiltins = map

builtins :: Map String ([Parameter], Type)
builtins = Map.fromList
    [ ("carth_alloc", ([Parameter i64 (mkName "size") []], LLType.ptr typeUnit))
    [ ("carth_alloc", ([Parameter i64 (mkName "size") []], typeGenericPtr))
    , ( "carth_str_eq"
      , ( [ Parameter typeStr (mkName "s1") []
          , Parameter typeStr (mkName "s2") []


@@ 538,14 538,13 @@ 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]
    , argumentTypes = [typeGenericPtr, a]
    , isVarArg = False
    }



@@ 691,7 690,7 @@ tconstLookup = Map.lookup . mkName . mangleTConst

lookupDatatype :: Name -> Gen' Type
lookupDatatype x = view (enumTypes . to (Map.lookup x)) >>= \case
    Just 0 -> pure (typeUnit)
    Just 0 -> pure typeUnit
    Just w -> pure (IntegerType w)
    Nothing -> fmap
        (maybe (ice ("Undefined datatype " ++ show x)) typeStruct)


@@ 807,6 806,9 @@ litStructNamed t xs =
litUnit :: Operand
litUnit = ConstantOperand (litStruct [])

typeGenericPtr :: Type
typeGenericPtr = LLType.ptr i8

typeStr :: Type
typeStr = NamedTypeReference (mkName (mangleTConst ("Str", [])))