@@ -26,14 +26,14 @@ import Language.PureScript.Values
2626import Language.PureScript.CodeGen.JS.AST
2727import Language.PureScript.Sugar.CaseDeclarations
2828import Language.PureScript.Prim
29−
30−import qualified Data.Map as M
29+import Language.PureScript.CodeGen.Common (identToJs)
3130
3231import Control.Applicative
3332import Control.Monad.State
3433import Control.Arrow (second)
34+import Data.Maybe (catMaybes)
3535
36−import Language.PureScript.CodeGen.Common (identToJs)
36+import qualified Data.Map as M
3737
3838type MemberMap = M.Map (ModuleName, ProperName) ([String], [(String, Type)])
3939
@@ -47,7 +47,10 @@ desugarTypeClasses :: [Module] -> Either String [Module]
4747desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule
4848
4949desugarModule :: Module -> Desugar Module
50−desugarModule (Module name decls exps) = Module name <$> concat <$> mapM (desugarDecl name) decls <*> pure exps
50+desugarModule (Module name decls (Just exps)) = do
51+ (newExpss, declss) <- unzip <$> mapM (desugarDecl name) decls
52+ return $ Module name (concat declss) $ Just (exps ++ catMaybes newExpss)
53+desugarModule _ = error "Exports should have been elaborated in name desugaring"
5154
5255-- |
5356-- Desugar type class and type class instance declarations
@@ -87,17 +90,17 @@ desugarModule (Module name decls exps) = Module name <$> concat <$> mapM (desuga
8790-- __Test_Foo_array :: forall a. Foo a -> Foo [a]
8891-- __Test_Foo_array _1 = { foo: __Test_Foo_array_foo _1 :: [a] -> [a] (unchecked) }
8992--
90−desugarDecl :: ModuleName -> Declaration -> Desugar [Declaration]
93+desugarDecl :: ModuleName -> Declaration -> Desugar (Maybe DeclarationRef, [Declaration])
9194desugarDecl mn d@(TypeClassDeclaration name args members) = do
9295 let tys = map memberToNameAndType members
9396 modify (M.insert (mn, name) (args, tys))
94− return $ d : typeClassDictionaryDeclaration name args members : map (typeClassMemberToDictionaryAccessor mn name args) members
97+ return $ (Nothing, d : typeClassDictionaryDeclaration name args members : map (typeClassMemberToDictionaryAccessor mn name args) members)
9598desugarDecl mn d@(TypeInstanceDeclaration name deps className ty members) = do
9699 desugared <- lift $ desugarCases members
97100 entries <- mapM (typeInstanceDictionaryEntryDeclaration name mn deps className ty) desugared
98101 dictDecl <- typeInstanceDictionaryDeclaration name mn deps className ty desugared
99− return $ d : entries ++ [dictDecl]
100−desugarDecl _ other = return [other]
102+ return $ (Just $ TypeInstanceRef name className ty, d : entries ++ [dictDecl])
103+desugarDecl _ other = return (Nothing, [other])
101104
102105memberToNameAndType :: Declaration -> (String, Type)
103106memberToNameAndType (TypeDeclaration ident ty) = (identToJs ident, ty)