0888ada · rowtype-yoga/purescript-native

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

on golang help sign in

Warn on shadowed type var within a single type

0888adaGary Burgess11 years ago

src/Language/PureScript/Errors.hs+5−1

compare with golang

unifiedsplit

@@ -140,6 +140,7 @@ data SimpleErrorMessage

140 | InvalidInstanceHead Type

141 | TransitiveExportError DeclarationRef [DeclarationRef]

142 | ShadowedName Ident

143+ | ShadowedTypeVar String

143 | WildcardInferredType Type

144 | WildcardInferredType Type

144 | NotExhaustivePattern [[Binder]] Bool

145 | NotExhaustivePattern [[Binder]] Bool

145 | OverlappingPattern [[Binder]] Bool

146 | OverlappingPattern [[Binder]] Bool

@@ -266,6 +267,7 @@ errorCode em = case unwrapErrorMessage em of

266 InvalidInstanceHead{} -> "InvalidInstanceHead"

267 InvalidInstanceHead{} -> "InvalidInstanceHead"

267 TransitiveExportError{} -> "TransitiveExportError"

268 TransitiveExportError{} -> "TransitiveExportError"

268 ShadowedName{} -> "ShadowedName"

269 ShadowedName{} -> "ShadowedName"

270+ ShadowedTypeVar{} -> "ShadowedTypeVar"

269 WildcardInferredType{} -> "WildcardInferredType"

271 WildcardInferredType{} -> "WildcardInferredType"

270 NotExhaustivePattern{} -> "NotExhaustivePattern"

272 NotExhaustivePattern{} -> "NotExhaustivePattern"

271 OverlappingPattern{} -> "OverlappingPattern"

273 OverlappingPattern{} -> "OverlappingPattern"

@@ -628,7 +630,9 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

628 paras $ line ("An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")

630 paras $ line ("An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")

629 : map (line . prettyPrintExport) ys

631 : map (line . prettyPrintExport) ys

630 goSimple (ShadowedName nm) =

632 goSimple (ShadowedName nm) =

631− line $ "Name '" ++ showIdent nm ++ "' was shadowed."

633+ line $ "Name '" ++ showIdent nm ++ "' was shadowed"

634+ goSimple (ShadowedTypeVar tv) =

635+ line $ "Type variable '" ++ tv ++ "' was shadowed"

632 goSimple (ClassOperator className opName) =

636 goSimple (ClassOperator className opName) =

633 paras [ line $ "Class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."

637 paras [ line $ "Class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."

634 , indent $ line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"

638 , indent $ line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"

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

@@ -33,6 +33,7 @@ import Control.Monad.Writer.Class

33import Language.PureScript.AST

34import Language.PureScript.Names

35import Language.PureScript.Errors

36+import Language.PureScript.Types

36import Language.PureScript.Linter.Exhaustive as L

37import Language.PureScript.Linter.Exhaustive as L

38-- | Lint the PureScript AST.

39-- | Lint the PureScript AST.

@@ -59,7 +60,7 @@ lint (Module _ _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_

60 f' :: Declaration -> MultipleErrors

61 f' :: Declaration -> MultipleErrors

61 f' (PositionedDeclaration pos _ dec) = onErrorMessages (PositionedError pos) (f' dec)

62 f' (PositionedDeclaration pos _ dec) = onErrorMessages (PositionedError pos) (f' dec)

62− f' dec = f dec

63+ f' dec = f dec <> checkShadowedTypeVars dec

64 in tell (f' d)

65 in tell (f' d)

65 where

66 where

@@ -75,17 +76,32 @@ lint (Module _ _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_

75 stepD s _ = (s, mempty)

76 stepD s _ = (s, mempty)

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

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

78− stepE s (Abs (Left name) _) = bind s name

79+ stepE s (Abs (Left name) _) = bindName s name

79 stepE s (Let ds' _) =

80 stepE s (Let ds' _) =

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

81+ case mapAccumL bindName s (nub (mapMaybe getDeclIdent ds')) of

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

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

82 stepE s _ = (s, mempty)

83 stepE s _ = (s, mempty)

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

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

85− stepB s (VarBinder name) = bind s name

86+ stepB s (VarBinder name) = bindName s name

86− stepB s (NamedBinder name _) = bind s name

87+ stepB s (NamedBinder name _) = bindName s name

87 stepB s _ = (s, mempty)

88 stepB s _ = (s, mempty)

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

90+ bindName :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)

91+ bindName = bind ShadowedName

92+

93+ checkShadowedTypeVars :: Declaration -> MultipleErrors

94+ checkShadowedTypeVars d =

95+ let (f, _, _, _, _) = accumTypes go in f d

96+ where

97+ go :: Type -> MultipleErrors

98+ go = everythingWithContextOnTypes S.empty mempty mappend step

99+ step :: S.Set String -> Type -> (S.Set String, MultipleErrors)

100+ step s (ForAll tv _ _) = bindVar s tv

101+ step s _ = (s, mempty)

102+ bindVar :: S.Set String -> String -> (S.Set String, MultipleErrors)

103+ bindVar = bind ShadowedTypeVar

104+

105+ bind :: (Ord a) => (a -> SimpleErrorMessage) -> S.Set a -> a -> (S.Set a, MultipleErrors)

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

106+ bind mkError s name | name `S.member` s = (s, errorMessage (mkError name))

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

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

src/Language/PureScript/Types.hs+15

@@ -312,3 +312,18 @@ everythingOnTypes (<>) f = go

312 go t@(PrettyPrintObject t1) = f t <> go t1

313 go t@(PrettyPrintForAll _ t1) = f t <> go t1

314 go other = f other

315+

316+everythingWithContextOnTypes :: s -> r -> (r -> r -> r) -> (s -> Type -> (s, r)) -> Type -> r

317+everythingWithContextOnTypes s0 r0 (<>) f = go' s0

318+ where

319+ go' s t = let (s', r) = f s t in r <> go s' t

320+ go s (TypeApp t1 t2) = go' s t1 <> go' s t2

321+ go s (SaturatedTypeSynonym _ tys) = foldl (<>) r0 (map (go' s) tys)

322+ go s (ForAll _ ty _) = go' s ty

323+ go s (ConstrainedType cs ty) = foldl (<>) r0 (map (go' s) $ concatMap snd cs) <> go' s ty

324+ go s (RCons _ ty rest) = go' s ty <> go' s rest

325+ go s (KindedType ty _) = go' s ty

326+ go s (PrettyPrintFunction t1 t2) = go' s t1 <> go' s t2

327+ go s (PrettyPrintObject t1) = go' s t1

328+ go s (PrettyPrintForAll _ t1) = go' s t1

329+ go _ _ = r0