class: center, middle
$$ \begin{aligned} e :=\ & x & \trule{Var} \\ & \lambda x. e & \trule{Lam} \\ & e\ e & \trule{App} \\ \end{aligned} $$
$$ ๐๐๐ a=e ๐๐ b:=(ฮปa.b)e $$
$$\rightarrow$$
$$\forall \alpha -> \forall \alpha$$
data Exp = EVar EVar
| ELit ELit
| EApp Exp Exp
| EAbs EVar Exp
| ELet EVar Exp Exp
deriving (Eq, Ord, Show)
class Substitutable a where
apply โท Subst โ a โ a
freeTvars :: a -> Set.Set TVar
instance Substitutable Type where
apply _ TInt = TInt
apply _ TBool = TBool
apply su t@(TVar a) = Map.findWithDefault t a su
apply su (t1 `TArrow` t2) = apply su t1 `TArrow` apply su t2
freeTvars TInt = Set.empty
freeTvars TBool = Set.empty
freeTvars (TVar a) = Set.singleton a
freeTvars (t1 `TArrow` t2) = freeTvars t1 `Set.union` freeTvars t2
instance Substitutable a โ Substitutable [a] where
apply = map โ apply
freeTvars = (foldr Set.union Set.empty) โ (map freeTvars)
instance Substitutable Scheme where
apply su (Forall as t) = Forall as $ apply s' t
where s' = foldr Map.delete su as
freeTvars (Forall as t) = (freeTvars t) `Set.difference` (Set.fromList as)
instance Substitutable TypeEnv where
apply su (TypeEnv env) = TypeEnv $ Map.map (apply su) env
freeTvars (TypeEnv env) = freeTvars $ Map.elems env
mgu โท MonadError String m โ Type โ Type โ m Subst
mgu (l `TArrow` r) (l' `TArrow` r') = do s1 โ mgu l l'
s2 โ mgu (apply s1 r) (apply s1 r')
return (s1 `after` s2)
mgu (TVar a) t = varAssign a t
mgu t (TVar a) = varAssign a t
mgu TInt TInt = return emptySubst
mgu TBool TBool = return emptySubst
mgu t1 t2 = throwError $ "types do no unify: " โงบ (show t1) โงบ " vs. " โงบ (show t2)
ti โท (MonadState TIState m, MonadError String m) โ TypeEnv โ Exp โ m (Subst, Type)
ti _ (ELit (LInt _)) = return (emptySubst, TInt)
ti _ (ELit (LBool _)) = return (emptySubst, TBool)
ti (TypeEnv env) (EVar x) =โข
case Map.lookup x env of
Nothing โ throwError $ "Unbound Variable: " โงบ show x
Just s โ doโข
v โ instantiate s
return (emptySubst, v)
ti env (EAbs x e) =โข
do tv โ freshTVar "a"
let env' = env โ (x, Forall [] tv)
(s1, t1) โ ti env' e
return (s1, (apply s1 tv) `TArrow` t1)
ti env (EApp e1 e2) =
do tv โ freshTVar "a"
(s1, t1) โ ti env e1
(s2, t2) โ ti (apply s1 env) e2
s3 โ mgu (apply s2 t1) (TArrow t2 tv)
return (s3 `after` s2 `after` s1, apply s3 tv)
$$ฮปxy.(ฮปxz.x+y)$$
ti env (ELet x e1 e2) =
do (s1, t1) โ ti env e1
let env' = apply s1 env
t' = generalize env' t1
(s2, t2) โ ti (env' โ (x, t')) e2
return (s1 `after` s2, t2)
lambda f : (forall A. A -> A). (f Int 1, f String "hello")