4e144ce · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Merge branch 'master' into pure11

4e144ceAndy Arvanitis11 years ago

CONTRIBUTORS.md+1

@@ -57,6 +57,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

57- [@senju](https://github.com/senju) - My existing contributions and all future contributions until further notice are Copyright senju, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

58<http://opensource.org/licenses/MIT>.

59- [@soupi](https://github.com/soupi) (Gil Mizrahi) My existing contributions and all future contributions until further notice are Copyright Gil Mizrahi, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

60+- [@tfausak](https://github.com/tfausak) (Taylor Fausak) My existing contributions and all future contributions until further notice are Copyright Taylor Fausak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

61### Companies

62### Companies

core-tests/tests/generic-deriving/Main.purs+2−2

@@ -14,7 +14,7 @@ data A a

14 = A Number String

15 | B Int

16 | C (Array (A a))

17− | D { a :: a }

17+ | D { "asgård" :: a }

18 | E Void

20derive instance genericA :: (Generic b) => Generic (A b)

@@ -24,4 +24,4 @@ newtype X b = X b

24derive instance genericX :: Generic (X String)

26main :: forall eff. Eff (console :: CONSOLE | eff) Unit

27−main = Control.Monad.Eff.Console.log (gShow (D { a: C [ A 1.0 "test", B 42, D { a: true } ] }))

27+main = Control.Monad.Eff.Console.log (gShow (D { "asgård": C [ A 1.0 "test", B 42, D { "asgård": true } ] }))

purescript.cabal+1−1

@@ -1,5 +1,5 @@

1name: purescript

2−version: 0.7.5.3

2+version: 0.7.6.1

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+11−6

@@ -73,6 +73,9 @@ dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]

73dataMaybe :: ModuleName

74dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]

76+typesProxy :: ModuleName

77+typesProxy = ModuleName [ ProperName "Type", ProperName "Proxy" ]

78+

76deriveGeneric :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> ProperName -> [Type] -> m [Declaration]

79deriveGeneric :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> ProperName -> [Type] -> m [Declaration]

77deriveGeneric mn ds tyConNm args = do

80deriveGeneric mn ds tyConNm args = do

78 tyCon <- findTypeDecl tyConNm ds

81 tyCon <- findTypeDecl tyConNm ds

@@ -107,7 +110,7 @@ mkSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> mapM mkCtorCl

107 return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))

110 return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))

108 where

111 where

109 caseResult idents =

112 caseResult idents =

110− App (prodConstructor (StringLiteral . runProperName $ ctorName))

113+ App (prodConstructor (StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))

111 . ArrayLiteral

114 . ArrayLiteral

112 $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys

115 $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys

113

116

@@ -121,19 +124,21 @@ mkSpineFunction mn (PositionedDeclaration _ _ d) = mkSpineFunction mn d

121mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"

124mkSpineFunction _ _ = internalError "mkSpineFunction: expected DataDeclaration"

122

125

123mkSignatureFunction :: ModuleName -> Declaration -> [Type] -> Expr

126mkSignatureFunction :: ModuleName -> Declaration -> [Type] -> Expr

124−mkSignatureFunction _ (DataDeclaration _ _ tyArgs args) classArgs = lamNull . mkSigProd $ map mkProdClause args

127+mkSignatureFunction mn (DataDeclaration _ name tyArgs args) classArgs = lamNull . mkSigProd $ map mkProdClause args

125 where

128 where

126 mkSigProd :: [Expr] -> Expr

129 mkSigProd :: [Expr] -> Expr

127− mkSigProd = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd"))) . ArrayLiteral

130+ mkSigProd = App (App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd")))

131+ (StringLiteral (showQualified runProperName (Qualified (Just mn) name)))

132+ ) . ArrayLiteral

128

133

129 mkSigRec :: [Expr] -> Expr

134 mkSigRec :: [Expr] -> Expr

130 mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral

135 mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral

131

136

132 proxy :: Type -> Type

137 proxy :: Type -> Type

133− proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))

138+ proxy = TypeApp (TypeConstructor (Qualified (Just typesProxy) (ProperName "Proxy")))

134

139

135 mkProdClause :: (ProperName, [Type]) -> Expr

140 mkProdClause :: (ProperName, [Type]) -> Expr

136− mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (runProperName ctorName))

141+ mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (showQualified runProperName (Qualified (Just mn) ctorName)))

137 , ("sigValues", ArrayLiteral . map (mkProductSignature . instantiate) $ tys)

142 , ("sigValues", ArrayLiteral . map (mkProductSignature . instantiate) $ tys)

138 ]

143 ]

139

144

@@ -168,7 +173,7 @@ mkFromSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch

168 mkAlternative :: (ProperName, [Type]) -> m CaseAlternative

173 mkAlternative :: (ProperName, [Type]) -> m CaseAlternative

169 mkAlternative (ctorName, tys) = do

174 mkAlternative (ctorName, tys) = do

170 idents <- replicateM (length tys) (fmap Ident freshName)

175 idents <- replicateM (length tys) (fmap Ident freshName)

171− return $ CaseAlternative [ prodBinder [ StringBinder (runProperName ctorName), ArrayBinder (map VarBinder idents)]]

176+ return $ CaseAlternative [ prodBinder [ StringBinder (showQualified runProperName (Qualified (Just mn) ctorName)), ArrayBinder (map VarBinder idents)]]

172 . Right

177 . Right

173 $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))

178 $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName))

174 (zipWith fromSpineFun (map (Var . Qualified Nothing) idents) tys)

179 (zipWith fromSpineFun (map (Var . Qualified Nothing) idents) tys)