6e45cdf · rowtype-yoga/purescript-native

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

Merge branch 'master' into nostatements

Conflicts: src/Language/PureScript/CodeGen/Optimize.hs

commit6e45cdff75d6a79234eb0c4f22530f322efcea30 authorPhil Freeman <paf31@cantab.net> dateMon 17 Feb 2014, 21:05 (13 years ago) parent7ff5a8e 832a58e

28 files changed+156−91

compare with golang

unifiedsplit

.travis.yml+3

@@ -1,3 +1,6 @@

11language: haskell

22notifications:

33 email: true

4+after_success:

5+ - cabal install

6+ - ./execTests.sh

CONTRIBUTING.md+5−2

@@ -2,8 +2,11 @@ Pull requests are encouraged.

33Please follow the following guidelines:

5−- Add at least a test to `examples/passing/` and possibly to `examples/failing`

6−- Run `cabal test`

5+- Add at least a test to `examples/passing/` and possibly to `examples/failing`.

6+- Build the binaries and libs with `cabal build`

7+- Install the binaries and libs with `cabal install`.

8+- Run `cabal test` to build the test suite.

9+- Run `./execTests.sh` to execute the test suite.

710- Please run `hlint`.

811

912If you would like to contribute, please consider the issues in the current milestone first.

RELEASE-0.5.md+1

@@ -11,6 +11,7 @@

1111### Enhancements

1212

1313- Pretty printing for row types was improved (garyb)

14+- Module names can now contain `.` (garyb)

1415

1516### Bug Fixes

1617

docgen/Main.hs+2−2

@@ -59,8 +59,8 @@ renderModules ms = do

5959 mapM_ renderModule ms

6060

6161renderModule :: P.Module -> Docs

62−renderModule (P.Module (P.ProperName moduleName) ds) = do

63− headerLevel 2 $ "Module " ++ moduleName

62+renderModule (P.Module moduleName ds) = do

63+ headerLevel 2 $ "Module " ++ (P.runModuleName moduleName)

6464 spacer

6565 headerLevel 3 "Types"

6666 spacer

docs/source/intro.rst+1−1

@@ -64,7 +64,7 @@ I was looking for a simple functional language which would compile to JavaScript

6464

6565I didn't find exactly what I was looking for, so I wrote PureScript. It doesn't have everything right now, but it should serve as a simple core on which to develop new ideas.

6666

67−PureScript is *not* designed to be a general-purpose programming language. The primary use case is as a generator for purely-functional core libraries, with the main application code written in another language.

67+PureScript was originally designed to implement purely functional core logic. However, recent additions to the compiler and libraries now also make it a good option for general-purpose programming.

6868

6969PureScript can also be seen as a trade-off between a theoretically ideal language and one which generates reasonably high performance code.

7070

examples/passing/Arrays.purs+11−4

@@ -4,7 +4,7 @@ import Prelude

55test1 arr = arr !! 0 + arr !! 1 + 1

7−test2 = \arr -> case arr of

7+test2 = \arr -> case arr of

88 [x, y] -> x + y

99 [x] -> x

1010 [] -> 0

@@ -16,12 +16,19 @@ test3 = \tree sum -> case tree of

1616 One n -> n

1717 Some (n1 : n2 : rest) -> test3 n1 sum * 10 + test3 n2 sum * 5 + sum rest

1818

19−test4 = \arr -> case arr of

19+test4 = \arr -> case arr of

2020 [] -> 0

2121 [_] -> 0

2222 x : y : xs -> x * y + test4 xs

23−

23+

2424module Main where

2525

26−main = Trace.trace "Done"

26+import Arrays

27+import Prelude

2728

29+main = do

30+ let x = [3,2,1]

31+ let y = sort x

32+ if x == [3,2,1]

33+ then Trace.trace "Done"

34+ else Errors.throwError "Not done"

examples/passing/DottedModules.pursnew file+20

@@ -0,0 +1,20 @@

1+module Some.Module.Name where

3+ class Foo a where

4+ foo :: a -> a

6+ data Text = Text String

8+ x = Text "Done"

10+module Main where

11+

12+ import Prelude

13+ import Some.Module.Name

14+

15+ instance Some.Module.Name.Foo String where

16+ foo s = s

17+

18+ unwrap (Text x) = x

19+

20+ main = Trace.print $ foo $ unwrap x

prelude/prelude.purs+2−3

@@ -578,7 +578,7 @@ module Arrays where

578578

579579 foreign import sort "function sort(l) {\

580580 \ var l1 = l.slice();\

581− \ l.sort();\

581+ \ l1.sort();\

582582 \ return l1;\

583583 \}" :: forall a. [a] -> [a]

584584

@@ -630,8 +630,7 @@ module Arrays where

630630 all p (a:as) = p a && all p as

631631

632632 instance (Prelude.Show a) => Prelude.Show [a] where

633− show [] = "[]"

634− show (x:xs) = show x ++ " : " ++ show xs

633+ show xs = "[" ++ joinWith (map show xs) "," ++ "]"

635634

636635 instance Prelude.Functor [] where

637636 (<$>) = map

psci/Main.hs+27−15

@@ -16,15 +16,19 @@

1616

1717module Main where

1818

19−import Control.Monad.IO.Class

2019import Control.Applicative

20+import Control.Monad

2121import Control.Monad.Trans.Class

22+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

2223

2324import Data.List (nub, isPrefixOf)

2425import Data.Maybe (mapMaybe)

26+import Data.Traversable (traverse)

2527

26−import System.Process

2728import System.Console.Haskeline

29+import System.Directory (findExecutable)

30+import System.Exit

31+import System.Process

2832

2933import qualified Language.PureScript as P

3034import qualified Paths_purescript as Paths

@@ -35,7 +39,7 @@ getPreludeFilename :: IO FilePath

3539getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"

3640

3741options :: P.Options

38−options = P.Options True False True Nothing True "PS" []

42+options = P.Options True False True (Just "Main") True "PS" []

3943

4044completion :: [P.Module] -> CompletionFunc IO

4145completion ms = completeWord Nothing " \t\n\r" findCompletions

@@ -43,12 +47,12 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions

4347 findCompletions :: String -> IO [Completion]

4448 findCompletions str = do

4549 files <- listFiles str

46− let names = nub $ [ show qual

47− | P.Module moduleName ds <- ms

48− , ident <- mapMaybe getDeclName ds

49− , qual <- [ P.Qualified Nothing ident

50− , P.Qualified (Just (P.ModuleName moduleName)) ident]

51− ]

50+ let names = nub [ show qual

51+ | P.Module moduleName ds <- ms

52+ , ident <- mapMaybe getDeclName ds

53+ , qual <- [ P.Qualified Nothing ident

54+ , P.Qualified (Just moduleName) ident]

55+ ]

5256 let matches = filter (isPrefixOf str) names

5357 return $ map simpleCompletion matches ++ files

5458 getDeclName :: P.Declaration -> Maybe P.Ident

@@ -58,16 +62,16 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions

5862createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module

5963createTemporaryModule imports value =

6064 let

61− moduleName = P.ProperName "Main"

65+ moduleName = P.ModuleName [P.ProperName "Main"]

6266 importDecl m = P.ImportDeclaration m Nothing

63− traceModule = P.ModuleName (P.ProperName "Trace")

67+ traceModule = P.ModuleName [P.ProperName "Trace"]

6468 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))

6569 mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing

6670 (P.Do [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value

6771 , P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )

6872 ])

6973 in

70− P.Module moduleName $ map (importDecl . P.ModuleName) imports ++ [mainDecl]

74+ P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]

7175

7276handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()

7377handleDeclaration loadedModules imports value = do

@@ -75,8 +79,12 @@ handleDeclaration loadedModules imports value = do

7579 case P.compile options (loadedModules ++ [m]) of

7680 Left err -> outputStrLn err

7781 Right (js, _, _) -> do

78− output <- liftIO $ readProcess "nodejs" [] js

79− outputStrLn output

82+ process <- lift findNodeProcess

83+ result <- lift $ traverse (\node -> readProcessWithExitCode node [] js) process

84+ case result of

85+ Just (ExitSuccess, out, _) -> outputStrLn out

86+ Just (ExitFailure _, _, err) -> outputStrLn err

87+ Nothing -> outputStrLn "Couldn't find node.js"

8088

8189data Command

8290 = Empty

@@ -108,6 +116,10 @@ loadModule moduleFile = do

108116 moduleText <- U.readFile moduleFile

109117 return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText

110118

119+findNodeProcess :: IO (Maybe String)

120+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names

121+ where names = ["nodejs", "node"]

122+

111123main :: IO ()

112124main = do

113125 preludeFilename <- getPreludeFilename

@@ -121,7 +133,7 @@ main = do

121133 outputStrLn " |_| "

122134 outputStrLn ""

123135 outputStrLn "Expressions are terminated using Ctrl+D"

124− go [P.ProperName "Prelude"] prelude

136+ go [P.ProperName "Prelude", P.ProperName "Eff"] prelude

125137 where

126138 go imports loadedModules = do

127139 cmd <- getCommand

purescript.cabal+3−3

@@ -78,9 +78,9 @@ executable psc

7878 ghc-options: -Wall -O2 -fno-warn-unused-do-bind

7979

8080executable psci

81− build-depends: base >=4 && <5, containers -any, mtl -any,

82− parsec -any, haskeline <=0.7.1.1, purescript -any, syb -any,

83− transformers -any, utf8-string -any, process -any

81+ build-depends: base >=4 && <5, containers -any, directory -any,

82+ mtl -any, parsec -any, haskeline <=0.7.1.1, purescript -any,

83+ syb -any, transformers -any, utf8-string -any, process -any

8484 main-is: Main.hs

8585 buildable: True

8686 hs-source-dirs: psci

src/Language/PureScript.hs+9−5

@@ -60,19 +60,23 @@ compile opts ms = do

6060 sorted <- sortModules ms

6161 desugared <- desugar sorted

6262 (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName decls) -> do

63− modify (\s -> s { checkCurrentModule = Just (ModuleName moduleName) })

64− Module moduleName <$> typeCheckAll mainModuleIdent (ModuleName moduleName) decls

63+ modify (\s -> s { checkCurrentModule = Just moduleName })

64+ Module moduleName <$> typeCheckAll mainModuleIdent moduleName decls

6565 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

66− let entryPoints = optionsModules opts

66+ let entryPoints = (ModuleName . splitProperNames) `map` optionsModules opts

6767 let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped

6868 let js = mapMaybe (flip (moduleToJs opts) env) elim

6969 let exts = intercalate "\n" . map (flip moduleToPs env) $ elim

7070 js' <- case optionsMain opts of

7171 Just mainModuleName -> do

72− when ((ModuleName (ProperName mainModuleName), Ident "main") `M.notMember` (names env)) $

72+ when ((ModuleName [ProperName mainModuleName], Ident "main") `M.notMember` (names env)) $

7373 Left $ mainModuleName ++ ".main is undefined"

7474 return $ js ++ [JSApp (JSAccessor "main" (JSAccessor mainModuleName (JSVar "_ps"))) []]

7575 _ -> return js

7676 return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)

7777 where

78− mainModuleIdent = ModuleName . ProperName <$> (optionsMain opts)

78+ mainModuleIdent = ModuleName . splitProperNames <$> optionsMain opts

79+ splitProperNames s = case dropWhile (== '.') s of

80+ "" -> []

81+ s' -> ProperName w : splitProperNames s''

82+ where (w, s'') = break (== '.') s'

src/Language/PureScript/CodeGen/Common.hs+3

@@ -16,6 +16,7 @@

1616module Language.PureScript.CodeGen.Common where

1717

1818import Data.Char

19+import Data.List (intercalate)

1920import Language.PureScript.Names

2021

2122-- |

@@ -127,3 +128,5 @@ nameIsJsReserved name =

127128 , "with"

128129 , "yield" ]

129130

131+moduleNameToJs :: ModuleName -> String

132+moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)

src/Language/PureScript/CodeGen/Externs.hs+3−3

@@ -29,9 +29,9 @@ import Data.List (intercalate)

2929-- Generate foreign imports for all declarations in a module

3030--

3131moduleToPs :: Module -> Environment -> String

32−moduleToPs (Module pname@(ProperName moduleName) decls) env =

33− "module " ++ moduleName ++ " where\n" ++

34− (intercalate "\n" . map (" " ++) . concatMap (declToPs (ModuleName pname) env) $ decls)

32+moduleToPs (Module mn decls) env =

33+ "module " ++ (runModuleName mn) ++ " where\n" ++

34+ (intercalate "\n" . map (" " ++) . concatMap (declToPs mn env) $ decls)

3535

3636declToPs :: ModuleName -> Environment -> Declaration -> [String]

3737declToPs path env (ValueDeclaration name _ _ _) = maybeToList $ do

src/Language/PureScript/CodeGen/JS.hs+5−5

@@ -52,14 +52,14 @@ import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)

5252-- module.

5353--

5454moduleToJs :: Options -> Module -> Environment -> Maybe JS

55−moduleToJs opts (Module pname@(ProperName name) decls) env =

55+moduleToJs opts (Module name decls) env =

5656 case jsDecls of

5757 [] -> Nothing

58− _ -> Just $ JSAssignment (JSAccessor name (JSVar "_ps")) $

58+ _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar "_ps")) $

5959 JSApp (JSFunction Nothing ["module"] (JSBlock $ jsDecls ++ [JSReturn $ JSVar "module"]))

60− [(JSBinary Or (JSAccessor name (JSVar "_ps")) (JSObjectLiteral []))]

60+ [(JSBinary Or (JSAccessor (moduleNameToJs name) (JSVar "_ps")) (JSObjectLiteral []))]

6161 where

62− jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts (ModuleName pname) decl env) (decls))

62+ jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) (decls))

6363

6464-- |

6565-- Generate code in the simplified Javascript intermediate representation for a declaration

@@ -211,7 +211,7 @@ varToJs m e qual@(Qualified _ ident) = go qual

211211-- variable that may have a qualified name.

212212--

213213qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS

214−qualifiedToJS m f (Qualified (Just m'@(ModuleName (ProperName mn))) a) | m /= m' = accessor (f a) (JSAccessor mn $ JSVar "_ps")

214+qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJs m') $ JSVar "_ps")

215215qualifiedToJS m f (Qualified _ a) = JSVar $ identToJs (f a)

216216

217217-- |

src/Language/PureScript/CodeGen/Optimize.hs+4−4

@@ -315,8 +315,8 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

315315 isEffFunc name (JSAccessor name' (JSAccessor "Eff" (JSVar "_ps"))) | name == name' = True

316316 isEffFunc _ _ = False

317317 -- Module names

318− prelude = ModuleName (ProperName "Prelude")

319− effModule = ModuleName (ProperName "Eff")

318+ prelude = ModuleName [ProperName "Prelude"]

319+ effModule = ModuleName [ProperName "Eff"]

320320 -- The name of the type class dictionary for the Monad Eff instance

321321 Right (Ident effDictName) = mkDictionaryValueName

322322 effModule

@@ -468,7 +468,7 @@ inlineCommonOperators = applyAll

468468 isOpDict className ty (JSApp (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == dictName = True

469469 where

470470 Right (Ident dictName) = mkDictionaryValueName

471− (ModuleName (ProperName "Prim"))

472− (Qualified (Just (ModuleName (ProperName "Prelude"))) (ProperName className))

471+ (ModuleName [ProperName "Prim"])

472+ (Qualified (Just (ModuleName [ProperName "Prelude"])) (ProperName className))

473473 ty

474474 isOpDict _ _ _ = False

src/Language/PureScript/DeadCodeElimination.hs+7−7

@@ -30,12 +30,12 @@ import Language.PureScript.TypeChecker.Monad

3030-- |

3131-- Eliminate all declarations which are not a transitive dependency of the entry point module

3232--

33−eliminateDeadCode :: Environment -> [String] -> [Module] -> [Module]

33+eliminateDeadCode :: Environment -> [ModuleName] -> [Module] -> [Module]

3434eliminateDeadCode env entryPoints ms =

3535 let declarations = concatMap (declarationsByModule env) ms

3636 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations

37− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((ModuleName (ProperName mn), _), _) -> mn `elem` entryPoints) $ declarations

38− in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (ModuleName moduleName) graph vertexFor entryPointVertices) ds)

37+ entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations

38+ in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (moduleName) graph vertexFor entryPointVertices) ds)

3939

4040type Key = (ModuleName, Either Ident ProperName)

4141

@@ -43,10 +43,10 @@ declarationsByModule :: Environment -> Module -> [(Key, [Key])]

4343declarationsByModule env (Module moduleName ds) = concatMap go $ ds

4444 where

4545 go :: Declaration -> [(Key, [Key])]

46− go d@(ValueDeclaration name _ _ _) = [((ModuleName moduleName, Left name), dependencies env (ModuleName moduleName) d)]

47− go (DataDeclaration _ _ dctors) = map (\(name, _) -> ((ModuleName moduleName, Right name), [])) dctors

48− go (ExternDeclaration _ name _ _) = [((ModuleName moduleName, Left name), [])]

49− go d@(BindingGroupDeclaration names) = map (\(name, _) -> ((ModuleName moduleName, Left name), dependencies env (ModuleName moduleName) d)) names

46+ go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies env (moduleName) d)]

47+ go (DataDeclaration _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors

48+ go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]

49+ go d@(BindingGroupDeclaration names) = map (\(name, _) -> ((moduleName, Left name), dependencies env moduleName d)) names

5050 go (DataBindingGroupDeclaration ds) = concatMap go ds

5151 go _ = []

5252

src/Language/PureScript/Declarations.hs+1−1

@@ -42,7 +42,7 @@ data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable

4242-- |

4343-- A module declaration, consisting of a module name and a list of declarations

4444--

45−data Module = Module ProperName [Declaration] deriving (Show, D.Data, D.Typeable)

45+data Module = Module ModuleName [Declaration] deriving (Show, D.Data, D.Typeable)

4646

4747-- |

4848-- The type of a foreign import

src/Language/PureScript/ModuleDependencies.hs+9−9

@@ -40,21 +40,21 @@ sortModules ms = do

4040-- |

4141-- Calculate a list of used modules based on explicit imports and qualified names

4242--

43−usedModules :: (Data d) => d -> [ProperName]

43+usedModules :: (Data d) => d -> [ModuleName]

4444usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProperNames `extQ` imports)

4545 where

46− qualifiedIdents :: Qualified Ident -> [ProperName]

47− qualifiedIdents (Qualified (Just (ModuleName pn)) _) = [pn]

46+ qualifiedIdents :: Qualified Ident -> [ModuleName]

47+ qualifiedIdents (Qualified (Just mn) _) = [mn]

4848 qualifiedIdents _ = []

49− qualifiedProperNames :: Qualified ProperName -> [ProperName]

50− qualifiedProperNames (Qualified (Just (ModuleName pn)) _) = [pn]

49+ qualifiedProperNames :: Qualified ProperName -> [ModuleName]

50+ qualifiedProperNames (Qualified (Just mn) _) = [mn]

5151 qualifiedProperNames _ = []

52− imports :: Declaration -> [ProperName]

53− imports (ImportDeclaration (ModuleName pn) _) = [pn]

52+ imports :: Declaration -> [ModuleName]

53+ imports (ImportDeclaration mn _) = [mn]

5454 imports _ = []

5555

56−getModuleName :: Module -> ProperName

57−getModuleName (Module pn _) = pn

56+getModuleName :: Module -> ModuleName

57+getModuleName (Module mn _) = mn

5858

5959-- |

6060-- Convert a strongly connected component of the module graph to a module

src/Language/PureScript/Names.hs+7−3

@@ -17,6 +17,7 @@

1717

1818module Language.PureScript.Names where

1919

20+import Data.List

2021import Data.Data

2122import Data.Function (on)

2223

@@ -64,10 +65,13 @@ instance Show ProperName where

6465-- |

6566-- Module names

6667--

67−data ModuleName = ModuleName { runModuleName :: ProperName } deriving (Eq, Ord, Data, Typeable)

68+data ModuleName = ModuleName [ProperName] deriving (Eq, Ord, Data, Typeable)

69+

70+runModuleName :: ModuleName -> String

71+runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)

6872

6973instance Show ModuleName where

70− show (ModuleName name) = show name

74+ show = runModuleName

7175

7276-- |

7377-- A qualified name, i.e. a name with an optional module name

@@ -76,7 +80,7 @@ data Qualified a = Qualified (Maybe ModuleName) a deriving (Eq, Ord, Data, Typea

7680

7781instance (Show a) => Show (Qualified a) where

7882 show (Qualified Nothing a) = show a

79− show (Qualified (Just (ModuleName name)) a) = show name ++ "." ++ show a

83+ show (Qualified (Just name) a) = show name ++ "." ++ show a

8084

8185-- |

8286-- Provide a default module name, if a name is unqualified

src/Language/PureScript/Parser/Common.hs+13−4

@@ -204,15 +204,24 @@ natural = PT.natural tokenParser

204204properName :: P.Parsec String u ProperName

205205properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many P.alphaNum P.<?> "name")

206206

207+-- |

208+-- Parse a module name

209+--

210+moduleName :: P.Parsec String ParseState ModuleName

211+moduleName = ModuleName <$> P.try (sepBy properName dot)

212+

207213-- |

208214-- Parse a qualified name, i.e. M.name or just name

209215--

210216parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)

211−parseQualified parser = qual

217+parseQualified parser = part []

212218 where

213− qual = (Qualified <$> (Just . ModuleName <$> P.try (properName <* delimiter)) <*> parser)

214− <|> (Qualified Nothing <$> P.try parser)

215− delimiter = indented *> dot

219+ part path = (do name <- P.try (properName <* delimiter)

220+ part (updatePath path name))

221+ <|> (Qualified (qual path) <$> P.try parser)

222+ delimiter = indented *> dot <* P.notFollowedBy dot

223+ updatePath path name = path ++ [name]

224+ qual path = if null path then Nothing else Just $ ModuleName path

216225

217226-- |

218227-- Parse an integer or floating point value

src/Language/PureScript/Parser/Declarations.hs+2−2

@@ -89,7 +89,7 @@ parseImportDeclaration :: P.Parsec String ParseState Declaration

8989parseImportDeclaration = do

9090 reserved "import"

9191 indented

92− moduleName <- ModuleName <$> properName

92+ moduleName <- moduleName

9393 idents <- P.optionMaybe $ parens $ commaSep1 (Left <$> parseIdent <|> Right <$> properName)

9494 return $ ImportDeclaration moduleName idents

9595

@@ -138,7 +138,7 @@ parseModule :: P.Parsec String ParseState Module

138138parseModule = do

139139 reserved "module"

140140 indented

141− name <- properName

141+ name <- moduleName

142142 _ <- lexeme $ P.string "where"

143143 decls <- mark (P.many (same *> parseDeclaration))

144144 return $ Module name decls

src/Language/PureScript/Sugar/BindingGroups.hs+1−1

@@ -36,7 +36,7 @@ import Language.PureScript.Types

3636-- Replace all sets of mutually-recursive declarations in a module with binding groups

3737--

3838createBindingGroupsModule :: [Module] -> Either String [Module]

39−createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups (ModuleName name) ds

39+createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups name ds

4040

4141-- |

4242-- Collapse all binding groups in a module to individual declarations

src/Language/PureScript/Sugar/DoNotation.hs+1−1

@@ -33,7 +33,7 @@ desugarDo :: (Data d) => d -> Either String d

3333desugarDo = everywhereM (mkM replace)

3434 where

3535 prelude :: ModuleName

36− prelude = ModuleName (ProperName "Prelude")

36+ prelude = ModuleName [ProperName "Prelude"]

3737 ret :: Value

3838 ret = Var (Qualified (Just prelude) (Ident "ret"))

3939 bind :: Value

src/Language/PureScript/Sugar/Operators.hs+2−2

@@ -46,9 +46,9 @@ rebracket = go M.empty []

4646 where

4747 go _ rb [] = return . reverse $ rb

4848 go m rb (Module name ds : ms) = do

49− m' <- M.union m <$> collectFixities m (ModuleName name) ds

49+ m' <- M.union m <$> collectFixities m name ds

5050 let opTable = customOperatorTable m'

51− ds' <- G.everywhereM' (G.mkM (matchOperators (ModuleName name) opTable)) ds

51+ ds' <- G.everywhereM' (G.mkM (matchOperators name opTable)) ds

5252 go m' (Module name (G.everywhere (G.mkT removeParens) ds') : rb) ms

5353

5454removeParens :: Value -> Value

src/Language/PureScript/Sugar/TypeClasses.hs+3−3

@@ -36,7 +36,7 @@ import Control.Arrow ((***))

3636import Data.Maybe (fromMaybe)

3737import Data.List (nub)

3838import Data.Generics (mkQ, everything)

39−import Language.PureScript.CodeGen.Common (identToJs)

39+import Language.PureScript.CodeGen.Common (identToJs, moduleNameToJs)

4040

4141type MemberMap = M.Map (ModuleName, ProperName) (String, [(String, Type)])

4242

@@ -50,7 +50,7 @@ desugarTypeClasses :: [Module] -> Either String [Module]

5050desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

5151

5252desugarModule :: Module -> Desugar Module

53−desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl (ModuleName name)) decls

53+desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl name) decls

5454

5555-- |

5656-- Desugar type class and type class instance declarations

@@ -159,7 +159,7 @@ typeInstanceDictionaryEntryDeclaration _ _ _ _ _ = error "Invalid declaration in

159159

160160qualifiedToString :: ModuleName -> Qualified ProperName -> String

161161qualifiedToString mn (Qualified Nothing pn) = qualifiedToString mn (Qualified (Just mn) pn)

162−qualifiedToString _ (Qualified (Just (ModuleName mn)) pn) = runProperName mn ++ "_" ++ runProperName pn

162+qualifiedToString _ (Qualified (Just mn) pn) = moduleNameToJs mn ++ "_" ++ runProperName pn

163163

164164-- |

165165-- Generate a name for a type class dictionary, based on the module name, class name and type name

src/Language/PureScript/TypeChecker/Monad.hs+5−5

@@ -118,11 +118,11 @@ data Environment = Environment {

118118-- The basic types existing in the external javascript environment

119119--

120120jsTypes ::M.Map (ModuleName, ProperName) (Kind, TypeDeclarationKind)

121−jsTypes = M.fromList [ ((ModuleName $ ProperName "Prim", ProperName "Function"), (FunKind Star $ FunKind Star Star, ExternData))

122− , ((ModuleName $ ProperName "Prim", ProperName "Array"), (FunKind Star Star, ExternData))

123− , ((ModuleName $ ProperName "Prim", ProperName "String"), (Star, ExternData))

124− , ((ModuleName $ ProperName "Prim", ProperName "Number"), (Star, ExternData))

125− , ((ModuleName $ ProperName "Prim", ProperName "Boolean"), (Star, ExternData)) ]

121+jsTypes = M.fromList [ ((ModuleName [ProperName "Prim"], ProperName "Function"), (FunKind Star $ FunKind Star Star, ExternData))

122+ , ((ModuleName [ProperName "Prim"], ProperName "Array"), (FunKind Star Star, ExternData))

123+ , ((ModuleName [ProperName "Prim"], ProperName "String"), (Star, ExternData))

124+ , ((ModuleName [ProperName "Prim"], ProperName "Number"), (Star, ExternData))

125+ , ((ModuleName [ProperName "Prim"], ProperName "Boolean"), (Star, ExternData)) ]

126126

127127-- |

128128-- The initial environment with no values and only the default javascript types defined

src/Language/PureScript/TypeChecker/Types.hs+1−1

@@ -208,7 +208,7 @@ typesOf mainModuleName moduleName vals = do

208208 -- If --main is enabled, need to check that `main` has type Eff eff a for some eff, a

209209 when (Just moduleName == mainModuleName && fst e == Ident "main") $ do

210210 [eff, a] <- replicateM 2 fresh

211− ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName (ProperName "Eff"))) (ProperName "Eff"))) eff) a

211+ ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Eff"])) (ProperName "Eff"))) eff) a

212212 -- Make sure unification variables do not escape

213213 escapeCheck val ty

214214 return triple

src/Language/PureScript/Types.hs+5−5

@@ -92,31 +92,31 @@ data Type

9292-- Type constructor for functions

9393--

9494tyFunction :: Type

95−tyFunction = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prim") (ProperName "Function")

95+tyFunction = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Function")

9696

9797-- |

9898-- Type constructor for strings

9999--

100100tyString :: Type

101−tyString = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prim") (ProperName "String")

101+tyString = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "String")

102102

103103-- |

104104-- Type constructor for numbers

105105--

106106tyNumber :: Type

107−tyNumber = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prim") (ProperName "Number")

107+tyNumber = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Number")

108108

109109-- |

110110-- Type constructor for booleans

111111--

112112tyBoolean :: Type

113−tyBoolean = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prim") (ProperName "Boolean")

113+tyBoolean = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Boolean")

114114

115115-- |

116116-- Type constructor for arrays

117117--

118118tyArray :: Type

119−tyArray = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prim") (ProperName "Array")

119+tyArray = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Array")

120120

121121-- |

122122-- Smart constructor for function types