git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Move typeCheckModule to TypeChecker
commite016ff9d6b62ac001c59b67bcaff1a97a4c767d2 authorGary Burgess <gary.burgess@gmail.com> dateThu 16 Oct 2014, 10:22 (12 years ago) parent5a20c09
2 files changed+38−45
compare with golang
unifiedsplit
src/Language/PureScript.hs+1−39 src/Language/PureScript/TypeChecker.hs+37−6
src/Language/PureScript.hs+1−39
@@ -38,12 +38,11 @@ import Language.PureScript.Renamer as P
3838import qualified Language.PureScript.Constants as C
3939import qualified Paths_purescript as Paths
4040
41−import Data.List (find, sortBy, groupBy, intercalate)
41+import Data.List (sortBy, groupBy, intercalate)
4242import Data.Time.Clock
4343import Data.Function (on)
4444import Data.Maybe (listToMaybe, fromMaybe)
4545import Control.Monad.Error
46−import Control.Monad.State.Lazy
4746import Control.Arrow ((&&&))
4847import Control.Applicative
4948import qualified Data.Map as M
@@ -93,43 +92,6 @@ compile' env opts ms prefix = do
9392 where
9493 mainModuleIdent = moduleNameFromString <$> optionsMain opts
9594
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−
13395generateMain :: Environment -> Options Compile -> [JS] -> Either String [JS]
13496generateMain env opts js =
13597 case moduleNameFromString <$> optionsMain opts of
src/Language/PureScript/TypeChecker.hs+37−6
@@ -17,7 +17,7 @@
1717
1818module Language.PureScript.TypeChecker (
1919 module T,
20− typeCheckAll
20+ typeCheckModule
2121) where
2222
2323import Language.PureScript.TypeChecker.Monad as T
@@ -26,7 +26,7 @@ import Language.PureScript.TypeChecker.Types as T
2626import Language.PureScript.TypeChecker.Synonyms as T
2727
2828import Data.Maybe
29−import Data.List (nub, (\\))
29+import Data.List (nub, (\\), find)
3030import Data.Monoid ((<>))
3131import Data.Foldable (for_)
3232import qualified Data.Map as M
@@ -119,7 +119,7 @@ checkTypeClassInstance _ ty = throwError $ mkErrorStack "Type class instance hea
119119--
120120-- * Process module imports
121121--
122−typeCheckAll :: Maybe ModuleName -> ModuleName -> Maybe [DeclarationRef] -> [Declaration] -> Check [Declaration]
122+typeCheckAll :: Maybe ModuleName -> ModuleName -> [DeclarationRef] -> [Declaration] -> Check [Declaration]
123123typeCheckAll mainModuleName moduleName exps = go
124124 where
125125 go :: [Declaration] -> Check [Declaration]
@@ -229,18 +229,49 @@ typeCheckAll mainModuleName moduleName exps = go
229229 return $ d : ds
230230 where
231231 isInstanceExported :: Bool
232− isInstanceExported = maybe True (any exportsInstance) exps
233−
232+ isInstanceExported = any exportsInstance exps
233+
234234 exportsInstance :: DeclarationRef -> Bool
235235 exportsInstance (TypeInstanceRef name) | name == dictName = True
236236 exportsInstance (PositionedDeclarationRef _ r) = exportsInstance r
237237 exportsInstance _ = False
238−
238+
239239 go (PositionedDeclaration pos d : rest) =
240240 rethrowWithPosition pos $ do
241241 (d' : rest') <- go (d : rest)
242242 return (PositionedDeclaration pos d' : rest')
243243
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
244252
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 ()
245264
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 _ = []
246271
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