git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #653 from purescript/652
4efc241Phil Freeman
examples/passing/652.pursnew file+15
compare with golang
unifiedsplit
@@ -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+27−21
@@ -126,35 +126,41 @@ 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 = go []
130 where
136 where
131− replaceTypeVars' bound name replacement = go bound
137+
138+ go :: [String] -> [(String, Type)] -> Type -> Type
139+ go _ m (TypeVar v) =
140+ case v `lookup` m of
141+ Just r -> r
142+ Nothing -> TypeVar v
143+ go bs m (TypeApp t1 t2) = TypeApp (go bs m t1) (go bs m t2)
144+ go bs m (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs m) ts
145+ go bs m f@(ForAll v t sco) | v `elem` keys = go bs (filter ((/= v) . fst) m) f
146+ | v `elem` usedVars =
147+ let v' = genName v (keys ++ bs ++ usedVars)
148+ t' = go bs [(v, TypeVar v')] t
149+ in ForAll v' (go (v' : bs) m t') sco
150+ | otherwise = ForAll v (go (v : bs) m t) sco
132 where
151 where
133− go :: [String] -> Type -> Type
152+ keys = map fst m
134− go _ (TypeVar v) | v == name = replacement
135− go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
136− go bs (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs) ts
137− go bs f@(ForAll v t sco) | v == name = f
138− | v `elem` usedTypeVariables replacement =
139− let v' = genName v (name : bs ++ usedTypeVariables replacement)
153+ usedVars = concatMap (usedTypeVariables . snd) m
140− t' = replaceTypeVars' bs v (TypeVar v') t
141− in ForAll v' (go (v' : bs) t') sco
142− | otherwise = ForAll v (go (v : bs) t) sco
143− go bs (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs)) cs) (go bs t)
154+ go bs m (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs m)) cs) (go bs m t)
144− go bs (RCons name' t r) = RCons name' (go bs t) (go bs r)
155+ go bs m (RCons name' t r) = RCons name' (go bs m t) (go bs m r)
145− go _ ty = ty
156+ go _ _ ty = ty
157+
146 genName orig inUse = try 0
158 genName orig inUse = try 0
147 where
159 where
148 try :: Integer -> String
160 try :: Integer -> String
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--