git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
First pass at #652
d410497Phil Freeman
examples/passing/652.pursnew file+15
@@ -0,0 +1,15 @@
1+module Main where
2+
3+class Foo a b
4+
5+class Bar a c
6+
7+class (Foo a b, Bar a c) <= Baz a b c
8+
9+instance foo :: Foo (a -> b) a
10+
11+instance bar :: Bar (a -> b) b
12+
13+instance baz :: (Eq a) => Baz (a -> b) a b
14+
15+main = Debug.Trace.trace "Done"
src/Language/PureScript/Types.hs+19−13
@@ -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
127--
127--
128replaceTypeVars :: String -> Type -> Type -> Type
128replaceTypeVars :: String -> Type -> Type -> Type
129−replaceTypeVars = replaceTypeVars' []
129+replaceTypeVars v r = replaceAllTypeVars [(v, r)]
130+
131+-- |
132+-- Replace named type variables with types
133+--
134+replaceAllTypeVars :: [(String, Type)] -> Type -> Type
135+replaceAllTypeVars = replaceAllTypeVars' []
130 where
136 where
131− replaceTypeVars' bound name replacement = go bound
137+ replaceAllTypeVars' bound m = go bound
132 where
138 where
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
142+ Just r -> r
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
152+ where
153+ keys = map fst m
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
151
163
152−-- |
153−-- Replace named type variables with types
154−--
155−replaceAllTypeVars :: [(String, Type)] -> Type -> Type
156−replaceAllTypeVars = foldl (\f (name, ty) -> replaceTypeVars name ty . f) id
157−
158-- |
164-- |
159-- Collect all type variables appearing in a type
165-- Collect all type variables appearing in a type
160--
166--