git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #376 and make types more easily understandable by pushing foralls before constraints in type class members.
commit807426adf330f86a9be7c4fca88dc91b1544f8b6 authorPhil Freeman <paf31@cantab.net> dateSat 12 Apr 2014, 14:18 (13 years ago) parent635330b
3 files changed+36−5
compare with golang
unifiedsplit
examples/passing/Sequence.purs+12 src/Language/PureScript/Sugar/TypeClasses.hs+5−5 src/Language/PureScript/Types.hs+19
examples/passing/Sequence.pursnew file+12
@@ -0,0 +1,12 @@
1+module Main where
2+
3+import Control.Monad.Eff
4+
5+class Sequence t where
6+ sequence :: forall m a. (Monad m) => t (m a) -> m (t a)
7+
8+instance sequenceArray :: Sequence [] where
9+ sequence [] = pure []
10+ sequence (x:xs) = (:) <$> x <*> sequence xs
11+
12+main = sequence $ [Debug.Trace.trace "Done"]
src/Language/PureScript/Sugar/TypeClasses.hs+5−5
@@ -145,7 +145,7 @@ typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> D
145145typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =
146146 ExternDeclaration TypeClassAccessorImport ident
147147 (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSIndexer (JSStringLiteral (identToProperty ident)) (JSVar "dict"))])))
148− (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))
148+ (moveQuantifiersToFront (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty)))
149149typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =
150150 PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d
151151typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"
@@ -169,7 +169,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =
169169 case mapMaybe declName tyDecls \\ mapMaybe declName decls of
170170 x : _ -> throwError $ mkErrorStack ("Member '" ++ show x ++ "' has not been implemented") Nothing
171171 [] -> do
172−
172+
173173 let instanceTys = map memberToNameAndType tyDecls
174174
175175 -- Replace the type arguments with the appropriate types in the member types
@@ -192,16 +192,16 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =
192192 dictTy = foldl TypeApp (TypeConstructor className) tys
193193 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)
194194 dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames') else ObjectLiteral memberNames'
195−
195+
196196 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)
197−
197+
198198 where
199199
200200 declName :: Declaration -> Maybe Ident
201201 declName (PositionedDeclaration _ d) = declName d
202202 declName (ValueDeclaration ident _ _ _ _) = Just ident
203203 declName (TypeDeclaration ident _) = Just ident
204− declName _ = Nothing
204+ declName _ = Nothing
205205
206206 memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)
207207 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do
src/Language/PureScript/Types.hs+19
@@ -182,3 +182,22 @@ freeTypeVariables = nub . go []
182182--
183183quantify :: Type -> Type
184184quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty
185+
186+-- |
187+-- Move all universal quantifiers to the front of a type
188+--
189+moveQuantifiersToFront :: Type -> Type
190+moveQuantifiersToFront = go [] []
191+ where
192+ go qs cs (ForAll q ty sco) = go ((q, sco) : qs) cs ty
193+ go qs cs (ConstrainedType cs' ty) = go qs (cs ++ cs') ty
194+ go qs cs ty =
195+ let constrained = case cs of
196+ [] -> ty
197+ cs' -> ConstrainedType cs' ty
198+ in case qs of
199+ [] -> constrained
200+ qs' -> foldl (\ty' (q, sco) -> ForAll q ty' sco) constrained qs'
201+
202+
203+