a628008 · rowtype-yoga/purescript-native

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

Merge pull request #2170 from garyb/1945

Fix issues with multiple data/type decls

commita6280084d0365d0df2999d6eca4cfebded794301 authorGary Burgess <gary.burgess@gmail.com> dateSun 29 May 2016, 01:02 (10 years ago) parent2bafbae d2dfad0

33 files changed+271−104

compare with golang

unifiedsplit

examples/failing/DeclConflictClassCtor.pursnew file+6

@@ -0,0 +1,6 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+data T = Fail

6+class Fail

examples/failing/DeclConflictClassSynonym.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+import Prelude

6+type Fail = Unit

8+class Fail

examples/failing/DeclConflictClassType.pursnew file+6

@@ -0,0 +1,6 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+class Fail

6+data Fail

examples/failing/DeclConflictCtorClass.pursnew file+6

@@ -0,0 +1,6 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+class Fail

6+data T = Fail

examples/failing/DeclConflictCtorCtor.pursnew file+6

@@ -0,0 +1,6 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+data T1 = Fail

6+data T2 = Fail

examples/failing/DeclConflictSynonymClass.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+import Prelude

6+class Fail

8+type Fail = Unit

examples/failing/DeclConflictSynonymType.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+import Prelude

6+data Fail

8+type Fail = Unit

examples/failing/DeclConflictTypeClass.pursnew file+6

@@ -0,0 +1,6 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+class Fail

6+data Fail

examples/failing/DeclConflictTypeSynonym.pursnew file+8

@@ -0,0 +1,8 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+import Prelude

6+type Fail = Unit

8+data Fail

examples/failing/DeclConflictTypeType.pursnew file+6

@@ -0,0 +1,6 @@

1+-- @shouldFailWith DeclConflict

2+module Main where

4+data Fail

6+data Fail

examples/failing/ExportConflictClass.pursnew file+5

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

1+-- @shouldFailWith ExportConflict

2+module C (module A, module B) where

4+import A as A

5+import B as B

examples/failing/ExportConflictClass/A.pursnew file+3

@@ -0,0 +1,3 @@

1+module A where

3+class X

examples/failing/ExportConflictClass/B.pursnew file+3

@@ -0,0 +1,3 @@

1+module B where

3+class X

examples/failing/ExportConflictCtor.pursnew file+5

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

1+-- @shouldFailWith ExportConflict

2+module C (module A, module B) where

4+import A as A

5+import B as B

examples/failing/ExportConflictCtor/A.pursnew file+3

@@ -0,0 +1,3 @@

1+module A where

3+data T1 = X

examples/failing/ExportConflictCtor/B.pursnew file+3

@@ -0,0 +1,3 @@

1+module B where

3+data T2 = X

examples/failing/ExportConflictType.pursnew file+5

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

1+-- @shouldFailWith ExportConflict

2+module C (module A, module B) where

4+import A as A

5+import B as B

examples/failing/ExportConflictType/A.pursnew file+3

@@ -0,0 +1,3 @@

1+module A where

3+data T

examples/failing/ExportConflictType/B.pursnew file+3

@@ -0,0 +1,3 @@

1+module B where

3+data T

examples/failing/ExportConflictTypeOp.pursnew file+5

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

1+-- @shouldFailWith ExportConflict

2+module C (module A, module B) where

4+import A as A

5+import B as B

examples/failing/ExportConflictTypeOp/A.pursnew file+5

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

1+module A where

3+type T1 a b = a -> b

5+infixr 4 type T1 as ??

examples/failing/ExportConflictTypeOp/B.pursnew file+5

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

1+module B where

3+type T2 a b = a -> b

5+infixr 4 type T2 as ??

examples/failing/ExportConflictValue.pursnew file+5

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

1+-- @shouldFailWith ExportConflict

2+module C (module A, module B) where

4+import A as A

5+import B as B

examples/failing/OverlappingReExport/A.purs → examples/failing/ExportConflictValue/A.pursrenamed+2

@@ -1,2 +1,4 @@

11module A where

3+x :: Boolean

24x = true

examples/failing/OverlappingReExport/B.purs → examples/failing/ExportConflictValue/B.pursrenamed+2

@@ -1,2 +1,4 @@

11module B where

3+x :: Boolean

24x = false

examples/failing/ExportConflictValueOp.pursnew file+5

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

1+-- @shouldFailWith ExportConflict

2+module C (module A, module B) where

4+import A as A

5+import B as B

examples/failing/ExportConflictValueOp/A.pursnew file+6

@@ -0,0 +1,6 @@

1+module A where

3+f1 :: forall a b. a -> b -> a

4+f1 x _ = x

6+infix 0 f1 as !!

examples/failing/ExportConflictValueOp/B.pursnew file+6

@@ -0,0 +1,6 @@

1+module B where

3+f2 :: forall a b. a -> b -> a

4+f2 x _ = x

6+infix 0 f2 as !!

examples/failing/OverlappingReExport.pursdeleted−5

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

1−-- @shouldFailWith DuplicateValueExport

2−module C (module A, module M2) where

3−

4−import A

5−import B as M2

purescript.cabal+6−1

@@ -59,6 +59,12 @@ extra-source-files: examples/passing/*.purs

5959 , examples/failing/ConflictingImports2/*.purs

6060 , examples/failing/ConflictingQualifiedImports/*.purs

6161 , examples/failing/ConflictingQualifiedImports2/*.purs

62+ , examples/failing/ExportConflictClass/*.purs

63+ , examples/failing/ExportConflictCtor/*.purs

64+ , examples/failing/ExportConflictType/*.purs

65+ , examples/failing/ExportConflictTypeOp/*.purs

66+ , examples/failing/ExportConflictValue/*.purs

67+ , examples/failing/ExportConflictValueOp/*.purs

6268 , examples/failing/ExportExplicit1/*.purs

6369 , examples/failing/ExportExplicit3/*.purs

6470 , examples/failing/ImportExplicit/*.purs

@@ -67,7 +73,6 @@ extra-source-files: examples/passing/*.purs

6773 , examples/failing/ImportModule/*.purs

6874 , examples/failing/InstanceExport/*.purs

6975 , examples/failing/OrphanInstance/*.purs

70− , examples/failing/OverlappingReExport/*.purs

7176 , examples/warning/*.purs

7277 , examples/warning/*.js

7378 , examples/docs/bower_components/purescript-prelude/src/*.purs

src/Language/PureScript/Errors.hs+37−57

@@ -65,17 +65,9 @@ data SimpleErrorMessage

6565 | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)

6666 | ScopeConflict Name [ModuleName]

6767 | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

68− | ConflictingTypeDecls (ProperName 'TypeName)

69− | ConflictingCtorDecls (ProperName 'ConstructorName)

70− | TypeConflictsWithClass (ProperName 'TypeName)

71− | CtorConflictsWithClass (ProperName 'ConstructorName)

72− | ClassConflictsWithType (ProperName 'ClassName)

73− | ClassConflictsWithCtor (ProperName 'ClassName)

68+ | DeclConflict Name Name

69+ | ExportConflict (Qualified Name) (Qualified Name)

7470 | DuplicateModuleName ModuleName

75− | DuplicateClassExport (ProperName 'ClassName)

76− | DuplicateValueExport Ident

77− | DuplicateValueOpExport (OpName 'ValueOpName)

78− | DuplicateTypeOpExport (OpName 'TypeOpName)

7971 | DuplicateTypeArgument String

8072 | InvalidDoBind

8173 | InvalidDoLet

@@ -234,17 +226,9 @@ errorCode em = case unwrapErrorMessage em of

234226 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"

235227 ScopeConflict{} -> "ScopeConflict"

236228 ScopeShadowing{} -> "ScopeShadowing"

237− ConflictingTypeDecls{} -> "ConflictingTypeDecls"

238− ConflictingCtorDecls{} -> "ConflictingCtorDecls"

239− TypeConflictsWithClass{} -> "TypeConflictsWithClass"

240− CtorConflictsWithClass{} -> "CtorConflictsWithClass"

241− ClassConflictsWithType{} -> "ClassConflictsWithType"

242− ClassConflictsWithCtor{} -> "ClassConflictsWithCtor"

229+ DeclConflict{} -> "DeclConflict"

230+ ExportConflict{} -> "ExportConflict"

243231 DuplicateModuleName{} -> "DuplicateModuleName"

244− DuplicateClassExport{} -> "DuplicateClassExport"

245− DuplicateValueExport{} -> "DuplicateValueExport"

246− DuplicateValueOpExport{} -> "DuplicateValueOpExport"

247− DuplicateTypeOpExport{} -> "DuplicateTypeOpExport"

248232 DuplicateTypeArgument{} -> "DuplicateTypeArgument"

249233 InvalidDoBind -> "InvalidDoBind"

250234 InvalidDoLet -> "InvalidDoLet"

@@ -479,7 +463,7 @@ colorCodeBox codeColor b = case codeColor of

479463 Just cc

480464 | Box.rows b == 1 ->

481465 Box.text (ansiColor cc) Box.<> b `endWith` Box.text ansiColorReset

482−

466+

483467 | otherwise -> Box.hcat Box.left -- making two boxes, one for each side of the box so that it will set each row it's own color and will reset it afterwards

484468 [ Box.vcat Box.top $ replicate (Box.rows b) $ Box.text $ ansiColor cc

485469 , b

@@ -648,28 +632,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

648632 Just exmn' -> "declaration from " ++ markCode (runModuleName exmn') ++ " will be used."

649633 Nothing -> "local declaration will be used."

650634 ]

651− renderSimpleErrorMessage (ConflictingTypeDecls nm) =

652− line $ "Conflicting type declarations for " ++ markCode (runProperName nm)

653− renderSimpleErrorMessage (ConflictingCtorDecls nm) =

654− line $ "Conflicting data constructor declarations for " ++ markCode (runProperName nm)

655− renderSimpleErrorMessage (TypeConflictsWithClass nm) =

656− line $ "Type " ++ markCode (runProperName nm) ++ " conflicts with a type class declaration with the same name."

657− renderSimpleErrorMessage (CtorConflictsWithClass nm) =

658− line $ "Data constructor " ++ markCode (runProperName nm) ++ " conflicts with a type class declaration with the same name."

659− renderSimpleErrorMessage (ClassConflictsWithType nm) =

660− line $ "Type class " ++ markCode (runProperName nm) ++ " conflicts with a type declaration with the same name."

661− renderSimpleErrorMessage (ClassConflictsWithCtor nm) =

662− line $ "Type class " ++ markCode (runProperName nm) ++ " conflicts with a data constructor declaration with the same name."

635+ renderSimpleErrorMessage (DeclConflict new existing) =

636+ line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."

637+ renderSimpleErrorMessage (ExportConflict new existing) =

638+ line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing

663639 renderSimpleErrorMessage (DuplicateModuleName mn) =

664640 line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."

665− renderSimpleErrorMessage (DuplicateClassExport nm) =

666− line $ "Duplicate export declaration for type class " ++ markCode (runProperName nm)

667− renderSimpleErrorMessage (DuplicateValueExport nm) =

668− line $ "Duplicate export declaration for value " ++ markCode (showIdent nm)

669− renderSimpleErrorMessage (DuplicateValueOpExport op) =

670− line $ "Duplicate export declaration for operator " ++ markCode (showOp op)

671− renderSimpleErrorMessage (DuplicateTypeOpExport op) =

672− line $ "Duplicate export declaration for type operator " ++ markCode (showOp op)

673641 renderSimpleErrorMessage (CycleInDeclaration nm) =

674642 line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."

675643 renderSimpleErrorMessage (CycleInModules mns) =

@@ -1096,22 +1064,34 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

10961064 ]

10971065

10981066 printName :: Qualified Name -> String

1099− printName (Qualified mn (IdentName name)) =

1100− "value " ++ markCode (showQualified showIdent (Qualified mn name))

1101− printName (Qualified mn (ValOpName op)) =

1102− "operator " ++ markCode (showQualified showOp (Qualified mn op))

1103− printName (Qualified mn (TyName name)) =

1104− "type " ++ markCode (showQualified runProperName (Qualified mn name))

1105− printName (Qualified mn (TyOpName op)) =

1106− "type operator " ++ markCode (showQualified showOp (Qualified mn op))

1107− printName (Qualified mn (DctorName name)) =

1108− "data constructor " ++ markCode (showQualified runProperName (Qualified mn name))

1109− printName (Qualified mn (TyClassName name)) =

1110− "type class " ++ markCode (showQualified runProperName (Qualified mn name))

1111− printName (Qualified Nothing (ModName name)) =

1112− "module " ++ markCode (runModuleName name)

1113− printName (Qualified _ ModName{}) =

1114− internalError "qualified ModName in printName"

1067+ printName qn = nameType (disqualify qn) ++ " " ++ markCode (runName qn)

1068+

1069+ nameType :: Name -> String

1070+ nameType (IdentName _) = "value"

1071+ nameType (ValOpName _) = "operator"

1072+ nameType (TyName _) = "type"

1073+ nameType (TyOpName _) = "type operator"

1074+ nameType (DctorName _) = "data constructor"

1075+ nameType (TyClassName _) = "type class"

1076+ nameType (ModName _) = "module"

1077+

1078+ runName :: Qualified Name -> String

1079+ runName (Qualified mn (IdentName name)) =

1080+ showQualified showIdent (Qualified mn name)

1081+ runName (Qualified mn (ValOpName op)) =

1082+ showQualified showOp (Qualified mn op)

1083+ runName (Qualified mn (TyName name)) =

1084+ showQualified runProperName (Qualified mn name)

1085+ runName (Qualified mn (TyOpName op)) =

1086+ showQualified showOp (Qualified mn op)

1087+ runName (Qualified mn (DctorName name)) =

1088+ showQualified runProperName (Qualified mn name)

1089+ runName (Qualified mn (TyClassName name)) =

1090+ showQualified runProperName (Qualified mn name)

1091+ runName (Qualified Nothing (ModName name)) =

1092+ runModuleName name

1093+ runName (Qualified _ ModName{}) =

1094+ internalError "qualified ModName in runName"

11151095

11161096 valueDepth :: Int

11171097 valueDepth | full = 1000

src/Language/PureScript/Sugar/Names/Env.hs+67−30

@@ -10,6 +10,7 @@ module Language.PureScript.Sugar.Names.Env

1010 , envModuleSourceSpan

1111 , envModuleImports

1212 , envModuleExports

13+ , ExportMode(..)

1314 , exportType

1415 , exportTypeOp

1516 , exportTypeClass

@@ -26,6 +27,7 @@ import Control.Monad.Error.Class (MonadError(..))

2627import Control.Monad.Writer.Class (MonadWriter(..))

2728

2829import Data.Function (on)

30+import Data.Foldable (find)

2931import Data.List (groupBy, sortBy, delete)

3032import Data.Maybe (fromJust, mapMaybe)

3133import qualified Data.Map as M

@@ -205,32 +207,51 @@ primEnv = M.singleton

205207 primModuleName

206208 (internalModuleSourceSpan "<Prim>", nullImports, primExports)

207209

210+-- |

211+-- When updating the `Exports` the behaviour is slightly different depending

212+-- on whether we are exporting values defined within the module or elaborating

213+-- re-exported values. This type is used to indicate which behaviour should be

214+-- used.

215+--

216+data ExportMode = Internal | ReExport

217+ deriving (Eq, Show)

218+

208219-- |

209220-- Safely adds a type and its data constructors to some exports, returning an

210221-- error if a conflict occurs.

211222--

212223exportType

213224 :: MonadError MultipleErrors m

214− => Exports

225+ => ExportMode

226+ -> Exports

215227 -> ProperName 'TypeName

216228 -> [ProperName 'ConstructorName]

217229 -> ModuleName

218230 -> m Exports

219−exportType exps name dctors mn = do

231+exportType exportMode exps name dctors mn = do

220232 let exTypes = exportedTypes exps

221233 let exClasses = exportedTypeClasses exps

222− forM_ (name `M.lookup` exTypes) $ \(_, mn') ->

223− when (mn /= mn') $ throwConflictError ConflictingTypeDecls name

224− when (coerceProperName name `M.member` exClasses) $

225− throwConflictError TypeConflictsWithClass name

226− forM_ dctors $ \dctor -> do

227− when (dctorExists (coerceProperName dctor) `any` exTypes) $

228− throwConflictError ConflictingCtorDecls dctor

229− when (coerceProperName dctor `M.member` exClasses) $

230− throwConflictError CtorConflictsWithClass dctor

234+ case exportMode of

235+ Internal -> do

236+ when (name `M.member` exTypes) $

237+ throwDeclConflict (TyName name) (TyName name)

238+ when (coerceProperName name `M.member` exClasses) $

239+ throwDeclConflict (TyName name) (TyClassName (coerceProperName name))

240+ forM_ dctors $ \dctor -> do

241+ when ((elem dctor . fst) `any` exTypes) $

242+ throwDeclConflict (DctorName dctor) (DctorName dctor)

243+ when (coerceProperName dctor `M.member` exClasses) $

244+ throwDeclConflict (DctorName dctor) (TyClassName (coerceProperName dctor))

245+ ReExport -> do

246+ forM_ (name `M.lookup` exTypes) $ \(_, mn') ->

247+ when (mn /= mn') $

248+ throwExportConflict mn mn' (TyName name)

249+ forM_ dctors $ \dctor ->

250+ forM_ ((elem dctor . fst) `find` exTypes) $ \(_, mn') ->

251+ when (mn /= mn') $

252+ throwExportConflict mn mn' (DctorName dctor)

231253 return $ exps { exportedTypes = M.alter updateOrInsert name exTypes }

232254 where

233− dctorExists dctor (dctors', mn') = mn /= mn' && elem dctor dctors'

234255 updateOrInsert Nothing = Just (dctors, mn)

235256 updateOrInsert (Just (dctors', _)) = Just (dctors ++ dctors', mn)

236257

@@ -245,7 +266,7 @@ exportTypeOp

245266 -> ModuleName

246267 -> m Exports

247268exportTypeOp exps op mn = do

248− typeOps <- addExport DuplicateTypeOpExport op mn (exportedTypeOps exps)

269+ typeOps <- addExport TyOpName op mn (exportedTypeOps exps)

249270 return $ exps { exportedTypeOps = typeOps }

250271

251272-- |

@@ -253,17 +274,19 @@ exportTypeOp exps op mn = do

253274--

254275exportTypeClass

255276 :: MonadError MultipleErrors m

256− => Exports

277+ => ExportMode

278+ -> Exports

257279 -> ProperName 'ClassName

258280 -> ModuleName

259281 -> m Exports

260−exportTypeClass exps name mn = do

282+exportTypeClass exportMode exps name mn = do

261283 let exTypes = exportedTypes exps

262− when (coerceProperName name `M.member` exTypes) $

263− throwConflictError ClassConflictsWithType name

264− when ((elem (coerceProperName name) . fst) `any` exTypes) $

265− throwConflictError ClassConflictsWithCtor name

266− classes <- addExport DuplicateClassExport name mn (exportedTypeClasses exps)

284+ when (exportMode == Internal) $ do

285+ when (coerceProperName name `M.member` exTypes) $

286+ throwDeclConflict (TyClassName name) (TyName (coerceProperName name))

287+ when ((elem (coerceProperName name) . fst) `any` exTypes) $

288+ throwDeclConflict (TyClassName name) (DctorName (coerceProperName name))

289+ classes <- addExport TyClassName name mn (exportedTypeClasses exps)

267290 return $ exps { exportedTypeClasses = classes }

268291

269292-- |

@@ -276,7 +299,7 @@ exportValue

276299 -> ModuleName

277300 -> m Exports

278301exportValue exps name mn = do

279− values <- addExport DuplicateValueExport name mn (exportedValues exps)

302+ values <- addExport IdentName name mn (exportedValues exps)

280303 return $ exps { exportedValues = values }

281304

282305-- |

@@ -290,7 +313,7 @@ exportValueOp

290313 -> ModuleName

291314 -> m Exports

292315exportValueOp exps op mn = do

293− valueOps <- addExport DuplicateValueOpExport op mn (exportedValueOps exps)

316+ valueOps <- addExport ValOpName op mn (exportedValueOps exps)

294317 return $ exps { exportedValueOps = valueOps }

295318

296319-- |

@@ -299,28 +322,42 @@ exportValueOp exps op mn = do

299322--

300323addExport

301324 :: (MonadError MultipleErrors m, Ord a)

302− => (a -> SimpleErrorMessage)

325+ => (a -> Name)

303326 -> a

304327 -> ModuleName

305328 -> M.Map a ModuleName

306329 -> m (M.Map a ModuleName)

307−addExport what name mn exports =

330+addExport toName name mn exports =

308331 case M.lookup name exports of

309332 Just mn'

310333 | mn == mn' -> return exports

311− | otherwise -> throwConflictError what name

334+ | otherwise -> throwExportConflict mn mn' (toName name)

312335 Nothing ->

313336 return $ M.insert name mn exports

314337

315338-- |

316339-- Raises an error for when there is more than one definition for something.

317340--

318−throwConflictError

341+throwDeclConflict

319342 :: MonadError MultipleErrors m

320− => (a -> SimpleErrorMessage)

321− -> a

322− -> m b

323−throwConflictError conflict = throwError . errorMessage . conflict

343+ => Name

344+ -> Name

345+ -> m a

346+throwDeclConflict new existing =

347+ throwError . errorMessage $ DeclConflict new existing

348+

349+-- |

350+-- Raises an error for when there are conflicting names in the exports.

351+--

352+throwExportConflict

353+ :: MonadError MultipleErrors m

354+ => ModuleName

355+ -> ModuleName

356+ -> Name

357+ -> m a

358+throwExportConflict new existing name =

359+ throwError . errorMessage $

360+ ExportConflict (Qualified (Just new) name) (Qualified (Just existing) name)

324361

325362-- |

326363-- Gets the exports for a module, or raise an error if the module doesn't exist.

src/Language/PureScript/Sugar/Names/Exports.hs+19−11

@@ -31,20 +31,28 @@ findExportable (Module _ _ mn ds _) =

3131 where

3232 updateExports :: Exports -> Declaration -> m Exports

3333 updateExports exps (TypeClassDeclaration tcn _ _ ds') = do

34− exps' <- exportTypeClass exps tcn mn

34+ exps' <- exportTypeClass Internal exps tcn mn

3535 foldM go exps' ds'

3636 where

3737 go exps'' (TypeDeclaration name _) = exportValue exps'' name mn

3838 go exps'' (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ go exps'' d

3939 go _ _ = internalError "Invalid declaration in TypeClassDeclaration"

40− updateExports exps (DataDeclaration _ tn _ dcs) = exportType exps tn (map fst dcs) mn

41− updateExports exps (TypeSynonymDeclaration tn _ _) = exportType exps tn [] mn

42− updateExports exps (ExternDataDeclaration tn _) = exportType exps tn [] mn

43− updateExports exps (ValueDeclaration name _ _ _) = exportValue exps name mn

44− updateExports exps (ValueFixityDeclaration _ _ op) = exportValueOp exps op mn

45− updateExports exps (TypeFixityDeclaration _ _ op) = exportTypeOp exps op mn

46− updateExports exps (ExternDeclaration name _) = exportValue exps name mn

47− updateExports exps (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ updateExports exps d

40+ updateExports exps (DataDeclaration _ tn _ dcs) =

41+ exportType Internal exps tn (map fst dcs) mn

42+ updateExports exps (TypeSynonymDeclaration tn _ _) =

43+ exportType Internal exps tn [] mn

44+ updateExports exps (ExternDataDeclaration tn _) =

45+ exportType Internal exps tn [] mn

46+ updateExports exps (ValueDeclaration name _ _ _) =

47+ exportValue exps name mn

48+ updateExports exps (ValueFixityDeclaration _ _ op) =

49+ exportValueOp exps op mn

50+ updateExports exps (TypeFixityDeclaration _ _ op) =

51+ exportTypeOp exps op mn

52+ updateExports exps (ExternDeclaration name _) =

53+ exportValue exps name mn

54+ updateExports exps (PositionedDeclaration pos _ d) =

55+ rethrowWithPosition pos $ updateExports exps d

4856 updateExports exps _ = return exps

4957

5058-- |

@@ -99,9 +107,9 @@ resolveExports env ss mn imps exps refs =

99107 reClasses <- extract isPseudo name TyClassName (importedTypeClasses imps)

100108 reValues <- extract isPseudo name IdentName (importedValues imps)

101109 reValueOps <- extract isPseudo name ValOpName (importedValueOps imps)

102− foldM (\exps' ((tctor, dctors), mn') -> exportType exps' tctor dctors mn') result (resolveTypeExports reTypes reDctors)

110+ foldM (\exps' ((tctor, dctors), mn') -> exportType ReExport exps' tctor dctors mn') result (resolveTypeExports reTypes reDctors)

103111 >>= flip (foldM (uncurry . exportTypeOp)) (map resolveTypeOp reTypeOps)

104− >>= flip (foldM (uncurry . exportTypeClass)) (map resolveClass reClasses)

112+ >>= flip (foldM (uncurry . exportTypeClass ReExport)) (map resolveClass reClasses)

105113 >>= flip (foldM (uncurry . exportValue)) (map resolveValue reValues)

106114 >>= flip (foldM (uncurry . exportValueOp)) (map resolveValueOp reValueOps)

107115 elaborateModuleExports result _ = return result