5469304 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge synonyms2 and incremental branches into master

5469304Phil Freeman11 years ago

src/Language/PureScript/Docs/Convert.hs−1

compare with golang

unifiedsplit

@@ -166,7 +166,6 @@ convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) tit

166 unQual x = let (P.Qualified _ y) = x in P.runProperName y

167

168 extractProperNames (P.TypeConstructor n) = [unQual n]

169− extractProperNames (P.SaturatedTypeSynonym n _) = [unQual n]

170 extractProperNames _ = []

169 extractProperNames _ = []

171

170

172 childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)

171 childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)

src/Language/PureScript/Make.hs+1−1

@@ -203,7 +203,7 @@ make MakeActions{..} ms = do

203 let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

204 lint m

205 ([desugared], nextVar) <- runSupplyT 0 $ desugar externs [m]

206− (checked@(Module ss coms _ elaborated exps), env') <- runCheck' env $ typeCheckModule Nothing desugared

206+ (checked@(Module ss coms _ elaborated exps), env') <- runCheck' env $ typeCheckModule desugared

207 checkExhaustiveModule env' checked

208 regrouped <- createBindingGroups moduleName . collapseBindingGroups $ elaborated

209 let mod' = Module ss coms moduleName regrouped exps

src/Language/PureScript/Pretty/Types.hs−1

@@ -42,7 +42,6 @@ typeLiterals = mkPattern match

42 match (TUnknown u) = Just $ '_' : show u

43 match (Skolem name s _) = Just $ name ++ show s

44 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> showQualified runProperName pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty

45− match (SaturatedTypeSynonym name args) = Just $ showQualified runProperName name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"

46 match REmpty = Just "()"

45 match REmpty = Just "()"

47 match row@RCons{} = Just $ '(' : prettyPrintRow row ++ ")"

46 match row@RCons{} = Just $ '(' : prettyPrintRow row ++ ")"

48 match _ = Nothing

47 match _ = Nothing

src/Language/PureScript/Sugar/Names.hs−1

@@ -207,7 +207,6 @@ renameInModule env imports (Module ss coms mn decls exps) =

207 where

208 updateType :: Type -> m Type

209 updateType (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos

210− updateType (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name pos <*> pure tys

211 updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints pos cs <*> pure t

210 updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints pos cs <*> pure t

212 updateType t = return t

211 updateType t = return t

213

212

src/Language/PureScript/TypeChecker.hs+8−8

@@ -132,8 +132,8 @@ checkTypeSynonyms = void . replaceAllTypeSynonyms

132--

133-- * Process module imports

134--

135−typeCheckAll :: Maybe ModuleName -> ModuleName -> [DeclarationRef] -> [Declaration] -> Check [Declaration]

135+typeCheckAll :: ModuleName -> [DeclarationRef] -> [Declaration] -> Check [Declaration]

136−typeCheckAll mainModuleName moduleName _ ds = mapM go ds <* mapM_ checkOrphanFixities ds

136+typeCheckAll moduleName _ ds = mapM go ds <* mapM_ checkOrphanFixities ds

137 where

138 go :: Declaration -> Check Declaration

139 go (DataDeclaration dtype name args dctors) = do

@@ -181,7 +181,7 @@ typeCheckAll mainModuleName moduleName _ ds = mapM go ds <* mapM_ checkOrphanFix

181 go (ValueDeclaration name nameKind [] (Right val)) =

182 warnAndRethrow (onErrorMessages (ErrorInValueDeclaration name)) $ do

183 valueIsNotDefined moduleName name

184− [(_, (val', ty))] <- typesOf mainModuleName moduleName [(name, val)]

184+ [(_, (val', ty))] <- typesOf moduleName [(name, val)]

185 addValue moduleName name ty nameKind

186 return $ ValueDeclaration name nameKind [] $ Right val'

187 go (ValueDeclaration{}) = error "Binders were not desugared"

@@ -189,7 +189,7 @@ typeCheckAll mainModuleName moduleName _ ds = mapM go ds <* mapM_ checkOrphanFix

189 warnAndRethrow (onErrorMessages (ErrorInBindingGroup (map (\(ident, _, _) -> ident) vals))) $ do

190 forM_ (map (\(ident, _, _) -> ident) vals) $ \name ->

191 valueIsNotDefined moduleName name

192− tys <- typesOf mainModuleName moduleName $ map (\(ident, _, ty) -> (ident, ty)) vals

192+ tys <- typesOf moduleName $ map (\(ident, _, ty) -> (ident, ty)) vals

193 vals' <- forM [ (name, val, nameKind, ty)

194 | (name, nameKind, _) <- vals

195 , (name', (val, ty)) <- tys

@@ -267,11 +267,11 @@ typeCheckAll mainModuleName moduleName _ ds = mapM go ds <* mapM_ checkOrphanFix

267-- Type check an entire module and ensure all types and classes defined within the module that are

268-- required by exported members are also exported.

269--

270−typeCheckModule :: Maybe ModuleName -> Module -> Check Module

270+typeCheckModule :: Module -> Check Module

271−typeCheckModule _ (Module _ _ _ _ Nothing) = error "exports should have been elaborated"

271+typeCheckModule (Module _ _ _ _ Nothing) = error "exports should have been elaborated"

272−typeCheckModule mainModuleName (Module ss coms mn decls (Just exps)) = warnAndRethrow (onErrorMessages (ErrorInModule mn)) $ do

272+typeCheckModule (Module ss coms mn decls (Just exps)) = warnAndRethrow (onErrorMessages (ErrorInModule mn)) $ do

273 modify (\s -> s { checkCurrentModule = Just mn })

274− decls' <- typeCheckAll mainModuleName mn exps decls

274+ decls' <- typeCheckAll mn exps decls

275 forM_ exps $ \e -> do

276 checkTypesAreExported e

277 checkClassMembersAreExported e

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

@@ -38,10 +38,8 @@ 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

44−import Language.PureScript.TypeChecker.Synonyms

45import Language.PureScript.TypeChecker.Unify

43import Language.PureScript.TypeChecker.Unify

46import Language.PureScript.TypeClassDictionaries

44import Language.PureScript.TypeClassDictionaries

47import Language.PureScript.Types

45import Language.PureScript.Types

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

51-- 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,

52-- return a type class dictionary reference.

50-- return a type class dictionary reference.

53--

51--

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

55−entails env moduleName context = solve

53+entails moduleName context = solve

56 where

54 where

57 forClassName :: Qualified ProperName -> [Type] -> [TypeClassDictionaryInScope]

55 forClassName :: Qualified ProperName -> [Type] -> [TypeClassDictionaryInScope]

58 forClassName cn@(Qualified (Just mn) _) tys = concatMap (findDicts cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))

56 forClassName cn@(Qualified (Just mn) _) tys = concatMap (findDicts cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))

@@ -75,14 +73,10 @@ entails env moduleName context = solve

75 go :: Int -> Qualified ProperName -> [Type] -> Check DictionaryValue

73 go :: Int -> Qualified ProperName -> [Type] -> Check DictionaryValue

76 go work className' tys' | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'

74 go work className' tys' | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'

77 go work className' tys' = do

75 go work className' tys' = do

78− -- We need to desugar synonyms here so that forClassName can find the correct modules

79− -- in types hidden inside the synonyms.

80− -- TODO: this can go away when synonyms get desugared up front.

81− tys'' <- mapM expandAllTypeSynonyms tys'

82 let instances = do

76 let instances = do

83− tcd <- forClassName className' tys''

77+ tcd <- forClassName className' tys'

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

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

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

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

86 return (subst, tcd)

80 return (subst, tcd)

87 (subst, tcd) <- unique instances

81 (subst, tcd) <- unique instances

88 -- Solve any necessary subgoals

82 -- Solve any necessary subgoals

@@ -140,7 +134,7 @@ entails env moduleName context = solve

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

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

141 verifySubstitution subst = do

135 verifySubstitution subst = do

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

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

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

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

144 return $ map head grps

138 return $ map head grps

145

139

146 valUndefined :: Expr

140 valUndefined :: Expr

@@ -150,24 +144,21 @@ entails env moduleName context = solve

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

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

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

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

152--

146--

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

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

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

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

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

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

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

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

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

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

158− <*> typeHeadsAreEqual m e t1 t2

152+ <*> typeHeadsAreEqual m t1 t2

159−typeHeadsAreEqual m e (SaturatedTypeSynonym name args) t2 = case expandTypeSynonym' e name args of

160− Left _ -> Nothing

161− Right t1 -> typeHeadsAreEqual m e t1 t2

162−typeHeadsAreEqual _ _ REmpty REmpty = Just []

153+typeHeadsAreEqual _ REmpty REmpty = Just []

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

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

164 let (s1, r1') = rowToList r1

155 let (s1, r1') = rowToList r1

165 (s2, r2') = rowToList r2

156 (s2, r2') = rowToList r2

166

157

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

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

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

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

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

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

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

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

171 <*> go sd1 r1' sd2 r2'

162 <*> go sd1 r1' sd2 r2'

172 where

163 where

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

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

@@ -177,7 +168,7 @@ typeHeadsAreEqual m e r1@(RCons _ _ _) r2@(RCons _ _ _) =

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

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

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

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

179 go _ _ _ _ = Nothing

170 go _ _ _ _ = Nothing

180−typeHeadsAreEqual _ _ _ _ = Nothing

171+typeHeadsAreEqual _ _ _ = Nothing

181

172

182-- |

173-- |

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

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

src/Language/PureScript/TypeChecker/Rows.hs−1

@@ -46,7 +46,6 @@ checkDuplicateLabels =

46 where

47 checkDups :: Type -> Check ()

48 checkDups (TypeApp t1 t2) = checkDups t1 >> checkDups t2

49− checkDups (SaturatedTypeSynonym _ ts) = mapM_ checkDups ts

50 checkDups (ForAll _ t _) = checkDups t

49 checkDups (ForAll _ t _) = checkDups t

51 checkDups (ConstrainedType args t) = do

50 checkDups (ConstrainedType args t) = do

52 mapM_ checkDups $ concatMap snd args

51 mapM_ checkDups $ concatMap snd args

src/Language/PureScript/TypeChecker/Subsumption.hs−8

@@ -20,7 +20,6 @@ module Language.PureScript.TypeChecker.Subsumption (

20import Data.List (sortBy)

21import Data.Ord (comparing)

23−import Control.Monad

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

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

25import Control.Monad.Unify

24import Control.Monad.Unify

@@ -29,7 +28,6 @@ import Language.PureScript.Environment

29import Language.PureScript.Errors

28import Language.PureScript.Errors

30import Language.PureScript.TypeChecker.Monad

29import Language.PureScript.TypeChecker.Monad

31import Language.PureScript.TypeChecker.Skolems

30import Language.PureScript.TypeChecker.Skolems

32−import Language.PureScript.TypeChecker.Synonyms

33import Language.PureScript.TypeChecker.Unify

31import Language.PureScript.TypeChecker.Unify

34import Language.PureScript.Types

32import Language.PureScript.Types

@@ -57,12 +55,6 @@ subsumes' val (TypeApp (TypeApp f1 arg1) ret1) (TypeApp (TypeApp f2 arg2) ret2)

57 _ <- subsumes Nothing arg2 arg1

55 _ <- subsumes Nothing arg2 arg1

58 _ <- subsumes Nothing ret1 ret2

56 _ <- subsumes Nothing ret1 ret2

59 return val

57 return val

60−subsumes' val (SaturatedTypeSynonym name tyArgs) ty2 = do

61− ty1 <- introduceSkolemScope <=< expandTypeSynonym name $ tyArgs

62− subsumes val ty1 ty2

63−subsumes' val ty1 (SaturatedTypeSynonym name tyArgs) = do

64− ty2 <- introduceSkolemScope <=< expandTypeSynonym name $ tyArgs

65− subsumes val ty1 ty2

66subsumes' val (KindedType ty1 _) ty2 =

58subsumes' val (KindedType ty1 _) ty2 =

67 subsumes val ty1 ty2

59 subsumes val ty1 ty2

68subsumes' val ty1 (KindedType ty2 _) =

60subsumes' val ty1 (KindedType ty2 _) =

src/Language/PureScript/TypeChecker/Synonyms.hs+20−66

@@ -9,22 +9,18 @@

9-- Portability :

10--

11-- |

12−-- Functions for replacing fully applied type synonyms with the @SaturatedTypeSynonym@ data constructor

12+-- Functions for replacing fully applied type synonyms

13--

14-----------------------------------------------------------------------------

16{-# LANGUAGE FlexibleContexts #-}

17{-# LANGUAGE MultiParamTypeClasses #-}

18+{-# LANGUAGE PatternGuards #-}

18{-# LANGUAGE GADTs #-}

19{-# LANGUAGE GADTs #-}

19{-# LANGUAGE CPP #-}

20{-# LANGUAGE CPP #-}

21module Language.PureScript.TypeChecker.Synonyms (

22module Language.PureScript.TypeChecker.Synonyms (

22− saturateAllTypeSynonyms,

23− desaturateAllTypeSynonyms,

24− replaceAllTypeSynonyms,

23+ replaceAllTypeSynonyms

25− expandAllTypeSynonyms,

26− expandTypeSynonym,

27− expandTypeSynonym'

28) where

24) where

30import Data.Maybe (fromMaybe)

26import Data.Maybe (fromMaybe)

@@ -38,73 +34,31 @@ import Control.Monad.State

39import Language.PureScript.Environment

35import Language.PureScript.Environment

40import Language.PureScript.Errors

36import Language.PureScript.Errors

41−import Language.PureScript.Names

42import Language.PureScript.TypeChecker.Monad

37import Language.PureScript.TypeChecker.Monad

43import Language.PureScript.Types

38import Language.PureScript.Types

45-- |

40-- |

46−-- Build a type substitution for a type synonym

41+-- Replace fully applied type synonyms.

47--

42--

48−buildTypeSubstitution :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage (Maybe Type)

43+replaceAllTypeSynonyms' :: Environment -> Type -> Either MultipleErrors Type

49−buildTypeSubstitution m = go 0 []

44+replaceAllTypeSynonyms' env = everywhereOnTypesTopDownM try

50 where

45 where

51− go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)

46+ try :: Type -> Either MultipleErrors Type

52− go c args (TypeConstructor ctor) | M.lookup ctor m == Just c = return (Just $ SaturatedTypeSynonym ctor args)

47+ try t = fromMaybe t <$> go 0 [] t

53− go c _ (TypeConstructor ctor) | M.lookup ctor m > Just c = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym ctor

54− go c args (TypeApp f arg) = go (c + 1) (arg:args) f

55− go _ _ _ = return Nothing

56−

57−-- |

58−-- Replace all type synonyms with the @SaturatedTypeSynonym@ data constructor

59−--

60−saturateAllTypeSynonyms :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage Type

61−saturateAllTypeSynonyms syns = everywhereOnTypesTopDownM replace

62− where

63− replace t = fromMaybe t <$> buildTypeSubstitution syns t

65−-- |

49+ go :: Int -> [Type] -> Type -> Either MultipleErrors (Maybe Type)

66−-- \"Desaturate\" @SaturatedTypeSynonym@s

50+ go c args (TypeConstructor ctor)

67−--

51+ | Just (synArgs, body) <- M.lookup ctor (typeSynonyms env)

68−desaturateAllTypeSynonyms :: Type -> Type

52+ , c == length synArgs

69−desaturateAllTypeSynonyms = everywhereOnTypes replaceSaturatedTypeSynonym

53+ = let repl = replaceAllTypeVars (zip (map fst synArgs) args) body

70− where

54+ in Just <$> try repl

71− replaceSaturatedTypeSynonym (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args

72− replaceSaturatedTypeSynonym t = t

73−

74−-- |

75−-- Replace fully applied type synonyms with the @SaturatedTypeSynonym@ data constructor, which helps generate

76−-- better error messages during unification.

77−--

78−replaceAllTypeSynonyms' :: Environment -> Type -> Either ErrorMessage Type

79−replaceAllTypeSynonyms' env d =

80− let

81− syns = length . fst <$> typeSynonyms env

55+ | Just (synArgs, _) <- M.lookup ctor (typeSynonyms env)

82− in

56+ , length synArgs > c

83− saturateAllTypeSynonyms syns d

57+ = throwError . errorMessage $ PartiallyAppliedSynonym ctor

58+ go c args (TypeApp f arg) = go (c + 1) (arg : args) f

59+ go _ _ _ = return Nothing

85replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

61replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

86replaceAllTypeSynonyms d = do

62replaceAllTypeSynonyms d = do

87 env <- getEnv

63 env <- getEnv

88− either (throwError . singleError) return $ replaceAllTypeSynonyms' env d

64+ either throwError return $ replaceAllTypeSynonyms' env d

89−

90−-- |

91−-- Replace a type synonym and its arguments with the aliased type

92−--

93−expandTypeSynonym' :: Environment -> Qualified ProperName -> [Type] -> Either ErrorMessage Type

94−expandTypeSynonym' env name args =

95− case M.lookup name (typeSynonyms env) of

96− Just (synArgs, body) -> do

97− let repl = replaceAllTypeVars (zip (map fst synArgs) args) body

98− replaceAllTypeSynonyms' env repl

99− Nothing -> error "Type synonym was not defined"

100−

101−expandTypeSynonym :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type

102−expandTypeSynonym name args = do

103− env <- getEnv

104− either (throwError . singleError) return $ expandTypeSynonym' env name args

105−

106−expandAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

107−expandAllTypeSynonyms = everywhereOnTypesTopDownM go

108− where

109− go (SaturatedTypeSynonym name args) = expandTypeSynonym name args

110− go other = return other

src/Language/PureScript/TypeChecker/Types.hs+6−41

@@ -67,24 +67,17 @@ import Language.PureScript.TypeChecker.Synonyms

67import Language.PureScript.TypeChecker.Unify

68import Language.PureScript.TypeClassDictionaries

69import Language.PureScript.Types

70−import qualified Language.PureScript.Constants as C

72-- |

71-- |

73-- Infer the types of multiple mutually-recursive values, and return elaborated values including

72-- Infer the types of multiple mutually-recursive values, and return elaborated values including

74-- type class dictionaries and type annotations.

73-- type class dictionaries and type annotations.

75--

74--

76−typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Expr)] -> Check [(Ident, (Expr, Type))]

75+typesOf :: ModuleName -> [(Ident, Expr)] -> Check [(Ident, (Expr, Type))]

77−typesOf mainModuleName moduleName vals = do

76+typesOf moduleName vals = do

78 tys <- fmap tidyUp . liftUnifyWarnings replace $ do

77 tys <- fmap tidyUp . liftUnifyWarnings replace $ do

79 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals

78 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals

80− ds1 <- parU typed $ \e -> do

81− triple@(_, (_, ty)) <- checkTypedBindingGroupElement moduleName e dict

79+ ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict

82− checkMain (fst e) ty

83− return triple

84− ds2 <- forM untyped $ \e -> do

85− triple@(_, (_, ty)) <- typeForBindingGroupElement e dict untypedDict

80+ ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict

86− checkMain (fst e) ty

87− return triple

88 return $ ds1 ++ ds2

81 return $ ds1 ++ ds2

90 forM tys $ \(ident, (val, ty)) -> do

83 forM tys $ \(ident, (val, ty)) -> do

@@ -94,21 +87,13 @@ typesOf mainModuleName moduleName vals = do

94 skolemEscapeCheck val'

87 skolemEscapeCheck val'

95 -- Check rows do not contain duplicate labels

88 -- Check rows do not contain duplicate labels

96 checkDuplicateLabels val'

89 checkDuplicateLabels val'

97− -- Remove type synonyms placeholders, and replace

98− -- top-level unification variables with named type variables.

99− let val'' = overTypes desaturateAllTypeSynonyms val'

100− ty' = varIfUnknown . desaturateAllTypeSynonyms $ ty

101− return (ident, (val'', ty'))

90+ return (ident, (val', varIfUnknown ty))

102 where

91 where

103 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values

92 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values

104 tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts

93 tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts

105 -- Replace all the wildcards types with their inferred types

94 -- Replace all the wildcards types with their inferred types

106 replace sub (SimpleErrorWrapper (WildcardInferredType ty)) = SimpleErrorWrapper $ WildcardInferredType (sub $? ty)

95 replace sub (SimpleErrorWrapper (WildcardInferredType ty)) = SimpleErrorWrapper $ WildcardInferredType (sub $? ty)

107 replace _ em = em

96 replace _ em = em

108− -- If --main is enabled, need to check that `main` has type Eff eff a for some eff, a

109− checkMain nm ty = when (Just moduleName == mainModuleName && nm == Ident C.main) $ do

110− [eff, a] <- replicateM 2 fresh

111− ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Control", ProperName "Monad", ProperName "Eff"])) (ProperName "Eff"))) eff) a

112

113type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)

98type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)

114

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

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

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

183 in f

168 in f

184 where

169 where

185− go (TypeClassDictionary constraint dicts) = do

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

186− env <- getEnv

187− entails env mn dicts constraint

188 go other = return other

171 go other = return other

189

172

190-- |

173-- |

@@ -346,9 +329,6 @@ inferProperty :: Type -> String -> UnifyT Type Check (Maybe Type)

346inferProperty (TypeApp obj row) prop | obj == tyObject = do

329inferProperty (TypeApp obj row) prop | obj == tyObject = do

347 let (props, _) = rowToList row

330 let (props, _) = rowToList row

348 return $ lookup prop props

331 return $ lookup prop props

349−inferProperty (SaturatedTypeSynonym name args) prop = do

350− replaced <- introduceSkolemScope <=< expandTypeSynonym name $ args

351− inferProperty replaced prop

352inferProperty (ForAll ident ty _) prop = do

332inferProperty (ForAll ident ty _) prop = do

353 replaced <- replaceVarWithUnknown ident ty

333 replaced <- replaceVarWithUnknown ident ty

354 inferProperty replaced prop

334 inferProperty replaced prop

@@ -493,9 +473,6 @@ check' val t@(ConstrainedType constraints ty) = do

493

473

494 instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]

474 instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]

495 instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs

475 instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs

496−check' val (SaturatedTypeSynonym name args) = do

497− ty <- introduceSkolemScope <=< expandTypeSynonym name $ args

498− check val ty

499check' val u@(TUnknown _) = do

476check' val u@(TUnknown _) = do

500 val'@(TypedValue _ _ ty) <- infer val

477 val'@(TypedValue _ _ ty) <- infer val

501 -- Don't unify an unknown with an inferred polytype

478 -- Don't unify an unknown with an inferred polytype

@@ -599,9 +576,6 @@ check' v@(Constructor c) ty = do

599check' (Let ds val) ty = do

576check' (Let ds val) ty = do

600 (ds', val') <- inferLetBinding [] ds val (`check` ty)

577 (ds', val') <- inferLetBinding [] ds val (`check` ty)

601 return $ TypedValue True (Let ds' val') ty

578 return $ TypedValue True (Let ds' val') ty

602−check' val ty | containsTypeSynonyms ty = do

603− ty' <- introduceSkolemScope <=< expandAllTypeSynonyms <=< replaceTypeWildcards $ ty

604− check val ty'

605check' val kt@(KindedType ty kind) = do

579check' val kt@(KindedType ty kind) = do

606 checkTypeKind ty kind

580 checkTypeKind ty kind

607 val' <- check' val ty

581 val' <- check' val ty

@@ -615,12 +589,6 @@ check' val ty = do

615 Nothing -> throwError . errorMessage $ SubsumptionCheckFailed

589 Nothing -> throwError . errorMessage $ SubsumptionCheckFailed

616 Just v' -> return $ TypedValue True v' ty

590 Just v' -> return $ TypedValue True v' ty

617

591

618−containsTypeSynonyms :: Type -> Bool

619−containsTypeSynonyms = everythingOnTypes (||) go where

620− go (SaturatedTypeSynonym _ _) = True

621− go _ = False

622−

623−

624-- |

592-- |

625-- Check the type of a collection of named record fields

593-- Check the type of a collection of named record fields

626--

594--

@@ -683,9 +651,6 @@ checkFunctionApplication' fn u@(TUnknown _) arg ret = do

683 ret' <- maybe fresh return ret

651 ret' <- maybe fresh return ret

684 u =?= function ty ret'

652 u =?= function ty ret'

685 return (ret', App fn arg')

653 return (ret', App fn arg')

686−checkFunctionApplication' fn (SaturatedTypeSynonym name tyArgs) arg ret = do

687− ty <- introduceSkolemScope <=< expandTypeSynonym name $ tyArgs

688− checkFunctionApplication fn ty arg ret

689checkFunctionApplication' fn (KindedType ty _) arg ret =

654checkFunctionApplication' fn (KindedType ty _) arg ret =

690 checkFunctionApplication fn ty arg ret

655 checkFunctionApplication fn ty arg ret

691checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do

656checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do

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

@@ -36,11 +36,9 @@ 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

43−import Language.PureScript.TypeChecker.Synonyms

44import Language.PureScript.Types

42import Language.PureScript.Types

46instance Partial Type where

44instance Partial Type where

@@ -69,10 +67,6 @@ unifyTypes t1 t2 = rethrow (onErrorMessages (ErrorUnifyingTypes t1 t2)) $

69 unifyTypes' (TUnknown u1) (TUnknown u2) | u1 == u2 = return ()

67 unifyTypes' (TUnknown u1) (TUnknown u2) | u1 == u2 = return ()

70 unifyTypes' (TUnknown u) t = u =:= t

68 unifyTypes' (TUnknown u) t = u =:= t

71 unifyTypes' t (TUnknown u) = u =:= t

69 unifyTypes' t (TUnknown u) = u =:= t

72− unifyTypes' (SaturatedTypeSynonym name args) ty = do

73− ty1 <- introduceSkolemScope <=< expandTypeSynonym name $ args

74− ty1 `unifyTypes` ty

75− unifyTypes' ty s@(SaturatedTypeSynonym _ _) = s `unifyTypes` ty

76 unifyTypes' (ForAll ident1 ty1 sc1) (ForAll ident2 ty2 sc2) =

70 unifyTypes' (ForAll ident1 ty1 sc1) (ForAll ident2 ty2 sc2) =

77 case (sc1, sc2) of

71 case (sc1, sc2) of

78 (Just sc1', Just sc2') -> do

72 (Just sc1', Just sc2') -> do

@@ -132,10 +126,6 @@ unifyRows r1 r2 =

132 rest <- fresh

126 rest <- fresh

133 u1 =:= rowFromList (sd2, rest)

127 u1 =:= rowFromList (sd2, rest)

134 u2 =:= rowFromList (sd1, rest)

128 u2 =:= rowFromList (sd1, rest)

135− unifyRows' sd1 (SaturatedTypeSynonym name args) sd2 r2' = do

136− r1' <- expandTypeSynonym name $ args

137− unifyRows (rowFromList (sd1, r1')) (rowFromList (sd2, r2'))

138− unifyRows' sd1 r1' sd2 r2'@(SaturatedTypeSynonym _ _) = unifyRows' sd2 r2' sd1 r1'

139 unifyRows' [] REmpty [] REmpty = return ()

129 unifyRows' [] REmpty [] REmpty = return ()

140 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()

130 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()

141 unifyRows' [] (Skolem _ s1 _) [] (Skolem _ s2 _) | s1 == s2 = return ()

131 unifyRows' [] (Skolem _ s1 _) [] (Skolem _ s2 _) | s1 == s2 = return ()

@@ -144,26 +134,21 @@ unifyRows r1 r2 =

144-- |

134-- |

145-- Check that two types unify

135-- Check that two types unify

146--

136--

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

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

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

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

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

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

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

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

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

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

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

153−unifiesWith e (SaturatedTypeSynonym name args) t2 =

154− case expandTypeSynonym' e name args of

155− Left _ -> False

156− Right t1 -> unifiesWith e t1 t2

157−unifiesWith e t1 t2@(SaturatedTypeSynonym _ _) = unifiesWith e t2 t1

158−unifiesWith _ REmpty REmpty = True

143+unifiesWith REmpty REmpty = True

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

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

160 let (s1, r1') = rowToList r1

145 let (s1, r1') = rowToList r1

161 (s2, r2') = rowToList r2

146 (s2, r2') = rowToList r2

162

147

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

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

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

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

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

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

166− 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'

167 where

152 where

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

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

169 go [] REmpty [] REmpty = True

154 go [] REmpty [] REmpty = True

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

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

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

174 go _ (TUnknown _) _ (TUnknown _) = True

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

175 go _ _ _ _ = False

160 go _ _ _ _ = False

176−unifiesWith _ _ _ = False

161+unifiesWith _ _ = False

177

162

178-- |

163-- |

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

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

src/Language/PureScript/Types.hs−12

@@ -66,10 +66,6 @@ data Type

66 --

67 | TypeApp Type Type

68 -- |

69− -- A type synonym which is \"saturated\", i.e. fully applied

70− --

71− | SaturatedTypeSynonym (Qualified ProperName) [Type]

72− -- |

73 -- Forall quantifier

69 -- Forall quantifier

74 --

70 --

75 | ForAll String Type (Maybe SkolemScope)

71 | ForAll String Type (Maybe SkolemScope)

@@ -161,7 +157,6 @@ replaceAllTypeVars = go []

161 Just r -> r

157 Just r -> r

162 Nothing -> TypeVar v

158 Nothing -> TypeVar v

163 go bs m (TypeApp t1 t2) = TypeApp (go bs m t1) (go bs m t2)

159 go bs m (TypeApp t1 t2) = TypeApp (go bs m t1) (go bs m t2)

164− go bs m (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs m) ts

165 go bs m f@(ForAll v t sco) | v `elem` keys = go bs (filter ((/= v) . fst) m) f

160 go bs m f@(ForAll v t sco) | v `elem` keys = go bs (filter ((/= v) . fst) m) f

166 | v `elem` usedVars =

161 | v `elem` usedVars =

167 let v' = genName v (keys ++ bs ++ usedVars)

162 let v' = genName v (keys ++ bs ++ usedVars)

@@ -200,7 +195,6 @@ freeTypeVariables = nub . go []

200 go :: [String] -> Type -> [String]

195 go :: [String] -> Type -> [String]

201 go bound (TypeVar v) | v `notElem` bound = [v]

196 go bound (TypeVar v) | v `notElem` bound = [v]

202 go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2

197 go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2

203− go bound (SaturatedTypeSynonym _ ts) = concatMap (go bound) ts

204 go bound (ForAll v t _) = go (v : bound) t

198 go bound (ForAll v t _) = go (v : bound) t

205 go bound (ConstrainedType cs t) = concatMap (concatMap (go bound) . snd) cs ++ go bound t

199 go bound (ConstrainedType cs t) = concatMap (concatMap (go bound) . snd) cs ++ go bound t

206 go bound (RCons _ t r) = go bound t ++ go bound r

200 go bound (RCons _ t r) = go bound t ++ go bound r

@@ -247,7 +241,6 @@ everywhereOnTypes :: (Type -> Type) -> Type -> Type

247everywhereOnTypes f = go

241everywhereOnTypes f = go

248 where

242 where

249 go (TypeApp t1 t2) = f (TypeApp (go t1) (go t2))

243 go (TypeApp t1 t2) = f (TypeApp (go t1) (go t2))

250− go (SaturatedTypeSynonym name tys) = f (SaturatedTypeSynonym name (map go tys))

251 go (ForAll arg ty sco) = f (ForAll arg (go ty) sco)

244 go (ForAll arg ty sco) = f (ForAll arg (go ty) sco)

252 go (ConstrainedType cs ty) = f (ConstrainedType (map (fmap (map go)) cs) (go ty))

245 go (ConstrainedType cs ty) = f (ConstrainedType (map (fmap (map go)) cs) (go ty))

253 go (RCons name ty rest) = f (RCons name (go ty) (go rest))

246 go (RCons name ty rest) = f (RCons name (go ty) (go rest))

@@ -261,7 +254,6 @@ everywhereOnTypesTopDown :: (Type -> Type) -> Type -> Type

261everywhereOnTypesTopDown f = go . f

254everywhereOnTypesTopDown f = go . f

262 where

255 where

263 go (TypeApp t1 t2) = TypeApp (go (f t1)) (go (f t2))

256 go (TypeApp t1 t2) = TypeApp (go (f t1)) (go (f t2))

264− go (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym name (map (go . f) tys)

265 go (ForAll arg ty sco) = ForAll arg (go (f ty)) sco

257 go (ForAll arg ty sco) = ForAll arg (go (f ty)) sco

266 go (ConstrainedType cs ty) = ConstrainedType (map (fmap (map (go . f))) cs) (go (f ty))

258 go (ConstrainedType cs ty) = ConstrainedType (map (fmap (map (go . f))) cs) (go (f ty))

267 go (RCons name ty rest) = RCons name (go (f ty)) (go (f rest))

259 go (RCons name ty rest) = RCons name (go (f ty)) (go (f rest))

@@ -275,7 +267,6 @@ everywhereOnTypesM :: (Functor m, Applicative m, Monad m) => (Type -> m Type) ->

275everywhereOnTypesM f = go

267everywhereOnTypesM f = go

276 where

268 where

277 go (TypeApp t1 t2) = (TypeApp <$> go t1 <*> go t2) >>= f

269 go (TypeApp t1 t2) = (TypeApp <$> go t1 <*> go t2) >>= f

278− go (SaturatedTypeSynonym name tys) = (SaturatedTypeSynonym name <$> mapM go tys) >>= f

279 go (ForAll arg ty sco) = (ForAll arg <$> go ty <*> pure sco) >>= f

270 go (ForAll arg ty sco) = (ForAll arg <$> go ty <*> pure sco) >>= f

280 go (ConstrainedType cs ty) = (ConstrainedType <$> mapM (sndM (mapM go)) cs <*> go ty) >>= f

271 go (ConstrainedType cs ty) = (ConstrainedType <$> mapM (sndM (mapM go)) cs <*> go ty) >>= f

281 go (RCons name ty rest) = (RCons name <$> go ty <*> go rest) >>= f

272 go (RCons name ty rest) = (RCons name <$> go ty <*> go rest) >>= f

@@ -289,7 +280,6 @@ everywhereOnTypesTopDownM :: (Functor m, Applicative m, Monad m) => (Type -> m T

289everywhereOnTypesTopDownM f = go <=< f

280everywhereOnTypesTopDownM f = go <=< f

290 where

281 where

291 go (TypeApp t1 t2) = TypeApp <$> (f t1 >>= go) <*> (f t2 >>= go)

282 go (TypeApp t1 t2) = TypeApp <$> (f t1 >>= go) <*> (f t2 >>= go)

292− go (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym name <$> mapM (go <=< f) tys

293 go (ForAll arg ty sco) = ForAll arg <$> (f ty >>= go) <*> pure sco

283 go (ForAll arg ty sco) = ForAll arg <$> (f ty >>= go) <*> pure sco

294 go (ConstrainedType cs ty) = ConstrainedType <$> mapM (sndM (mapM (go <=< f))) cs <*> (f ty >>= go)

284 go (ConstrainedType cs ty) = ConstrainedType <$> mapM (sndM (mapM (go <=< f))) cs <*> (f ty >>= go)

295 go (RCons name ty rest) = RCons name <$> (f ty >>= go) <*> (f rest >>= go)

285 go (RCons name ty rest) = RCons name <$> (f ty >>= go) <*> (f rest >>= go)

@@ -303,7 +293,6 @@ everythingOnTypes :: (r -> r -> r) -> (Type -> r) -> Type -> r

303everythingOnTypes (<>) f = go

293everythingOnTypes (<>) f = go

304 where

294 where

305 go t@(TypeApp t1 t2) = f t <> go t1 <> go t2

295 go t@(TypeApp t1 t2) = f t <> go t1 <> go t2

306− go t@(SaturatedTypeSynonym _ tys) = foldl (<>) (f t) (map go tys)

307 go t@(ForAll _ ty _) = f t <> go ty

296 go t@(ForAll _ ty _) = f t <> go ty

308 go t@(ConstrainedType cs ty) = foldl (<>) (f t) (map go $ concatMap snd cs) <> go ty

297 go t@(ConstrainedType cs ty) = foldl (<>) (f t) (map go $ concatMap snd cs) <> go ty

309 go t@(RCons _ ty rest) = f t <> go ty <> go rest

298 go t@(RCons _ ty rest) = f t <> go ty <> go rest

@@ -318,7 +307,6 @@ everythingWithContextOnTypes s0 r0 (<>) f = go' s0

318 where

307 where

319 go' s t = let (s', r) = f s t in r <> go s' t

308 go' s t = let (s', r) = f s t in r <> go s' t

320 go s (TypeApp t1 t2) = go' s t1 <> go' s t2

309 go s (TypeApp t1 t2) = go' s t1 <> go' s t2

321− go s (SaturatedTypeSynonym _ tys) = foldl (<>) r0 (map (go' s) tys)

322 go s (ForAll _ ty _) = go' s ty

310 go s (ForAll _ ty _) = go' s ty

323 go s (ConstrainedType cs ty) = foldl (<>) r0 (map (go' s) $ concatMap snd cs) <> go' s ty

311 go s (ConstrainedType cs ty) = foldl (<>) r0 (map (go' s) $ concatMap snd cs) <> go' s ty

324 go s (RCons _ ty rest) = go' s ty <> go' s rest

312 go s (RCons _ ty rest) = go' s ty <> go' s rest