git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Move typeCheckModule to TypeChecker
e016ff9Gary Burgess
src/Language/PureScript.hs+1−39
compare with golang
unifiedsplit
@@ -38,12 +38,11 @@ import Language.PureScript.Renamer as P
38import qualified Language.PureScript.Constants as C
38import qualified Language.PureScript.Constants as C
39import qualified Paths_purescript as Paths
39import qualified Paths_purescript as Paths
40
40
41−import Data.List (find, sortBy, groupBy, intercalate)
41+import Data.List (sortBy, groupBy, intercalate)
42import Data.Time.Clock
42import Data.Time.Clock
43import Data.Function (on)
43import Data.Function (on)
44import Data.Maybe (listToMaybe, fromMaybe)
44import Data.Maybe (listToMaybe, fromMaybe)
45import Control.Monad.Error
45import Control.Monad.Error
46−import Control.Monad.State.Lazy
47import Control.Arrow ((&&&))
46import Control.Arrow ((&&&))
48import Control.Applicative
47import Control.Applicative
49import qualified Data.Map as M
48import qualified Data.Map as M
@@ -93,43 +92,6 @@ compile' env opts ms prefix = do
93 where
92 where
94 mainModuleIdent = moduleNameFromString <$> optionsMain opts
93 mainModuleIdent = moduleNameFromString <$> optionsMain opts
95
94
96−typeCheckModule :: Maybe ModuleName -> Module -> Check Module
97−typeCheckModule mainModuleName (Module mn decls exps) = do
98− modify (\s -> s { checkCurrentModule = Just mn })
99− decls' <- typeCheckAll mainModuleName mn exps decls
100− mapM_ checkTypesAreExported exps'
101− return $ Module mn decls' exps
102− where
103−
104− exps' = fromMaybe (error "exports should have been elaborated") exps
105−
106− -- Check that all the type constructors defined in the current module that appear in member types
107− -- have also been exported from the module
108− checkTypesAreExported :: DeclarationRef -> Check ()
109− checkTypesAreExported (ValueRef name) = do
110− ty <- lookupVariable mn (Qualified (Just mn) name)
111− case find isTconHidden (findTcons ty) of
112− Just hiddenType -> throwError . strMsg $
113− "Error in module '" ++ show mn ++ "':\n\
114− \Exporting declaration '" ++ show name ++ "' requires type '" ++ show hiddenType ++ "' to be exported as well"
115− Nothing -> return ()
116− checkTypesAreExported _ = return ()
117−
118− -- Find the type constructors exported from the current module used in a type
119− findTcons :: Type -> [ProperName]
120− findTcons = everythingOnTypes (++) go
121− where
122− go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]
123− go _ = []
124−
125− -- Checks whether a type constructor is not being exported from the current module
126− isTconHidden :: ProperName -> Bool
127− isTconHidden tyName = all go exps'
128− where
129− go (TypeRef tyName' _) = tyName' /= tyName
130− go _ = True
131−
132−
133generateMain :: Environment -> Options Compile -> [JS] -> Either String [JS]
95generateMain :: Environment -> Options Compile -> [JS] -> Either String [JS]
134generateMain env opts js =
96generateMain env opts js =
135 case moduleNameFromString <$> optionsMain opts of
97 case moduleNameFromString <$> optionsMain opts of
src/Language/PureScript/TypeChecker.hs+37−6
@@ -17,7 +17,7 @@
17
17
18module Language.PureScript.TypeChecker (
18module Language.PureScript.TypeChecker (
19 module T,
19 module T,
20− typeCheckAll
20+ typeCheckModule
21) where
21) where
22
22
23import Language.PureScript.TypeChecker.Monad as T
23import Language.PureScript.TypeChecker.Monad as T
@@ -26,7 +26,7 @@ import Language.PureScript.TypeChecker.Types as T
26import Language.PureScript.TypeChecker.Synonyms as T
26import Language.PureScript.TypeChecker.Synonyms as T
27
27
28import Data.Maybe
28import Data.Maybe
29−import Data.List (nub, (\\))
29+import Data.List (nub, (\\), find)
30import Data.Monoid ((<>))
30import Data.Monoid ((<>))
31import Data.Foldable (for_)
31import Data.Foldable (for_)
32import qualified Data.Map as M
32import qualified Data.Map as M
@@ -119,7 +119,7 @@ checkTypeClassInstance _ ty = throwError $ mkErrorStack "Type class instance hea
119--
119--
120-- * Process module imports
120-- * Process module imports
121--
121--
122−typeCheckAll :: Maybe ModuleName -> ModuleName -> Maybe [DeclarationRef] -> [Declaration] -> Check [Declaration]
122+typeCheckAll :: Maybe ModuleName -> ModuleName -> [DeclarationRef] -> [Declaration] -> Check [Declaration]
123typeCheckAll mainModuleName moduleName exps = go
123typeCheckAll mainModuleName moduleName exps = go
124 where
124 where
125 go :: [Declaration] -> Check [Declaration]
125 go :: [Declaration] -> Check [Declaration]
@@ -229,18 +229,49 @@ typeCheckAll mainModuleName moduleName exps = go
229 return $ d : ds
229 return $ d : ds
230 where
230 where
231 isInstanceExported :: Bool
231 isInstanceExported :: Bool
232− isInstanceExported = maybe True (any exportsInstance) exps
232+ isInstanceExported = any exportsInstance exps
233−
233+
234 exportsInstance :: DeclarationRef -> Bool
234 exportsInstance :: DeclarationRef -> Bool
235 exportsInstance (TypeInstanceRef name) | name == dictName = True
235 exportsInstance (TypeInstanceRef name) | name == dictName = True
236 exportsInstance (PositionedDeclarationRef _ r) = exportsInstance r
236 exportsInstance (PositionedDeclarationRef _ r) = exportsInstance r
237 exportsInstance _ = False
237 exportsInstance _ = False
238−
238+
239 go (PositionedDeclaration pos d : rest) =
239 go (PositionedDeclaration pos d : rest) =
240 rethrowWithPosition pos $ do
240 rethrowWithPosition pos $ do
241 (d' : rest') <- go (d : rest)
241 (d' : rest') <- go (d : rest)
242 return (PositionedDeclaration pos d' : rest')
242 return (PositionedDeclaration pos d' : rest')
243
243
244+typeCheckModule :: Maybe ModuleName -> Module -> Check Module
245+typeCheckModule _ (Module _ _ Nothing) = error "exports should have been elaborated"
246+typeCheckModule mainModuleName (Module mn decls (Just exps)) = do
247+ modify (\s -> s { checkCurrentModule = Just mn })
248+ decls' <- typeCheckAll mainModuleName mn exps decls
249+ mapM_ checkTypesAreExported exps
250+ return $ Module mn decls' (Just exps)
251+ where
244
252
253+ -- Check that all the type constructors defined in the current module that appear in member types
254+ -- have also been exported from the module
255+ checkTypesAreExported :: DeclarationRef -> Check ()
256+ checkTypesAreExported (ValueRef name) = do
257+ ty <- lookupVariable mn (Qualified (Just mn) name)
258+ case find isTconHidden (findTcons ty) of
259+ Just hiddenType -> throwError . strMsg $
260+ "Error in module '" ++ show mn ++ "':\n\
261+ \Exporting declaration '" ++ show name ++ "' requires type '" ++ show hiddenType ++ "' to be exported as well"
262+ Nothing -> return ()
263+ checkTypesAreExported _ = return ()
245
264
265+ -- Find the type constructors exported from the current module used in a type
266+ findTcons :: Type -> [ProperName]
267+ findTcons = everythingOnTypes (++) go
268+ where
269+ go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]
270+ go _ = []
246
271
272+ -- Checks whether a type constructor is not being exported from the current module
273+ isTconHidden :: ProperName -> Bool
274+ isTconHidden tyName = all go exps
275+ where
276+ go (TypeRef tyName' _) = tyName' /= tyName
277+ go _ = True