git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix failing tests
commita8108d09557ccd9ce2e972b3633a7a6666b0cf11 authorPhil Freeman <paf31@cantab.net> dateSat 5 Apr 2014, 19:06 (13 years ago) parent8f956e0
4 files changed+34−4
examples/passing/MonadState.purs+7 examples/passing/TypeClasses.purs+21 src/Language/PureScript/Sugar/TypeClasses.hs+1−1 src/Language/PureScript/TypeChecker/Types.hs+5−3
examples/passing/MonadState.purs+7
@@ -12,6 +12,13 @@ data State s a = State (s -> Tuple s a)
1212
1313runState s (State f) = f s
1414
15+instance functorState :: Functor (State s) where
16+ (<$>) = liftM1
17+
18+instance appState :: Applicative (State s) where
19+ pure = return
20+ (<*>) = ap
21+
1522instance monadState :: Prelude.Monad (State s) where
1623 return a = State $ \s -> Tuple s a
1724 (>>=) f g = State $ \s -> case runState s f of
examples/passing/TypeClasses.purs+21
@@ -21,12 +21,26 @@ instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where
2121
2222test3 = \_ -> show (Data "testing")
2323
24+instance functorData :: Functor Data where
25+ (<$>) = liftM1
26+
27+instance appData :: Applicative Data where
28+ pure = return
29+ (<*>) = ap
30+
2431instance monadData :: Prelude.Monad Data where
2532 return = Data
2633 (>>=) (Data a) f = f a
2734
2835data Maybe a = Nothing | Just a
2936
37+instance functorMaybe :: Functor Maybe where
38+ (<$>) = liftM1
39+
40+instance appMaybe :: Applicative Maybe where
41+ pure = return
42+ (<*>) = ap
43+
3044instance monadMaybe :: Prelude.Monad Maybe where
3145 return = Just
3246 (>>=) Nothing _ = Nothing
@@ -43,6 +57,13 @@ instance showArray :: (Prelude.Show a) => Prelude.Show [a] where
4357
4458test6 = \_ -> show ["testing"]
4559
60+instance functorFunction :: Functor ((->) r) where
61+ (<$>) = liftM1
62+
63+instance appFunction :: Applicative ((->) r) where
64+ pure = return
65+ (<*>) = ap
66+
4667instance monadFunction :: Prelude.Monad ((->) r) where
4768 return a r = a
4869 (>>=) f g r = g (f r) r
src/Language/PureScript/Sugar/TypeClasses.hs+1−1
@@ -152,7 +152,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do
152152 M.lookup (qualify mn className) m
153153 let instanceTys = map memberToNameAndType tyDecls
154154
155− let superclasses = TypedValue False (ArrayLiteral [ TypeClassDictionary False (superclass, tyArgs) Nothing
155+ let superclasses = TypedValue False (ArrayLiteral [ Abs (Left (Ident "_")) (TypeClassDictionary False (superclass, tyArgs) Nothing)
156156 | (superclass, suTyArgs) <- implies
157157 , let tyArgs = map (replaceAllTypeVars (zip args tys)) suTyArgs
158158 ]) (TypeApp tyArray unit)
src/Language/PureScript/TypeChecker/Types.hs+5−3
@@ -355,9 +355,10 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
355355 dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
356356 dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
357357 dictionaryValueToValue (SubclassDictionaryValue dict index) =
358− App (App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident (C.!!))))
359− (Accessor C.__superclasses (dictionaryValueToValue dict)))
360− (NumericLiteral (Left index))
358+ App (App (App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident (C.!!))))
359+ (Accessor C.__superclasses (dictionaryValueToValue dict)))
360+ (NumericLiteral (Left index)))
361+ (ObjectLiteral [])
361362 -- Ensure that a substitution is valid
362363 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]
363364 verifySubstitution subst = do
@@ -383,6 +384,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
383384 [] -> ds
384385 simple -> simple
385386 isSimpleDictionaryValue SubclassDictionaryValue{} = False
387+ isSimpleDictionaryValue (DependentDictionaryValue _ ds) = all isSimpleDictionaryValue ds
386388 isSimpleDictionaryValue _ = True
387389
388390-- |