Merge pull request purescript#1614 from purescript/1335

paf31 · paf31 · commit 09c43143bfac · 2015-11-07T17:43:42.000-08:00
Fix purescript#1335, track scoped type variables when skolemizing
diff --git a/examples/passing/1335.purs b/examples/passing/1335.purs
@@ -0,0 +1,12 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+x :: forall a. a -> String
+x a = y "Done"
+  where
+  y :: forall a. (Show a) => a -> String
+  y a = show (a :: a)
+
+main = log (x 0)
diff --git a/src/Language/PureScript/TypeChecker/Skolems.hs b/src/Language/PureScript/TypeChecker/Skolems.hs
@@ -29,6 +29,7 @@ import Prelude.Compat
 
 import Data.List (nub, (\\))
 import Data.Monoid
+import Data.Functor.Identity (Identity(), runIdentity)
 
 import Control.Monad.Error.Class (MonadError(..))
 import Control.Monad.State.Class (MonadState(..), gets, modify)
@@ -38,6 +39,7 @@ import Language.PureScript.AST
 import Language.PureScript.Errors
 import Language.PureScript.TypeChecker.Monad
 import Language.PureScript.Types
+import Language.PureScript.Traversals (defS)
 
 -- |
 -- Generate a new skolem constant
@@ -78,16 +80,26 @@ skolemize ident sko scope = replaceTypeVars ident (Skolem ident sko scope)
 -- only example of scoped type variables.
 --
 skolemizeTypesInValue :: String -> Int -> SkolemScope -> Expr -> Expr
-skolemizeTypesInValue ident sko scope = let (_, f, _) = everywhereOnValues id onExpr onBinder in f
+skolemizeTypesInValue ident sko scope =
+  let
+    (_, f, _, _, _) = everywhereWithContextOnValuesM [] defS onExpr onBinder defS defS
+  in runIdentity . f
   where
-  onExpr :: Expr -> Expr
-  onExpr (SuperClassDictionary c ts) = SuperClassDictionary c (map (skolemize ident sko scope) ts)
-  onExpr (TypedValue check val ty) = TypedValue check val (skolemize ident sko scope ty)
-  onExpr other = other
+  onExpr :: [String] -> Expr -> Identity ([String], Expr)
+  onExpr sco (SuperClassDictionary c ts)
+    | ident `notElem` sco = return (sco, SuperClassDictionary c (map (skolemize ident sko scope) ts))
+  onExpr sco (TypedValue check val ty)
+    | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedValue check val (skolemize ident sko scope ty))
+  onExpr sco other = return (sco, other)
 
-  onBinder :: Binder -> Binder
-  onBinder (TypedBinder ty b) = TypedBinder (skolemize ident sko scope ty) b
-  onBinder other = other
+  onBinder :: [String] -> Binder -> Identity ([String], Binder)
+  onBinder sco (TypedBinder ty b)
+    | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedBinder (skolemize ident sko scope ty) b)
+  onBinder sco other = return (sco, other)
+
+  peelTypeVars :: Type -> [String]
+  peelTypeVars (ForAll i ty _) = i : peelTypeVars ty
+  peelTypeVars _ = []
 
 -- |
 -- Ensure skolem variables do not escape their scope
