230 likes | 378 Views
Advanced Functional Programming. Tim Sheard Oregon Graduate Institute of Science & Technology. Lecture 5: Algorithms for Hindley-Milner type Inference. Type inference and Hindley-Milner. How is type inference done? Structural recursion over a term.
E N D
Advanced Functional Programming • Tim Sheard • Oregon Graduate Institute of Science & Technology • Lecture 5: • Algorithms for Hindley-Milner type Inference
Type inference and Hindley-Milner • How is type inference done? • Structural recursion over a term. • Uses an environment which maps variables to their types • Returns a computation in a monad • type infer :: Exp -> Env -> M Type • What does the Env look like • partial function from Name -> Scheme • Scheme is an encoding of a Hindley-Milner polymorphic type. All the forall's to the outermost position. • Often implemented as a list
The Inference Monad • newtype IM a x = • Ck (Int -> (ST a (x, String, Int))) • instance Functor (IM a) where • fmap f (Ck g) = Ck h • where h n = do { (x, out, n') <- g n • ; return (f x,out,n') • } • instance Monad (IM a) where • return x = Ck h • where h n = return (x, "", n) • (Ck g) >>= f = Ck ff • where ff n = do { (a, out1, n1) <- g n • ; let (Ck h) = f a • ; (y, out2, n2) <- h n1 • ; return (y, out1 ++ out2, n2)}
Interface to IM • readVar :: STRef a b -> IM a b • readVar ref = Ck f • where f n = do { z <- readSTRef ref • ; return (z, "", n) } • newVar :: x -> IM a (STRef a x) • newVar init = Ck f • where f n = do { z <- newSTRef init • ; return (z, "", n) } • writeVar :: STRef a b -> b -> IM a () • writeVar ref value = Ck f • where f n = do { z <- writeSTRef ref value • ; return (z, "", n) } • nextN :: IM a Int • nextN = Ck f • where f n = return (n, "", n+1)
Escaping the monad • Since the monad is a variant of the state monad we need to escape from it: • runIM :: (forall a . IM a c) -> Int -> (c,String,Int) • runIM w n = let (Ck f) = w in runST (f n) • force :: (forall a . IM a c) -> c • force w = • case (runIM w) 0 of • (x, _, _) -> x • Note the use of Rank 2 polymorphism
Representing Types • data Type a = • Tunit • | Tarrow (Type a) (Type a) • | Ttuple [ Type a ] • | Tdata String [ Type a ] • | Tgen Int • | Tvar (STRef a (Maybe (Type a))) • data Scheme a = Sch [Int] (Type a) • forall a,b . (a,b) = • Sch [1,2] (Ttuple [ Tgen 1, Tgen 2 ])
Handling Errors • class Error a b where • occursCk :: Type a -> Type a -> IM a b • nameMtch:: Type a -> Type a -> IM a b • shapeMtch:: Type a -> Type a -> IM a b • tupleLenMtch:: Type a -> Type a -> IM a b
Unification • unify :: Error a [String] => Type a -> Type a -> IM a [String] • unify tA tB = • do { t1 <- prune1 tA • ; t2 <- prune1 tB • ; case (t1,t2) of • (Tvar r1,Tvar r2) -> -- Both are Variables • if r1==r2 • then return [] • else do { writeVar r1 (Just t2); return []} • (Tvar r1,_) -> -- One is a Variable • do { b <- occursIn1 r1 t2 • ; if b then occursCk t1 t2 • else do { writeVar r1 (Just t2) • ; return [] } • } • (_,Tvar r2) -> unify t2 t1
Unification 2 • ; case (t1,t2) of . . . • (Tgen s, Tgen t) -> • if s==t then return [] else (nameMtch t1 t2) • (Tarrow x y,Tarrow m n) -> • do { cs1 <- unify x m • ; cs2 <- unify y n • ; return (cs1 ++ cs2) • } • (Ttuple xs, Ttuple ys) -> • if (length xs) == (length ys) • then do { xss <- sequence • (fmap (uncurry unify) (zip xs ys)) • ; return (concat xss) } • else tupleLenMtch t1 t2 • (_,_) -> (shapeMtch t1 t2) • }
Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tuple[ X, Y] Tuple[ X, Y] Operations on Types • prune1 (typ @ (Tvar ref)) = • do { m <- readVar ref • ; case m of • Just t -> do { newt <- prune1 t • ; writeVar ref (Just newt) • ; return newt • } • Nothing -> return typ • } • prune1 typ = return typ
Does a ref occur in a type? • occursIn1 r t = • do { t2 <- prune1 t • ; case t2 of • Tunit -> return False • Tarrow x y -> • do { b1 <- occursIn1 r x • ; b2 <- occursIn1 r y • ; return ((||) b1 b2 ) } • Ttuple xs -> • do { bs <- sequence (map (occursIn1 r) xs) • ; return (or bs)} • Tdata name xs -> • do { bs <- sequence (map (occursIn1 r) xs) • ; return (or bs)} • Tgen s -> return False • Tvar z -> return(r == z) • }
Generalizing • We need to look through a type, and replace all generalizable TVar's with consistent Tgen's • A TVar is generalizable if its isn't bound to something. I.e. Tvar ref and • do { x <- readVar ref • ; case x of Nothing -> .... • and its not mentioned in the outer environment. • Keep a list of pairs, pairing known generalizable Tvar's and their unique Int
Finding unique Ints • genVar :: Tref a -> [(Tref a,Int)] -> • IM a (Type a,[(Tref a,Int)]) • genVar r [] = do { n <- nextN • ; return (Tgen n,[(r,n)]) } • genVar r (ps @ ((p @ (r1,n)):more)) = • if r1==r then return (Tgen n,ps) • else do { (t,ps2) <- genVar r more • ; return (t,p:ps2)} • Note we return the new extended list as well as the type (Tgen n) that corresponds to the Tvar reference
Putting it all together • gen :: (Tref a -> IM a Bool) -> Type a -> [(Tref a,Int)] -> IM a (Type a,[(Tref a,Int)]) • gen pred t pairs = • do { t1 <- prune1 t • ; case t1 of • Tvar r -> do { b <- pred r • ; if b then genVar r pairs • else return(t1,pairs)} • Tgen n -> return(t1,pairs) • Tunit -> return(t1,pairs) • Tarrow x y -> • do { (x',p1) <- gen pred x pairs • ; (y',p2) <- gen pred y p1 • ; return (Tarrow x' y',p2)} • Ttuple ts -> do { (ts',p) <- thread pred ts pairs • ; return (Ttuple ts',p) } • Tdata c ts -> do { (ts',p) <- thread pred ts pairs • ; return (Tdata c ts',p) } • }
Finishing up generalization • thread p [] pairs = return ([],pairs) • thread p (t:ts) pairs = • do { (t',p1) <- gen p t pairs • ; (ts',p2) <- thread p ts p1 • ; return(t':ts',p2) • } • generalize :: (Tref a -> IM a Bool) • -> Type a -> IM a (Scheme a) • generalize p t = • do { (t',pairs) <- gen p t [] • ; return(Sch (map snd pairs) t') • }
Instantiation • freshVar = do { r <- newVar Nothing • ; return (Tvar r) } • -- Sch [1] (Tarrow (Tgen 1) (Ttuple [Tvar a, Tgen 1])) • instantiate (Sch ns t) = • do { ts <- sequence(map (\ _ -> freshVar) ns) • ; let sub = zip ns ts • ; subGen sub t • } g (x::a) = let f :: forall b . b -> (a,b) f = \ y -> (x,y) w1 = f "z" w2 = f True in (x,f)
Substituting (Tgen n) for T • subGen sub t = • do { t2 <- prune1 t • ; case t2 of • Tunit -> return Tunit • Tarrow x y -> • do { b1 <- subGen sub x • ; b2 <- subGen sub y • ; return (Tarrow b1 b2)} • Ttuple xs -> • do { bs <- sequence (map (subGen sub) xs) • ; return (Ttuple bs)} • Tdata name xs -> • do { bs <- sequence (map (subGen sub) xs) • ; return (Tdata name bs)} • Tgen s -> return(find s sub) • Tvar z -> return(Tvar z) • }
Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tvar(Just _ ) Tuple[ X, Y] Tuple[ X, Y] Note the pattern • Before we do a case analysis we always prune. • gen pred t pairs = • do { t1 <- prune1 t • ; case t1 of . . . • occursIn1 r t = • do { t2 <- prune1 t • ; case t2 of . . . • unify tA tB = • do { t1 <- prune1 tA • ; t2 <- prune1 tB • ; case (t1,t2) of . . . • subGen sub t = • do { t2 <- prune1 t • ; case t2 of
Type inference • Representing programs • data Exp • = App Exp Exp • | Abs String Exp • | Var String • | Tuple [ Exp] • | Const Int • | Let String Exp Exp
infer :: Error a [String] => Exp -> [(String,Scheme a)] -> IM a (Type a) • infer e env = • case e of • Var s -> instantiate (find s env) • App f x -> • do { ftyp <- infer f env • ; xtyp <- infer x env • ; result <- freshVar • ; unify (Tarrow xtyp result) ftyp • ; return result • } • Abs x e -> • do { xtyp <- freshVar • ; etyp <- infer e ((x,Sch [] xtyp):env) • ; return(Tarrow xtyp etyp) • }
Let inference • Let bound variables can be given polymorphic types if their type doesn't mention any type variables in an outer scope. • generic :: [(n,Scheme a)] -> Tref a -> IM a Bool • generic [] r = return True • generic ((name,Sch _ typ):more) r = • do { b <- occursIn1 r typ • ; if b then return False else generic more r • } g x = let f = ((\ y -> (x,y)) ::C1 -> (A1,C1)) w1 = f "z" w2 = f True in (x,f) {g::E1, x::A1, f::B1}
inference continued • infer e env = • case e of . . . • Tuple es -> • do { ts' <- sequence(map (\ e -> infer e env) es) • ; return(Ttuple ts') • } • Const n -> return(Tdata "Int" []) • Let x e b -> • do { xtyp <- freshVar • ; etyp <- infer e ((x,Sch [] xtyp):env) • ; unify xtyp etyp • ; schm <- generalize (generic env) etyp • ; btyp <- infer b ((x,schm):env) • ; return btyp • }
Poly morphic recursion • f :: [a] -> Int • f [] = 0 • f (x:xs) = 1 + f xs + (f (map g xs)) • where g x = [x]