~jojo/Carth

19a334cde38b361bdbd332f7cbd134c50992d241 — JoJo 1 year, 6 months ago fadaf69
Revert "Use i8* for generic pointer instead of {}*"

This reverts commit 426a43633839ccaefee948f4278cb33dc77920f8.
3 files changed, 21 insertions(+), 19 deletions(-)

M src/Codegen.hs
M src/Extern.hs
M src/Gen.hs
M src/Codegen.hs => src/Codegen.hs +9 -5
@@ 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 hiding (void)
import Control.Monad.Writer
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 hiding (void)
import Data.Functor
import Data.Bifunctor
import Control.Applicative
import Lens.Micro.Platform (use, assign)


@@ 187,7 187,8 @@ 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 captures = LLConst.Null typeGenericPtr
        let capturesType = LLType.ptr typeUnit
        let captures = LLConst.Null capturesType
        let closure = litStruct [captures, fRef]
        let closureDef = simpleGlobVar (mkName name) (typeOf closure) closure
        pure (GlobalDefinition closureDef : GlobalDefinition f : gs)


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

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 typeGenericPtr
            let captures = LLConst.Null (LLType.ptr typeUnit)
            let closure = litStruct [captures, fref]
            let closureDef = simpleGlobVar
                    (mkName ("_wrapper_" ++ externName))

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

import Control.Monad.Writer hiding (void)
import Control.Monad.State hiding (void)
import Control.Monad.Reader hiding (void)
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Reader
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 hiding (void)
import Data.Functor
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 = typeGenericPtr
        let capturesPtrGenericType = LLType.ptr typeUnit
        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' typeGenericPtr)
        then pure (null' (LLType.ptr typeUnit))
        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") []], typeGenericPtr))
    [ ("carth_alloc", ([Parameter i64 (mkName "size") []], LLType.ptr typeUnit))
    , ( "carth_str_eq"
      , ( [ Parameter typeStr (mkName "s1") []
          , Parameter typeStr (mkName "s2") []


@@ 538,13 538,14 @@ 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 [typeGenericPtr, LLType.ptr (closureFunType a r)]
closureType a r =
    typeStruct [LLType.ptr typeUnit, 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 = [typeGenericPtr, a]
    , argumentTypes = [LLType.ptr typeUnit, a]
    , isVarArg = False
    }



@@ 690,7 691,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)


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

typeGenericPtr :: Type
typeGenericPtr = LLType.ptr i8

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