3bd0d85 · elk · git.iko.soy

git.iko.soy/elk

Primarily rename *Pattern and *Decl to just * in a ton of places

Also introduces the beginnings of “define” as a valid declaration in source declarations

commit3bd0d85b707ab65861884309ec4c5c7efc0b81dc authorEvan Czaplicki <info@elm-lang.org> dateWed 3 Feb 2016, 16:21 (11 years ago) parent50a14ca

17 files changed+118−77

compare with master

unifiedsplit

src/AST/Declaration.hs+38−16 src/AST/Expression/Canonical.hs+1−1 src/AST/Expression/Source.hs+2−2 src/AST/Expression/Valid.hs+1−1 src/AST/Pattern.hs+16−6 src/Canonicalize/Declaration.hs+6−6 src/Canonicalize/Setup.hs+10−7 src/Canonicalize/Sort.hs+4−4 src/Docs/Centralize.hs+7−7 src/Nitpick/Pattern.hs+1−1 src/Nitpick/PatternMatches.hs+13−3 src/Nitpick/TopLevelTypes.hs+5−5 src/Optimize/Case.hs+1−1 src/Optimize/DecisionTree.hs+3−3 src/Parse/Pattern.hs+8−8 src/Type/Constrain/Expression.hs+1−1 src/Type/Constrain/Pattern.hs+1−5

src/AST/Declaration.hs+38−16

@@ -14,10 +14,10 @@ import qualified Reporting.Annotation as A

1414-- DECLARATIONS

1515

1616

17−data Declaration' def tipe expr

18− = Definition def

19− | Datatype String [String] [(String, [tipe])]

20− | TypeAlias String [String] tipe

17+data Decl def tipe expr

18+ = Def def

19+ | Union String [String] [(String, [tipe])]

20+ | Alias String [String] tipe

2121 | Fixity Assoc Int String

2222

2323

@@ -32,30 +32,52 @@ data Assoc = L | N | R

3232assocToString :: Assoc -> String

3333assocToString assoc =

3434 case assoc of

35− L -> "left"

36− N -> "non"

37− R -> "right"

35+ L ->

36+ "left"

37+

38+ N ->

39+ "non"

40+

41+ R ->

42+ "right"

43+

44+

45+

46+-- COMMENTS

47+

48+

49+data CommentOr a

50+ = Comment (A.Located String)

51+ | Whatever a

3852

3953

4054

4155-- DECLARATION PHASES

4256

4357

44−type SourceDecl' =

45− Declaration' Source.Def Type.Raw Source.Expr

58+type Source =

59+ CommentOr (A.Located SourceOrDefine)

60+

61+

62+data SourceOrDefine

63+ = Source Source'

64+ | Define String [CommentOr (A.Located Source.Effect)]

65+

66+

67+type Source' =

68+ Decl Source.Def Type.Raw Source.Expr

4669

4770

48−data SourceDecl

49− = Comment String

50− | Decl (A.Located SourceDecl')

71+type Valid =

72+ A.Commented Valid'

5173

5274

53−type ValidDecl =

54− A.Commented (Declaration' Valid.Def Type.Raw Valid.Expr)

75+type Valid' =

76+ Decl Valid.Def Type.Raw Valid.Expr

5577

5678

57−type CanonicalDecl =

58− A.Commented (Declaration' Canonical.Def Type.Canonical Canonical.Expr)

79+type Canonical =

80+ A.Commented (Decl Canonical.Def Type.Canonical Canonical.Expr)

5981

6082

6183

src/AST/Expression/Canonical.hs+1−1

@@ -21,7 +21,7 @@ type Expr' =

2121

2222

2323data Def

24− = Definition Facts Pattern.CanonicalPattern Expr (Maybe (A.Located Type.Canonical))

24+ = Definition Facts Pattern.Canonical Expr (Maybe (A.Located Type.Canonical))

2525

2626

2727data Facts = Facts

src/AST/Expression/Source.hs+2−2

@@ -26,6 +26,6 @@ type Def =

2626

2727

2828data Def'

29− = Definition Pattern.RawPattern Expr

30− | TypeAnnotation String Type.Raw

29+ = Definition Pattern.Raw Expr

30+ | Annotation String Type.Raw

3131

src/AST/Expression/Valid.hs+1−1

@@ -21,5 +21,5 @@ type Expr' =

2121

2222

2323data Def

24− = Definition Pattern.RawPattern Expr (Maybe Type.Raw)

24+ = Definition Pattern.Raw Expr (Maybe Type.Raw)

2525

src/AST/Pattern.hs+16−6

@@ -22,19 +22,29 @@ data Pattern' ann var

2222 | Literal L.Literal

2323

2424

25−type RawPattern =

25+type Raw =

2626 Pattern R.Region Var.Raw

2727

2828

29−type RawPattern' =

29+type Raw' =

3030 Pattern' R.Region Var.Raw

3131

3232

33−type CanonicalPattern =

33+type Canonical =

3434 Pattern R.Region Var.Canonical

3535

3636

37−list :: R.Position -> [RawPattern] -> RawPattern

37+isVar :: String -> Pattern ann var -> Bool

38+isVar name (A.A _ pattern) =

39+ case pattern of

40+ Var pName ->

41+ name == pName

42+

43+ _ ->

44+ False

45+

46+

47+list :: R.Position -> [Raw] -> Raw

3848list end patterns =

3949 case patterns of

4050 [] ->

@@ -44,7 +54,7 @@ list end patterns =

4454 A.at start end (Data (Var.Raw "::") [pattern, list end rest])

4555

4656

47−consMany :: R.Position -> [RawPattern] -> RawPattern

57+consMany :: R.Position -> [Raw] -> Raw

4858consMany end patterns =

4959 let cons hd@(A.A (R.Region start _) _) tl =

5060 A.at start end (Data (Var.Raw "::") [hd, tl])

@@ -52,7 +62,7 @@ consMany end patterns =

5262 foldr1 cons patterns

5363

5464

55−tuple :: [RawPattern] -> RawPattern'

65+tuple :: [Raw] -> Raw'

5666tuple patterns =

5767 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns

5868

src/Canonicalize/Declaration.hs+6−6

@@ -12,12 +12,12 @@ import qualified Reporting.Annotation as A

1212import qualified Reporting.Region as R

1313

1414

15−toExpr :: ModuleName.Canonical -> [D.CanonicalDecl] -> [Canonical.Def]

15+toExpr :: ModuleName.Canonical -> [D.Canonical] -> [Canonical.Def]

1616toExpr moduleName decls =

1717 concatMap (toDefs moduleName) decls

1818

1919

20−toDefs :: ModuleName.Canonical -> D.CanonicalDecl -> [Canonical.Def]

20+toDefs :: ModuleName.Canonical -> D.Canonical -> [Canonical.Def]

2121toDefs moduleName (A.A (region,_) decl) =

2222 let

2323 typeVar =

@@ -27,10 +27,10 @@ toDefs moduleName (A.A (region,_) decl) =

2727 A.A region expr

2828 in

2929 case decl of

30− D.Definition def ->

30+ D.Def def ->

3131 [def]

3232

33− D.Datatype name tvars constructors ->

33+ D.Union name tvars constructors ->

3434 concatMap toDefs' constructors

3535 where

3636 toDefs' (ctor, tipes) =

@@ -40,7 +40,7 @@ toDefs moduleName (A.A (region,_) decl) =

4040 in

4141 [ definition ctor (buildFunction body vars) region (foldr T.Lambda tbody tipes) ]

4242

43− D.TypeAlias name tvars tipe@(T.Record fields Nothing) ->

43+ D.Alias name tvars tipe@(T.Record fields Nothing) ->

4444 [ definition name (buildFunction record vars) region (foldr T.Lambda result args) ]

4545 where

4646 result =

@@ -57,7 +57,7 @@ toDefs moduleName (A.A (region,_) decl) =

5757

5858 -- Type aliases must be added to an extended equality dictionary,

5959 -- but they do not require any basic constraints.

60− D.TypeAlias _ _ _ ->

60+ D.Alias _ _ _ ->

6161 []

6262

6363 -- no constraints are needed for fixity declarations

src/Canonicalize/Setup.hs+10−7

@@ -28,10 +28,13 @@ import qualified Canonicalize.Type as Canonicalize

2828environment

2929 :: Map.Map ModuleName.Raw ModuleName.Canonical

3030 -> Module.Interfaces

31− -> Module.ValidModule

31+ -> Module.Valid

3232 -> Result.ResultErr Env.Environment

33−environment importDict interfaces (Module.Module _ name _ _ _ (defaults, imports) decls) =

33+environment importDict interfaces (Module.Module _ name _ info) =

3434 let

35+ (Module.Valid _ _ (defaults, imports) decls _ _) =

36+ info

37+

3538 allImports =

3639 imports ++ map (A.A (error "default import not found")) defaults

3740

@@ -297,7 +300,7 @@ addTypeAlias moduleName scc env =

297300

298301declarationsToPatches

299302 :: ModuleName.Canonical

300− -> [D.ValidDecl]

303+ -> [D.Valid]

301304 -> ([Node], [Env.Patch])

302305declarationsToPatches moduleName decls =

303306 let

@@ -314,7 +317,7 @@ declarationsToPatches moduleName decls =

314317-- all other _values are local (Var.Local)

315318declToPatches

316319 :: ModuleName.Canonical

317− -> D.ValidDecl

320+ -> D.Valid

318321 -> (Maybe Node, [Env.Patch])

319322declToPatches moduleName (A.A (region,_) decl) =

320323 let

@@ -328,12 +331,12 @@ declToPatches moduleName (A.A (region,_) decl) =

328331 Env.Pattern name (Var.fromModule moduleName name, length args)

329332 in

330333 case decl of

331− D.Definition (Valid.Definition pattern _ _) ->

334+ D.Def (Valid.Definition pattern _ _) ->

332335 ( Nothing

333336 , map (topLevel Env.Value) (P.boundVarList pattern)

334337 )

335338

336− D.Datatype name _ ctors ->

339+ D.Union name _ ctors ->

337340 let ctorNames = map fst ctors

338341 in

339342 ( Nothing

@@ -342,7 +345,7 @@ declToPatches moduleName (A.A (region,_) decl) =

342345 ++ map patternPatch ctors

343346 )

344347

345− D.TypeAlias name tvars alias ->

348+ D.Alias name tvars alias ->

346349 ( Just (node region name tvars alias)

347350 , case alias of

348351 A.A _ (Type.RRecord _ Nothing) ->

src/Canonicalize/Sort.hs+4−4

@@ -121,7 +121,7 @@ reorder (A.A ann expression) =

121121 return let'

122122

123123

124−ctors :: P.CanonicalPattern -> [String]

124+ctors :: P.Canonical -> [String]

125125ctors (A.A _ pattern) =

126126 case pattern of

127127 P.Var _ ->

@@ -149,7 +149,7 @@ ctors (A.A _ pattern) =

149149 rest = concatMap ctors ps

150150

151151

152−bound :: P.CanonicalPattern -> State (Set.Set String) ()

152+bound :: P.Canonical -> State (Set.Set String) ()

153153bound pattern =

154154 let

155155 boundVars =

@@ -159,8 +159,8 @@ bound pattern =

159159

160160

161161bindingReorder

162− :: (P.CanonicalPattern, Canonical.Expr)

163− -> State (Set.Set String) (P.CanonicalPattern, Canonical.Expr)

162+ :: (P.Canonical, Canonical.Expr)

163+ -> State (Set.Set String) (P.Canonical, Canonical.Expr)

164164bindingReorder (pattern, expr) =

165165 do expr' <- reorder expr

166166 bound pattern

src/Docs/Centralize.hs+7−7

@@ -14,7 +14,7 @@ import qualified Reporting.Annotation as A

1414

1515-- CENTRALIZE DOCUMENTATION

1616

17−centralize :: [D.CanonicalDecl] -> String -> Docs.Centralized

17+centralize :: [D.Canonical] -> String -> Docs.Centralized

1818centralize decls comment =

1919 let

2020 (Raw aliases types valueInfo fixities) =

@@ -46,15 +46,15 @@ data Raw = Raw

4646 }

4747

4848

49−toRawDocs :: [D.CanonicalDecl] -> Raw

49+toRawDocs :: [D.Canonical] -> Raw

5050toRawDocs decls =

5151 foldr addDeclToDocs (Raw Map.empty Map.empty Map.empty Map.empty) decls

5252

5353

54−addDeclToDocs :: D.CanonicalDecl -> Raw -> Raw

54+addDeclToDocs :: D.Canonical -> Raw -> Raw

5555addDeclToDocs (A.A (region,maybeComment) decl) docs =

5656 case decl of

57− D.Definition (Canonical.Definition _ (A.A subregion (P.Var name)) _ maybeType) ->

57+ D.Def (Canonical.Definition _ (A.A subregion (P.Var name)) _ maybeType) ->

5858 let

5959 info =

6060 ( maybeComment

@@ -66,10 +66,10 @@ addDeclToDocs (A.A (region,maybeComment) decl) docs =

6666 in

6767 docs { rawValues = newValues }

6868

69− D.Definition _ ->

69+ D.Def _ ->

7070 docs

7171

72− D.Datatype name args ctors ->

72+ D.Union name args ctors ->

7373 let

7474 ctors' =

7575 map (second (map Extract.toAliasedType)) ctors

@@ -79,7 +79,7 @@ addDeclToDocs (A.A (region,maybeComment) decl) docs =

7979 in

8080 docs { rawTypes = Map.insert name union (rawTypes docs) }

8181

82− D.TypeAlias name args tipe ->

82+ D.Alias name args tipe ->

8383 let

8484 alias =

8585 A.A region (Docs.Alias maybeComment args (Extract.toAliasedType tipe))

src/Nitpick/Pattern.hs+1−1

@@ -20,7 +20,7 @@ data Pattern

2020 deriving (Eq)

2121

2222

23−fromCanonicalPattern :: P.CanonicalPattern -> Pattern

23+fromCanonicalPattern :: P.Canonical -> Pattern

2424fromCanonicalPattern (A.A _ pattern) =

2525 case pattern of

2626 P.Data tag patterns ->

src/Nitpick/PatternMatches.hs+13−3

@@ -37,8 +37,10 @@ patternMatches interfaces modul =

3737 <$> checkExpression tagDict (Module.program body)

3838

3939

40+

4041-- TAG DICT

4142

43+

4244type TagDict =

4345 Map.Map Var.Home (Map.Map Tag [TagInfo])

4446

@@ -113,8 +115,10 @@ lookupOtherTags (Var.Canonical home name) tagDict =

113115 \found."

114116

115117

118+

116119-- CHECK EXPRESSIONS

117120

121+

118122checkExpression

119123 :: TagDict

120124 -> Canonical.Expr

@@ -184,13 +188,15 @@ checkExpression tagDict (A.A region expression) =

184188 Result.ok ()

185189

186190

191+

187192-- CHECK PATTERNS

188193

194+

189195checkPatterns

190196 :: TagDict

191197 -> Region.Region

192198 -> Error.Origin

193− -> [Pattern.CanonicalPattern]

199+ -> [Pattern.Canonical]

194200 -> Result.Result w Error.Error ()

195201checkPatterns tagDict region origin patterns =

196202 checkPatternsHelp tagDict region origin [Anything] patterns

@@ -201,7 +207,7 @@ checkPatternsHelp

201207 -> Region.Region

202208 -> Error.Origin

203209 -> [Pattern]

204− -> [Pattern.CanonicalPattern]

210+ -> [Pattern.Canonical]

205211 -> Result.Result w Error.Error ()

206212checkPatternsHelp tagDict region origin unhandled patterns =

207213 case (unhandled, patterns) of

@@ -219,7 +225,7 @@ checkPatternsHelp tagDict region origin unhandled patterns =

219225filterPatterns

220226 :: TagDict

221227 -> Region.Region

222− -> Pattern.CanonicalPattern

228+ -> Pattern.Canonical

223229 -> [Pattern]

224230 -> Result.Result w Error.Error [Pattern]

225231filterPatterns tagDict region pattern unhandled =

@@ -241,8 +247,10 @@ filterPatterns tagDict region pattern unhandled =

241247 unhandled

242248

243249

250+

244251-- PATTERN INTERSECTION

245252

253+

246254intersection :: Pattern -> Pattern -> Maybe Pattern

247255intersection pattern1 pattern2 =

248256 case (pattern1, pattern2) of

@@ -298,8 +306,10 @@ intersection pattern1 pattern2 =

298306 Nothing

299307

300308

309+

301310-- PATTERN COMPLEMENT

302311

312+

303313complement :: TagDict -> Pattern -> [Pattern]

304314complement tagDict nitPattern =

305315 case nitPattern of

src/Nitpick/TopLevelTypes.hs+5−5

@@ -20,7 +20,7 @@ import qualified Reporting.Warning as Warning

2020

2121topLevelTypes

2222 :: Map.Map String Type.Canonical

23− -> [Decl.ValidDecl]

23+ -> [Decl.Valid]

2424 -> Result.Result Warning.Warning Error.Error ()

2525topLevelTypes typeEnv validDecls =

2626 do F.traverse_ (warnMissingAnnotation typeEnv) validDecls

@@ -31,11 +31,11 @@ topLevelTypes typeEnv validDecls =

3131

3232warnMissingAnnotation

3333 :: Map.Map String Type.Canonical

34− -> Decl.ValidDecl

34+ -> Decl.Valid

3535 -> Result.Result Warning.Warning Error.Error ()

3636warnMissingAnnotation typeEnv (A.A (region,_) decl) =

3737 case decl of

38− Decl.Definition (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->

38+ Decl.Def (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->

3939 case Map.lookup name typeEnv of

4040 Nothing ->

4141 return ()

@@ -49,11 +49,11 @@ warnMissingAnnotation typeEnv (A.A (region,_) decl) =

4949

5050checkMainType

5151 :: Map.Map String Type.Canonical

52− -> [Decl.ValidDecl]

52+ -> [Decl.Valid]

5353 -> Result.Result w Error.Error ()

5454checkMainType typeEnv decls =

5555 case decls of

56− A.A (region,_) (Decl.Definition (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->

56+ A.A (region,_) (Decl.Def (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->

5757 case Map.lookup "main" typeEnv of

5858 Nothing ->

5959 return ()

src/Optimize/Case.hs+1−1

@@ -15,7 +15,7 @@ import qualified Optimize.DecisionTree as DT

1515-- OPTIMIZE A CASE EXPRESSION

1616

1717

18−optimize :: DT.VariantDict -> String -> [(P.CanonicalPattern, Opt.Expr)] -> Opt.Expr

18+optimize :: DT.VariantDict -> String -> [(P.Canonical, Opt.Expr)] -> Opt.Expr

1919optimize variantDict exprName optBranches =

2020 let

2121 (patterns, indexedBranches) =

src/Optimize/DecisionTree.hs+3−3

@@ -24,7 +24,7 @@ import qualified AST.Variable as Var

2424import qualified Reporting.Annotation as A

2525

2626

27−type CPattern = P.CanonicalPattern

27+type CPattern = P.Canonical

2828

2929

3030-- COMPILE CASES

@@ -431,7 +431,7 @@ addWeights toWeight paths =

431431

432432

433433bests :: [(Path, Int)] -> [Path]

434−bests ((path,weight):weightedPaths) =

434+bests ( (headPath, headWeight) : weightedPaths ) =

435435 let

436436 gatherMinimum acc@(minWeight, paths) (path, weight) =

437437 if weight == minWeight then

@@ -443,7 +443,7 @@ bests ((path,weight):weightedPaths) =

443443 else

444444 acc

445445 in

446− snd (List.foldl' gatherMinimum (weight, [path]) weightedPaths)

446+ snd (List.foldl' gatherMinimum (headWeight, [headPath]) weightedPaths)

447447

448448

449449-- PATH PICKING HEURISTICS

src/Parse/Pattern.hs+8−8

@@ -13,7 +13,7 @@ import qualified Reporting.Annotation as A

1313import qualified Reporting.Region as R

1414

1515

16−basic :: IParser P.RawPattern

16+basic :: IParser P.Raw

1717basic =

1818 addLocation $

1919 choice

@@ -37,7 +37,7 @@ basic =

3737 P.Var str

3838

3939

40−asPattern :: IParser P.RawPattern -> IParser P.RawPattern

40+asPattern :: IParser P.Raw -> IParser P.Raw

4141asPattern patternParser =

4242 do pattern <- patternParser

4343

@@ -59,13 +59,13 @@ asPattern patternParser =

5959 lowVar

6060

6161

62−record :: IParser P.RawPattern

62+record :: IParser P.Raw

6363record =

6464 addLocation

6565 (P.Record <$> brackets (commaSep1 lowVar))

6666

6767

68−tuple :: IParser P.RawPattern

68+tuple :: IParser P.Raw

6969tuple =

7070 do (start, patterns, end) <-

7171 located (parens (commaSep expr))

@@ -78,20 +78,20 @@ tuple =

7878 return (A.at start end (P.tuple patterns))

7979

8080

81−list :: IParser P.RawPattern

81+list :: IParser P.Raw

8282list =

8383 braces $

8484 do (_, patterns, end) <- located (commaSep expr)

8585 return (P.list end patterns)

8686

8787

88−term :: IParser P.RawPattern

88+term :: IParser P.Raw

8989term =

9090 choice [ record, tuple, list, basic ]

9191 <?> "a pattern"

9292

9393

94−patternConstructor :: IParser P.RawPattern

94+patternConstructor :: IParser P.Raw

9595patternConstructor =

9696 addLocation $

9797 do v <- List.intercalate "." <$> dotSep1 capVar

@@ -101,7 +101,7 @@ patternConstructor =

101101 _ -> P.Data (Var.Raw v) <$> spacePrefix term

102102

103103

104−expr :: IParser P.RawPattern

104+expr :: IParser P.Raw

105105expr =

106106 asPattern subPattern <?> "a pattern"

107107 where

src/Type/Constrain/Expression.hs+1−1

@@ -374,7 +374,7 @@ constrainCase

374374 :: Env.Environment

375375 -> R.Region

376376 -> Canonical.Expr

377− -> [(P.CanonicalPattern, Canonical.Expr)]

377+ -> [(P.Canonical, Canonical.Expr)]

378378 -> Type

379379 -> IO TypeConstraint

380380constrainCase env region expr branches tipe =

src/Type/Constrain/Pattern.hs+1−5

@@ -14,11 +14,7 @@ import Type.Fragment

1414import Type.Type

1515

1616

17−constrain

18− :: Env.Environment

19− -> P.CanonicalPattern

20− -> Type

21− -> IO Fragment

17+constrain :: Env.Environment -> P.Canonical -> Type -> IO Fragment

2218constrain env (A.A region pattern) tipe =

2319 let

2420 equal patternError leftType rightType =