5cee177 · rowtype-yoga/purescript-native

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

Simplify representation of foreign declarations

commit5cee1770deed95e348df22dc481c216c34dfe4dd authorGary Burgess <gary.burgess@gmail.com> dateSun 3 May 2015, 19:21 (11 years ago) parent330bab9

23 files changed+69−102

compare with golang

unifiedsplit

psc-docs/Main.hs−1

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

9393 let fp = fst (head grp)

9494 createDirectoryIfMissing True (takeDirectory fp)

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

96−

9796 where

9897 guardMissing [] = return ()

9998 guardMissing [mn] = do

psc-docs/Tags.hs+1−1

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

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

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

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

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

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

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

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

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

psci/Completion.hs+1−1

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

199199 where

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

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

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

204204 getDeclName _ = Nothing

205205

psci/PSCi.hs+3−3

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

6565

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

6767supportModule :: P.Module

68−supportModule =

68+supportModule =

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

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

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

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

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

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

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

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

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

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

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

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

251251 in

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

psci/Parser.hs+7−7

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

122122discardPositionInfo d = d

123123

124124acceptable :: P.Declaration -> Bool

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

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

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

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

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

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

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

125+acceptable P.DataDeclaration{} = True

126+acceptable P.TypeSynonymDeclaration{} = True

127+acceptable P.ExternDeclaration{} = True

128+acceptable P.ExternDataDeclaration{} = True

129+acceptable P.ExternInstanceDeclaration{} = True

130+acceptable P.TypeClassDeclaration{} = True

131+acceptable P.TypeInstanceDeclaration{} = True

132132acceptable _ = False

133133

134134parseReplQuery' :: String -> Either String ReplQuery

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

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

2626import Language.PureScript.Kinds

2727import Language.PureScript.TypeClassDictionaries

2828import Language.PureScript.Comments

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

3029import Language.PureScript.Environment

3130

3231-- |

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

122121 --

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

124123 -- |

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

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

126125 --

127− | ExternDeclaration ForeignImportType Ident (Maybe JS) Type

126+ | ExternDeclaration Ident Type

128127 -- |

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

130129 --

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

255254 --

256255 | StringLiteral String

257256 -- |

258− -- A character literal

257+ -- A character literal

259258 --

260259 | CharLiteral Char

261260 -- |

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

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

109109 where

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

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

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

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

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

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

115115 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

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

388388 where

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

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

390+ forDecls (ExternDeclaration _ ty) = f ty

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

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

393393 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

9090 exportToPs (ValueRef ident) =

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

9292 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, _) ->

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

9595 _ -> return ()

9696 exportToPs (TypeClassRef className) =

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

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

2626 ) where

2727

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

29−import Data.Maybe (mapMaybe)

3029import qualified Data.Traversable as T (traverse)

3130

3231import Control.Applicative

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

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

5554 additional <- asks optionsAdditional

5655 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

5857 jsDecls <- mapM bindToJs decls

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

6059 let isModuleEmpty = null exps

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

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

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

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

200200 fqValues _ = []

201−

201+

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

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

204204 fqBinders _ = []

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

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

216216--

217217externToCoreFn :: A.Declaration -> Maybe ForeignDecl

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

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

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

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

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

221221externToCoreFn _ = Nothing

222222

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

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

1414

1515module Language.PureScript.CoreFn.Module where

1616

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

1817import Language.PureScript.Comments

1918import Language.PureScript.CoreFn.Expr

2019import Language.PureScript.Names

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

2928 , moduleDecls :: [Bind a]

3029 } deriving (Show)

3130

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

5050-- Extract the ident for a foreign declaration.

5151--

5252foreignIdent :: ForeignDecl -> Ident

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

53+foreignIdent = fst

5454

5555-- |

5656-- Key type to use in graph

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

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

7474

7575getDeclarationTitle :: P.Declaration -> Maybe String

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

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

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

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

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

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

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

9393 code = ident (show ident')

9494 <> sp <> syntax "::" <> sp

9595 <> renderType ty

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

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

9797 basicDeclaration title code

9898 where

9999 code = ident (show ident')

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

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

6262initEnvironment :: Environment

6363initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty

6464

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−

7865-- |

7966-- The visibility of a name in scope

8067--

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

8976 | Defined deriving (Show, Eq)

9077

9178-- |

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.

9381--

9482data NameKind

9583 -- |

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

97− --

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

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

85+ -- accessors, etc.)

11386 --

114− | DataConstructor

87+ = Private

11588 -- |

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

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

11790 --

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

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

11992

12093-- |

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

3939 where

4040 moduleNames :: S.Set Ident

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

42−

42+

4343 getDeclIdent :: Declaration -> Maybe Ident

4444 getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d

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

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

46+ getDeclIdent (ExternDeclaration ident _) = Just ident

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

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

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

5050 getDeclIdent _ = Nothing

5151

5252 lintDeclaration :: Declaration -> m ()

53− lintDeclaration d =

53+ lintDeclaration d =

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

5555 in tell (f d)

5656 where

5757 def s _ = (s, mempty)

58−

58+

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

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

61− stepE s (Let ds' _) =

61+ stepE s (Let ds' _) =

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

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

6464 stepE s _ = (s, mempty)

65−

65+

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

6767 stepB s (VarBinder name) = bind s name

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

6969 stepB s _ = (s, mempty)

70−

70+

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

7272 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 (

3030

3131import Prelude hiding (lex)

3232

33−import Data.Maybe (isJust, fromMaybe)

33+import Data.Maybe (fromMaybe)

3434import Data.Traversable (forM)

3535

3636import Control.Applicative

3737import Control.Arrow ((+++))

3838

39−import Language.PureScript.Kinds

4039import Language.PureScript.AST

4140import Language.PureScript.Comments

41+import Language.PureScript.Environment

42+import Language.PureScript.Kinds

43+import Language.PureScript.Names

4244import Language.PureScript.Parser.Common

43−import Language.PureScript.Parser.Types

4445import Language.PureScript.Parser.Kinds

4546import Language.PureScript.Parser.Lexer

46−import Language.PureScript.Names

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

48−import Language.PureScript.Environment

47+import Language.PureScript.Parser.Types

4948

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

5150import qualified Text.Parsec as P

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

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

10099 ))

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

102− return $ ValueDeclaration name Value binders value

101+ return $ ValueDeclaration name Public binders value

103102 where

104103 parseValueWithWhereClause :: TokenParser Expr

105104 parseValueWithWhereClause = do

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

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

127126 return $ ExternInstanceDeclaration name deps className tys)

128127 <|> (do ident <- parseIdent

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

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

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

129+ return $ ExternDeclaration ident ty))

132130

133131parseAssociativity :: TokenParser Associativity

134132parseAssociativity =

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

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

101101 isVarBinder (VarBinder _) = True

102102 isVarBinder (PositionedBinder _ _ b) = isVarBinder b

103103 isVarBinder _ = False

104−

104+

105105 fromVarBinder :: Binder -> m Ident

106106 fromVarBinder NullBinder = Ident <$> freshName

107107 fromVarBinder (VarBinder name) = return name

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

129129makeCaseDeclaration ident alternatives = do

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

131131 argNames = map join $ foldl1 resolveNames namedArgs

132− args <- if allUnique (catMaybes argNames)

133− then mapM argName argNames

132+ args <- if allUnique (catMaybes argNames)

133+ then mapM argName argNames

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

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

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

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

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

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

139139 where

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

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

143143 -- have to generate a name.

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

145145 -- have to generate a name.

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

162162

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

164164 -- by zipping correspoding columns.

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

166− [Maybe (Maybe Ident)] ->

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

166+ [Maybe (Maybe Ident)] ->

167167 [Maybe (Maybe Ident)]

168168 resolveNames = zipWith resolveName

169169

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

171171 -- else results in Nothing.

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

173− Maybe (Maybe Ident) ->

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

173+ Maybe (Maybe Ident) ->

174174 Maybe (Maybe Ident)

175175 resolveName (Just (Just a)) (Just (Just b))

176176 | 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) =

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

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

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

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

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

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

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

231231 updateDecl s d = return (s, d)

232232

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

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

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

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

339339 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

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

342342 addDecl _ env _ = return env

343343

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

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

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

6060 where

6161 classesFirst :: Declaration -> Declaration -> Ordering

62− classesFirst d1 d2

62+ classesFirst d1 d2

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

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

6565 | otherwise = EQ

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

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

220220typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

221221 let className = Qualified (Just mn) name

222− in ValueDeclaration ident TypeClassAccessorImport [] $ Right $

222+ in ValueDeclaration ident Private [] $ Right $

223223 TypedValue False (TypeClassDictionaryAccessor className ident) $

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

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

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

264264 dictTy = foldl TypeApp (TypeConstructor className) tys

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

266266 dict = TypeClassDictionaryConstructorApp className props

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

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

268268 return result

269269

270270 where

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

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

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

208208 ds <- go rest

209209 return $ d : ds

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

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

211211 rethrow (onErrorMessages (ErrorInForeignImport name)) $ do

212212 env <- getEnv

213213 kind <- kindOf moduleName ty

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

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

216216 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) })

218218 ds <- go rest

219219 return $ d : ds

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

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

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

8686--

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

8888bindLocalVariables 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)))

9090

9191-- |

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

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

9898-- |

9999-- Update the visibility of all names to Defined

100100--

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

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

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

103103

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

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

128128 untypedDict = zip (map fst untyped) untypedNames

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

131131 return (untyped, typed, dict, untypedDict)

132132

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

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

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

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

327327 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']

329329 bindNames dict $ do

330330 makeBindingGroupVisible

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