~jojo/Carth

b7e3f996f3552ae6bffa70ace80cbce5e64af97f — JoJo 1 year, 10 months ago 4f9693e
Ptr -> Box
8 files changed, 16 insertions(+), 16 deletions(-)

M src/Ast.hs
M src/Check.hs
M src/Codegen.hs
M src/Match.hs
M src/Mono.hs
M src/MonoAst.hs
M src/Parse.hs
M src/Subst.hs
M src/Ast.hs => src/Ast.hs +2 -2
@@ 69,7 69,7 @@ data Type
    | TPrim TPrim
    | TConst TConst
    | TFun Type Type
    | TPtr Type
    | TBox Type
    deriving (Show, Eq, Ord)

data Scheme = Forall


@@ 311,7 311,7 @@ prettyType = \case
    Ast.TVar tv -> pretty tv
    Ast.TPrim c -> pretty c
    Ast.TFun a b -> prettyTFun a b
    Ast.TPtr t -> "(Ptr " ++ pretty t ++ ")"
    Ast.TBox t -> "(Box " ++ pretty t ++ ")"
    Ast.TConst (c, ts) -> case ts of
        [] -> c
        ts -> concat ["(", c, " ", spcPretty ts, ")"]

M src/Check.hs => src/Check.hs +2 -2
@@ 189,7 189,7 @@ builtinDataTypes' :: [(String, [TVar], [(String, [Type])])]
builtinDataTypes' =
    [ ( "Array"
      , [TVImplicit 0]
      , [("Array", [TPtr (TVar (TVImplicit 0)), TPrim TNat])]
      , [("Array", [TBox (TVar (TVImplicit 0)), TPrim TNat])]
      )
    , ("Str", [], [("Str", [TConst ("Array", [TPrim TNat8])])])
    ]


@@ 475,7 475,7 @@ ftv = \case
    TVar tv -> Set.singleton tv
    TPrim _ -> Set.empty
    TFun t1 t2 -> Set.union (ftv t1) (ftv t2)
    TPtr t -> ftv t
    TBox t -> ftv t
    TConst (_, ts) -> Set.unions (map ftv ts)

ftvEnv :: Env -> Set TVar

M src/Codegen.hs => src/Codegen.hs +2 -2
@@ 324,7 324,7 @@ toLlvmType = \case
        TChar -> i32
        TBool -> typeBool
    TFun a r -> toLlvmClosureType a r
    TPtr t -> LLType.ptr (toLlvmType t)
    TBox t -> LLType.ptr (toLlvmType t)
    TConst t -> typeNamed (mangleTConst t)

-- | A `Fun` is a closure, and follows a certain calling convention


@@ 893,7 893,7 @@ mangleType :: MonoAst.Type -> String
mangleType = \case
    TPrim c -> pretty c
    TFun p r -> mangleTConst ("->", [p, r])
    TPtr t -> mangleTConst ("*", [t])
    TBox t -> mangleTConst ("*", [t])
    TConst tc -> mangleTConst tc

mangleTConst :: TConst -> String

M src/Match.hs => src/Match.hs +1 -1
@@ 111,7 111,7 @@ missingPat t descr = case t of
        vs <- views tdefs (fromJust . Map.lookup tx)
        missingPat' vs descr
    TFun _ _ -> pure "_"
    TPtr _ -> pure "_"
    TBox _ -> pure "_"

missingPat' :: [String] -> Descr -> Match String
missingPat' vs = \case

M src/Mono.hs => src/Mono.hs +3 -4
@@ 146,13 146,13 @@ bindTvs :: An.Type -> Type -> Map TVar Type
bindTvs a b = case (a, b) of
    (An.TVar v, t) -> Map.singleton v t
    (An.TFun p0 r0, TFun p1 r1) -> Map.union (bindTvs p0 p1) (bindTvs r0 r1)
    (An.TPtr t0, TPtr t1) -> bindTvs t0 t1
    (An.TBox t0, TBox t1) -> bindTvs t0 t1
    (An.TPrim _, TPrim _) -> Map.empty
    (An.TConst (_, ts0), TConst (_, ts1)) ->
        Map.unions (zipWith bindTvs ts0 ts1)
    (An.TPrim _, _) -> err
    (An.TFun _ _, _) -> err
    (An.TPtr _, _) -> err
    (An.TBox _, _) -> err
    (An.TConst _, _) -> err
    where err = ice $ "bindTvs: " ++ show a ++ ", " ++ show b



@@ 161,7 161,7 @@ monotype = \case
    An.TVar v -> views tvBinds (lookup' (ice (show v ++ " not in tvBinds")) v)
    An.TPrim c -> pure (TPrim c)
    An.TFun a b -> liftA2 TFun (monotype a) (monotype b)
    An.TPtr t -> fmap TPtr (monotype t)
    An.TBox t -> fmap TBox (monotype t)
    An.TConst (c, ts) -> do
        ts' <- mapM monotype ts
        let tdefInst = (c, ts')


@@ 171,7 171,6 @@ monotype = \case
insertInst :: String -> Type -> Expr -> Mono ()
insertInst x t b = modifying defInsts (Map.adjust (Map.insert t b) x)

-- insts :: Set TConst
instTypeDefs :: An.TypeDefs -> Mono TypeDefs
instTypeDefs tdefs = do
    insts <- uses tdefInsts Set.toList

M src/MonoAst.hs => src/MonoAst.hs +1 -1
@@ 38,7 38,7 @@ type TConst = (String, [Type])
data Type
    = TPrim TPrim
    | TFun Type Type
    | TPtr Type
    | TBox Type
    | TConst TConst
    deriving (Show, Eq, Ord)


M src/Parse.hs => src/Parse.hs +4 -3
@@ 245,7 245,7 @@ ptype :: Parser Type
ptype = parens ptype'

ptype' :: Parser Type
ptype' = tfun <|> tapp <|> tptr
ptype' = tfun <|> tbox <|> tapp

tapp :: Parser Type
tapp = liftA2 (TConst .* (,)) big (some type_)


@@ 257,8 257,8 @@ tfun = do
    ts <- some type_
    pure (foldr1 TFun (t : ts))

tptr :: Parser Type
tptr = reserved "Ptr" *> fmap TPtr type_
tbox :: Parser Type
tbox = reserved "Box" *> fmap TBox type_

ns_tprim :: Parser TPrim
ns_tprim = try $ do


@@ 362,6 362,7 @@ reserveds :: [String]
reserveds =
    [ ":"
    , "Fun"
    , "Box"
    , "define"
    , "define:"
    , "extern"

M src/Subst.hs => src/Subst.hs +1 -1
@@ 62,7 62,7 @@ subst s t = case t of
    TVar tv -> fromMaybe t (Map.lookup tv s)
    TPrim _ -> t
    TFun a b -> TFun (subst s a) (subst s b)
    TPtr a -> TPtr (subst s a)
    TBox a -> TBox (subst s a)
    TConst (c, ts) -> TConst (c, (map (subst s) ts))

composeSubsts :: Subst -> Subst -> Subst