git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix typechecking of constrained type values
commitd0a2fc2ddf65f0064e8a79f2911bbb3027b5ef31 authorGary Burgess <gary.burgess@gmail.com> dateSun 8 Mar 2015, 18:17 (12 years ago) parentd81ea93
2 files changed+39−5
examples/passing/SequenceDesugared.purs+34 src/Language/PureScript/TypeChecker/Types.hs+5−5
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
506506 val' <- subsumes (Just val) ty1' ty2'
507507 case val' of
508508 Nothing -> throwError . errorMessage $ SubsumptionCheckFailed
509− Just val'' -> do
510− val''' <- if checkType then withScopedTypeVars moduleName args (check val'' ty2') else return val''
511− return $ TypedValue checkType (TypedValue True val''' ty1') ty2'
509+ Just _ -> do
510+ val''' <- if checkType then withScopedTypeVars moduleName args (check val ty2') else return val
511+ return $ TypedValue checkType val''' ty2'
512512check' (Case vals binders) ret = do
513513 vals' <- mapM infer vals
514514 let ts = map (\(TypedValue _ _ t) -> t) vals'
@@ -660,8 +660,8 @@ meet e1 e2 t1 t2 = do
660660-- Ensure a set of property names and value does not contain duplicate labels
661661--
662662ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(String, Expr)] -> m ()
663−ensureNoDuplicateProperties ps =
663+ensureNoDuplicateProperties ps =
664664 let ls = map fst ps in
665665 case ls \\ nub ls of
666666 l : _ -> throwError . errorMessage $ DuplicateLabel l Nothing
667− _ -> return ()
667+ _ -> return ()