9e32d43 · rowtype-yoga/purescript-native

examples/passing/InstanceBeforeClass.pursnew file+9

compare with golang

unifiedsplit

@@ -0,0 +1,9 @@

1+module Main where

2+

3+instance fooNumber :: Foo Number where

4+ foo = 0

5+

6+class Foo a where

7+ foo :: a

8+

9+main = Debug.Trace.trace "Done"

src/Language/PureScript/AST/Declarations.hs+9−2

@@ -261,11 +261,18 @@ isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d

261isExternDecl _ = False

262

263-- |

264−-- Test if a declaration is a type class or instance declaration

264+-- Test if a declaration is a type class instance declaration

265+--

266+isTypeClassInstanceDeclaration :: Declaration -> Bool

267+isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True

268+isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d

269+isTypeClassInstanceDeclaration _ = False

270+

271+-- |

272+-- Test if a declaration is a type class declaration

265--

273--

266isTypeClassDeclaration :: Declaration -> Bool

274isTypeClassDeclaration :: Declaration -> Bool

267isTypeClassDeclaration TypeClassDeclaration{} = True

275isTypeClassDeclaration TypeClassDeclaration{} = True

268−isTypeClassDeclaration TypeInstanceDeclaration{} = True

269isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d

276isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d

270isTypeClassDeclaration _ = False

277isTypeClassDeclaration _ = False

271

278

src/Language/PureScript/Sugar/BindingGroups.hs+1

@@ -78,6 +78,7 @@ createBindingGroups moduleName = mapM f <=< handleDecls

78 filter isExternInstanceDecl ds ++

79 dataBindingGroupDecls ++

80 filter isTypeClassDeclaration ds ++

81+ filter isTypeClassInstanceDeclaration ds ++

81 filter isFixityDecl ds ++

82 filter isFixityDecl ds ++

82 filter isExternDecl ds ++

83 filter isExternDecl ds ++

83 bindingGroupDecls

84 bindingGroupDecls

src/Language/PureScript/Sugar/TypeClasses.hs+8−2

@@ -38,7 +38,7 @@ import Control.Applicative

38import Control.Arrow (first, second)

39import Control.Monad.Except

40import Control.Monad.State

41−import Data.List ((\\), find)

41+import Data.List ((\\), find, sortBy)

42import Data.Maybe (catMaybes, mapMaybe, isJust)

43

44import qualified Data.Map as M

@@ -56,8 +56,14 @@ desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

56

57desugarModule :: (Functor m, Applicative m, MonadSupply m, MonadError ErrorStack m) => Module -> Desugar m Module

58desugarModule (Module coms name decls (Just exps)) = do

59− (newExpss, declss) <- unzip <$> parU decls (desugarDecl name exps)

59+ (newExpss, declss) <- unzip <$> parU (sortBy classesFirst decls) (desugarDecl name exps)

60 return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)

61+ where

62+ classesFirst :: Declaration -> Declaration -> Ordering

63+ classesFirst d1 d2

64+ | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT

65+ | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT

66+ | otherwise = EQ

61desugarModule _ = error "Exports should have been elaborated in name desugaring"

67desugarModule _ = error "Exports should have been elaborated in name desugaring"

62

68

63{- Desugar type class and type class instance declarations

69{- Desugar type class and type class instance declarations