c6a9b91 · rowtype-yoga/purescript-native

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

Remove unused function arguments

commitc6a9b919646d37d9ff4b79046ced4055e75e4d05 authorPhil Freeman <paf31@cantab.net> dateSat 26 Sep 2015, 13:53 (11 years ago) parent641395e

3 files changed+25−29

compare with golang

unifiedsplit

src/Language/PureScript/TypeChecker/Entailment.hs+14−15 src/Language/PureScript/TypeChecker/Types.hs+1−3 src/Language/PureScript/TypeChecker/Unify.hs+10−11

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

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

3838

3939import Language.PureScript.AST

4040import Language.PureScript.Errors

41−import Language.PureScript.Environment

4241import Language.PureScript.Names

4342import Language.PureScript.TypeChecker.Monad

4443import Language.PureScript.TypeChecker.Unify

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

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

5150-- return a type class dictionary reference.

5251--

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

54−entails env moduleName context = solve

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

53+entails moduleName context = solve

5554 where

5655 forClassName :: Qualified ProperName -> [TypeClassDictionaryInScope]

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

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

7069 let instances = do

7170 tcd <- forClassName className'

7271 -- 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)

7473 return (subst, tcd)

7574 (subst, tcd) <- unique instances

7675 -- Solve any necessary subgoals

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

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

129128 verifySubstitution subst = do

130129 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)

132131 return $ map head grps

133132

134133 valUndefined :: Expr

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

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

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

140139--

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

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

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

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

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

146− <*> typeHeadsAreEqual m e t1 t2

147−typeHeadsAreEqual _ _ REmpty REmpty = Just []

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

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

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

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

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

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

145+ <*> typeHeadsAreEqual m t1 t2

146+typeHeadsAreEqual _ REmpty REmpty = Just []

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

149148 let (s1, r1') = rowToList r1

150149 (s2, r2') = rowToList r2

151150

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

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

154153 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

156155 <*> go sd1 r1' sd2 r2'

157156 where

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

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

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

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

164163 go _ _ _ _ = Nothing

165−typeHeadsAreEqual _ _ _ _ = Nothing

164+typeHeadsAreEqual _ _ _ = Nothing

166165

167166-- |

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

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

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

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

168168 in f

169169 where

170− go (TypeClassDictionary constraint dicts) = do

171− env <- getEnv

172− entails env mn dicts constraint

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

173171 go other = return other

174172

175173-- |

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

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

3636import Control.Monad.Writer

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

3838

39−import Language.PureScript.Environment

4039import Language.PureScript.Errors

4140import Language.PureScript.TypeChecker.Monad

4241import Language.PureScript.TypeChecker.Skolems

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

135134-- |

136135-- Check that two types unify

137136--

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

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

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

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

142−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

144−unifiesWith _ REmpty REmpty = True

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

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

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

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

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

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

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

143+unifiesWith REmpty REmpty = True

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

146145 let (s1, r1') = rowToList r1

147146 (s2, r2') = rowToList r2

148147

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

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

151150 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'

153152 where

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

155154 go [] REmpty [] REmpty = True

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

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

160159 go _ (TUnknown _) _ (TUnknown _) = True

161160 go _ _ _ _ = False

162−unifiesWith _ _ _ = False

161+unifiesWith _ _ = False

163162

164163-- |

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