Remove parenthesis from EAnn

This commit is contained in:
Martin Fredin 2023-04-11 13:46:54 +02:00
parent a109b3010d
commit 9730552eab
2 changed files with 36 additions and 36 deletions

View file

@ -42,15 +42,15 @@ Inj. Inj ::= UIdent ":" Type ;
-- * Expressions -- * Expressions
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
EAnn. Exp4 ::= "(" Exp ":" Type ")"; EVar. Exp4 ::= LIdent;
EVar. Exp3 ::= LIdent; EInj. Exp4 ::= UIdent;
EInj. Exp3 ::= UIdent; ELit. Exp4 ::= Lit;
ELit. Exp3 ::= Lit; EApp. Exp3 ::= Exp3 Exp4;
EApp. Exp2 ::= Exp2 Exp3; EAdd. Exp2 ::= Exp2 "+" Exp3;
EAdd. Exp1 ::= Exp1 "+" Exp2; ELet. Exp1 ::= "let" Bind "in" Exp1;
ELet. Exp ::= "let" Bind "in" Exp; EAbs. Exp1 ::= "\\" LIdent "." Exp1;
EAbs. Exp ::= "\\" LIdent "." Exp; ECase. Exp1 ::= "case" Exp "of" "{" [Branch] "}";
ECase. Exp ::= "case" Exp "of" "{" [Branch] "}"; EAnn. Exp ::= Exp1 ":" Type;
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- * LITERALS -- * LITERALS

View file

@ -8,11 +8,14 @@ module TypeChecker.TypeCheckerBidir (typecheck, getVars) where
import Auxiliary (int, liftMM2, litType, import Auxiliary (int, liftMM2, litType,
maybeToRightM, onM, onMM, snoc) maybeToRightM, onM, onMM, snoc)
import Control.Applicative (Applicative (liftA2), (<|>)) import Control.Applicative (Alternative, Applicative (liftA2),
(<|>))
import Control.Monad.Except (ExceptT, MonadError (throwError), import Control.Monad.Except (ExceptT, MonadError (throwError),
runExceptT, unless, zipWithM, runExceptT, unless, zipWithM,
zipWithM_) zipWithM_)
import Control.Monad.State (State, evalState, gets, modify) import Control.Monad.Extra (fromMaybeM, maybeM)
import Control.Monad.State (MonadState, State, evalState, gets,
modify)
import Data.Coerce (coerce) import Data.Coerce (coerce)
import Data.Function (on) import Data.Function (on)
import Data.List (intercalate) import Data.List (intercalate)
@ -57,8 +60,8 @@ data Cxt = Cxt
, data_injs :: Map UIdent Type -- ^ Data injections (constructors) K/inj : A , data_injs :: Map UIdent Type -- ^ Data injections (constructors) K/inj : A
} deriving (Show, Eq) } deriving (Show, Eq)
type Tc a = ExceptT String (State Cxt) a newtype Tc a = Tc { runTc :: ExceptT String (State Cxt) a }
-- deriving (Functor, Applicative, Monad, Alternative, MonadState Cxt, MonadError String) deriving (Functor, Applicative, Monad, MonadState Cxt, MonadError String)
initCxt :: [Def] -> Cxt initCxt :: [Def] -> Cxt
@ -95,7 +98,7 @@ typecheck (Program defs) = do
typecheckBinds :: Cxt -> [Bind] -> Err [T.Bind' Type] typecheckBinds :: Cxt -> [Bind] -> Err [T.Bind' Type]
typecheckBinds cxt = flip evalState cxt typecheckBinds cxt = flip evalState cxt
. runExceptT . runExceptT
-- . runTc . runTc
. mapM typecheckBind . mapM typecheckBind
typecheckBind :: Bind -> Tc (T.Bind' Type) typecheckBind :: Bind -> Tc (T.Bind' Type)
@ -191,12 +194,10 @@ check exp typ
putEnv env_l putEnv env_l
pure (T.EAbs (coerce name) e', typ) pure (T.EAbs (coerce name) e', typ)
| otherwise = subsumption
where
-- Γ,α ⊢ e ↓ A ⊣ Θ Θ ⊢ [Θ]A <: [Θ]B ⊣ Δ -- Γ,α ⊢ e ↓ A ⊣ Θ Θ ⊢ [Θ]A <: [Θ]B ⊣ Δ
-- -------------------------------------- Sub -- -------------------------------------- Sub
-- Γ ⊢ e ↑ B ⊣ Δ -- Γ ⊢ e ↑ B ⊣ Δ
subsumption = do | otherwise = do
(exp', t) <- infer exp (exp', t) <- infer exp
typ' <- apply typ typ' <- apply typ
subtype t typ' subtype t typ'
@ -210,18 +211,16 @@ infer = \case
ELit lit -> pure (T.ELit lit, litType lit) ELit lit -> pure (T.ELit lit, litType lit)
-- Γ ∋ (x : A) Γ ∌ (x : A) -- Γ ∋ (x : A) Γ ∌ (x : A)
-- ------------- Var --------------- Var' -- ------------- Var --------------------- Var'
-- Γ ⊢ x ↓ A ⊣ Γ Γ ⊢ x ↓ ά ⊣ Γ,ά -- Γ ⊢ x ↓ A ⊣ Γ Γ ⊢ x ↓ ά ⊣ Γ,(x : ά)
EVar name -> do EVar x -> do
t <- liftA2 (<|>) (lookupEnv name) (lookupSig name) >>= \case t <- fromMaybeM extend $ liftA2 (<|>) (lookupEnv x) (lookupSig x)
Just t -> pure t apply (T.EVar (coerce x), t)
Nothing -> do where
tevar <- fresh extend = do
insertEnv (EnvTEVar tevar) t <- TEVar <$> fresh
let t = TEVar tevar insertEnv (EnvVar x t)
insertEnv (EnvVar name t)
pure t pure t
apply (T.EVar (coerce name), t)
EInj name -> do EInj name -> do
t <- maybeToRightM ("Unknown constructor: " ++ show name) t <- maybeToRightM ("Unknown constructor: " ++ show name)
@ -320,7 +319,9 @@ applyInfer typ exp = case typ of
-- Γ ⊢ e ↑ A ⊣ Δ -- Γ ⊢ e ↑ A ⊣ Δ
-- --------------------- →App -- --------------------- →App
-- Γ ⊢ A → C • e ⇓ C ⊣ Δ -- Γ ⊢ A → C • e ⇓ C ⊣ Δ
TFun t1 t2 -> (, t2) <$> check exp t1 TFun t1 t2 -> do
exp' <- check exp t1
apply (exp', t2)
_ -> throwError ("Cannot apply type " ++ show typ ++ " with expression " ++ show exp) _ -> throwError ("Cannot apply type " ++ show typ ++ " with expression " ++ show exp)
@ -336,7 +337,6 @@ applyInfer typ exp = case typ of
inferBranches :: [Branch] -> Type -> Tc ([T.Branch' Type], Type) inferBranches :: [Branch] -> Type -> Tc ([T.Branch' Type], Type)
inferBranches branches t_patt = do inferBranches branches t_patt = do
(branches', ts_exp) <- inferBranches' t_patt branches (branches', ts_exp) <- inferBranches' t_patt branches
traceTs "TYPES " ts_exp
t_exp <- case ts_exp of t_exp <- case ts_exp of
[] -> pure t_patt [] -> pure t_patt
t:_ -> do t:_ -> do