git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #281 from garyb/master

Prevent module merging

commit9ee7d742fd5012ee23a29fb7412e07402512684f authorPhil Freeman <paf31@cantab.net> dateTue 11 Mar 2014, 16:22 (13 years ago) parentbf55694f1c71f3
9 files changed+21−13
compare with golang
unifiedsplit
examples/passing/Arrays.purs+1−1 examples/passing/BindersInFunctions.purs+1−1 examples/passing/Eff.purs+1−1 examples/passing/EmptyDataDecls.purs+1−1 examples/passing/FunctionScope.purs+1−1 examples/passing/Functions2.purs+1−1 prelude/prelude.purs+1−1 src/Language/PureScript/CodeGen/JS.hs+6−3 src/Language/PureScript/Sugar/Names.hs+8−3
examples/passing/Arrays.purs+1−1
@@ -31,4 +31,4 @@ main = do
3131 let y = sort x
3232 if x == [3,2,1]
3333 then Debug.Trace.trace "Done"
34− else Control.Monad.Error.throwError "Not done"
34+ else Control.Monad.Eff.Error.throwError "Not done"
examples/passing/BindersInFunctions.purs+1−1
@@ -9,4 +9,4 @@ main =
99 let ts = tails [[1, 2, 3], [4, 5], [6]] in
1010 if ts == [[2, 3], [5], []]
1111 then Debug.Trace.trace "Done"
12− else Control.Monad.Error.throwError "Incorrect result from 'tails'."
12+ else Control.Monad.Eff.Error.throwError "Incorrect result from 'tails'."
examples/passing/Eff.purs+1−1
@@ -3,7 +3,7 @@ module TestEff where
33import Prelude
44import Control.Monad.Eff
55import Control.Monad.ST
6−import Control.Monad.Error
6+import Control.Monad.Eff.Error
77import Debug.Trace
88
99test1 = catchError (\s -> return 0) $ do
examples/passing/EmptyDataDecls.purs+1−1
@@ -17,4 +17,4 @@ cons x (Array xs) = Array $ x : xs
1717main = let (Array xs) = cons 1 $ cons 2 $ cons 3 nil
1818 in if xs == [1, 2, 3]
1919 then Debug.Trace.trace "Done"
20− else Control.Monad.Error.throwError "Failed"
20+ else Control.Monad.Eff.Error.throwError "Failed"
examples/passing/FunctionScope.purs+1−1
@@ -14,4 +14,4 @@ module Main where
1414 let value = mkValue 1
1515 if value == 1
1616 then Debug.Trace.trace "Done"
17− else Control.Monad.Error.throwError "Not done"
17+ else Control.Monad.Eff.Error.throwError "Not done"
examples/passing/Functions2.purs+1−1
@@ -14,4 +14,4 @@ module Main where
1414 let value = test "Done" {}
1515 if value == "Done"
1616 then Debug.Trace.trace "Done"
17− else Control.Monad.Error.throwError "Not done"
17+ else Control.Monad.Eff.Error.throwError "Not done"
prelude/prelude.purs+1−1
@@ -1031,7 +1031,7 @@ module Random where
10311031 \ return Math.random();\
10321032 \}" :: forall e. Eff (random :: Random | e) Number
10331033
1034−module Control.Monad.Error where
1034+module Control.Monad.Eff.Error where
10351035
10361036 import Control.Monad.Eff
10371037
src/Language/PureScript/CodeGen/JS.hs+6−3
@@ -52,11 +52,14 @@ moduleToJs opts (Module name decls (Just exps)) env =
5252 case jsDecls of
5353 [] -> Nothing
5454 _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar C._ps)) $
55− JSApp (JSFunction Nothing ["module"] (JSBlock $ jsDecls ++ [JSReturn $ JSVar "module"]))
56− [JSBinary Or (JSAccessor (moduleNameToJs name) (JSVar C._ps)) (JSObjectLiteral [])]
55+ JSApp (JSFunction Nothing [] (JSBlock $
56+ JSVariableIntroduction "module" (Just $ JSObjectLiteral []) :
57+ jsDecls ++
58+ jsExports ++
59+ [JSReturn $ JSVar "module"])) []
5760 where
5861 jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) decls)
59− ++ concatMap exportToJs exps
62+ jsExports = concatMap exportToJs exps
6063moduleToJs _ _ _ = error "Exports should have been elaborated in name desugaring"
6164
6265-- |
src/Language/PureScript/Sugar/Names.hs+8−3
@@ -89,8 +89,11 @@ updateExportedModule env mn update = do
8989-- |
9090-- Adds an empty module to an ExportEnvironment.
9191--
92−addEmptyModule :: ExportEnvironment -> ModuleName -> ExportEnvironment
93−addEmptyModule env name = M.insert name (Exports [] [] []) env
92+addEmptyModule :: ExportEnvironment -> ModuleName -> Either String ExportEnvironment
93+addEmptyModule env name =
94+ if name `M.member` env
95+ then throwError $ "Module '" ++ show name ++ "' has been defined more than once"
96+ else return $ M.insert name (Exports [] [] []) env
9497
9598-- |
9699-- Adds a type belonging to a module to the export environment.
@@ -255,7 +258,9 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName "Prim"]) pri
255258
256259 -- Add all of the exported declarations from a module to the global export environment
257260 addModule :: ExportEnvironment -> Module -> Either String ExportEnvironment
258− addModule env m@(Module mn ds _) = rethrowForModule m $ foldM (addDecl mn) (addEmptyModule env mn) ds
261+ addModule env m@(Module mn ds _) = do
262+ env' <- addEmptyModule env mn
263+ rethrowForModule m $ foldM (addDecl mn) env' ds
259264
260265 -- Add a declaration from a module to the global export environment
261266 addDecl :: ModuleName -> ExportEnvironment -> Declaration -> Either String ExportEnvironment