5cee177 · rowtype-yoga/purescript-native

psc-docs/Main.hs−1

compare with golang

unifiedsplit

@@ -93,7 +93,6 @@ docgen (PSCDocsOptions fmt input output) =

93 let fp = fst (head grp)

94 createDirectoryIfMissing True (takeDirectory fp)

95 writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)

96−

97 where

96 where

98 guardMissing [] = return ()

97 guardMissing [] = return ()

99 guardMissing [mn] = do

98 guardMissing [mn] = do

psc-docs/Tags.hs+1−1

@@ -11,7 +11,7 @@ tags = concatMap dtags . P.exportedDeclarations

11 names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames

12 where consNames = map (\(cname, _) -> P.runProperName cname) dcons

13 names (P.TypeDeclaration ident _) = [show ident]

14− names (P.ExternDeclaration _ ident _ _) = [show ident]

14+ names (P.ExternDeclaration ident _) = [show ident]

15 names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]

16 names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]

17 names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]

psci/Completion.hs+1−1

@@ -199,7 +199,7 @@ identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations

199 where

200 getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)

201 getDeclName d@(P.ValueDeclaration ident _ _ _) = Just (ident, d)

202− getDeclName d@(P.ExternDeclaration _ ident _ _) = Just (ident, d)

202+ getDeclName d@(P.ExternDeclaration ident _) = Just (ident, d)

203 getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d

204 getDeclName _ = Nothing

205

psci/PSCi.hs+3−3

@@ -65,7 +65,7 @@ supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]

65

66-- | Support module, contains code to evaluate terms

67supportModule :: P.Module

68−supportModule =

68+supportModule =

69 case P.parseModulesFromFiles id [("", code)] of

70 Right [(_, P.Module cs _ ds exps)] -> P.Module cs supportModuleName ds exps

71 _ -> error "Support module could not be parsed"

@@ -245,8 +245,8 @@ createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindi

245 moduleName = P.ModuleName [P.ProperName "$PSCI"]

246 trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))

247 mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

248− itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] $ Right val

248+ itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val

249− mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue

249+ mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue

250 decls = if exec then [itDecl, mainDecl] else [itDecl]

251 in

252 P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing

psci/Parser.hs+7−7

@@ -122,13 +122,13 @@ discardPositionInfo (P.PositionedDeclaration _ _ d) = d

122discardPositionInfo d = d

123

124acceptable :: P.Declaration -> Bool

125−acceptable (P.DataDeclaration _ _ _ _) = True

125+acceptable P.DataDeclaration{} = True

126−acceptable (P.TypeSynonymDeclaration _ _ _) = True

126+acceptable P.TypeSynonymDeclaration{} = True

127−acceptable (P.ExternDeclaration _ _ _ _) = True

127+acceptable P.ExternDeclaration{} = True

128−acceptable (P.ExternDataDeclaration _ _) = True

128+acceptable P.ExternDataDeclaration{} = True

129−acceptable (P.ExternInstanceDeclaration _ _ _ _) = True

129+acceptable P.ExternInstanceDeclaration{} = True

130−acceptable (P.TypeClassDeclaration _ _ _ _) = True

130+acceptable P.TypeClassDeclaration{} = True

131−acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True

131+acceptable P.TypeInstanceDeclaration{} = True

132acceptable _ = False

133

134parseReplQuery' :: String -> Either String ReplQuery

src/Language/PureScript/AST/Declarations.hs+3−4

@@ -26,7 +26,6 @@ import Language.PureScript.Names

26import Language.PureScript.Kinds

27import Language.PureScript.TypeClassDictionaries

28import Language.PureScript.Comments

29−import Language.PureScript.CodeGen.JS.AST

30import Language.PureScript.Environment

29import Language.PureScript.Environment

31

30

32-- |

31-- |

@@ -122,9 +121,9 @@ data Declaration

122 --

121 --

123 | BindingGroupDeclaration [(Ident, NameKind, Expr)]

122 | BindingGroupDeclaration [(Ident, NameKind, Expr)]

124 -- |

123 -- |

125− -- A foreign import declaration (type, name, optional inline Javascript, type)

124+ -- A foreign import declaration (name, type)

126 --

125 --

127− | ExternDeclaration ForeignImportType Ident (Maybe JS) Type

126+ | ExternDeclaration Ident Type

128 -- |

127 -- |

129 -- A data type foreign import (name, kind)

128 -- A data type foreign import (name, kind)

130 --

129 --

@@ -255,7 +254,7 @@ data Expr

255 --

254 --

256 | StringLiteral String

255 | StringLiteral String

257 -- |

256 -- |

258− -- A character literal

257+ -- A character literal

259 --

258 --

260 | CharLiteral Char

259 | CharLiteral Char

261 -- |

260 -- |

src/Language/PureScript/AST/Exported.hs+1−1

@@ -109,7 +109,7 @@ isExported (Just exps) decl = any (matches decl) exps

109 where

110 matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'

111 matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'

112− matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'

112+ matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'

113 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'

114 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'

115 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'

src/Language/PureScript/AST/Traversals.hs+1−1

@@ -387,7 +387,7 @@ accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder

387accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

388 where

389 forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)

390− forDecls (ExternDeclaration _ _ _ ty) = f ty

390+ forDecls (ExternDeclaration _ ty) = f ty

391 forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

392 forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)

393 forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

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

@@ -90,7 +90,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri

90 exportToPs (ValueRef ident) =

91 case (moduleName, ident) `M.lookup` names env of

92 Nothing -> error $ show ident ++ " has no type in exportToPs"

93− Just (ty, nameKind, _) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->

93+ Just (ty, Public, _) ->

94 tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]

95 _ -> return ()

96 exportToPs (TypeClassRef className) =

src/Language/PureScript/CodeGen/JS.hs+1−2

@@ -26,7 +26,6 @@ module Language.PureScript.CodeGen.JS

26 ) where

27

28import Data.List ((\\), delete)

29−import Data.Maybe (mapMaybe)

30import qualified Data.Traversable as T (traverse)

29import qualified Data.Traversable as T (traverse)

31

30

32import Control.Applicative

31import Control.Applicative

@@ -54,7 +53,7 @@ moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode)

54moduleToJs (Module coms mn imps exps foreigns decls) = do

53moduleToJs (Module coms mn imps exps foreigns decls) = do

55 additional <- asks optionsAdditional

54 additional <- asks optionsAdditional

56 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps

55 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps

57− let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns

56+ let foreigns' = [] -- TODO: Update this. mapMaybe (\(_, js, _) -> js) foreigns

58 jsDecls <- mapM bindToJs decls

57 jsDecls <- mapM bindToJs decls

59 optimized <- T.traverse (T.traverse optimize) jsDecls

58 optimized <- T.traverse (T.traverse optimize) jsDecls

60 let isModuleEmpty = null exps

59 let isModuleEmpty = null exps

src/Language/PureScript/CoreFn/Desugar.hs+3−3

@@ -198,7 +198,7 @@ findQualModules decls =

198 fqValues (A.Var (Qualified (Just mn) _)) = [mn]

199 fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]

200 fqValues _ = []

201−

201+

202 fqBinders :: A.Binder -> [ModuleName]

203 fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]

204 fqBinders _ = []

@@ -215,8 +215,8 @@ importToCoreFn _ = Nothing

215-- Desugars foreign declarations from AST to CoreFn representation.

216--

217externToCoreFn :: A.Declaration -> Maybe ForeignDecl

218−externToCoreFn (A.ExternDeclaration _ name js ty) = Just (name, js, ty)

218+externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)

219−externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, Nothing, tyObject)

219+externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, tyObject)

220externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d

221externToCoreFn _ = Nothing

222

src/Language/PureScript/CoreFn/Module.hs+1−2

@@ -14,7 +14,6 @@

14

15module Language.PureScript.CoreFn.Module where

16

17−import Language.PureScript.CodeGen.JS.AST

18import Language.PureScript.Comments

17import Language.PureScript.Comments

19import Language.PureScript.CoreFn.Expr

18import Language.PureScript.CoreFn.Expr

20import Language.PureScript.Names

19import Language.PureScript.Names

@@ -29,4 +28,4 @@ data Module a = Module

29 , moduleDecls :: [Bind a]

28 , moduleDecls :: [Bind a]

30 } deriving (Show)

29 } deriving (Show)

31

30

32−type ForeignDecl = (Ident, Maybe JS, Type)

31+type ForeignDecl = (Ident, Type)

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

@@ -50,7 +50,7 @@ bindIdents (Rec names) = map fst names

50-- Extract the ident for a foreign declaration.

51--

52foreignIdent :: ForeignDecl -> Ident

53−foreignIdent (name, _, _) = name

53+foreignIdent = fst

54

55-- |

56-- Key type to use in graph

src/Language/PureScript/Docs/Render.hs+2−2

@@ -74,7 +74,7 @@ groupChildren (partitionEithers -> (children, toplevels)) =

74

75getDeclarationTitle :: P.Declaration -> Maybe String

76getDeclarationTitle (P.TypeDeclaration name _) = Just (show name)

77−getDeclarationTitle (P.ExternDeclaration _ name _ _) = Just (show name)

77+getDeclarationTitle (P.ExternDeclaration name _) = Just (show name)

78getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (show name)

79getDeclarationTitle (P.ExternDataDeclaration name _) = Just (show name)

80getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (show name)

@@ -93,7 +93,7 @@ renderDeclaration (P.TypeDeclaration ident' ty) title =

93 code = ident (show ident')

94 <> sp <> syntax "::" <> sp

95 <> renderType ty

96−renderDeclaration (P.ExternDeclaration _ ident' _ ty) title =

96+renderDeclaration (P.ExternDeclaration ident' ty) title =

97 basicDeclaration title code

98 where

99 code = ident (show ident')

src/Language/PureScript/Environment.hs+7−34

@@ -62,19 +62,6 @@ data Environment = Environment {

62initEnvironment :: Environment

63initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty

64

65−-- |

66−-- The type of a foreign import

67−--

68−data ForeignImportType

69− -- |

70− -- A regular foreign import

71− --

72− = ForeignImport

73− -- |

74− -- A foreign import which contains inline Javascript as a string literal

75− --

76− | InlineJavascript deriving (Show, Eq, Data, Typeable)

77−

78-- |

65-- |

79-- The visibility of a name in scope

66-- The visibility of a name in scope

80--

67--

@@ -89,33 +76,19 @@ data NameVisibility

89 | Defined deriving (Show, Eq)

76 | Defined deriving (Show, Eq)

90

77

91-- |

78-- |

92−-- The kind of a name

79+-- A flag for whether a name is for an private or public value - only public values will be

80+-- included in a generated externs file.

93--

81--

94data NameKind

82data NameKind

95 -- |

83 -- |

96− -- A value introduced as a binding in a module

84+ -- A private value introduced as an artifact of code generation (class instances, class member

97− --

85+ -- accessors, etc.)

98− = Value

99− -- |

100− -- A type class dictionary member accessor import, generated during desugaring of type class declarations

101− --

102− | TypeClassAccessorImport

103− -- |

104− -- A foreign import

105− --

106− | Extern ForeignImportType

107− -- |

108− -- A local name introduced using a lambda abstraction, variable introduction or binder

109− --

110− | LocalVariable

111− -- |

112− -- A data constructor

113 --

86 --

114− | DataConstructor

87+ = Private

115 -- |

88 -- |

116− -- A type class dictionary, generated during desugaring of type class declarations

89+ -- A public value for a module member or foreing import declaration

117 --

90 --

118− | TypeInstanceDictionaryValue deriving (Show, Eq, Data, Typeable)

91+ | Public deriving (Show, Eq, Data, Typeable)

119

92

120-- |

93-- |

121-- The kinds of a type

94-- The kinds of a type

src/Language/PureScript/Linter.hs+8−8

@@ -39,35 +39,35 @@ lint (Module _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_ li

39 where

40 moduleNames :: S.Set Ident

41 moduleNames = S.fromList (nub (mapMaybe getDeclIdent ds))

42−

42+

43 getDeclIdent :: Declaration -> Maybe Ident

44 getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d

45 getDeclIdent (ValueDeclaration ident _ _ _) = Just ident

46− getDeclIdent (ExternDeclaration _ ident _ _) = Just ident

46+ getDeclIdent (ExternDeclaration ident _) = Just ident

47 getDeclIdent (ExternInstanceDeclaration ident _ _ _) = Just ident

48 getDeclIdent (TypeInstanceDeclaration ident _ _ _ _) = Just ident

49 getDeclIdent (BindingGroupDeclaration _) = error "lint: binding groups should not be desugared yet."

50 getDeclIdent _ = Nothing

51

52 lintDeclaration :: Declaration -> m ()

53− lintDeclaration d =

53+ lintDeclaration d =

54 let (f, _, _, _, _) = everythingWithContextOnValues moduleNames mempty mappend def stepE stepB def def

55 in tell (f d)

56 where

57 def s _ = (s, mempty)

58−

58+

59 stepE :: S.Set Ident -> Expr -> (S.Set Ident, MultipleErrors)

60 stepE s (Abs (Left name) _) = bind s name

61− stepE s (Let ds' _) =

61+ stepE s (Let ds' _) =

62 case mapAccumL bind s (nub (mapMaybe getDeclIdent ds')) of

63 (s', es) -> (s', mconcat es)

64 stepE s _ = (s, mempty)

65−

65+

66 stepB :: S.Set Ident -> Binder -> (S.Set Ident, MultipleErrors)

67 stepB s (VarBinder name) = bind s name

68 stepB s (NamedBinder name _) = bind s name

69 stepB s _ = (s, mempty)

70−

70+

71 bind :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)

72 bind s name | name `S.member` s = (s, errorMessage (ShadowedName name))

73− | otherwise = (S.insert name s, mempty)

73+ | otherwise = (S.insert name s, mempty)

src/Language/PureScript/Parser/Declarations.hs+7−9

@@ -30,22 +30,21 @@ module Language.PureScript.Parser.Declarations (

30

31import Prelude hiding (lex)

32

33−import Data.Maybe (isJust, fromMaybe)

33+import Data.Maybe (fromMaybe)

34import Data.Traversable (forM)

35

36import Control.Applicative

37import Control.Arrow ((+++))

38

39−import Language.PureScript.Kinds

40import Language.PureScript.AST

39import Language.PureScript.AST

41import Language.PureScript.Comments

40import Language.PureScript.Comments

41+import Language.PureScript.Environment

42+import Language.PureScript.Kinds

43+import Language.PureScript.Names

42import Language.PureScript.Parser.Common

44import Language.PureScript.Parser.Common

43−import Language.PureScript.Parser.Types

44import Language.PureScript.Parser.Kinds

45import Language.PureScript.Parser.Kinds

45import Language.PureScript.Parser.Lexer

46import Language.PureScript.Parser.Lexer

46−import Language.PureScript.Names

47+import Language.PureScript.Parser.Types

47−import Language.PureScript.CodeGen.JS.AST

48−import Language.PureScript.Environment

49

48

50import qualified Language.PureScript.Parser.Common as C

49import qualified Language.PureScript.Parser.Common as C

51import qualified Text.Parsec as P

50import qualified Text.Parsec as P

@@ -99,7 +98,7 @@ parseValueDeclaration = do

99 <*> (indented *> equals *> parseValueWithWhereClause)

98 <*> (indented *> equals *> parseValueWithWhereClause)

100 ))

99 ))

101 <|> Right <$> (indented *> equals *> parseValueWithWhereClause)

100 <|> Right <$> (indented *> equals *> parseValueWithWhereClause)

102− return $ ValueDeclaration name Value binders value

101+ return $ ValueDeclaration name Public binders value

103 where

102 where

104 parseValueWithWhereClause :: TokenParser Expr

103 parseValueWithWhereClause :: TokenParser Expr

105 parseValueWithWhereClause = do

104 parseValueWithWhereClause = do

@@ -126,9 +125,8 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "imp

126 tys <- P.many (indented *> noWildcards parseTypeAtom)

125 tys <- P.many (indented *> noWildcards parseTypeAtom)

127 return $ ExternInstanceDeclaration name deps className tys)

126 return $ ExternInstanceDeclaration name deps className tys)

128 <|> (do ident <- parseIdent

127 <|> (do ident <- parseIdent

129− js <- P.optionMaybe (JSRaw <$> stringLiteral)

130 ty <- indented *> doubleColon *> noWildcards parsePolyType

128 ty <- indented *> doubleColon *> noWildcards parsePolyType

131− return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))

129+ return $ ExternDeclaration ident ty))

132

130

133parseAssociativity :: TokenParser Associativity

131parseAssociativity :: TokenParser Associativity

134parseAssociativity =

132parseAssociativity =

src/Language/PureScript/Sugar/CaseDeclarations.hs+9−9

@@ -101,7 +101,7 @@ toDecls [ValueDeclaration ident nameKind bs (Right val)] | all isVarBinder bs =

101 isVarBinder (VarBinder _) = True

102 isVarBinder (PositionedBinder _ _ b) = isVarBinder b

103 isVarBinder _ = False

104−

104+

105 fromVarBinder :: Binder -> m Ident

106 fromVarBinder NullBinder = Ident <$> freshName

107 fromVarBinder (VarBinder name) = return name

@@ -129,17 +129,17 @@ makeCaseDeclaration :: forall m. (Functor m, Applicative m, MonadSupply m, Monad

129makeCaseDeclaration ident alternatives = do

130 let namedArgs = map findName . fst <$> alternatives

131 argNames = map join $ foldl1 resolveNames namedArgs

132− args <- if allUnique (catMaybes argNames)

132+ args <- if allUnique (catMaybes argNames)

133− then mapM argName argNames

133+ then mapM argName argNames

134 else replicateM (length argNames) (Ident <$> freshName)

135 let vars = map (Var . Qualified Nothing) args

136 binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]

137 value = foldr (Abs . Left) (Case vars binders) args

138− return $ ValueDeclaration ident Value [] (Right value)

138+ return $ ValueDeclaration ident Public [] (Right value)

139 where

140 -- We will construct a table of potential names.

141 -- VarBinders will become Just (Just _) which is a potential name.

142− -- NullBinder will become Just Nothing, which indicates that we may

142+ -- NullBinder will become Just Nothing, which indicates that we may

143 -- have to generate a name.

144 -- Everything else becomes Nothing, which indicates that we definitely

145 -- have to generate a name.

@@ -162,15 +162,15 @@ makeCaseDeclaration ident alternatives = do

162

163 -- Combine two lists of potential names from two case alternatives

164 -- by zipping correspoding columns.

165− resolveNames :: [Maybe (Maybe Ident)] ->

165+ resolveNames :: [Maybe (Maybe Ident)] ->

166− [Maybe (Maybe Ident)] ->

166+ [Maybe (Maybe Ident)] ->

167 [Maybe (Maybe Ident)]

168 resolveNames = zipWith resolveName

169

170 -- Resolve a pair of names. VarBinder beats NullBinder, and everything

171 -- else results in Nothing.

172− resolveName :: Maybe (Maybe Ident) ->

172+ resolveName :: Maybe (Maybe Ident) ->

173− Maybe (Maybe Ident) ->

173+ Maybe (Maybe Ident) ->

174 Maybe (Maybe Ident)

175 resolveName (Just (Just a)) (Just (Just b))

176 | a == b = Just (Just a)

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

@@ -226,8 +226,8 @@ renameInModule imports exports (Module coms mn decls exps) =

226 (,) (pos, bound) <$> (ExternInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn Nothing <*> mapM (updateTypesEverywhere pos) ts)

227 updateDecl (pos, bound) (TypeDeclaration name ty) =

228 (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)

229− updateDecl (pos, bound) (ExternDeclaration fit name js ty) =

229+ updateDecl (pos, bound) (ExternDeclaration name ty) =

230− (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)

230+ (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)

231 updateDecl s d = return (s, d)

232

233 updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> m ((Maybe SourceSpan, [Ident]), Expr)

@@ -337,7 +337,7 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName C.prim]) pri

337 addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []

338 addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []

339 addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name

340− addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name

340+ addDecl mn env (ExternDeclaration name _) = addValue env mn name

341 addDecl mn env (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ addDecl mn env d

342 addDecl _ env _ = return env

343

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

@@ -59,7 +59,7 @@ desugarModule (Module coms name decls (Just exps)) = do

59 return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)

60 where

61 classesFirst :: Declaration -> Declaration -> Ordering

62− classesFirst d1 d2

62+ classesFirst d1 d2

63 | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT

64 | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT

65 | otherwise = EQ

@@ -219,7 +219,7 @@ typeClassDictionaryDeclaration name args implies members =

219typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Declaration -> Declaration

220typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

221 let className = Qualified (Just mn) name

222− in ValueDeclaration ident TypeClassAccessorImport [] $ Right $

222+ in ValueDeclaration ident Private [] $ Right $

223 TypedValue False (TypeClassDictionaryAccessor className ident) $

224 moveQuantifiersToFront (quantify (ConstrainedType [(className, map (TypeVar . fst) args)] ty))

225typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =

@@ -264,7 +264,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

264 dictTy = foldl TypeApp (TypeConstructor className) tys

265 constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)

266 dict = TypeClassDictionaryConstructorApp className props

267− result = ValueDeclaration name TypeInstanceDictionaryValue [] (Right (TypedValue True dict constrainedTy))

267+ result = ValueDeclaration name Private [] (Right (TypedValue True dict constrainedTy))

268 return result

269

270 where

src/Language/PureScript/TypeChecker.hs+2−2

@@ -207,14 +207,14 @@ typeCheckAll mainModuleName moduleName exps = go

207 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }

208 ds <- go rest

209 return $ d : ds

210− go (d@(ExternDeclaration importTy name _ ty) : rest) = do

210+ go (d@(ExternDeclaration name ty) : rest) = do

211 rethrow (onErrorMessages (ErrorInForeignImport name)) $ do

212 env <- getEnv

213 kind <- kindOf moduleName ty

214 guardWith (errorMessage (ExpectedType kind)) $ kind == Star

215 case M.lookup (moduleName, name) (names env) of

216 Just _ -> throwError . errorMessage $ RedefinedIdent name

217− Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, Extern importTy, Defined) (names env) })

217+ Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, Public, Defined) (names env) })

218 ds <- go rest

219 return $ d : ds

220 go (d@(FixityDeclaration _ name) : rest) = do

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

@@ -86,7 +86,7 @@ getTypeClassDictionaries = M.elems . typeClassDictionaries . checkEnv <$> get

86--

87bindLocalVariables :: (Functor m, MonadState CheckState m) => ModuleName -> [(Ident, Type, NameVisibility)] -> m a -> m a

88bindLocalVariables moduleName bindings =

89− bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, LocalVariable, visibility)))

89+ bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, Private, visibility)))

90

91-- |

92-- Temporarily bind a collection of names to local type variables

@@ -98,7 +98,7 @@ bindLocalTypeVariables moduleName bindings =

98-- |

99-- Update the visibility of all names to Defined

100--

101−makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()

101+makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()

102makeBindingGroupVisible = modifyEnv $ \e -> e { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names e) }

103

104-- | Update the visibility of all names to Defined in the scope of the provided action

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

@@ -127,7 +127,7 @@ typeDictionaryForBindingGroup moduleName vals = do

127 -- Make a map of names to the unification variables of untyped declarations

128 untypedDict = zip (map fst untyped) untypedNames

129 -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking

130− dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, LocalVariable, Undefined))) $ typedDict ++ untypedDict)

130+ dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)

131 return (untyped, typed, dict, untypedDict)

132

133checkTypedBindingGroupElement :: ModuleName -> (Ident, (Expr, Type, Bool)) -> TypeData -> UnifyT Type Check (Ident, (Expr, Type))

@@ -325,7 +325,7 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do

325 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)

326 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict

327 ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict

328− let ds' = [(ident, LocalVariable, val') | (ident, (val', _)) <- ds1' ++ ds2']

328+ let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']

329 bindNames dict $ do

330 makeBindingGroupVisible

331 inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j