c6a9b91 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Remove unused function arguments

c6a9b91Phil Freeman11 years ago

src/Language/PureScript/TypeChecker/Entailment.hs+14−15

compare with golang

unifiedsplit

@@ -38,7 +38,6 @@ import Control.Monad.Writer.Class (tell)

39import Language.PureScript.AST

40import Language.PureScript.Errors

41−import Language.PureScript.Environment

42import Language.PureScript.Names

41import Language.PureScript.Names

43import Language.PureScript.TypeChecker.Monad

42import Language.PureScript.TypeChecker.Monad

44import Language.PureScript.TypeChecker.Unify

43import Language.PureScript.TypeChecker.Unify

@@ -50,8 +49,8 @@ import qualified Language.PureScript.Constants as C

50-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,

49-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,

51-- return a type class dictionary reference.

50-- return a type class dictionary reference.

52--

51--

53−entails :: Environment -> ModuleName -> M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)) -> Constraint -> Check Expr

52+entails :: ModuleName -> M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)) -> Constraint -> Check Expr

54−entails env moduleName context = solve

53+entails moduleName context = solve

55 where

54 where

56 forClassName :: Qualified ProperName -> [TypeClassDictionaryInScope]

55 forClassName :: Qualified ProperName -> [TypeClassDictionaryInScope]

57 forClassName cn = findDicts cn Nothing ++ findDicts cn (Just moduleName)

56 forClassName cn = findDicts cn Nothing ++ findDicts cn (Just moduleName)

@@ -70,7 +69,7 @@ entails env moduleName context = solve

70 let instances = do

69 let instances = do

71 tcd <- forClassName className'

70 tcd <- forClassName className'

72 -- Make sure the type unifies with the type in the type instance definition

71 -- Make sure the type unifies with the type in the type instance definition

73− subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)

72+ subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName) tys' (tcdInstanceTypes tcd)

74 return (subst, tcd)

73 return (subst, tcd)

75 (subst, tcd) <- unique instances

74 (subst, tcd) <- unique instances

76 -- Solve any necessary subgoals

75 -- Solve any necessary subgoals

@@ -128,7 +127,7 @@ entails env moduleName context = solve

128 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

127 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

129 verifySubstitution subst = do

128 verifySubstitution subst = do

130 let grps = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ subst

129 let grps = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ subst

131− guard (all (pairwise (unifiesWith env) . map snd) grps)

130+ guard (all (pairwise unifiesWith . map snd) grps)

132 return $ map head grps

131 return $ map head grps

133

132

134 valUndefined :: Expr

133 valUndefined :: Expr

@@ -138,21 +137,21 @@ entails env moduleName context = solve

138-- Check whether the type heads of two types are equal (for the purposes of type class dictionary lookup),

137-- Check whether the type heads of two types are equal (for the purposes of type class dictionary lookup),

139-- and return a substitution from type variables to types which makes the type heads unify.

138-- and return a substitution from type variables to types which makes the type heads unify.

140--

139--

141−typeHeadsAreEqual :: ModuleName -> Environment -> Type -> Type -> Maybe [(String, Type)]

140+typeHeadsAreEqual :: ModuleName -> Type -> Type -> Maybe [(String, Type)]

142−typeHeadsAreEqual _ _ (Skolem _ s1 _) (Skolem _ s2 _) | s1 == s2 = Just []

141+typeHeadsAreEqual _ (Skolem _ s1 _) (Skolem _ s2 _) | s1 == s2 = Just []

143−typeHeadsAreEqual _ _ t (TypeVar v) = Just [(v, t)]

142+typeHeadsAreEqual _ t (TypeVar v) = Just [(v, t)]

144−typeHeadsAreEqual _ _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []

143+typeHeadsAreEqual _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []

145−typeHeadsAreEqual m e (TypeApp h1 t1) (TypeApp h2 t2) = (++) <$> typeHeadsAreEqual m e h1 h2

144+typeHeadsAreEqual m (TypeApp h1 t1) (TypeApp h2 t2) = (++) <$> typeHeadsAreEqual m h1 h2

146− <*> typeHeadsAreEqual m e t1 t2

145+ <*> typeHeadsAreEqual m t1 t2

147−typeHeadsAreEqual _ _ REmpty REmpty = Just []

146+typeHeadsAreEqual _ REmpty REmpty = Just []

148−typeHeadsAreEqual m e r1@(RCons _ _ _) r2@(RCons _ _ _) =

147+typeHeadsAreEqual m r1@RCons{} r2@RCons{} =

149 let (s1, r1') = rowToList r1

148 let (s1, r1') = rowToList r1

150 (s2, r2') = rowToList r2

149 (s2, r2') = rowToList r2

151

150

152 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

151 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

153 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

152 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

154 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

153 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

155− in (++) <$> foldMap (\(t1, t2) -> typeHeadsAreEqual m e t1 t2) int

154+ in (++) <$> foldMap (uncurry (typeHeadsAreEqual m)) int

156 <*> go sd1 r1' sd2 r2'

155 <*> go sd1 r1' sd2 r2'

157 where

156 where

158 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Maybe [(String, Type)]

157 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Maybe [(String, Type)]

@@ -162,7 +161,7 @@ typeHeadsAreEqual m e r1@(RCons _ _ _) r2@(RCons _ _ _) =

162 go [] (Skolem _ s1 _) [] (Skolem _ s2 _) | s1 == s2 = Just []

161 go [] (Skolem _ s1 _) [] (Skolem _ s2 _) | s1 == s2 = Just []

163 go sd r [] (TypeVar v) = Just [(v, rowFromList (sd, r))]

162 go sd r [] (TypeVar v) = Just [(v, rowFromList (sd, r))]

164 go _ _ _ _ = Nothing

163 go _ _ _ _ = Nothing

165−typeHeadsAreEqual _ _ _ _ = Nothing

164+typeHeadsAreEqual _ _ _ = Nothing

166

165

167-- |

166-- |

168-- Check all values in a list pairwise match a predicate

167-- Check all values in a list pairwise match a predicate

src/Language/PureScript/TypeChecker/Types.hs+1−3

@@ -167,9 +167,7 @@ replaceTypeClassDictionaries mn =

167 let (_, f, _) = everywhereOnValuesTopDownM return go return

168 in f

169 where

170− go (TypeClassDictionary constraint dicts) = do

170+ go (TypeClassDictionary constraint dicts) = entails mn dicts constraint

171− env <- getEnv

172− entails env mn dicts constraint

173 go other = return other

171 go other = return other

174

172

175-- |

173-- |

src/Language/PureScript/TypeChecker/Unify.hs+10−11

@@ -36,7 +36,6 @@ import Control.Monad.Unify

36import Control.Monad.Writer

37import Control.Monad.Error.Class (MonadError(..))

39−import Language.PureScript.Environment

40import Language.PureScript.Errors

39import Language.PureScript.Errors

41import Language.PureScript.TypeChecker.Monad

40import Language.PureScript.TypeChecker.Monad

42import Language.PureScript.TypeChecker.Skolems

41import Language.PureScript.TypeChecker.Skolems

@@ -135,21 +134,21 @@ unifyRows r1 r2 =

135-- |

134-- |

136-- Check that two types unify

135-- Check that two types unify

137--

136--

138−unifiesWith :: Environment -> Type -> Type -> Bool

137+unifiesWith :: Type -> Type -> Bool

139−unifiesWith _ (TUnknown u1) (TUnknown u2) | u1 == u2 = True

138+unifiesWith (TUnknown u1) (TUnknown u2) | u1 == u2 = True

140−unifiesWith _ (Skolem _ s1 _) (Skolem _ s2 _) | s1 == s2 = True

139+unifiesWith (Skolem _ s1 _) (Skolem _ s2 _) | s1 == s2 = True

141−unifiesWith _ (TypeVar v1) (TypeVar v2) | v1 == v2 = True

140+unifiesWith (TypeVar v1) (TypeVar v2) | v1 == v2 = True

142−unifiesWith _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = True

141+unifiesWith (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = True

143−unifiesWith e (TypeApp h1 t1) (TypeApp h2 t2) = unifiesWith e h1 h2 && unifiesWith e t1 t2

142+unifiesWith (TypeApp h1 t1) (TypeApp h2 t2) = h1 `unifiesWith` h2 && t1 `unifiesWith` t2

144−unifiesWith _ REmpty REmpty = True

143+unifiesWith REmpty REmpty = True

145−unifiesWith e r1@(RCons _ _ _) r2@(RCons _ _ _) =

144+unifiesWith r1@(RCons _ _ _) r2@(RCons _ _ _) =

146 let (s1, r1') = rowToList r1

145 let (s1, r1') = rowToList r1

147 (s2, r2') = rowToList r2

146 (s2, r2') = rowToList r2

148

147

149 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

148 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

150 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

149 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

151 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

150 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

152− in all (\(t1, t2) -> unifiesWith e t1 t2) int && go sd1 r1' sd2 r2'

151+ in all (uncurry unifiesWith) int && go sd1 r1' sd2 r2'

153 where

152 where

154 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool

153 go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool

155 go [] REmpty [] REmpty = True

154 go [] REmpty [] REmpty = True

@@ -159,7 +158,7 @@ unifiesWith e r1@(RCons _ _ _) r2@(RCons _ _ _) =

159 go _ _ [] (TUnknown _) = True

158 go _ _ [] (TUnknown _) = True

160 go _ (TUnknown _) _ (TUnknown _) = True

159 go _ (TUnknown _) _ (TUnknown _) = True

161 go _ _ _ _ = False

160 go _ _ _ _ = False

162−unifiesWith _ _ _ = False

161+unifiesWith _ _ = False

163

162

164-- |

163-- |

165-- Replace a single type variable with a new unification variable

164-- Replace a single type variable with a new unification variable