git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix last remaining breaking test case for skolems bug #147
4f77064Phil Freeman
examples/passing/Eff.purs+2−2
compare with golang
unifiedsplit
@@ -10,10 +10,10 @@ test1 = catchError (\s -> ret 0) $ do
10 trace "Testing"
10 trace "Testing"
11 throwError "Error!"
11 throwError "Error!"
12
12
13−test2 = runST (do
13+test2 = runPure (runST (do
14 ref <- newSTRef 0
14 ref <- newSTRef 0
15 modifySTRef ref $ \n -> n + 1
15 modifySTRef ref $ \n -> n + 1
16− readSTRef ref)
16+ readSTRef ref))
17
17
18module Main where
18module Main where
19
19
src/Language/PureScript/TypeChecker/Types.hs+8−8
@@ -297,9 +297,9 @@ skolemEscapeCheck (TypedValue False _ _) = return ()
297skolemEscapeCheck root@(TypedValue _ _ _) =
297skolemEscapeCheck root@(TypedValue _ _ _) =
298 case everythingWithContext [] (++) (mkQ ((,) []) go) root of
298 case everythingWithContext [] (++) (mkQ ((,) []) go) root of
299 [] -> return ()
299 [] -> return ()
300− ((binding, val) : _) -> throwError $ "Rigid/skolem type variable bound by " ++ prettyPrintValue binding ++ " has escaped at " ++ prettyPrintValue val
300+ ((binding, val) : _) -> throwError $ "Rigid/skolem type variable bound by " ++ maybe "<unknown>" prettyPrintValue binding ++ " has escaped at " ++ prettyPrintValue val
301 where
301 where
302− go :: Value -> [(SkolemScope, Value)] -> ([(Value, Value)], [(SkolemScope, Value)])
302+ go :: Value -> [(SkolemScope, Value)] -> ([(Maybe Value, Value)], [(SkolemScope, Value)])
303 go val@(TypedValue _ _ (ForAll _ _ (Just sco))) scos = ([], (sco, val) : scos)
303 go val@(TypedValue _ _ (ForAll _ _ (Just sco))) scos = ([], (sco, val) : scos)
304 go val@(TypedValue _ _ ty) scos = case collectSkolems ty \\ map fst scos of
304 go val@(TypedValue _ _ ty) scos = case collectSkolems ty \\ map fst scos of
305 (sco : _) -> ([(findBindingScope sco, val)], scos)
305 (sco : _) -> ([(findBindingScope sco, val)], scos)
@@ -311,8 +311,8 @@ skolemEscapeCheck root@(TypedValue _ _ _) =
311 collect (Skolem _ scope) = [scope]
311 collect (Skolem _ scope) = [scope]
312 collect _ = []
312 collect _ = []
313 go _ scos = ([], scos)
313 go _ scos = ([], scos)
314− findBindingScope :: SkolemScope -> Value
314+ findBindingScope :: SkolemScope -> Maybe Value
315− findBindingScope sco = fromMaybe (error "No introducing ForAll for skolem variable.") $ something (mkQ Nothing go) root
315+ findBindingScope sco = something (mkQ Nothing go) root
316 where
316 where
317 go val@(TypedValue _ _ (ForAll _ _ (Just sco'))) | sco == sco' = Just val
317 go val@(TypedValue _ _ (ForAll _ _ (Just sco'))) | sco == sco' = Just val
318 go _ = Nothing
318 go _ = Nothing
@@ -730,6 +730,10 @@ check' val t@(ConstrainedType constraints ty) = do
730 (qualifyAllUnqualifiedNames moduleName env constraints)) $
730 (qualifyAllUnqualifiedNames moduleName env constraints)) $
731 check val ty
731 check val ty
732 return $ TypedValue True (foldr Abs val' dictNames) t
732 return $ TypedValue True (foldr Abs val' dictNames) t
733+check' val t@(SaturatedTypeSynonym name args) = do
734+ ty <- introduceSkolemScope <=< expandTypeSynonym name $ args
735+ val' <- check val ty
736+ return $ TypedValue True val' ty
733check' val u@(TUnknown _) = do
737check' val u@(TUnknown _) = do
734 val'@(TypedValue _ _ ty) <- infer val
738 val'@(TypedValue _ _ ty) <- infer val
735 -- Don't unify an unknown with an inferred polytype
739 -- Don't unify an unknown with an inferred polytype
@@ -812,10 +816,6 @@ check' (Constructor c) ty = do
812 repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
816 repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
813 _ <- subsumes Nothing repl ty
817 _ <- subsumes Nothing repl ty
814 return $ TypedValue True (Constructor c) ty
818 return $ TypedValue True (Constructor c) ty
815−check' val t@(SaturatedTypeSynonym name args) = do
816− ty <- introduceSkolemScope <=< expandTypeSynonym name $ args
817− val' <- check val ty
818− return $ TypedValue True val' ty
819check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty
819check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty
820
820
821-- |
821-- |