ddb7c79 · elk · git.iko.soy

git.iko.soy/elk

Switch canonicalization to CPS / gather usage counts for variables

The main goals here are: 1. Gather usage counts for each argument. This will make it easier to make inlining decisions in the optimization phase 2. Track whether variable uses are direct or delayed. When deciding if top-level cycles are valid, this information allows us to accept cycles of all values as long as the recursion passes through a lambda. Making this more flexible is based on learnings from writing random Mondrian generators with Ju. This means it’ll work if the recursion passes through at least one Random.lazy or Random.andThen. Switching to CPS makes it easier to do the info tracking IMO, so I just switched it now.

commitddb7c79dbcc3d440c67e239a5ad7ab278c90fb91 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 28 Nov 2017, 17:43 (9 years ago) parente41ae10

13 files changed+964−652

compare with master

unifiedsplit

src/AST/Canonical.hs+63−25 src/Canonicalize/Effects.hs+12−13 src/Canonicalize/Environment.hs+179−10 src/Canonicalize/Environment/Dups.hs+48−51 src/Canonicalize/Environment/Foreign.hs+15−16 src/Canonicalize/Environment/Internals.hs−233 src/Canonicalize/Environment/Local.hs+24−30 src/Canonicalize/Expression.hs+299−130 src/Canonicalize/Module.hs+95−57 src/Canonicalize/Pattern.hs+66−42 src/Canonicalize/Result.hs+112 src/Canonicalize/Type.hs+14−16 src/Reporting/Warning.hs+37−29

src/AST/Canonical.hs+63−25

@@ -3,9 +3,11 @@

33module AST.Canonical

44 ( Expr, Expr_(..)

55 , CaseBranch(..)

6+ -- definitions

67 , Def(..)

78 , Arg(..)

89 , TypedArg(..)

10+ , Decls(..)

911 -- patterns

1012 , Pattern, Pattern_(..)

1113 , CtorAlts(..)

@@ -13,14 +15,15 @@ module AST.Canonical

1315 , toAlts

1416 , ctorsToAlts

1517 , PatternCtorArg(..)

18+ -- destructors

1619 , Destructors

20+ , DestructorInfo(..)

1721 , Destructor(..)

1822 -- types

1923 , Annotation(..)

2024 , Type(..)

2125 , AliasType(..)

22− -- decls

23− , Decls(..)

26+ -- modules

2427 , Module(..)

2528 , Alias(..)

2629 , Union(..)

@@ -34,6 +37,24 @@ module AST.Canonical

3437 )

3538 where

3639

40+{- Creating a canonical AST means finding the home module for all variables.

41+So if you have L.map, you need to figure out that it is from the elm-lang/core

42+package in the List module.

43+

44+In later phases (e.g. type inference, exhaustiveness checking, optimization)

45+you need to look up additional info from these modules. What is the type?

46+What are the alternative type constructors? These lookups can be quite costly,

47+especially in type inference. To reduce costs the canonicalization phase

48+caches info needed in later phases. This means we no longer build large

49+dictionaries of metadata with O(log(n)) lookups in those phases. Instead

50+there is an O(1) read of an existing field! I have tried to mark all

51+cached data with comments like:

52+

53+-- CACHE for exhaustiveness

54+-- CACHE for inference

55+

56+So it is clear why the data is kept around.

57+-}

3758

3859import Control.Monad (liftM, liftM2, liftM3, liftM4, replicateM)

3960import Data.Binary

@@ -63,7 +84,10 @@ data Expr_

6384 | VarTopLevel ModuleName.Canonical N.Name

6485 | VarKernel N.Name N.Name

6586 | VarForeign ModuleName.Canonical N.Name Annotation

87+ -- CACHE Annotation for inference

6688 | VarOperator N.Name ModuleName.Canonical N.Name Annotation

89+ -- CACHE real name for optimization

90+ -- CACHE Annotation for inference

6791 | Chr Text

6892 | Str Text

6993 | Int Int

@@ -71,6 +95,8 @@ data Expr_

7195 | List [Expr]

7296 | Negate Expr

7397 | Binop N.Name ModuleName.Canonical N.Name Annotation Expr Expr

98+ -- CACHE real name for optimization

99+ -- CACHE Annotation for inference

74100 | Lambda [Arg] Destructors Expr

75101 | Call Expr [Expr]

76102 | If [(Expr, Expr)] Expr

@@ -109,10 +135,22 @@ data TypedArg =

109135

110136

111137

138+-- DECLARATIONS

139+

140+

141+data Decls

142+ = Declare Def Decls

143+ | DeclareRec [Def] Decls

144+ | SaveTheEnvironment

145+

146+

147+

112148-- PATTERNS

113149

114150

115−type Pattern = A.Located Pattern_

151+type Pattern =

152+ A.Located Pattern_

153+

116154

117155data Pattern_

118156 = PAnything

@@ -134,15 +172,21 @@ data Pattern_

134172 , _p_name :: N.Name

135173 , _p_args :: [PatternCtorArg]

136174 }

175+ -- CACHE _p_home, _p_type, and _p_vars for type inference

176+ -- CACHE _p_alts for exhaustiveness checker

137177

138178

139−

140−-- PATTERN CTORS

179+data PatternCtorArg =

180+ PatternCtorArg

181+ { _index :: Index.ZeroBased -- CACHE for destructors/errors

182+ , _type :: Type -- CACHE for type inference

183+ , _arg :: Pattern

184+ }

141185

142186

143187data CtorAlts =

144188 CtorAlts

145− { _num :: Int -- result of (length _alts) to amortize O(n) cost

189+ { _num :: Int -- CACHE (length _alts) for exhaustiveness

146190 , _alts :: [CtorAlt]

147191 }

148192 deriving (Eq)

@@ -156,6 +200,10 @@ data CtorAlt =

156200 deriving (Eq)

157201

158202

203+

204+-- PATTERN CTOR HELPERS

205+

206+

159207toAlts :: [CtorAlt] -> CtorAlts

160208toAlts alts =

161209 CtorAlts (length alts) alts

@@ -171,20 +219,20 @@ toAlt (ctor, argTypes) =

171219 CtorAlt ctor (length argTypes)

172220

173221

174−data PatternCtorArg =

175− PatternCtorArg

176− { _index :: Index.ZeroBased

177− , _type :: Type

178− , _arg :: Pattern

179− }

180−

181−

182222

183223-- DESTRUCTORS

184224

185225

186226type Destructors =

187− Map.Map N.Name (A.Located Destructor)

227+ Map.Map N.Name DestructorInfo

228+

229+

230+data DestructorInfo =

231+ DestructorInfo

232+ { _destructor :: Destructor

233+ , _direct_uses :: Int -- CACHE for inlining

234+ , _delayed_uses :: Int -- CACHE for inlining

235+ }

188236

189237

190238data Destructor

@@ -219,16 +267,6 @@ data AliasType

219267

220268

221269

222−-- DECLARATIONS

223−

224−

225−data Decls

226− = Declare Def Decls

227− | DeclareRec [Def] Decls

228− | SaveTheEnvironment

229−

230−

231−

232270-- MODULES

233271

234272

src/Canonicalize/Effects.hs+12−13

@@ -16,21 +16,20 @@ import qualified AST.Valid as Valid

1616import qualified AST.Module.Name as ModuleName

1717import qualified AST.Utils.Type as Type

1818import qualified Canonicalize.Environment as Env

19+import qualified Canonicalize.Result as Result

1920import qualified Canonicalize.Type as Type

2021import qualified Elm.Name as N

2122import qualified Reporting.Annotation as A

2223import qualified Reporting.Error.Canonicalize as Error

2324import qualified Reporting.Region as R

24−import qualified Reporting.Result as Result

25−import qualified Reporting.Warning as Warning

2625

2726

2827

2928-- RESULT

3029

3130

32−type Result a =

33− Result.Result () Warning.Warning Error.Error a

31+type Result i w a =

32+ Result.Result i w Error.Error a

3433

3534

3635

@@ -42,7 +41,7 @@ canonicalize

4241 -> [A.Located Valid.Decl]

4342 -> Map.Map N.Name union

4443 -> Valid.Effects

45− -> Result Can.Effects

44+ -> Result i w Can.Effects

4645canonicalize env decls unions effects =

4746 case effects of

4847 Valid.NoEffects ->

@@ -76,7 +75,7 @@ canonicalize env decls unions effects =

7675-- CANONICALIZE PORT

7776

7877

79−canonicalizePort :: Env.Env -> Valid.Port -> Result (N.Name, Can.Port)

78+canonicalizePort :: Env.Env -> Valid.Port -> Result i w (N.Name, Can.Port)

8079canonicalizePort env (Valid.Port (A.At region portName) tipe) =

8180 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe

8281 case Type.deepDealias ctipe of

@@ -84,7 +83,7 @@ canonicalizePort env (Valid.Port (A.At region portName) tipe) =

8483 | home == ModuleName.cmd && name == "Cmd" ->

8584 case checkPayload outgoingType of

8685 Left (badType, err) ->

87− Result.throw region (Error.PortPayloadInvalid portName badType err)

86+ Result.throw (Error.PortPayloadInvalid region portName badType err)

8887

8988 Right () ->

9089 Result.ok (portName, Can.Outgoing freeVars ctipe)

@@ -93,25 +92,25 @@ canonicalizePort env (Valid.Port (A.At region portName) tipe) =

9392 | home == ModuleName.sub && name == "Sub" && msg1 == msg2 ->

9493 case checkPayload incomingType of

9594 Left (badType, err) ->

96− Result.throw region (Error.PortPayloadInvalid portName badType err)

95+ Result.throw (Error.PortPayloadInvalid region portName badType err)

9796

9897 Right () ->

9998 Result.ok (portName, Can.Incoming freeVars ctipe)

10099

101100 _ ->

102− Result.throw region (Error.PortTypeInvalid portName ctipe)

101+ Result.throw (Error.PortTypeInvalid region portName ctipe)

103102

104103

105104

106105-- VERIFY MANAGER

107106

108107

109−verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result N.Name

108+verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result i w N.Name

110109verifyEffectType (A.At region name) unions =

111110 if Map.member name unions then

112111 Result.ok name

113112 else

114− Result.throw region (Error.EffectNotFound name)

113+ Result.throw (Error.EffectNotFound region name)

115114

116115

117116toNameRegion :: A.Located Valid.Decl -> (N.Name, R.Region)

@@ -119,14 +118,14 @@ toNameRegion (A.At _ (Valid.Decl (A.At region name) _ _ _)) =

119118 (name, region)

120119

121120

122−verifyManager :: R.Region -> Map.Map N.Name R.Region -> N.Name -> Result R.Region

121+verifyManager :: R.Region -> Map.Map N.Name R.Region -> N.Name -> Result i w R.Region

123122verifyManager tagRegion decls name =

124123 case Map.lookup name decls of

125124 Just region ->

126125 Result.ok region

127126

128127 Nothing ->

129− Result.throw tagRegion (Error.EffectFunctionNotFound name)

128+ Result.throw (Error.EffectFunctionNotFound tagRegion name)

130129

131130

132131

src/Canonicalize/Environment.hs+179−10

@@ -1,17 +1,186 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

33module Canonicalize.Environment

4− ( Env.Result

5− , Env.Env

6− , Env.addLocals

7− , Env.findVar

8− , Env.findType

9− , Env.findPattern

10− , Env.findBinop

11− , Env.Binop(Env.Binop)

12− , Env.Pattern(Env.Pattern)

4+ ( Env(..)

5+ , VarHomes(..)

6+ , UnqualifiedVarHome(..)

7+ , ForeignVarHome(..)

8+ , Type(..)

9+ , Pattern(..)

10+ , Homes(..)

11+ , addLocals

12+ , findType

13+ , findPattern

14+ , findBinop

15+ , Binop(..)

1316 )

1417 where

1518

1619

17−import qualified Canonicalize.Environment.Internals as Env

20+import qualified Data.Map.Strict as Map

21+import qualified Data.Map.Merge.Strict as Map

22+

23+import qualified AST.Utils.Binop as Binop

24+import qualified AST.Canonical as Can

25+import qualified AST.Module.Name as ModuleName

26+import qualified Canonicalize.Result as Result

27+import qualified Data.Bag as Bag

28+import qualified Data.OneOrMore as OneOrMore

29+import qualified Elm.Name as N

30+import qualified Reporting.Annotation as A

31+import qualified Reporting.Error.Canonicalize as Error

32+import qualified Reporting.Region as R

33+

34+

35+

36+-- RESULT

37+

38+

39+type Result i w a =

40+ Result.Result i w Error.Error a

41+

42+

43+

44+-- ENVIRONMENT

45+

46+

47+data Env =

48+ Env

49+ { _home :: ModuleName.Canonical

50+ , _vars :: Map.Map N.Name VarHomes

51+ , _types :: Map.Map N.Name (Homes Type)

52+ , _patterns :: Map.Map N.Name (Homes Pattern)

53+ , _binops :: Map.Map N.Name (OneOrMore.OneOrMore Binop)

54+ }

55+

56+

57+data Homes a =

58+ Homes

59+ { _unqualified :: Bag.Bag a

60+ , _qualified :: Map.Map N.Name (OneOrMore.OneOrMore a)

61+ }

62+

63+

64+

65+-- VARIABLES

66+

67+

68+data VarHomes =

69+ VarHomes

70+ { _var_unqualified :: UnqualifiedVarHome

71+ , _var_qualified :: Map.Map N.Name (OneOrMore.OneOrMore ForeignVarHome)

72+ }

73+

74+

75+data UnqualifiedVarHome

76+ = Local

77+ | TopLevel

78+ | Foreign (Bag.Bag ForeignVarHome)

79+

80+

81+data ForeignVarHome =

82+ ForeignVarHome ModuleName.Canonical Can.Annotation

83+

84+

85+

86+-- TYPES

87+

88+

89+data Type

90+ = Alias Int ModuleName.Canonical [N.Name] Can.Type

91+ | Union Int ModuleName.Canonical

92+

93+

94+

95+-- PATTERNs

96+

97+

98+data Pattern =

99+ Pattern

100+ { _p_home :: ModuleName.Canonical

101+ , _p_type :: N.Name

102+ , _p_vars :: [N.Name]

103+ , _p_alts :: Can.CtorAlts

104+ , _p_args :: [Can.Type]

105+ }

106+

107+

108+

109+-- BINOPS

110+

111+

112+data Binop =

113+ Binop

114+ { _op :: N.Name

115+ , _op_home :: ModuleName.Canonical

116+ , _op_name :: N.Name

117+ , _op_annotation :: Can.Annotation

118+ , _op_associativity :: Binop.Associativity

119+ , _op_precedence :: Binop.Precedence

120+ }

121+

122+

123+

124+-- VARIABLE -- ADD LOCALS

125+

126+

127+addLocals :: Map.Map N.Name (A.Located a) -> Env -> Result i w Env

128+addLocals names (Env home vars types patterns binops) =

129+ do newVars <-

130+ Map.mergeA

131+ (Map.mapMissing (\_ _ -> localVarHomes))

132+ (Map.mapMissing (\_ homes -> homes))

133+ (Map.zipWithAMatched addLocalBoth)

134+ names

135+ vars

136+ Result.ok $ Env home newVars types patterns binops

137+

138+

139+{-# NOINLINE localVarHomes #-}

140+localVarHomes :: VarHomes

141+localVarHomes =

142+ VarHomes Local Map.empty

143+

144+

145+addLocalBoth :: N.Name -> A.Located a -> VarHomes -> Result i w VarHomes

146+addLocalBoth name (A.At region _) (VarHomes unqualified qualified) =

147+ case unqualified of

148+ Foreign _ ->

149+ Result.ok (VarHomes Local qualified)

150+

151+ Local ->

152+ Result.throw (Error.Shadowing name region)

153+

154+ TopLevel ->

155+ Result.throw (Error.Shadowing name region)

156+

157+

158+

159+-- FIND TYPE and PATTERN

160+

161+

162+findType :: R.Region -> Env -> Maybe N.Name -> N.Name -> Result i w Type

163+findType region (Env _ _ types _ _) maybePrefix name =

164+ error "TODO findType" region types maybePrefix name

165+

166+

167+findPattern :: R.Region -> Env -> Maybe N.Name -> N.Name -> Result i w Pattern

168+findPattern region (Env _ _ _ patterns _) maybePrefix name =

169+ error "TODO findPattern" region patterns maybePrefix name

170+

171+

172+

173+-- FIND BINOP

174+

175+

176+findBinop :: R.Region -> Env -> N.Name -> Result i w Binop

177+findBinop region (Env _ _ _ _ binops) name =

178+ case Map.lookup name binops of

179+ Just (OneOrMore.One binop) ->

180+ Result.ok binop

181+

182+ Nothing ->

183+ Result.throw (error "TODO unknown binop" region)

184+

185+ Just _ ->

186+ Result.throw (error "TODO ambiguous binop" region)

src/Canonicalize/Environment/Dups.hs+48−51

@@ -1,31 +1,30 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

33module Canonicalize.Environment.Dups

4− ( Dict

4+ ( detect

5+ , checkFields

6+ , Dict

57 , none

68 , one

9+ , insert

710 , union

811 , unions

9− , insert

10− , detect

11− , checkFields

1212 )

1313 where

1414

1515

1616import qualified Data.Map as Map

1717

18−import Canonicalize.Environment.Internals (Result)

18+import qualified Canonicalize.Result as Result

1919import qualified Data.OneOrMore as OneOrMore

2020import qualified Elm.Name as N

2121import qualified Reporting.Annotation as A

2222import qualified Reporting.Error.Canonicalize as Error

2323import qualified Reporting.Region as R

24−import qualified Reporting.Result as Result

2524

2625

2726

28−-- INFO

27+-- DUPLICATE TRACKER

2928

3029

3130type Dict category value =

@@ -40,70 +39,68 @@ data Info category value =

4039 }

4140

4241

43−none :: Dict c v

44−none =

45− Map.empty

46−

47−

48−one :: N.Name -> R.Region -> category -> value -> Dict category value

49−one name region category value =

50− Map.singleton name (OneOrMore.one (Info region category value))

51−

52−

53−union :: Dict c v -> Dict c v -> Dict c v

54−union a b =

55− Map.unionWith OneOrMore.more a b

56−

57−

58−unions :: [Dict c v] -> Dict c v

59−unions dicts =

60− Map.unionsWith OneOrMore.more dicts

61−

62−

63−insert :: N.Name -> R.Region -> c -> v -> Dict c v -> Dict c v

64−insert name region category value dict =

65− Map.insertWith OneOrMore.more name (OneOrMore.one (Info region category value)) dict

66−

67−

6842

6943-- DETECT

7044

7145

7246type ToError c =

73− N.Name -> c -> c -> Error.Error

47+ N.Name -> R.Region -> c -> R.Region -> c -> Error.Error

7448

7549

76−detect :: ToError c -> Dict c v -> Result () (Map.Map N.Name v)

50+detect :: ToError c -> Dict c v -> Result.Result i w Error.Error (Map.Map N.Name v)

7751detect toError dict =

7852 Map.traverseWithKey (detectHelp toError) dict

7953

8054

81−detectHelp :: ToError c -> N.Name -> OneOrMore.OneOrMore (Info c v) -> Result () v

55+detectHelp :: ToError c -> N.Name -> OneOrMore.OneOrMore (Info c v) -> Result.Result i w Error.Error v

8256detectHelp toError name values =

8357 case values of

8458 OneOrMore.One (Info _ _ value) ->

85− Result.ok value

59+ return value

8660

8761 OneOrMore.More _ _ ->

88− let

89− (Info r1 c1 _ : Info r2 c2 _ : _) =

90− OneOrMore.toList values

91− in

92− Result.throw (max r1 r2) (toError name c1 c2)

62+ let (Info r1 c1 _ : Info r2 c2 _ : _) = OneOrMore.toList values in

63+ Result.throw (toError name r1 c1 r2 c2)

9364

9465

9566

9667-- CHECK FIELDS

9768

9869

99−checkFields :: [(A.Located N.Name, a)] -> Result () (Map.Map N.Name a)

70+checkFields :: [(A.Located N.Name, a)] -> Result.Result i w Error.Error (Map.Map N.Name a)

10071checkFields fields =

101− let

102− toInfo (A.At region name, value) =

103− Map.singleton name (OneOrMore.one (Info region () value))

104−

105− toError name () () =

106− Error.DuplicateField name

107− in

108− detect toError $

109− Map.unionsWith OneOrMore.more (map toInfo fields)

72+ detect Error.DuplicateField (foldr addField none fields)

73+

74+

75+addField :: (A.Located N.Name, a) -> Dict () a -> Dict () a

76+addField (A.At region name, value) dups =

77+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region () value)) dups

78+

79+

80+

81+-- BUILDING DICTIONARIES

82+

83+

84+none :: Dict c v

85+none =

86+ Map.empty

87+

88+

89+one :: N.Name -> R.Region -> category -> value -> Dict category value

90+one name region category value =

91+ Map.singleton name (OneOrMore.one (Info region category value))

92+

93+

94+insert :: N.Name -> R.Region -> c -> v -> Dict c v -> Dict c v

95+insert name region category value dict =

96+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region category value)) dict

97+

98+

99+union :: Dict c v -> Dict c v -> Dict c v

100+union a b =

101+ Map.unionWith OneOrMore.more a b

102+

103+

104+unions :: [Dict c v] -> Dict c v

105+unions dicts =

106+ Map.unionsWith OneOrMore.more dicts

src/Canonicalize/Environment/Foreign.hs+15−16

@@ -12,7 +12,8 @@ import qualified Data.Set as Set

1212import qualified AST.Canonical as Can

1313import qualified AST.Source as Src

1414import qualified AST.Module.Name as ModuleName

15−import qualified Canonicalize.Environment.Internals as Env

15+import qualified Canonicalize.Environment as Env

16+import qualified Canonicalize.Result as Result

1617import qualified Data.Bag as Bag

1718import qualified Data.OneOrMore as OneOrMore

1819import qualified Elm.Interface as I

@@ -21,16 +22,14 @@ import qualified Reporting.Annotation as A

2122import qualified Reporting.Error.Canonicalize as Error

2223import qualified Reporting.Helpers as Help (nearbyNames)

2324import qualified Reporting.Region as R

24−import qualified Reporting.Result as Result

25−import qualified Reporting.Warning as Warning

2625

2726

2827

2928-- RESULT

3029

3130

32−type Result a =

33− Result.Result () Warning.Warning Error.Error a

31+type Result i w a =

32+ Result.Result i w Error.Error a

3433

3534

3635

@@ -79,7 +78,7 @@ type ImportDict =

7978 Map.Map N.Name ModuleName.Canonical

8079

8180

82−createInitialEnv :: ModuleName.Canonical -> ImportDict -> I.Interfaces -> [Src.Import] -> Result Env.Env

81+createInitialEnv :: ModuleName.Canonical -> ImportDict -> I.Interfaces -> [Src.Import] -> Result i w Env.Env

8382createInitialEnv home importDict interfaces sourceImports =

8483 do imports <- traverse (verifyImport importDict interfaces) sourceImports

8584 let (Env vars types patterns binops) = foldr merge emptyEnv (map importToEnv imports)

@@ -269,7 +268,7 @@ data Exposed

269268 | Alias

270269

271270

272−verifyImport :: ImportDict -> I.Interfaces -> Src.Import -> Result Import

271+verifyImport :: ImportDict -> I.Interfaces -> Src.Import -> Result i w Import

273272verifyImport importDict interfaces (Src.Import (A.At region name) alias exposing) =

274273 case Map.lookup name importDict of

275274 Nothing ->

@@ -291,14 +290,14 @@ verifyImport importDict interfaces (Src.Import (A.At region name) alias exposing

291290 Result.ok (Explicit (Map.fromList (concat pairLists)))

292291

293292

294−throwImportNotFound :: R.Region -> N.Name -> [ModuleName.Canonical] -> Result a

293+throwImportNotFound :: R.Region -> N.Name -> [ModuleName.Canonical] -> Result i w a

295294throwImportNotFound region name knownModules =

296− Result.throw region $ Error.ImportNotFound name $

295+ Result.throw $ Error.ImportNotFound region name $

297296 Help.nearbyNames N.toString name $

298297 map ModuleName._module knownModules

299298

300299

301−verifyExposed :: N.Name -> I.Interface -> A.Located Src.Exposed -> Result [(N.Name, Exposed)]

300+verifyExposed :: N.Name -> I.Interface -> A.Located Src.Exposed -> Result i w [(N.Name, Exposed)]

302301verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.At region exposed) =

303302 case exposed of

304303 Src.Operator name ->

@@ -322,7 +321,7 @@ verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.At region

322321 throwExposingNotFound moduleName region name interface

323322

324323

325−verifyValue :: N.Name -> R.Region -> N.Name -> I.Interface -> Result [(N.Name, Exposed)]

324+verifyValue :: N.Name -> R.Region -> N.Name -> I.Interface -> Result i w [(N.Name, Exposed)]

326325verifyValue moduleName region name interface@(I.Interface types _ _ _) =

327326 case Map.lookup name types of

328327 Nothing ->

@@ -332,17 +331,17 @@ verifyValue moduleName region name interface@(I.Interface types _ _ _) =

332331 Result.ok [(name, Value)]

333332

334333

335−verifyAlias :: R.Region -> N.Name -> Src.Privacy -> Result [(N.Name, Exposed)]

334+verifyAlias :: R.Region -> N.Name -> Src.Privacy -> Result i w [(N.Name, Exposed)]

336335verifyAlias region name privacy =

337336 case privacy of

338337 Src.Public ->

339− Result.throw region (error "TODO cannot have (..) on type alias")

338+ Result.throw (error "TODO cannot have (..) on type alias" region)

340339

341340 Src.Private ->

342341 Result.ok [(name, Alias)]

343342

344343

345−throwExposingNotFound :: N.Name -> R.Region -> N.Name -> I.Interface -> Result a

344+throwExposingNotFound :: N.Name -> R.Region -> N.Name -> I.Interface -> Result i w a

346345throwExposingNotFound moduleName region name (I.Interface types unions aliases _) =

347346 let

348347 toCtorPairs (tipe, Can.Union _ ctors) =

@@ -353,9 +352,9 @@ throwExposingNotFound moduleName region name (I.Interface types unions aliases _

353352 in

354353 case Map.lookup name ctorDict of

355354 Just tipe ->

356− Result.throw region $ Error.ImportCtorNotFound name tipe

355+ Result.throw $ Error.ImportCtorNotFound region name tipe

357356

358357 Nothing ->

359− Result.throw region $ Error.ImportExposingNotFound moduleName name $

358+ Result.throw $ Error.ImportExposingNotFound region moduleName name $

360359 Help.nearbyNames N.toString name $ Set.toList $

361360 Set.unions [ Map.keysSet types, Map.keysSet unions, Map.keysSet aliases ]

src/Canonicalize/Environment/Internals.hsdeleted−233

@@ -1,233 +0,0 @@

1−{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−module Canonicalize.Environment.Internals

4− ( Result

5− , Env(..)

6− , VarHomes(..)

7− , UnqualifiedVarHome(..)

8− , ForeignVarHome(..)

9− , Type(..)

10− , Pattern(..)

11− , Homes(..)

12− , addLocals

13− , findVar

14− , findType

15− , findPattern

16− , findBinop

17− , Binop(..)

18− )

19− where

20−

21−

22−import qualified Data.Map.Strict as Map

23−import qualified Data.Map.Merge.Strict as Map

24−import qualified Data.Set as Set

25−

26−import qualified AST.Utils.Binop as Binop

27−import qualified AST.Canonical as Can

28−import qualified AST.Module.Name as ModuleName

29−import qualified Data.Bag as Bag

30−import qualified Data.OneOrMore as OneOrMore

31−import qualified Elm.Name as N

32−import qualified Reporting.Annotation as A

33−import qualified Reporting.Error.Canonicalize as Error

34−import qualified Reporting.Region as R

35−import qualified Reporting.Result as Result

36−import qualified Reporting.Warning as Warning

37−

38−

39−

40−-- RESULT HELPERS

41−

42−

43−type Result i a =

44− Result.Result i Warning.Warning Error.Error a

45−

46−

47−

48−-- ENVIRONMENT

49−

50−

51−data Env =

52− Env

53− { _home :: ModuleName.Canonical

54− , _vars :: Map.Map N.Name VarHomes

55− , _types :: Map.Map N.Name (Homes Type)

56− , _patterns :: Map.Map N.Name (Homes Pattern)

57− , _binops :: Map.Map N.Name (OneOrMore.OneOrMore Binop)

58− }

59−

60−

61−data Homes a =

62− Homes

63− { _unqualified :: Bag.Bag a

64− , _qualified :: Map.Map N.Name (OneOrMore.OneOrMore a)

65− }

66−

67−

68−

69−-- VARIABLES

70−

71−

72−data VarHomes =

73− VarHomes

74− { _var_unqualified :: UnqualifiedVarHome

75− , _var_qualified :: Map.Map N.Name (OneOrMore.OneOrMore ForeignVarHome)

76− }

77−

78−

79−data UnqualifiedVarHome

80− = Local

81− | TopLevel

82− | Foreign (Bag.Bag ForeignVarHome)

83−

84−

85−data ForeignVarHome =

86− ForeignVarHome ModuleName.Canonical Can.Annotation

87−

88−

89−

90−-- TYPES

91−

92−

93−data Type

94− = Alias Int ModuleName.Canonical [N.Name] Can.Type

95− | Union Int ModuleName.Canonical

96−

97−

98−

99−-- PATTERNs

100−

101−

102−data Pattern =

103− Pattern

104− { _p_home :: ModuleName.Canonical

105− , _p_type :: N.Name

106− , _p_vars :: [N.Name]

107− , _p_alts :: Can.CtorAlts

108− , _p_args :: [Can.Type]

109− }

110−

111−

112−

113−-- BINOPS

114−

115−

116−data Binop =

117− Binop

118− { _op :: N.Name

119− , _op_home :: ModuleName.Canonical

120− , _op_name :: N.Name

121− , _op_annotation :: Can.Annotation

122− , _op_associativity :: Binop.Associativity

123− , _op_precedence :: Binop.Precedence

124− }

125−

126−

127−

128−-- ADD LOCALS

129−

130−

131−addLocals :: Map.Map N.Name (A.Located a) -> Env -> Result () Env

132−addLocals names (Env home vars types patterns binops) =

133− do newVars <-

134− Map.mergeA

135− (Map.mapMissing (\_ _ -> localVarHomes))

136− (Map.mapMissing (\_ homes -> homes))

137− (Map.zipWithAMatched addLocalBoth)

138− names

139− vars

140− Result.ok $ Env home newVars types patterns binops

141−

142−

143−{-# NOINLINE localVarHomes #-}

144−localVarHomes :: VarHomes

145−localVarHomes =

146− VarHomes Local Map.empty

147−

148−

149−addLocalBoth :: N.Name -> A.Located a -> VarHomes -> Result () VarHomes

150−addLocalBoth name (A.At region _) (VarHomes unqualified qualified) =

151− case unqualified of

152− Foreign _ ->

153− Result.ok (VarHomes Local qualified)

154−

155− Local ->

156− Result.throw region (Error.Shadowing name)

157−

158− TopLevel ->

159− Result.throw region (Error.Shadowing name)

160−

161−

162−

163−-- FIND VAR

164−

165−

166−findVar :: R.Region -> Env -> Maybe N.Name -> N.Name -> Result (Set.Set N.Name) Can.Expr_

167−findVar region (Env localHome vars _ _ _) maybePrefix name =

168− case Map.lookup name vars of

169− Nothing ->

170− Result.throw region (error "TODO no name")

171−

172− Just (VarHomes unqualified qualified) ->

173− case maybePrefix of

174− Nothing ->

175− case unqualified of

176− Local ->

177− Result.accumulate (Set.singleton name) (Can.VarLocal name)

178−

179− TopLevel ->

180− Result.accumulate (Set.singleton name) (Can.VarTopLevel localHome name)

181−

182− Foreign bag ->

183− case bag of

184− Bag.One (ForeignVarHome home annotation) ->

185− Result.ok (Can.VarForeign home name annotation)

186−

187− Bag.Empty ->

188− Result.throw region (error "TODO no unqualified")

189−

190− Bag.Two _ _ ->

191− Result.throw region (error "TODO ambiguous unqualified")

192−

193− Just prefix ->

194− case Map.lookup prefix qualified of

195− Nothing ->

196− Result.throw region (error "TODO no qualified")

197−

198− Just (OneOrMore.One (ForeignVarHome home annotation)) ->

199− Result.ok (Can.VarForeign home name annotation)

200−

201− Just _ ->

202− Result.throw region (error "TODO ambiguous qualified")

203−

204−

205−

206−-- FIND TYPE and PATTERN

207−

208−

209−findType :: R.Region -> Env -> Maybe N.Name -> N.Name -> Result () Type

210−findType region (Env _ _ types _ _) maybePrefix name =

211− error "TODO findType" region types maybePrefix name

212−

213−

214−findPattern :: (Monoid i) => R.Region -> Env -> Maybe N.Name -> N.Name -> Result i Pattern

215−findPattern region (Env _ _ _ patterns _) maybePrefix name =

216− error "TODO findPattern" region patterns maybePrefix name

217−

218−

219−

220−-- FIND BINOP

221−

222−

223−findBinop :: R.Region -> Env -> N.Name -> Result (Set.Set N.Name) Binop

224−findBinop region (Env _ _ _ _ binops) name =

225− case Map.lookup name binops of

226− Just (OneOrMore.One binop) ->

227− Result.ok binop

228−

229− Nothing ->

230− Result.throw region (error "TODO unknown binop")

231−

232− Just _ ->

233− Result.throw region (error "TODO ambiguous binop")

src/Canonicalize/Environment/Local.hs+24−30

@@ -16,15 +16,15 @@ import qualified Data.Map.Merge.Strict as Map

1616import qualified AST.Canonical as Can

1717import qualified AST.Source as Src

1818import qualified AST.Valid as Valid

19+import qualified Canonicalize.Environment as Env

1920import qualified Canonicalize.Environment.Dups as Dups

20−import qualified Canonicalize.Environment.Internals as Env

21+import qualified Canonicalize.Result as Result

2122import qualified Canonicalize.Type as Type

2223import qualified Data.Bag as Bag

2324import qualified Elm.Name as N

2425import qualified Reporting.Annotation as A

2526import qualified Reporting.Error.Canonicalize as Error

2627import qualified Reporting.Region as R

27−import qualified Reporting.Result as Result

2828import qualified Reporting.Warning as Warning

2929

3030

@@ -32,8 +32,8 @@ import qualified Reporting.Warning as Warning

3232-- RESULT

3333

3434

35−type Result a =

36− Result.Result () Warning.Warning Error.Error a

35+type Result i a =

36+ Result.Result i [Warning.Warning] Error.Error a

3737

3838

3939

@@ -46,7 +46,7 @@ type Result a =

4646-- This code checks for (1) duplicate names and (2) cycles in type aliases.

4747

4848

49−addVarsAndTypes :: Valid.Module -> Env.Env -> Result Env.Env

49+addVarsAndTypes :: Valid.Module -> Env.Env -> Result i Env.Env

5050addVarsAndTypes module_ env =

5151 addVars module_ =<< addTypes module_ env

5252

@@ -108,7 +108,7 @@ addPatterns unions (Env.Env home vars types patterns binops) =

108108-- ADD VARS

109109

110110

111−addVars :: Valid.Module -> Env.Env -> Result Env.Env

111+addVars :: Valid.Module -> Env.Env -> Result i Env.Env

112112addVars module_ (Env.Env home vars types patterns binops) =

113113 do upperDict <- collectUpperVars module_

114114 lowerDict <- collectLowerVars module_

@@ -132,7 +132,7 @@ addVarsHelp localVars vars =

132132 merge addLeft addBoth localVars vars

133133

134134

135−collectLowerVars :: Valid.Module -> Result (Map.Map N.Name ())

135+collectLowerVars :: Valid.Module -> Result i (Map.Map N.Name ())

136136collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

137137 let

138138 addDecl (A.At _ (Valid.Decl (A.At region name) _ _ _)) dict =

@@ -161,14 +161,11 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

161161 Dups.union

162162 (Dups.one "command" regionCmd () ())

163163 (Dups.one "subscription" regionSub () ())

164−

165− toError name () () =

166− Error.DuplicateDecl name

167164 in

168− Dups.detect toError $ foldr addDecl effectDict decls

165+ Dups.detect Error.DuplicateDecl $ foldr addDecl effectDict decls

169166

170167

171−collectUpperVars :: Valid.Module -> Result (Map.Map N.Name ())

168+collectUpperVars :: Valid.Module -> Result i (Map.Map N.Name ())

172169collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =

173170 let

174171 addUnion (Valid.Union (A.At _ name) _ ctors) dict =

@@ -193,7 +190,7 @@ collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =

193190-- ADD TYPES

194191

195192

196−addTypes :: Valid.Module -> Env.Env -> Result Env.Env

193+addTypes :: Valid.Module -> Env.Env -> Result i Env.Env

197194addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) env =

198195 let

199196 aliasToDict alias@(Valid.Alias (A.At region name) _ tipe) =

@@ -204,9 +201,6 @@ addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) env =

204201 do arity <- checkUnionFreeVars union

205202 return $ Dups.one name region () (Right arity)

206203

207− toError name () () =

208− Error.DuplicateType name

209−

210204 combineDicts dicts1 dicts2 =

211205 Dups.union (Dups.unions dicts1) (Dups.unions dicts2)

212206 in

@@ -214,7 +208,7 @@ addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) env =

214208 liftA2 combineDicts

215209 (traverse aliasToDict aliases)

216210 (traverse unionToDict unions)

217− types <- Dups.detect toError dict

211+ types <- Dups.detect Error.DuplicateType dict

218212 let (aliasDict, unionDict) = Map.mapEither id types

219213 addTypeAliases aliasDict (addUnionTypes unionDict env)

220214

@@ -247,14 +241,14 @@ data Alias =

247241 }

248242

249243

250−addTypeAliases :: Map.Map N.Name Alias -> Env.Env -> Result Env.Env

244+addTypeAliases :: Map.Map N.Name Alias -> Env.Env -> Result i Env.Env

251245addTypeAliases aliases env =

252246 do let nodes = map toNode (Map.elems aliases)

253247 let sccs = Graph.stronglyConnComp nodes

254248 foldM addTypeAlias env sccs

255249

256250

257−addTypeAlias :: Env.Env -> Graph.SCC Alias -> Result Env.Env

251+addTypeAlias :: Env.Env -> Graph.SCC Alias -> Result i Env.Env

258252addTypeAlias env@(Env.Env home vars types patterns binops) scc =

259253 case scc of

260254 Graph.AcyclicSCC (Alias _ name args tipe) ->

@@ -268,7 +262,7 @@ addTypeAlias env@(Env.Env home vars types patterns binops) scc =

268262

269263 Graph.CyclicSCC (Alias region name1 args tipe : others) ->

270264 let toName (Alias _ name _ _) = name in

271− Result.throw region (Error.RecursiveAlias name1 args tipe (map toName others))

265+ Result.throw (Error.RecursiveAlias region name1 args tipe (map toName others))

272266

273267

274268addAliasInfo :: a -> Maybe (Env.Homes a) -> Maybe (Env.Homes a)

@@ -324,14 +318,14 @@ getEdges (A.At _ tipe) =

324318-- CHECK FREE VARIABLES

325319

326320

327−checkUnionFreeVars :: Valid.Union -> Result Int

321+checkUnionFreeVars :: Valid.Union -> Result i Int

328322checkUnionFreeVars (Valid.Union (A.At unionRegion name) args ctors) =

329323 let

330324 addUnion (A.At region arg) dict =

331325 Dups.insert arg region () region dict

332326

333− toError badArg () () =

334− Error.DuplicateUnionArg name badArg (map A.drop args)

327+ toError =

328+ Error.DuplicateUnionArg name (map A.drop args)

335329

336330 addCtorFreeVars (_, tipes) freeVars =

337331 foldr addFreeVars freeVars tipes

@@ -344,19 +338,19 @@ checkUnionFreeVars (Valid.Union (A.At unionRegion name) args ctors) =

344338

345339 unbound ->

346340 let toLoc (arg, region) = A.At region arg in

347− Result.throw unionRegion $

348− Error.TypeVarsUnboundInUnion name (map A.drop args) (map toLoc unbound)

341+ Result.throw $

342+ Error.TypeVarsUnboundInUnion unionRegion name (map A.drop args) (map toLoc unbound)

349343

350344

351345

352−checkAliasFreeVars :: Valid.Alias -> Result [N.Name]

346+checkAliasFreeVars :: Valid.Alias -> Result i [N.Name]

353347checkAliasFreeVars (Valid.Alias (A.At aliasRegion name) args tipe) =

354348 let

355349 addAlias (A.At region arg) dict =

356350 Dups.insert arg region () region dict

357351

358− toError badArg () () =

359− Error.DuplicateAliasArg name badArg (map A.drop args)

352+ toError =

353+ Error.DuplicateAliasArg name (map A.drop args)

360354 in

361355 do boundVars <- Dups.detect toError (foldr addAlias Dups.none args)

362356 let freeVars = addFreeVars tipe Map.empty

@@ -365,8 +359,8 @@ checkAliasFreeVars (Valid.Alias (A.At aliasRegion name) args tipe) =

365359 then Result.ok (map A.drop args)

366360 else

367361 let toLoc (arg, region) = A.At region arg in

368− Result.throw aliasRegion $

369− Error.TypeVarsMessedUpInAlias name

362+ Result.throw $

363+ Error.TypeVarsMessedUpInAlias aliasRegion name

370364 (map A.drop args)

371365 (map toLoc (Map.toList (Map.difference boundVars freeVars)))

372366 (map toLoc (Map.toList (Map.difference freeVars boundVars)))

src/Canonicalize/Expression.hs+299−130

@@ -1,7 +1,9 @@

11{-# OPTIONS_GHC -Wall #-}

22module Canonicalize.Expression

33 ( canonicalize

4− , removeLocals

4+ , FreeLocals

5+ , Uses(..)

6+ , verifyBindings

57 , gatherTypedArgs

68 )

79 where

@@ -9,7 +11,6 @@ module Canonicalize.Expression

911

1012import qualified Data.Graph as Graph

1113import qualified Data.Map.Strict as Map

12−import qualified Data.Set as Set

1314

1415import qualified AST.Canonical as Can

1516import qualified AST.Source as Src

@@ -19,34 +20,42 @@ import qualified AST.Valid as Valid

1920import qualified Canonicalize.Environment as Env

2021import qualified Canonicalize.Environment.Dups as Dups

2122import qualified Canonicalize.Pattern as Pattern

23+import qualified Canonicalize.Result as Result

2224import qualified Canonicalize.Type as Type

2325import qualified Data.Bag as Bag

2426import qualified Data.Index as Index

27+import qualified Data.OneOrMore as OneOrMore

2528import qualified Elm.Name as N

2629import qualified Reporting.Annotation as A

2730import qualified Reporting.Error.Canonicalize as Error

2831import qualified Reporting.Region as R

29−import qualified Reporting.Result as Result

30−import qualified Reporting.Warning as Warning

32+import qualified Reporting.Warning as W

3133

3234

3335

3436-- RESULTS

3537

3638

37−type Result i a =

38− Result.Result i Warning.Warning Error.Error a

39+type Result i w a =

40+ Result.Result i w Error.Error a

3941

4042

4143type FreeLocals =

42− Set.Set N.Name

44+ Map.Map N.Name Uses

4345

4446

47+data Uses =

48+ Uses

49+ { _direct :: {-# UNPACK #-} !Int

50+ , _delayed :: {-# UNPACK #-} !Int

51+ }

4552

46−-- EXPRESSIONS

4753

4854

49−canonicalize :: Env.Env -> Valid.Expr -> Result FreeLocals Can.Expr

55+-- CANONICALIZE

56+

57+

58+canonicalize :: Env.Env -> Valid.Expr -> Result FreeLocals [W.Warning] Can.Expr

5059canonicalize env (A.At region expression) =

5160 A.At region <$>

5261 case expression of

@@ -63,7 +72,7 @@ canonicalize env (A.At region expression) =

6372 Result.ok (Can.Float float)

6473

6574 Valid.Var maybePrefix name ->

66− Env.findVar region env maybePrefix name

75+ findVar region env maybePrefix name

6776

6877 Valid.List exprs ->

6978 Can.List <$> traverse (canonicalize env) exprs

@@ -79,13 +88,18 @@ canonicalize env (A.At region expression) =

7988 A.drop <$> canonicalizeBinops region env ops final

8089

8190 Valid.Lambda srcArgs body ->

82− addLocals $

83− do (args, destructors) <-

91+ delayedUsage $

92+ do (args, bindings) <-

8493 Pattern.verify Error.DPLambdaArgs $

8594 Index.indexedTraverse (Pattern.canonicalizeArg env) srcArgs

86− newEnv <- Env.addLocals destructors env

87− removeLocals Warning.Pattern destructors $

88− Can.Lambda args destructors <$> canonicalize newEnv body

95+

96+ newEnv <-

97+ Env.addLocals bindings env

98+

99+ (cbody, destructors, freeLocals) <-

100+ verifyBindings W.Pattern bindings (canonicalize newEnv body)

101+

102+ return (Can.Lambda args destructors cbody, freeLocals)

89103

90104 Valid.Call func args ->

91105 Can.Call

@@ -114,13 +128,13 @@ canonicalize env (A.At region expression) =

114128 <*> Result.ok field

115129

116130 Valid.Update (A.At reg name) fields ->

117− do fieldDict <- Result.untracked $ Dups.checkFields fields

118− name_ <- Env.findVar reg env Nothing name

131+ do fieldDict <- Dups.checkFields fields

132+ name_ <- findVar reg env Nothing name

119133 Can.Update (A.At reg name_)

120134 <$> traverse (canonicalize env) fieldDict

121135

122136 Valid.Record fields ->

123− do fieldDict <- Result.untracked $ Dups.checkFields fields

137+ do fieldDict <- Dups.checkFields fields

124138 Can.Record <$> traverse (canonicalize env) fieldDict

125139

126140 Valid.Unit ->

@@ -140,7 +154,7 @@ canonicalize env (A.At region expression) =

140154-- CANONICALIZE TUPLE EXTRAS

141155

142156

143−canonicalizeTupleExtras :: R.Region -> Env.Env -> [Valid.Expr] -> Result FreeLocals (Maybe Can.Expr)

157+canonicalizeTupleExtras :: R.Region -> Env.Env -> [Valid.Expr] -> Result FreeLocals [W.Warning] (Maybe Can.Expr)

144158canonicalizeTupleExtras region env extras =

145159 case extras of

146160 [] ->

@@ -151,14 +165,14 @@ canonicalizeTupleExtras region env extras =

151165

152166 _ : others ->

153167 let (A.At r1 _, A.At r2 _) = (head others, last others) in

154− Result.throw region (Error.TupleLargerThanThree (R.merge r1 r2))

168+ Result.throw (Error.TupleLargerThanThree region (R.merge r1 r2))

155169

156170

157171

158172-- CANONICALIZE IF BRANCH

159173

160174

161−canonicalizeIfBranch :: Env.Env -> (Valid.Expr, Valid.Expr) -> Result FreeLocals (Can.Expr, Can.Expr)

175+canonicalizeIfBranch :: Env.Env -> (Valid.Expr, Valid.Expr) -> Result FreeLocals [W.Warning] (Can.Expr, Can.Expr)

162176canonicalizeIfBranch env (condition, branch) =

163177 (,)

164178 <$> canonicalize env condition

@@ -169,22 +183,25 @@ canonicalizeIfBranch env (condition, branch) =

169183-- CANONICALIZE CASE BRANCH

170184

171185

172−canonicalizeCaseBranch :: Env.Env -> (Src.Pattern, Valid.Expr) -> Result FreeLocals Can.CaseBranch

186+canonicalizeCaseBranch :: Env.Env -> (Src.Pattern, Valid.Expr) -> Result FreeLocals [W.Warning] Can.CaseBranch

173187canonicalizeCaseBranch env (pattern, expr) =

174− addLocals $

175− do (cpattern, destructors) <-

188+ directUsage $

189+ do (cpattern, bindings) <-

176190 Pattern.verify Error.DPCaseBranch $

177191 Pattern.canonicalize env Index.first pattern

178− newEnv <- Env.addLocals destructors env

179− removeLocals Warning.Pattern destructors $

180− Can.CaseBranch cpattern destructors <$> canonicalize newEnv expr

192+ newEnv <- Env.addLocals bindings env

193+

194+ (cexpr, destructors, freeLocals) <-

195+ verifyBindings W.Pattern bindings (canonicalize newEnv expr)

196+

197+ return (Can.CaseBranch cpattern destructors cexpr, freeLocals)

181198

182199

183200

184201-- CANONICALIZE BINOPS

185202

186203

187−canonicalizeBinops :: R.Region -> Env.Env -> [(Valid.Expr, A.Located N.Name)] -> Valid.Expr -> Result FreeLocals Can.Expr

204+canonicalizeBinops :: R.Region -> Env.Env -> [(Valid.Expr, A.Located N.Name)] -> Valid.Expr -> Result FreeLocals [W.Warning] Can.Expr

188205canonicalizeBinops overallRegion env ops final =

189206 let

190207 canonicalizeHelp (expr, A.At region op) =

@@ -205,7 +222,7 @@ data Step

205222 | Error Env.Binop Env.Binop

206223

207224

208−runBinopStepper :: R.Region -> Step -> Result FreeLocals Can.Expr

225+runBinopStepper :: R.Region -> Step -> Result FreeLocals w Can.Expr

209226runBinopStepper overallRegion step =

210227 case step of

211228 Done expr ->

@@ -219,7 +236,7 @@ runBinopStepper overallRegion step =

219236 toBinopStep (toBinop op expr) op rest final

220237

221238 Error (Env.Binop op1 _ _ _ _ _) (Env.Binop op2 _ _ _ _ _) ->

222− Result.throw overallRegion (Error.Binop op1 op2)

239+ Result.throw (Error.Binop overallRegion op1 op2)

223240

224241

225242toBinopStep :: (Can.Expr -> Can.Expr) -> Env.Binop -> [(Can.Expr, Env.Binop)] -> Can.Expr -> Step

@@ -267,57 +284,47 @@ toBinop (Env.Binop op home name annotation _ _) left right =

267284-- CANONICALIZE LET

268285

269286

270−canonicalizeLet :: R.Region -> Env.Env -> [Valid.Def] -> Valid.Expr -> Result FreeLocals Can.Expr

287+canonicalizeLet :: R.Region -> Env.Env -> [Valid.Def] -> Valid.Expr -> Result FreeLocals [W.Warning] Can.Expr

271288canonicalizeLet letRegion env defs body =

272− addLocals $

289+ directUsage $

273290 do let keyedDefs = zip defs [ 0 .. length defs ]

274− let toError name () () = Error.DuplicatePattern Error.DPLetBinding name

275291 let names = foldr addBindings Dups.none keyedDefs

276− boundNames <- Dups.detect toError names

292+ boundNames <- Dups.detect (Error.DuplicatePattern Error.DPLetBinding) names

293+

277294 newEnv <- Env.addLocals boundNames env

278295 let defKeys = Map.map A.drop boundNames

279− nodes <- traverse (defToNode defKeys newEnv) keyedDefs

280− removeLocals Warning.Binding boundNames $

281− do cbody <- canonicalize env body

282− detectCycles letRegion (Graph.stronglyConnComp nodes) cbody

283296

297+ (nodes, cbody, bindingUses, freeLocals) <-

298+ verifyLetBindings boundNames $

299+ (,)

300+ <$> traverse (defToNode defKeys newEnv) keyedDefs

301+ <*> canonicalize newEnv body

284302

285−addLocals :: Result () (expr, FreeLocals) -> Result FreeLocals expr

286−addLocals (Result.Result () warnings answer) =

287− case answer of

288− Result.Ok (value, freeLocals) ->

289− Result.Result freeLocals warnings (Result.Ok value)

303+ letExpr <-

304+ detectCycles letRegion bindingUses (Graph.stronglyConnComp nodes) cbody

290305

291− Result.Err err ->

292− Result.Result Set.empty warnings (Result.Err err)

306+ return (letExpr, freeLocals)

293307

294308

295−removeLocals :: Warning.Unused -> Map.Map N.Name (A.Located a) -> Result FreeLocals expr -> Result () (expr, FreeLocals)

296−removeLocals unused boundNames (Result.Result freeLocals warnings answer) =

297− case answer of

298− Result.Err err ->

299− Result.Result () warnings (Result.Err err)

300−

301− Result.Ok value ->

302− let

303− newFreeLocals =

304− Set.difference freeLocals (Map.keysSet boundNames)

305−

306− newWarnings =

307− -- NOTE: check for unused variables without any large allocations.

308− -- This relies on the fact that Map.size and Set.size are O(1)

309− if Set.size freeLocals - Map.size boundNames == Set.size newFreeLocals then

310− warnings

311− else

312− Bag.append warnings $ Bag.fromList (toUnusedWarning unused) $

313− Map.toList (Map.withoutKeys boundNames freeLocals)

314− in

315− Result.Result () newWarnings (Result.Ok (value, newFreeLocals))

316−

317−

318−toUnusedWarning :: Warning.Unused -> (N.Name, A.Located a) -> A.Located Warning.Warning

319−toUnusedWarning unused (name, A.At region _) =

320− A.At region (Warning.UnusedVariable unused name)

309+verifyLetBindings

310+ :: Map.Map N.Name (A.Located Int)

311+ -> Result FreeLocals [W.Warning] ([Node], Can.Expr)

312+ -> Result info [W.Warning] ([Node], Can.Expr, FreeLocals, FreeLocals)

313+verifyLetBindings bindings (Result.Result k) =

314+ Result.Result $ \info warnings bad good ->

315+ k Map.empty warnings

316+ (\_ warnings1 err ->

317+ bad info warnings1 err

318+ )

319+ (\freeLocals warnings1 (nodes, body) ->

320+ let

321+ newFreeLocals = Map.difference freeLocals bindings

322+ bindingUses = Map.intersection freeLocals bindings

323+ in

324+ good info

325+ (addUnusedWarnings W.Def bindings bindingUses warnings1)

326+ (nodes, body, bindingUses, newFreeLocals)

327+ )

321328

322329

323330

@@ -386,71 +393,92 @@ addBindingsHelp key (A.At region pattern) bindings =

386393-- BUILD BINDINGS GRAPH

387394

388395

389−data Node = Node Binding FreeLocals

396+type Node =

397+ (Binding, Int, [Int])

390398

391399

392400data Binding

393401 = Define R.Region Can.Def

394− | Destruct R.Region Can.Pattern Can.Destructors Can.Expr

402+ | Destruct R.Region Can.Pattern Pattern.Bindings Can.Expr

395403

396404

397−defToNode :: Map.Map N.Name Int -> Env.Env -> (Valid.Def, Int) -> Result () (Node, Int, [Int])

405+defToNode :: Map.Map N.Name Int -> Env.Env -> (Valid.Def, Int) -> Result FreeLocals [W.Warning] Node

398406defToNode defKeys env (def, key) =

399407 case def of

400408 Valid.Define region aname@(A.At _ name) srcArgs body Nothing ->

401− do (args, destructors) <-

409+ do (args, argBindings) <-

402410 Pattern.verify (Error.DPFuncArgs name) $

403411 Index.indexedTraverse (Pattern.canonicalizeArg env) srcArgs

404− newEnv <- Env.addLocals destructors env

405− toNode defKeys key destructors $

406− do cbody <- canonicalize newEnv body

407− return $ Define region $

408− Can.Def aname args destructors cbody

412+

413+ newEnv <-

414+ Env.addLocals argBindings env

415+

416+ (cbody, destructors, freeLocals) <-

417+ verifyBindings W.Pattern argBindings (canonicalize newEnv body)

418+

419+ logLetLocals args freeLocals

420+ ( Define region (Can.Def aname args destructors cbody)

421+ , key

422+ , Map.elems (Map.intersection defKeys freeLocals)

423+ )

409424

410425 Valid.Destruct region pattern body ->

411− do (cpattern, destructors) <-

426+ do (cpattern, bindings) <-

412427 Pattern.verify Error.DPDestruct $

413428 Pattern.canonicalize env Index.first pattern

414429

415− toNode defKeys key destructors $

416− Destruct region cpattern destructors <$> canonicalize env body

430+ Result.Result $ \freeLocals warnings bad good ->

431+ case canonicalize env body of

432+ Result.Result k ->

433+ k Map.empty warnings

434+ (\_ ws es -> bad freeLocals ws es)

435+ (\newFreeLocals warnings1 cbody ->

436+ good

437+ (Map.unionWith combineUses freeLocals newFreeLocals)

438+ warnings1

439+ ( Destruct region cpattern bindings cbody

440+ , key

441+ , Map.elems (Map.intersection defKeys freeLocals)

442+ )

443+ )

417444

418445 Valid.Define region aname@(A.At _ name) srcArgs body (Just tipe) ->

419446 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe

420− ((args, resultType), destructors) <-

447+ ((args, resultType), argBindings) <-

421448 Pattern.verify (Error.DPFuncArgs name) $

422449 gatherTypedArgs env name srcArgs ctipe Index.first []

423− newEnv <- Env.addLocals destructors env

424− toNode defKeys key destructors $

425− do cbody <- canonicalize newEnv body

426− return $ Define region $

427− Can.TypedDef aname freeVars args destructors cbody resultType

428450

451+ newEnv <-

452+ Env.addLocals argBindings env

429453

430−toNode :: Map.Map N.Name Int -> Int -> Map.Map N.Name a -> Result FreeLocals Binding -> Result () (Node, Int, [Int])

431−toNode defKeys key args (Result.Result freeLocals warnings answer) =

432− Result.Result () warnings $

433− case answer of

434− Result.Err err ->

435− Result.Err err

454+ (cbody, destructors, freeLocals) <-

455+ verifyBindings W.Pattern argBindings (canonicalize newEnv body)

436456

437− Result.Ok binding ->

438− let

439− actuallyFreeLocals = Set.difference freeLocals (Map.keysSet args)

440− locallyDefinedLocals = Map.restrictKeys defKeys freeLocals

441− in

442− Result.Ok

443− ( Node binding actuallyFreeLocals

444− , key

445− , Map.elems locallyDefinedLocals

446− )

457+ logLetLocals args freeLocals

458+ ( Define region (Can.TypedDef aname freeVars args destructors cbody resultType)

459+ , key

460+ , Map.elems (Map.intersection defKeys freeLocals)

461+ )

462+

463+

464+logLetLocals :: [arg] -> FreeLocals -> value -> Result FreeLocals w value

465+logLetLocals args letLocals value =

466+ Result.Result $ \freeLocals warnings _ good ->

467+ good

468+ ( Map.unionWith combineUses freeLocals $

469+ case args of

470+ [] -> letLocals

471+ _ -> Map.map delayUse letLocals

472+ )

473+ warnings

474+ value

447475

448476

449477

450478-- GATHER TYPED ARGS

451479

452480

453−gatherTypedArgs :: Env.Env -> N.Name -> [Src.Pattern] -> Can.Type -> Index.ZeroBased -> [Can.TypedArg] -> Result Pattern.Bindings ([Can.TypedArg], Can.Type)

481+gatherTypedArgs :: Env.Env -> N.Name -> [Src.Pattern] -> Can.Type -> Index.ZeroBased -> [Can.TypedArg] -> Result Pattern.DupsDict w ([Can.TypedArg], Can.Type)

454482gatherTypedArgs env name srcArgs tipe index revTypedArgs =

455483 case srcArgs of

456484 [] ->

@@ -466,16 +494,16 @@ gatherTypedArgs env name srcArgs tipe index revTypedArgs =

466494

467495 _ ->

468496 let (A.At start _, A.At end _) = (head srcArgs, last srcArgs) in

469− Result.throw (R.merge start end) $

470− Error.AnnotationTooShort name index (length srcArgs)

497+ Result.throw $

498+ Error.AnnotationTooShort (R.merge start end) name index (length srcArgs)

471499

472500

473501

474502-- DETECT CYCLES

475503

476504

477−detectCycles :: R.Region -> [Graph.SCC Node] -> Can.Expr -> Result FreeLocals Can.Expr

478−detectCycles letRegion sccs body =

505+detectCycles :: R.Region -> FreeLocals -> [Graph.SCC Binding] -> Can.Expr -> Result i w Can.Expr

506+detectCycles letRegion bindingUses sccs body =

479507 case sccs of

480508 [] ->

481509 Result.ok body

@@ -483,41 +511,45 @@ detectCycles letRegion sccs body =

483511 scc : subSccs ->

484512 A.At letRegion <$>

485513 case scc of

486− Graph.AcyclicSCC (Node binding freeLocals) ->

514+ Graph.AcyclicSCC binding ->

487515 case binding of

488516 Define _ def ->

489− Result.accumulate freeLocals (Can.Let def)

490− <*> detectCycles letRegion subSccs body

517+ Can.Let def

518+ <$> detectCycles letRegion bindingUses subSccs body

519+

520+ Destruct _ pattern bindings expr ->

521+ let

522+ destructors =

523+ Map.intersectionWith toDestructorInfo bindings bindingUses

524+ in

525+ Can.LetDestruct pattern destructors expr

526+ <$> detectCycles letRegion bindingUses subSccs body

527+

528+ Graph.CyclicSCC bindings ->

529+ case traverse requireFunction bindings of

530+ Just defs ->

531+ Can.LetRec defs

532+ <$> detectCycles letRegion bindingUses subSccs body

491533

492− Destruct _ pattern destructors expr ->

493− Result.accumulate freeLocals (Can.LetDestruct pattern destructors expr)

494− <*> detectCycles letRegion subSccs body

495−

496− Graph.CyclicSCC nodes ->

497− case unzip <$> traverse requireFunction nodes of

498534 Nothing ->

499− Result.throw letRegion (Error.RecursiveLet (map toCycleNodes nodes))

500−

501− Just (defs, freeLocals) ->

502− Result.accumulate (Set.unions freeLocals) (Can.LetRec defs)

503− <*> detectCycles letRegion subSccs body

535+ Result.throw (Error.RecursiveLet letRegion (map toCycleNodes bindings))

504536

505537

506−requireFunction :: Node -> Maybe (Can.Def, FreeLocals)

507−requireFunction (Node binding freeLocals) =

538+requireFunction :: Binding -> Maybe Can.Def

539+requireFunction binding =

508540 case binding of

509541 Define _ def@(Can.Def _ (_:_) _ _) ->

510− Just (def, freeLocals)

542+ Just def

511543

512544 Define _ def@(Can.TypedDef _ _ (_:_) _ _ _) ->

513− Just (def, freeLocals)

545+ Just def

514546

515547 _ ->

516548 Nothing

517549

518550

519−toCycleNodes :: Node -> Error.CycleNode

520−toCycleNodes (Node binding _) =

551+toCycleNodes :: Binding -> Error.CycleNode

552+toCycleNodes binding =

521553 case binding of

522554 Define _ def ->

523555 case def of

@@ -529,3 +561,140 @@ toCycleNodes (Node binding _) =

529561

530562 Destruct _ pattern _ _ ->

531563 Error.CyclePattern pattern

564+

565+

566+

567+-- LOG VARIABLE USES

568+

569+

570+logVar :: N.Name -> a -> Result FreeLocals w a

571+logVar name value =

572+ Result.Result $ \freeLocals warnings _ good ->

573+ good (Map.insertWith combineUses name oneDirectUse freeLocals) warnings value

574+

575+

576+{-# NOINLINE oneDirectUse #-}

577+oneDirectUse :: Uses

578+oneDirectUse =

579+ Uses 1 0

580+

581+

582+combineUses :: Uses -> Uses -> Uses

583+combineUses (Uses a b) (Uses x y) =

584+ Uses (a + x) (b + y)

585+

586+

587+delayUse :: Uses -> Uses

588+delayUse (Uses direct delayed) =

589+ Uses 0 (direct + delayed)

590+

591+

592+

593+-- MANAGING BINDINGS

594+

595+

596+verifyBindings

597+ :: W.Context

598+ -> Pattern.Bindings

599+ -> Result FreeLocals [W.Warning] Can.Expr

600+ -> Result info [W.Warning] (Can.Expr, Can.Destructors, FreeLocals)

601+verifyBindings context bindings (Result.Result k) =

602+ Result.Result $ \info warnings bad good ->

603+ k Map.empty warnings

604+ (\_ warnings1 err ->

605+ bad info warnings1 err

606+ )

607+ (\freeLocals warnings1 body ->

608+ let

609+ destructors =

610+ Map.intersectionWith toDestructorInfo bindings freeLocals

611+ in

612+ good info

613+ (addUnusedWarnings context bindings destructors warnings1)

614+ (body, destructors, Map.difference freeLocals bindings)

615+ )

616+

617+

618+toDestructorInfo :: A.Located Can.Destructor -> Uses -> Can.DestructorInfo

619+toDestructorInfo (A.At _ destructor) (Uses direct delayed) =

620+ Can.DestructorInfo destructor direct delayed

621+

622+

623+-- NOTE: Uses Map.size for O(1) lookup. This means there is

624+-- no dictionary allocation unless a problem is detected.

625+addUnusedWarnings :: W.Context -> Map.Map N.Name (A.Located a) -> Map.Map N.Name b -> [W.Warning] -> [W.Warning]

626+addUnusedWarnings context bindings uses warnings =

627+ if Map.size bindings == Map.size uses then

628+ warnings

629+ else

630+ Map.foldlWithKey (addUnusedWarning context) warnings $

631+ Map.difference bindings uses

632+

633+

634+addUnusedWarning :: W.Context -> [W.Warning] -> N.Name -> A.Located a -> [W.Warning]

635+addUnusedWarning context warnings name (A.At region _) =

636+ W.UnusedVariable region context name : warnings

637+

638+

639+directUsage :: Result () w (expr, FreeLocals) -> Result FreeLocals w expr

640+directUsage (Result.Result k) =

641+ Result.Result $ \freeLocals warnings bad good ->

642+ k () warnings

643+ (\() ws es -> bad freeLocals ws es)

644+ (\() ws (value, newFreeLocals) ->

645+ good (Map.unionWith combineUses freeLocals newFreeLocals) ws value

646+ )

647+

648+

649+delayedUsage :: Result () w (expr, FreeLocals) -> Result FreeLocals w expr

650+delayedUsage (Result.Result k) =

651+ Result.Result $ \freeLocals warnings bad good ->

652+ k () warnings

653+ (\() ws es -> bad freeLocals ws es)

654+ (\() ws (value, newFreeLocals) ->

655+ let delayedLocals = Map.map delayUse newFreeLocals in

656+ good (Map.unionWith combineUses freeLocals delayedLocals) ws value

657+ )

658+

659+

660+

661+-- FIND VARIABLE

662+

663+

664+findVar :: R.Region -> Env.Env -> Maybe N.Name -> N.Name -> Result FreeLocals w Can.Expr_

665+findVar region (Env.Env localHome vars _ _ _) maybePrefix name =

666+ case Map.lookup name vars of

667+ Nothing ->

668+ Result.throw (error "TODO no name" region)

669+

670+ Just (Env.VarHomes unqualified qualified) ->

671+ case maybePrefix of

672+ Nothing ->

673+ case unqualified of

674+ Env.Local ->

675+ logVar name (Can.VarLocal name)

676+

677+ Env.TopLevel ->

678+ logVar name (Can.VarTopLevel localHome name)

679+

680+ Env.Foreign bag ->

681+ case bag of

682+ Bag.One (Env.ForeignVarHome home annotation) ->

683+ Result.ok (Can.VarForeign home name annotation)

684+

685+ Bag.Empty ->

686+ Result.throw (error "TODO no unqualified" region)

687+

688+ Bag.Two _ _ ->

689+ Result.throw (error "TODO ambiguous unqualified" region)

690+

691+ Just prefix ->

692+ case Map.lookup prefix qualified of

693+ Nothing ->

694+ Result.throw (error "TODO no qualified" region)

695+

696+ Just (OneOrMore.One (Env.ForeignVarHome home annotation)) ->

697+ Result.ok (Can.VarForeign home name annotation)

698+

699+ Just _ ->

700+ Result.throw (error "TODO ambiguous qualified" region)

src/Canonicalize/Module.hs+95−57

@@ -7,7 +7,6 @@ module Canonicalize.Module

88import qualified Data.Graph as Graph

99import qualified Data.Map as Map

10−import qualified Data.Set as Set

1110

1211import qualified AST.Canonical as Can

1312import qualified AST.Source as Src

@@ -20,6 +19,7 @@ import qualified Canonicalize.Environment.Foreign as Foreign

2019import qualified Canonicalize.Environment.Local as Local

2120import qualified Canonicalize.Expression as Expr

2221import qualified Canonicalize.Pattern as Pattern

22+import qualified Canonicalize.Result as Result

2323import qualified Canonicalize.Type as Type

2424import qualified Data.Index as Index

2525import qualified Elm.Interface as I

@@ -27,16 +27,15 @@ import qualified Elm.Name as N

2727import qualified Elm.Package as Pkg

2828import qualified Reporting.Annotation as A

2929import qualified Reporting.Error.Canonicalize as Error

30−import qualified Reporting.Result as Result

31−import qualified Reporting.Warning as Warning

30+import qualified Reporting.Warning as W

3231

3332

3433

3534-- RESULT

3635

3736

38−type Result a =

39− Result.Result () Warning.Warning Error.Error a

37+type Result i w a =

38+ Result.Result i w Error.Error a

4039

4140

4241

@@ -48,7 +47,7 @@ canonicalize

4847 -> Map.Map N.Name ModuleName.Canonical

4948 -> I.Interfaces

5049 -> Valid.Module

51− -> Result Can.Module

50+ -> Result i [W.Warning] Can.Module

5251canonicalize pkg importDict interfaces module_@(Valid.Module name _ _ exports imports decls unions aliases binops effects) =

5352 do let home = ModuleName.Canonical pkg name

5453

@@ -92,7 +91,7 @@ toDocs (Valid.Module _ (A.At region maybeOverview) comments _ _ _ _ _ _ _) =

9291-- CANONICALIZE ALIAS

9392

9493

95−canonicalizeAlias :: Env.Env -> Valid.Alias -> Result ( N.Name, Can.Alias )

94+canonicalizeAlias :: Env.Env -> Valid.Alias -> Result i w ( N.Name, Can.Alias )

9695canonicalizeAlias env (Valid.Alias (A.At _ name) args tipe) =

9796 do ctipe <- Type.canonicalize env tipe

9897 return (name, Can.Alias (map A.drop args) ctipe (toRecordCtorInfo tipe))

@@ -112,7 +111,7 @@ toRecordCtorInfo (A.At _ tipe) =

112111-- CANONICALIZE UNION

113112

114113

115−canonicalizeUnion :: Env.Env -> Valid.Union -> Result ( N.Name, Can.Union )

114+canonicalizeUnion :: Env.Env -> Valid.Union -> Result i w ( N.Name, Can.Union )

116115canonicalizeUnion env (Valid.Union (A.At _ name) args ctors) =

117116 let

118117 canonicalizeCtor (A.At _ ctor, tipes) =

@@ -133,16 +132,22 @@ canonicalizeBinop (Valid.Binop (A.At _ op) associativity precedence func) =

133132

134133

135134

136−-- CANONICALIZE DECLARATIONS

135+-- DECLARATIONS / CYCLE DETECTION

136+--

137+-- There are two phases of cycle detection:

138+--

139+-- 1. Detect cycles using ALL dependencies => needed for type inference

140+-- 2. Detect cycles using DIRECT dependencies => nonterminating recursion

141+--

137142

138143

139−canonicalizeDecls :: Env.Env -> [A.Located Valid.Decl] -> Result Can.Decls

144+canonicalizeDecls :: Env.Env -> [A.Located Valid.Decl] -> Result i [W.Warning] Can.Decls

140145canonicalizeDecls env decls =

141− do nodes <- traverse (toNode env) decls

146+ do nodes <- traverse (toNodeOne env) decls

142147 detectCycles (Graph.stronglyConnComp nodes)

143148

144149

145−detectCycles :: [Graph.SCC Can.Def] -> Result Can.Decls

150+detectCycles :: [Graph.SCC NodeTwo] -> Result i w Can.Decls

146151detectCycles sccs =

147152 case sccs of

148153 [] ->

@@ -150,70 +155,104 @@ detectCycles sccs =

150155

151156 scc : otherSccs ->

152157 case scc of

153− Graph.AcyclicSCC def ->

158+ Graph.AcyclicSCC (def, _, _) ->

154159 Can.Declare def <$> detectCycles otherSccs

155160

156161 Graph.CyclicSCC [] ->

157162 detectCycles otherSccs

158163

159− Graph.CyclicSCC cyclicDefs@(def:defs) ->

160− do detectBadCycles def defs

161− Can.DeclareRec cyclicDefs <$> detectCycles otherSccs

164+ Graph.CyclicSCC subNodes ->

165+ Can.DeclareRec

166+ <$> traverse detectBadCycles (Graph.stronglyConnComp subNodes)

167+ <*> detectCycles otherSccs

162168

163169

164−toNode :: Env.Env -> A.Located Valid.Decl -> Result (Can.Def, N.Name, [N.Name])

165−toNode env (A.At _ (Valid.Decl aname@(A.At _ name) srcArgs body maybeType)) =

170+detectBadCycles :: Graph.SCC Can.Def -> Result i w Can.Def

171+detectBadCycles scc =

172+ case scc of

173+ Graph.AcyclicSCC def ->

174+ Result.ok def

175+

176+ Graph.CyclicSCC cyclicValueDefs ->

177+ Result.throw (Error.RecursiveDecl cyclicValueDefs)

178+

179+

180+

181+-- DECLARATIONS / CYCLE DETECTION SETUP

182+--

183+-- toNodeOne and toNodeTwo set up nodes for the two cycle detection phases.

184+--

185+

186+-- Phase one nodes track ALL dependencies.

187+-- This allows us to find cyclic values for type inference.

188+type NodeOne =

189+ (NodeTwo, N.Name, [N.Name])

190+

191+

192+-- Phase two nodes track DIRECT dependencies.

193+-- This allows us to detect cycles that definitely do not terminate.

194+type NodeTwo =

195+ (Can.Def, N.Name, [N.Name])

196+

197+

198+toNodeOne :: Env.Env -> A.Located Valid.Decl -> Result i [W.Warning] NodeOne

199+toNodeOne env (A.At _ (Valid.Decl aname@(A.At _ name) srcArgs body maybeType)) =

166200 case maybeType of

167201 Nothing ->

168− do (args, destructors) <-

202+ do (args, argBindings) <-

169203 Pattern.verify (Error.DPFuncArgs name) $

170204 Index.indexedTraverse (Pattern.canonicalizeArg env) srcArgs

171205

172− newEnv <- Env.addLocals destructors env

173− (cbody, freeLocals) <-

174− Expr.removeLocals Warning.Pattern destructors $

175− Expr.canonicalize newEnv body

206+ newEnv <-

207+ Env.addLocals argBindings env

208+

209+ (cbody, destructors, freeLocals) <-

210+ Expr.verifyBindings W.Pattern argBindings (Expr.canonicalize newEnv body)

176211

177212 let def = Can.Def aname args destructors cbody

178− return (def, name, Set.toList freeLocals)

213+ return

214+ ( toNodeTwo name srcArgs def freeLocals

215+ , name

216+ , Map.keys freeLocals

217+ )

179218

180219 Just srcType ->

181220 do (Can.Forall freeVars tipe) <- Type.toAnnotation env srcType

182221

183− ((args,resultType), destructors) <-

222+ ((args,resultType), argBindings) <-

184223 Pattern.verify (Error.DPFuncArgs name) $

185224 Expr.gatherTypedArgs env name srcArgs tipe Index.first []

186225

187− newEnv <- Env.addLocals destructors env

188− (cbody, freeLocals) <-

189− Expr.removeLocals Warning.Pattern destructors $

190− Expr.canonicalize newEnv body

191−

192− let def = Can.TypedDef aname freeVars args destructors cbody resultType

193− return (def, name, Set.toList freeLocals)

226+ newEnv <-

227+ Env.addLocals argBindings env

194228

229+ (cbody, destructors, freeLocals) <-

230+ Expr.verifyBindings W.Pattern argBindings (Expr.canonicalize newEnv body)

195231

196−detectBadCycles :: Can.Def -> [Can.Def] -> Result ()

197−detectBadCycles def defs =

198− case (,) <$> detectBadCyclesHelp def <*> traverse detectBadCyclesHelp defs of

199− Nothing ->

200− Result.ok ()

232+ let def = Can.TypedDef aname freeVars args destructors cbody resultType

233+ return

234+ ( toNodeTwo name srcArgs def freeLocals

235+ , name

236+ , Map.keys freeLocals

237+ )

201238

202− Just (name, otherNames) ->

203− Result.throw (error "TODO") (Error.RecursiveDecl name otherNames)

204239

240+toNodeTwo :: N.Name -> [arg] -> Can.Def -> Expr.FreeLocals -> NodeTwo

241+toNodeTwo name args def freeLocals =

242+ case args of

243+ [] ->

244+ (def, name, Map.foldrWithKey addDirects [] freeLocals)

205245

206−detectBadCyclesHelp :: Can.Def -> Maybe N.Name

207−detectBadCyclesHelp def =

208− case def of

209− Can.Def (A.At _ name) [] _ _ ->

210− Just name

246+ _ ->

247+ (def, name, [])

211248

212− Can.TypedDef (A.At _ name) _ [] _ _ _ ->

213− Just name

214249

215− _ ->

216− Nothing

250+addDirects :: N.Name -> Expr.Uses -> [N.Name] -> [N.Name]

251+addDirects name (Expr.Uses directUses _) directDeps =

252+ if directUses > 0 then

253+ name:directDeps

254+ else

255+ directDeps

217256

218257

219258

@@ -227,7 +266,7 @@ canonicalizeExports

227266 -> Map.Map N.Name binop

228267 -> Can.Effects

229268 -> Src.Exposing

230− -> Result Can.Exports

269+ -> Result i w Can.Exports

231270canonicalizeExports decls unions aliases binops effects exposing =

232271 case exposing of

233272 Src.Open ->

@@ -236,8 +275,7 @@ canonicalizeExports decls unions aliases binops effects exposing =

236275 Src.Explicit exposeds ->

237276 do let names = Map.fromList (map declToName decls)

238277 infos <- traverse (checkExposed names unions aliases binops effects) exposeds

239− let toError name () () = Error.ExportDuplicate name

240− Can.Export <$> Dups.detect toError (Dups.unions infos)

278+ Can.Export <$> Dups.detect Error.ExportDuplicate (Dups.unions infos)

241279

242280

243281declToName :: A.Located Valid.Decl -> ( N.Name, () )

@@ -252,7 +290,7 @@ checkExposed

252290 -> Map.Map N.Name binop

253291 -> Can.Effects

254292 -> A.Located Src.Exposed

255− -> Result (Dups.Dict () Can.Export)

293+ -> Result i w (Dups.Dict () Can.Export)

256294checkExposed decls unions aliases binops effects (A.At region exposed) =

257295 case exposed of

258296 Src.Lower name ->

@@ -264,23 +302,23 @@ checkExposed decls unions aliases binops effects (A.At region exposed) =

264302 Result.ok (Dups.one name region () Can.ExportPort)

265303

266304 Just ports ->

267− Result.throw region $ Error.ExportNotFound Error.BadVar name $

305+ Result.throw $ Error.ExportNotFound region Error.BadVar name $

268306 ports ++ Map.keys decls

269307

270308 Src.Operator name ->

271309 if Map.member name binops then

272310 Result.ok (Dups.one name region () Can.ExportBinop)

273311 else

274− Result.throw region $ Error.ExportNotFound Error.BadOp name $

312+ Result.throw $ Error.ExportNotFound region Error.BadOp name $

275313 Map.keys binops

276314

277315 Src.Upper name Src.Public ->

278316 if Map.member name unions then

279317 Result.ok (Dups.one name region () Can.ExportUnionOpen)

280318 else if Map.member name aliases then

281− Result.throw region $ Error.ExportOpenAlias name

319+ Result.throw $ Error.ExportOpenAlias region name

282320 else

283− Result.throw region $ Error.ExportNotFound Error.BadType name $

321+ Result.throw $ Error.ExportNotFound region Error.BadType name $

284322 Map.keys unions ++ Map.keys aliases

285323

286324 Src.Upper name Src.Private ->

@@ -289,7 +327,7 @@ checkExposed decls unions aliases binops effects (A.At region exposed) =

289327 else if Map.member name aliases then

290328 Result.ok (Dups.one name region () Can.ExportAlias)

291329 else

292− Result.throw region $ Error.ExportNotFound Error.BadType name $

330+ Result.throw $ Error.ExportNotFound region Error.BadType name $

293331 Map.keys unions ++ Map.keys aliases

294332

295333

src/Canonicalize/Pattern.hs+66−42

@@ -2,71 +2,82 @@

22module Canonicalize.Pattern

33 ( verify

44 , Bindings

5+ , DupsDict

56 , canonicalize

67 , canonicalizeArg

78 )

89 where

910

1011

12+import qualified Data.Map.Strict as Map

13+

1114import qualified AST.Canonical as Can

1215import qualified AST.Source as Src

1316import qualified Canonicalize.Environment as Env

1417import qualified Canonicalize.Environment.Dups as Dups

18+import qualified Canonicalize.Result as Result

1519import qualified Data.Index as Index

20+import qualified Elm.Name as N

1621import qualified Reporting.Annotation as A

1722import qualified Reporting.Error.Canonicalize as Error

1823import qualified Reporting.Region as R

19−import qualified Reporting.Result as Result

20−import qualified Reporting.Warning as Warning

2124

2225

2326

2427-- RESULTS

2528

2629

27−type Result i =

28− Result.Result i Warning.Warning Error.Error

30+type Result i w a =

31+ Result.Result i w Error.Error a

32+

33+

34+type Bindings =

35+ Map.Map N.Name (A.Located Can.Destructor)

2936

3037

3138

3239-- VERIFY NAMES

3340

3441

35−verify :: Error.DuplicatePatternContext -> Result Bindings a -> Result () (a, Can.Destructors)

36−verify context (Result.Result bindings warnings answer) =

37− case answer of

38− Result.Ok value ->

39− do let toError name () () = Error.DuplicatePattern context name

40− destructors <- Dups.detect toError bindings

41− Result.Result () warnings $ Result.Ok (value, destructors)

42+verify :: Error.DuplicatePatternContext -> Result DupsDict w a -> Result i w (a, Bindings)

43+verify context (Result.Result k) =

44+ Result.Result $ \info warnings bad good ->

45+ k Dups.none warnings

46+ (\_ warnings1 errors ->

47+ bad info warnings1 errors

48+ )

49+ (\bindings warnings1 value ->

50+ case Dups.detect (Error.DuplicatePattern context) bindings of

51+ Result.Result k1 ->

52+ k1 () ()

53+ (\() () errs -> bad info warnings1 errs)

54+ (\() () dict -> good info warnings1 (value, dict))

55+ )

4256

43− Result.Err err ->

44− Result.Result () warnings (Result.Err err)

4557

4658

59+-- CANONICALIZE

60+

4761

48−-- CANONICALIZE ARG

62+type DupsDict =

63+ Dups.Dict () (A.Located Can.Destructor)

4964

5065

51−canonicalizeArg :: Env.Env -> Index.ZeroBased -> Src.Pattern -> Result Bindings Can.Arg

66+canonicalizeArg :: Env.Env -> Index.ZeroBased -> Src.Pattern -> Result DupsDict w Can.Arg

5267canonicalizeArg env index pattern =

5368 Can.Arg index <$> canonicalize env index pattern

5469

5570

71+canonicalize :: Env.Env -> Index.ZeroBased -> Src.Pattern -> Result DupsDict w Can.Pattern

72+canonicalize env index pattern =

73+ process env (Can.DRoot index) pattern

5674

57−-- CANONICALIZE

5875

5976

60−type Bindings =

61− Dups.Dict () (A.Located Can.Destructor)

77+-- PROCESS PATTERNS

6278

6379

64−canonicalize :: Env.Env -> Index.ZeroBased -> Src.Pattern -> Result Bindings Can.Pattern

65−canonicalize env index pattern =

66− process env (Can.DRoot index) pattern

67−

68−

69−process :: Env.Env -> Can.Destructor -> Src.Pattern -> Result Bindings Can.Pattern

80+process :: Env.Env -> Can.Destructor -> Src.Pattern -> Result DupsDict w Can.Pattern

7081process env destructor (A.At region pattern) =

7182 A.At region <$>

7283 case pattern of

@@ -74,18 +85,10 @@ process env destructor (A.At region pattern) =

7485 Result.ok Can.PAnything

7586

7687 Src.PVar name ->

77− Result.accumulate

78− (Dups.one name region () (A.At region destructor))

79− (Can.PVar name)

88+ logVar name region destructor (Can.PVar name)

8089

8190 Src.PRecord fields ->

82− let

83− addField (A.At reg name) dict =

84− Dups.insert name reg () (A.At reg (Can.DField name destructor)) dict

85− in

86− Result.accumulate

87− (foldr addField Dups.none fields)

88− (Can.PRecord (map A.drop fields))

91+ logFields fields destructor (Can.PRecord (map A.drop fields))

8992

9093 Src.PUnit ->

9194 Result.ok Can.PUnit

@@ -106,10 +109,10 @@ process env destructor (A.At region pattern) =

106109 verifiedList <- Index.indexedZipWithA toCanonicalArg patterns args

107110 case verifiedList of

108111 Index.LengthMatch cargs ->

109− Result.ok $ Can.PCtor home tipe vars alts name cargs

112+ Result.ok (Can.PCtor home tipe vars alts name cargs)

110113

111114 Index.LengthMismatch actualLength expectedLength ->

112− Result.throw region (error "TODO" actualLength expectedLength)

115+ Result.throw (error "TODO" region actualLength expectedLength)

113116

114117 Src.PList patterns ->

115118 Can.PList <$> processList env destructor patterns

@@ -121,9 +124,7 @@ process env destructor (A.At region pattern) =

121124

122125 Src.PAlias ptrn (A.At reg name) ->

123126 do cpattern <- process env destructor ptrn

124− Result.accumulate

125− (Dups.one name reg () (A.At reg destructor))

126− (Can.PAlias cpattern name)

127+ logVar name reg destructor (Can.PAlias cpattern name)

127128

128129 Src.PChr chr ->

129130 Result.ok (Can.PChr chr)

@@ -135,7 +136,7 @@ process env destructor (A.At region pattern) =

135136 Result.ok (Can.PInt int)

136137

137138

138−processTuple :: R.Region -> Env.Env -> Can.Destructor -> [Src.Pattern] -> Result Bindings (Maybe Can.Pattern)

139+processTuple :: R.Region -> Env.Env -> Can.Destructor -> [Src.Pattern] -> Result DupsDict w (Maybe Can.Pattern)

139140processTuple tupleRegion env destructor extras =

140141 case extras of

141142 [] ->

@@ -146,10 +147,10 @@ processTuple tupleRegion env destructor extras =

146147

147148 _ : others ->

148149 let (A.At r1 _, A.At r2 _) = (head others, last others) in

149− Result.throw tupleRegion (Error.TupleLargerThanThree (R.merge r1 r2))

150+ Result.throw (Error.TupleLargerThanThree tupleRegion (R.merge r1 r2))

150151

151152

152−processList :: Env.Env -> Can.Destructor -> [Src.Pattern] -> Result Bindings [Can.Pattern]

153+processList :: Env.Env -> Can.Destructor -> [Src.Pattern] -> Result DupsDict w [Can.Pattern]

153154processList env destructor list =

154155 case list of

155156 [] ->

@@ -159,3 +160,26 @@ processList env destructor list =

159160 (:)

160161 <$> process env (Can.DIndex Index.first destructor) pattern

161162 <*> processList env (Can.DIndex Index.second destructor) otherPatterns

163+

164+

165+

166+-- LOG BINDINGS

167+

168+

169+logVar :: N.Name -> R.Region -> Can.Destructor -> a -> Result DupsDict w a

170+logVar name region destructor value =

171+ Result.Result $ \bindings warnings _ ok ->

172+ ok

173+ (Dups.insert name region () (A.At region destructor) bindings)

174+ warnings

175+ value

176+

177+

178+logFields :: [A.Located N.Name] -> Can.Destructor -> a -> Result DupsDict w a

179+logFields fields destructor value =

180+ let

181+ addField (A.At region name) dict =

182+ Dups.insert name region () (A.At region (Can.DField name destructor)) dict

183+ in

184+ Result.Result $ \bindings warnings _ ok ->

185+ ok (foldr addField bindings fields) warnings value

src/Canonicalize/Result.hsnew file+112

@@ -0,0 +1,112 @@

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE Rank2Types #-}

3+module Canonicalize.Result

4+ ( Result(..)

5+ , run

6+ , ok

7+ , warn

8+ , throw

9+ )

10+ where

11+

12+

13+-- TODO try adding INLINE to warn, throw, (>>=), etc.

14+

15+

16+import qualified Data.OneOrMore as OneOrMore

17+import qualified Reporting.Warning as Warning

18+

19+

20+

21+-- RESULT

22+

23+

24+newtype Result info warnings error a =

25+ Result (

26+ forall result.

27+ info

28+ -> warnings

29+ -> (info -> warnings -> OneOrMore.OneOrMore error -> result)

30+ -> (info -> warnings -> a -> result)

31+ -> result

32+ )

33+

34+

35+run :: Result () [w] e a -> ([w], Either (OneOrMore.OneOrMore e) a)

36+run (Result k) =

37+ k () []

38+ (\() w e -> (reverse w, Left e))

39+ (\() w a -> (reverse w, Right a))

40+

41+

42+

43+-- HELPERS

44+

45+

46+{-# INLINE ok #-}

47+ok :: a -> Result i w e a

48+ok a =

49+ Result $ \i w _ good ->

50+ good i w a

51+

52+

53+warn :: Warning.Warning -> Result i [Warning.Warning] e ()

54+warn warning =

55+ Result $ \i warnings _ good ->

56+ good i (warning:warnings) ()

57+

58+

59+throw :: e -> Result i w e a

60+throw e =

61+ Result $ \i w bad _ ->

62+ bad i w (OneOrMore.one e)

63+

64+

65+

66+-- FANCY INSTANCE STUFF

67+

68+

69+instance Functor (Result i w e) where

70+ fmap func (Result k) =

71+ Result $ \i w bad good ->

72+ let

73+ good1 i1 w1 value =

74+ good i1 w1 (func value)

75+ in

76+ k i w bad good1

77+

78+

79+instance Applicative (Result i w e) where

80+ pure = ok

81+

82+ (<*>) (Result kf) (Result kv) =

83+ Result $ \i w bad good ->

84+ let

85+ bad1 i1 w1 e1 =

86+ let

87+ bad2 i2 w2 e2 = bad i2 w2 (OneOrMore.more e1 e2)

88+ good2 i2 w2 _value = bad i2 w2 e1

89+ in

90+ kv i1 w1 bad2 good2

91+

92+ good1 i1 w1 func =

93+ let

94+ bad2 i2 w2 e2 = bad i2 w2 e2

95+ good2 i2 w2 value = good i2 w2 (func value)

96+ in

97+ kv i1 w1 bad2 good2

98+ in

99+ kf i w bad1 good1

100+

101+

102+instance Monad (Result i w e) where

103+ return = ok

104+

105+ (>>=) (Result ka) callback =

106+ Result $ \i w bad good ->

107+ let

108+ good1 i1 w1 a =

109+ case callback a of

110+ Result kb -> kb i1 w1 bad good

111+ in

112+ ka i w bad good1

src/Canonicalize/Type.hs+14−16

@@ -3,7 +3,6 @@

33module Canonicalize.Type

44 ( toAnnotation

55 , canonicalize

6− , addFreeVars

76 )

87 where

@@ -12,39 +11,38 @@ import qualified Data.Map as Map

1211

1312import qualified AST.Canonical as Can

1413import qualified AST.Source as Src

14+import qualified Canonicalize.Environment as Env

1515import qualified Canonicalize.Environment.Dups as Dups

16−import qualified Canonicalize.Environment.Internals as Env

16+import qualified Canonicalize.Result as Result

1717import qualified Elm.Name as N

1818import qualified Reporting.Annotation as A

1919import qualified Reporting.Error.Canonicalize as Error

2020import qualified Reporting.Region as R

21−import qualified Reporting.Result as Result

22−import qualified Reporting.Warning as Warning

2321

2422

2523

2624-- RESULT

2725

2826

29−type Result i a =

30− Result.Result i Warning.Warning Error.Error a

27+type Result i w a =

28+ Result.Result i w Error.Error a

3129

3230

3331

3432-- TO ANNOTATION

3533

3634

37−toAnnotation :: Env.Env -> Src.Type -> Result () Can.Annotation

35+toAnnotation :: Env.Env -> Src.Type -> Result i w Can.Annotation

3836toAnnotation env srcType =

3937 do tipe <- canonicalize env srcType

40− return $ Can.Forall (addFreeVars tipe Map.empty) tipe

38+ Result.ok $ Can.Forall (addFreeVars tipe Map.empty) tipe

4139

4240

4341

4442-- CANONICALIZE TYPES

4543

4644

47−canonicalize :: Env.Env -> Src.Type -> Result () Can.Type

45+canonicalize :: Env.Env -> Src.Type -> Result i w Can.Type

4846canonicalize env (A.At typeRegion tipe) =

4947 case tipe of

5048 Src.TVar x ->

@@ -83,36 +81,36 @@ canonicalize env (A.At typeRegion tipe) =

8381 <*>

8482 case cs of

8583 [] ->

86− return Nothing

84+ Result.ok Nothing

8785

8886 [c] ->

8987 Just <$> canonicalize env c

9088

9189 _ ->

9290 let (A.At start _, A.At end _) = (head cs, last cs) in

93− Result.throw typeRegion $

94− Error.TupleLargerThanThree (R.merge start end)

91+ Result.throw $

92+ Error.TupleLargerThanThree typeRegion (R.merge start end)

9593

9694

9795

9896-- CHECK ARGS

9997

10098

101−checkArgs :: Error.Args -> Int -> R.Region -> N.Name -> [A.Located arg] -> answer -> Result () answer

99+checkArgs :: Error.Args -> Int -> R.Region -> N.Name -> [A.Located arg] -> answer -> Result i w answer

102100checkArgs argsType expected region name args answer =

103101 let actual = length args in

104102 if expected == actual then

105103 Result.ok answer

106104 else

107− Result.throw region $

105+ Result.throw $

108106 if actual < expected then

109− Error.TooFew argsType name expected actual

107+ Error.TooFew region argsType name expected actual

110108 else

111109 let

112110 extras = drop expected args

113111 (A.At start _, A.At end _) = (head extras, last extras)

114112 in

115− Error.TooMany argsType name expected actual (R.merge start end)

113+ Error.TooMany region argsType name expected actual (R.merge start end)

116114

117115

118116

src/Reporting/Warning.hs+37−29

@@ -2,7 +2,7 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Reporting.Warning

44 ( Warning(..)

5− , Unused(..)

5+ , Context(..)

66 , toReport

77 , toJson

88 )

@@ -15,6 +15,7 @@ import Data.Text (Text)

1515import qualified AST.Canonical as Can

1616import qualified Elm.Name as N

1717import qualified Reporting.Annotation as A

18+import qualified Reporting.Region as R

1819import qualified Reporting.Report as Report

1920import qualified Reporting.Render.Type as RenderType

2021import qualified Reporting.Helpers as Help

@@ -27,11 +28,11 @@ import Reporting.Helpers ((<>), text)

2728

2829data Warning

2930 = UnusedImport N.Name

30− | UnusedVariable Unused N.Name

31+ | UnusedVariable R.Region Context N.Name

3132 | MissingTypeAnnotation Text Can.Type

3233

3334

34−data Unused = Pattern | Binding

35+data Context = Def | Pattern

3536

3637

3738

@@ -42,31 +43,31 @@ toReport :: RenderType.Localizer -> Warning -> Report.Report

4243toReport localizer warning =

4344 case warning of

4445 UnusedImport moduleName ->

45− Report.report

46− "unused import"

47− Nothing

48− ("Nothing from the `" <> moduleName <> "` module is used in this file.")

49− (text "I recommend removing unused imports.")

50−

51− UnusedVariable Pattern name ->

52− Report.report

53− "unused variable"

54− Nothing

55− ("The `" <> name <> "` variable is unused.")

56− ( Help.reflowParagraph $

57− "Maybe this indicates there is a mistake around here? Switching `"

58− <> name <> "` to _ will indicate that it is intentionally unused."

59− )

60−

61− UnusedVariable Binding name ->

62− Report.report

63− "unused binding"

64− Nothing

65− ("The `" <> name <> "` binding is unused.")

66− ( Help.reflowParagraph $

67− "Maybe this indicates there is a mistake around here? Or maybe it\

68− \ just is not used anymore and should be removed?"

69− )

46+ Report.report

47+ "unused import"

48+ Nothing

49+ ("Nothing from the `" <> moduleName <> "` module is used in this file.")

50+ (text "I recommend removing unused imports.")

51+

52+ UnusedVariable _ context name ->

53+ Report.report

54+ (defOrPat context "unused definition" "unused variable")

55+ Nothing

56+ ("You are not using `" <> name <> "` anywhere.")

57+ ( Help.stack

58+ [ Help.reflowParagraph $

59+ "Is there a typo? Maybe you intended to use `" <> name

60+ <> "` but typed a similar name instead?"

61+ , Help.reflowParagraph $

62+ defOrPat context

63+ ( "If you are sure there is no typo, remove the definition.\

64+ \ This way future readers will not have to wonder!"

65+ )

66+ ( "If you are sure there is no typo, replace `" <> name

67+ <> "` with _ so future readers will not have to wonder!"

68+ )

69+ ]

70+ )

7071

7172 MissingTypeAnnotation name inferredType ->

7273 Report.report

@@ -80,12 +81,19 @@ toReport localizer warning =

8081 )

8182

8283

84+defOrPat :: Context -> a -> a -> a

85+defOrPat context def pat =

86+ case context of

87+ Def -> def

88+ Pattern -> pat

89+

90+

8391

8492-- TO JSON

8593

8694

8795toJson :: RenderType.Localizer -> FilePath -> A.Located Warning -> Json.Value

88−toJson localizer filePath (A.A region warning) =

96+toJson localizer filePath (A.At region warning) =

8997 let

9098 (maybeRegion, additionalFields) =

9199 Report.toJson [] (toReport localizer warning)