@@ -126,20 +126,32 @@ mkForAll args ty = foldl (\t arg -> ForAll arg t Nothing) ty args
126-- Replace a type variable, taking into account variable shadowing
126-- Replace a type variable, taking into account variable shadowing
128replaceTypeVars :: String -> Type -> Type -> Type
128replaceTypeVars :: String -> Type -> Type -> Type
129−replaceTypeVars = replaceTypeVars' []
129+replaceTypeVars v r = replaceAllTypeVars [(v, r)]
132+-- Replace named type variables with types
134+replaceAllTypeVars :: [(String, Type)] -> Type -> Type
135+replaceAllTypeVars = replaceAllTypeVars' []
131− replaceTypeVars' bound name replacement = go bound
137+ replaceAllTypeVars' bound m = go bound
133 go :: [String] -> Type -> Type
139 go :: [String] -> Type -> Type
134− go _ (TypeVar v) | v == name = replacement
140+ go _ (TypeVar v) =
141+ case v `lookup` m of
143+ Nothing -> TypeVar v
135 go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
144 go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
136 go bs (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs) ts
145 go bs (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs) ts
137− go bs f@(ForAll v t sco) | v == name = f
146+ go bs f@(ForAll v t sco) | v `elem` keys = f
138− | v `elem` usedTypeVariables replacement =
147+ | v `elem` usedVars =
139− let v' = genName v (name : bs ++ usedTypeVariables replacement)
148+ let v' = genName v (keys ++ bs ++ usedVars)
140− t' = replaceTypeVars' bs v (TypeVar v') t
149+ t' = replaceAllTypeVars' bs [(v, TypeVar v')] t
141 in ForAll v' (go (v' : bs) t') sco
150 in ForAll v' (go (v' : bs) t') sco
142 | otherwise = ForAll v (go (v : bs) t) sco
151 | otherwise = ForAll v (go (v : bs) t) sco
154+ usedVars = concatMap (usedTypeVariables . snd) m
143 go bs (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs)) cs) (go bs t)
155 go bs (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs)) cs) (go bs t)
144 go bs (RCons name' t r) = RCons name' (go bs t) (go bs r)
156 go bs (RCons name' t r) = RCons name' (go bs t) (go bs r)
145 go _ ty = ty
157 go _ ty = ty
@@ -149,12 +161,6 @@ replaceTypeVars = replaceTypeVars' []
149 try n | (orig ++ show n) `elem` inUse = try (n + 1)
161 try n | (orig ++ show n) `elem` inUse = try (n + 1)
150 | otherwise = orig ++ show n
162 | otherwise = orig ++ show n
153−-- Replace named type variables with types
155−replaceAllTypeVars :: [(String, Type)] -> Type -> Type
156−replaceAllTypeVars = foldl (\f (name, ty) -> replaceTypeVars name ty . f) id
159-- Collect all type variables appearing in a type
165-- Collect all type variables appearing in a type