6e45cdf · rowtype-yoga/purescript-native

.travis.yml+3

compare with golang

unifiedsplit

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

1language: haskell

2notifications:

3 email: true

4+after_success:

5+ - cabal install

6+ - ./execTests.sh

CONTRIBUTING.md+5−2

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

2

3Please follow the following guidelines:

4

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

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`.

6−- Run `cabal test`

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

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

7- Please run `hlint`.

10- Please run `hlint`.

8

11

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

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

RELEASE-0.5.md+1

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

11### Enhancements

12

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

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

14

15

15### Bug Fixes

16### Bug Fixes

16

17

docgen/Main.hs+2−2

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

59 mapM_ renderModule ms

60

61renderModule :: P.Module -> Docs

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

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

63− headerLevel 2 $ "Module " ++ moduleName

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

64 spacer

65 headerLevel 3 "Types"

66 spacer

docs/source/intro.rst+1−1

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

64

65I 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.

66

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.

68

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

70

examples/passing/Arrays.purs+11−4

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

4

5test1 arr = arr !! 0 + arr !! 1 + 1

6

7−test2 = \arr -> case arr of

7+test2 = \arr -> case arr of

8 [x, y] -> x + y

9 [x] -> x

10 [] -> 0

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

16 One n -> n

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

18

19−test4 = \arr -> case arr of

19+test4 = \arr -> case arr of

20 [] -> 0

21 [_] -> 0

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

23−

23+

24module Main where

25

26−main = Trace.trace "Done"

26+import Arrays

27+import Prelude

27

28

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

2+

3+ class Foo a where

4+ foo :: a -> a

5+

6+ data Text = Text String

7+

8+ x = Text "Done"

9+

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

578

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

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

581− \ l.sort();\

581+ \ l1.sort();\

582 \ return l1;\

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

584

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

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

631

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

633− show [] = "[]"

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

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

635

634

636 instance Prelude.Functor [] where

635 instance Prelude.Functor [] where

637 (<$>) = map

636 (<$>) = map

psci/Main.hs+27−15

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

16

17module Main where

18

19−import Control.Monad.IO.Class

20import Control.Applicative

19import Control.Applicative

20+import Control.Monad

21import Control.Monad.Trans.Class

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

22

23

23import Data.List (nub, isPrefixOf)

24import Data.List (nub, isPrefixOf)

24import Data.Maybe (mapMaybe)

25import Data.Maybe (mapMaybe)

26+import Data.Traversable (traverse)

25

27

26−import System.Process

27import System.Console.Haskeline

28import System.Console.Haskeline

29+import System.Directory (findExecutable)

30+import System.Exit

31+import System.Process

28

32

29import qualified Language.PureScript as P

33import qualified Language.PureScript as P

30import qualified Paths_purescript as Paths

34import qualified Paths_purescript as Paths

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

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

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

36

40

37options :: P.Options

41options :: P.Options

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

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

39

43

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

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

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

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

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

43 findCompletions :: String -> IO [Completion]

47 findCompletions :: String -> IO [Completion]

44 findCompletions str = do

48 findCompletions str = do

45 files <- listFiles str

49 files <- listFiles str

46− let names = nub $ [ show qual

50+ let names = nub [ show qual

47− | P.Module moduleName ds <- ms

51+ | P.Module moduleName ds <- ms

48− , ident <- mapMaybe getDeclName ds

52+ , ident <- mapMaybe getDeclName ds

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

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

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

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

51− ]

55+ ]

52 let matches = filter (isPrefixOf str) names

56 let matches = filter (isPrefixOf str) names

53 return $ map simpleCompletion matches ++ files

57 return $ map simpleCompletion matches ++ files

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

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

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

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

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

59createTemporaryModule imports value =

63createTemporaryModule imports value =

60 let

64 let

61− moduleName = P.ProperName "Main"

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

62 importDecl m = P.ImportDeclaration m Nothing

66 importDecl m = P.ImportDeclaration m Nothing

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

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

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

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

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

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

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

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

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

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

68 ])

72 ])

69 in

73 in

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

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

71

75

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

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

73handleDeclaration loadedModules imports value = do

77handleDeclaration loadedModules imports value = do

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

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

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

76 Left err -> outputStrLn err

80 Left err -> outputStrLn err

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

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

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

82+ process <- lift findNodeProcess

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

84+ case result of

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

79− outputStrLn output

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

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

80

88

81data Command

89data Command

82 = Empty

90 = Empty

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

108 moduleText <- U.readFile moduleFile

116 moduleText <- U.readFile moduleFile

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

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

110

118

119+findNodeProcess :: IO (Maybe String)

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

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

122+

111main :: IO ()

123main :: IO ()

112main = do

124main = do

113 preludeFilename <- getPreludeFilename

125 preludeFilename <- getPreludeFilename

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

121 outputStrLn " |_| "

133 outputStrLn " |_| "

122 outputStrLn ""

134 outputStrLn ""

123 outputStrLn "Expressions are terminated using Ctrl+D"

135 outputStrLn "Expressions are terminated using Ctrl+D"

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

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

125 where

137 where

126 go imports loadedModules = do

138 go imports loadedModules = do

127 cmd <- getCommand

139 cmd <- getCommand

purescript.cabal+3−3

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

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

79

80executable psci

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

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

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

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

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

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

84 main-is: Main.hs

85 buildable: True

86 hs-source-dirs: psci

src/Language/PureScript.hs+9−5

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

60 sorted <- sortModules ms

61 desugared <- desugar sorted

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

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

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

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

64+ Module moduleName <$> typeCheckAll mainModuleIdent moduleName decls

65 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

66− let entryPoints = optionsModules opts

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

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

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

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

70 js' <- case optionsMain opts of

71 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)) $

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

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

75 _ -> return js

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

77 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 @@

16module Language.PureScript.CodeGen.Common where

17

18import Data.Char

19+import Data.List (intercalate)

19import Language.PureScript.Names

20import Language.PureScript.Names

20

21

21-- |

22-- |

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

127 , "with"

128 , "with"

128 , "yield" ]

129 , "yield" ]

129

130

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)

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

30--

31moduleToPs :: Module -> Environment -> String

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

32+moduleToPs (Module mn decls) env =

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

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

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

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

35

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

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

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

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

52-- module.

53--

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

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

55+moduleToJs opts (Module name decls) env =

56 case jsDecls of

57 [] -> Nothing

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

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

59 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 []))]

61 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))

63

64-- |

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

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

211-- variable that may have a qualified name.

212--

213qualifiedToJS :: 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")

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

216

217-- |

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

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

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

316 isEffFunc _ _ = False

317 -- Module names

318− prelude = ModuleName (ProperName "Prelude")

318+ prelude = ModuleName [ProperName "Prelude"]

319− effModule = ModuleName (ProperName "Eff")

319+ effModule = ModuleName [ProperName "Eff"]

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

321 Right (Ident effDictName) = mkDictionaryValueName

322 effModule

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

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

469 where

470 Right (Ident dictName) = mkDictionaryValueName

471− (ModuleName (ProperName "Prim"))

471+ (ModuleName [ProperName "Prim"])

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

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

473 ty

474 isOpDict _ _ _ = False

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

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

30-- |

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

32--

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

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

34eliminateDeadCode env entryPoints ms =

35 let declarations = concatMap (declarationsByModule env) ms

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

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

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

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

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

39

40type Key = (ModuleName, Either Ident ProperName)

41

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

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

44 where

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

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

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

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

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

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

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

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

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

50 go (DataBindingGroupDeclaration ds) = concatMap go ds

51 go _ = []

52

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

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

42-- |

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

44--

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

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

46

47-- |

48-- The type of a foreign import

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

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

40-- |

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

42--

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

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

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

45 where

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

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

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

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

48 qualifiedIdents _ = []

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

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

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

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

51 qualifiedProperNames _ = []

52− imports :: Declaration -> [ProperName]

52+ imports :: Declaration -> [ModuleName]

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

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

54 imports _ = []

55

56−getModuleName :: Module -> ProperName

56+getModuleName :: Module -> ModuleName

57−getModuleName (Module pn _) = pn

57+getModuleName (Module mn _) = mn

58

59-- |

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

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

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

17

18module Language.PureScript.Names where

19

20+import Data.List

20import Data.Data

21import Data.Data

21import Data.Function (on)

22import Data.Function (on)

22

23

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

64-- |

65-- |

65-- Module names

66-- Module names

66--

67--

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)

68

72

69instance Show ModuleName where

73instance Show ModuleName where

70− show (ModuleName name) = show name

74+ show = runModuleName

71

75

72-- |

76-- |

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

77-- 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

76

80

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

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

78 show (Qualified Nothing a) = show a

82 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

80

84

81-- |

85-- |

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

86-- 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

204properName :: P.Parsec String u ProperName

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

206

207+-- |

208+-- Parse a module name

209+--

210+moduleName :: P.Parsec String ParseState ModuleName

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

212+

207-- |

213-- |

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

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

209--

215--

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

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

211−parseQualified parser = qual

217+parseQualified parser = part []

212 where

218 where

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

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

220+ part (updatePath path name))

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

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

215− delimiter = indented *> dot

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

216

225

217-- |

226-- |

218-- Parse an integer or floating point value

227-- 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

89parseImportDeclaration = do

90 reserved "import"

91 indented

92− moduleName <- ModuleName <$> properName

92+ moduleName <- moduleName

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

94 return $ ImportDeclaration moduleName idents

95

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

138parseModule = do

139 reserved "module"

140 indented

141− name <- properName

141+ name <- moduleName

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

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

144 return $ Module name decls

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

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

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

37--

38createBindingGroupsModule :: [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

40

41-- |

42-- 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

33desugarDo = everywhereM (mkM replace)

34 where

35 prelude :: ModuleName

36− prelude = ModuleName (ProperName "Prelude")

36+ prelude = ModuleName [ProperName "Prelude"]

37 ret :: Value

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

39 bind :: Value

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

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

46 where

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

48 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

50 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

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

53

54removeParens :: Value -> Value

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

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

36import Data.Maybe (fromMaybe)

37import Data.List (nub)

38import Data.Generics (mkQ, everything)

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

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

40

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

42

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

50desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

51

52desugarModule :: 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

54

55-- |

56-- Desugar type class and type class instance declarations

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

159

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

161qualifiedToString 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

163

164-- |

165-- 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 {

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

119--

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

121−jsTypes = M.fromList [ ((ModuleName $ ProperName "Prim", ProperName "Function"), (FunKind Star $ FunKind Star 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))

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

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

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

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

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

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

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

126

127-- |

128-- 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

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

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

210 [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

212 -- Make sure unification variables do not escape

213 escapeCheck val ty

214 return triple

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

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

92-- Type constructor for functions

93--

94tyFunction :: Type

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

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

96

97-- |

98-- Type constructor for strings

99--

100tyString :: Type

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

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

102

103-- |

104-- Type constructor for numbers

105--

106tyNumber :: Type

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

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

108

109-- |

110-- Type constructor for booleans

111--

112tyBoolean :: Type

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

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

114

115-- |

116-- Type constructor for arrays

117--

118tyArray :: Type

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

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

120

121-- |

122-- Smart constructor for function types