d3f368b · rowtype-yoga/purescript-native

docgen/Main.hs+2−2

compare with golang

unifiedsplit

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

psci/Main.hs+4−4

@@ -51,7 +51,7 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions

51 | P.Module moduleName ds <- ms

52 , ident <- mapMaybe getDeclName ds

53 , qual <- [ P.Qualified Nothing ident

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

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

55 ]

56 let matches = filter (isPrefixOf str) names

57 return $ map simpleCompletion matches ++ files

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

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

63createTemporaryModule imports value =

64 let

65− moduleName = P.ProperName "Main"

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

66 importDecl m = P.ImportDeclaration m Nothing

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

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

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

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

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

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

72 ])

73 in

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

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

75

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

77handleDeclaration loadedModules imports value = do

src/Language/PureScript.hs+5−5

@@ -60,19 +60,19 @@ 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 . return . ProperName) `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 . return . ProperName) <$> optionsMain opts

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+9−6

@@ -23,7 +23,7 @@ module Language.PureScript.CodeGen.JS (

23) where

24

25import Data.Maybe (fromMaybe, mapMaybe)

26−import Data.List (sortBy)

26+import Data.List (sortBy, intercalate)

27import Data.Function (on)

28import Data.Data (Data)

29import Data.Generics (mkQ, everything)

@@ -52,14 +52,17 @@ 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+moduleNameToJS :: ModuleName -> String

65+moduleNameToJS (ModuleName pns) = intercalate "_" (runProperName `map` pns)

63

66

64-- |

67-- |

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

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

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

212-- variable that may have a qualified name.

215-- variable that may have a qualified name.

213--

216--

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

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

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

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

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

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

217

220

218-- |

221-- |

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

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

284 isRetPoly (JSIndexer (JSStringLiteral "return") (JSAccessor "Prelude" (JSVar "_ps"))) = True

285 isRetPoly _ = False

286

287− prelude = ModuleName (ProperName "Prelude")

287+ prelude = ModuleName [ProperName "Prelude"]

288− effModule = ModuleName (ProperName "Eff")

288+ effModule = ModuleName [ProperName "Eff"]

289

290 Right (Ident effDictName) = mkDictionaryValueName

291 effModule

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

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

383 where

384 Right (Ident dictName) = mkDictionaryValueName

385− (ModuleName (ProperName "Prim"))

385+ (ModuleName [ProperName "Prim"])

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

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

387 ty

388 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+6−2

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

src/Language/PureScript/Parser/Common.hs+1−1

@@ -209,7 +209,7 @@ properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many P.alphaNum

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

210parseQualified parser = qual

211 where

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

212+ qual = (Qualified <$> (Just . ModuleName . pure <$> P.try (properName <* delimiter)) <*> parser)

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

214 delimiter = indented *> dot

215

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 . pure <$> properName

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

94 return $ ImportDeclaration moduleName idents

95

@@ -141,7 +141,7 @@ parseModule = do

141 name <- properName

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

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

144− return $ Module name decls

144+ return $ Module (ModuleName [name]) decls

145

146-- |

147-- Parse a collection of modules

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+2−2

@@ -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) = runModuleName 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