git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix up some remaining issues with scoped type variables.
commit4570234de641c4ba2637d8325cd2b7423d9d6b9a authorPhil Freeman <paf31@cantab.net> dateWed 11 Feb 2015, 19:02 (12 years ago) parent2372665
4 files changed+27−14
compare with golang
unifiedsplit
examples/passing/ScopedTypeVariables.purs+12 src/Language/PureScript/Environment.hs+1−1 src/Language/PureScript/TypeChecker/Monad.hs+1−1 src/Language/PureScript/TypeChecker/Types.hs+13−12
examples/passing/ScopedTypeVariables.purs+12
@@ -6,4 +6,16 @@ test1 f x = g (g x)
66 g :: a -> a
77 g y = f (f y)
88
9+test2 :: forall a. (a -> a) -> a -> a
10+test2 = h
11+ where
12+ h :: forall b. (b -> b) -> b -> b
13+ h f x = g (g x)
14+ where
15+ g :: b -> b
16+ g y = f (f y)
17+
18+test3 :: Number
19+test3 = ((\b -> b :: b) :: forall b. b -> b) 0
20+
921main = Debug.Trace.trace "Done"
src/Language/PureScript/Environment.hs+1−1
@@ -140,7 +140,7 @@ data TypeKind
140140 -- |
141141 -- A scoped type variable
142142 --
143− | ScopedTypeVar Type
143+ | ScopedTypeVar
144144 deriving (Show, Eq, Data, Typeable)
145145
146146-- |
src/Language/PureScript/TypeChecker/Monad.hs+1−1
@@ -60,7 +60,7 @@ bindTypes newNames action = do
6060-- Temporarily bind a collection of names to types
6161--
6262withScopedTypeVars :: (Functor m, MonadState CheckState m) => ModuleName -> [(String, Kind)] -> m a -> m a
63−withScopedTypeVars mn ks = bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar (TypeVar name)))) ks))
63+withScopedTypeVars mn ks = bindTypes (M.fromList (map (\(name, k) -> (Qualified (Just mn) (ProperName name), (k, ScopedTypeVar))) ks))
6464
6565-- |
6666-- Temporarily make a collection of type class dictionaries available
src/Language/PureScript/TypeChecker/Types.hs+13−12
@@ -134,7 +134,7 @@ checkTypedBindingGroupElement mn (ident, (val', ty, checkType)) dict = do
134134 ty' <- replaceTypeWildcards ty
135135 -- Kind check
136136 (kind, args) <- liftCheck $ kindOfWithScopedVars ty
137− guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
137+ checkTypeKind kind
138138 -- Check the type with the new names in scope
139139 ty'' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty'
140140 val'' <- if checkType
@@ -183,10 +183,8 @@ replaceTypeClassDictionaries mn =
183183-- |
184184-- Check the kind of a type, failing if it is not of kind *.
185185--
186−checkTypeKind :: ModuleName -> Type -> UnifyT t Check ()
187−checkTypeKind moduleName ty = do
188− kind <- liftCheck $ kindOf moduleName ty
189− guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
186+checkTypeKind :: Kind -> UnifyT t Check ()
187+checkTypeKind kind = guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
190188
191189-- |
192190-- Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns
@@ -293,9 +291,10 @@ infer' (SuperClassDictionary className tys) = do
293291 return $ TypeClassDictionary False (className, tys) dicts
294292infer' (TypedValue checkType val ty) = do
295293 Just moduleName <- checkCurrentModule <$> get
296− checkTypeKind moduleName ty
294+ (kind, args) <- liftCheck $ kindOfWithScopedVars ty
295+ checkTypeKind kind
297296 ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty
298− val' <- if checkType then check val ty' else return val
297+ val' <- if checkType then withScopedTypeVars moduleName args (check val ty') else return val
299298 return $ TypedValue True val' ty'
300299infer' (PositionedValue pos _ val) = rethrowWithPosition pos $ infer' val
301300infer' _ = error "Invalid argument to infer"
@@ -304,10 +303,11 @@ inferLetBinding :: [Declaration] -> [Declaration] -> Expr -> (Expr -> UnifyT Typ
304303inferLetBinding seen [] ret j = (,) seen <$> makeBindingGroupVisible (j ret)
305304inferLetBinding seen (ValueDeclaration ident nameKind [] (Right (tv@(TypedValue checkType val ty))) : rest) ret j = do
306305 Just moduleName <- checkCurrentModule <$> get
307− checkTypeKind moduleName ty
306+ (kind, args) <- liftCheck $ kindOfWithScopedVars ty
307+ checkTypeKind kind
308308 let dict = M.singleton (moduleName, ident) (ty, nameKind, Undefined)
309309 ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty
310− TypedValue _ val' ty'' <- if checkType then bindNames dict (check val ty') else return tv
310+ TypedValue _ val' ty'' <- if checkType then withScopedTypeVars moduleName args (bindNames dict (check val ty')) else return tv
311311 bindNames (M.singleton (moduleName, ident) (ty'', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] (Right (TypedValue checkType val' ty''))]) rest ret j
312312inferLetBinding seen (ValueDeclaration ident nameKind [] (Right val) : rest) ret j = do
313313 valTy <- fresh
@@ -507,14 +507,15 @@ check' (SuperClassDictionary className tys) _ = do
507507 return $ TypeClassDictionary False (className, tys) dicts
508508check' (TypedValue checkType val ty1) ty2 = do
509509 Just moduleName <- checkCurrentModule <$> get
510− checkTypeKind moduleName ty1
510+ (kind, args) <- liftCheck $ kindOfWithScopedVars ty1
511+ checkTypeKind kind
511512 ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty1
512513 ty2' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty2
513514 val' <- subsumes (Just val) ty1' ty2'
514515 case val' of
515516 Nothing -> throwError . strMsg $ "Unable to check type subsumption"
516517 Just val'' -> do
517− val''' <- if checkType then check val'' ty2' else return val''
518+ val''' <- if checkType then withScopedTypeVars moduleName args (check val'' ty2') else return val''
518519 return $ TypedValue checkType (TypedValue True val''' ty1') ty2'
519520check' (Case vals binders) ret = do
520521 vals' <- mapM infer vals
@@ -562,7 +563,7 @@ check' val ty | containsTypeSynonyms ty = do
562563 ty' <- introduceSkolemScope <=< expandAllTypeSynonyms <=< replaceTypeWildcards $ ty
563564 check val ty'
564565check' val kt@(KindedType ty kind) = do
565− guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
566+ checkTypeKind kind
566567 val' <- check' val ty
567568 return $ TypedValue True val' kt
568569check' (PositionedValue pos _ val) ty =