git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix typechecking of constrained type values
d0a2fc2Gary Burgess
examples/passing/SequenceDesugared.pursnew file+34
@@ -0,0 +1,34 @@
1+module Main where
2+
3+import Control.Monad.Eff
4+
5+data Sequence t = Sequence (forall m a. (Monad m) => t (m a) -> m (t a))
6+
7+sequence :: forall t. Sequence t -> (forall m a. (Monad m) => t (m a) -> m (t a))
8+sequence (Sequence s) = s
9+
10+sequenceArraySeq :: forall m a. (Monad m) => Array (m a) -> m (Array a)
11+sequenceArraySeq [] = pure []
12+sequenceArraySeq (x:xs) = (:) <$> x <*> sequenceArraySeq xs
13+
14+sequenceArray :: Sequence []
15+sequenceArray = Sequence (sequenceArraySeq)
16+
17+sequenceArray' :: Sequence []
18+sequenceArray' = Sequence ((\val -> case val of
19+ [] -> pure []
20+ (x:xs) -> (:) <$> x <*> sequence sequenceArray' xs))
21+
22+sequenceArray'' :: Sequence []
23+sequenceArray'' = Sequence (sequenceArraySeq :: forall m a. (Monad m) => Array (m a) -> m (Array a))
24+
25+sequenceArray''' :: Sequence []
26+sequenceArray''' = Sequence ((\val -> case val of
27+ [] -> pure []
28+ (x:xs) -> (:) <$> x <*> sequence sequenceArray''' xs) :: forall m a. (Monad m) => Array (m a) -> m (Array a))
29+
30+main = do
31+ sequence sequenceArray $ [Debug.Trace.trace "Done"]
32+ sequence sequenceArray' $ [Debug.Trace.trace "Done"]
33+ sequence sequenceArray'' $ [Debug.Trace.trace "Done"]
34+ sequence sequenceArray''' $ [Debug.Trace.trace "Done"]
src/Language/PureScript/TypeChecker/Types.hs+5−5
@@ -506,9 +506,9 @@ check' (TypedValue checkType val ty1) ty2 = do
506 val' <- subsumes (Just val) ty1' ty2'
506 val' <- subsumes (Just val) ty1' ty2'
507 case val' of
507 case val' of
508 Nothing -> throwError . errorMessage $ SubsumptionCheckFailed
508 Nothing -> throwError . errorMessage $ SubsumptionCheckFailed
509− Just val'' -> do
509+ Just _ -> do
510− val''' <- if checkType then withScopedTypeVars moduleName args (check val'' ty2') else return val''
510+ val''' <- if checkType then withScopedTypeVars moduleName args (check val ty2') else return val
511− return $ TypedValue checkType (TypedValue True val''' ty1') ty2'
511+ return $ TypedValue checkType val''' ty2'
512check' (Case vals binders) ret = do
512check' (Case vals binders) ret = do
513 vals' <- mapM infer vals
513 vals' <- mapM infer vals
514 let ts = map (\(TypedValue _ _ t) -> t) vals'
514 let ts = map (\(TypedValue _ _ t) -> t) vals'
@@ -660,8 +660,8 @@ meet e1 e2 t1 t2 = do
660-- Ensure a set of property names and value does not contain duplicate labels
660-- Ensure a set of property names and value does not contain duplicate labels
661--
661--
662ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(String, Expr)] -> m ()
662ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(String, Expr)] -> m ()
663−ensureNoDuplicateProperties ps =
663+ensureNoDuplicateProperties ps =
664 let ls = map fst ps in
664 let ls = map fst ps in
665 case ls \\ nub ls of
665 case ls \\ nub ls of
666 l : _ -> throwError . errorMessage $ DuplicateLabel l Nothing
666 l : _ -> throwError . errorMessage $ DuplicateLabel l Nothing
667− _ -> return ()
667+ _ -> return ()