3bd0d85 · elk · git.iko.soy

src/AST/Declaration.hs+38−16

compare with master

unifiedsplit

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

14-- DECLARATIONS

15

16

17−data Declaration' def tipe expr

17+data Decl def tipe expr

18− = Definition def

18+ = Def def

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

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

20− | TypeAlias String [String] tipe

20+ | Alias String [String] tipe

21 | Fixity Assoc Int String

22

23

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

32assocToString :: Assoc -> String

33assocToString assoc =

34 case assoc of

35+ L ->

35− L -> "left"

36+ "left"

37+

38+ N ->

36− N -> "non"

39+ "non"

40+

41+ R ->

37− R -> "right"

42+ "right"

43+

44+

45+

46+-- COMMENTS

47+

48+

49+data CommentOr a

50+ = Comment (A.Located String)

51+ | Whatever a

38

52

39

53

40

54

41-- DECLARATION PHASES

55-- DECLARATION PHASES

42

56

43

57

44−type SourceDecl' =

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' =

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

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

46

69

47

70

48−data SourceDecl

71+type Valid =

49− = Comment String

72+ A.Commented Valid'

50− | Decl (A.Located SourceDecl')

51

73

52

74

53−type ValidDecl =

75+type Valid' =

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

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

55

77

56

78

57−type CanonicalDecl =

79+type Canonical =

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

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

59

81

60

82

61

83

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

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

21

22

23data Def

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

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

25

26

27data Facts = Facts

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

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

26

27

28data Def'

29− = Definition Pattern.RawPattern Expr

29+ = Definition Pattern.Raw Expr

30− | TypeAnnotation String Type.Raw

30+ | Annotation String Type.Raw

31

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

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

21

22

23data Def

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

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

25

src/AST/Pattern.hs+16−6

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

22 | Literal L.Literal

23

24

25−type RawPattern =

25+type Raw =

26 Pattern R.Region Var.Raw

27

28

29−type RawPattern' =

29+type Raw' =

30 Pattern' R.Region Var.Raw

31

32

33−type CanonicalPattern =

33+type Canonical =

34 Pattern R.Region Var.Canonical

35

36

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+

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

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

38list end patterns =

48list end patterns =

39 case patterns of

49 case patterns of

40 [] ->

50 [] ->

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

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

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

45

55

46

56

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

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

48consMany end patterns =

58consMany end patterns =

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

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

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

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

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

52 foldr1 cons patterns

62 foldr1 cons patterns

53

63

54

64

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

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

56tuple patterns =

66tuple patterns =

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

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

58

68

src/Canonicalize/Declaration.hs+6−6

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

12import qualified Reporting.Region as R

13

14

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

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

16toExpr moduleName decls =

17 concatMap (toDefs moduleName) decls

18

19

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

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

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

22 let

23 typeVar =

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

27 A.A region expr

28 in

29 case decl of

30− D.Definition def ->

30+ D.Def def ->

31 [def]

32

33− D.Datatype name tvars constructors ->

33+ D.Union name tvars constructors ->

34 concatMap toDefs' constructors

35 where

36 toDefs' (ctor, tipes) =

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

40 in

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

42

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

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

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

45 where

46 result =

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

57

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

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

60− D.TypeAlias _ _ _ ->

60+ D.Alias _ _ _ ->

61 []

62

63 -- no constraints are needed for fixity declarations

src/Canonicalize/Setup.hs+10−7

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

28environment

29 :: Map.Map ModuleName.Raw ModuleName.Canonical

30 -> Module.Interfaces

31− -> Module.ValidModule

31+ -> Module.Valid

32 -> Result.ResultErr Env.Environment

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

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

34 let

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

36+ info

37+

35 allImports =

38 allImports =

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

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

37

40

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

297

300

298declarationsToPatches

301declarationsToPatches

299 :: ModuleName.Canonical

302 :: ModuleName.Canonical

300− -> [D.ValidDecl]

303+ -> [D.Valid]

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

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

302declarationsToPatches moduleName decls =

305declarationsToPatches moduleName decls =

303 let

306 let

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

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

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

315declToPatches

318declToPatches

316 :: ModuleName.Canonical

319 :: ModuleName.Canonical

317− -> D.ValidDecl

320+ -> D.Valid

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

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

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

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

320 let

323 let

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

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

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

329 in

332 in

330 case decl of

333 case decl of

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

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

332 ( Nothing

335 ( Nothing

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

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

334 )

337 )

335

338

336− D.Datatype name _ ctors ->

339+ D.Union name _ ctors ->

337 let ctorNames = map fst ctors

340 let ctorNames = map fst ctors

338 in

341 in

339 ( Nothing

342 ( Nothing

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

342 ++ map patternPatch ctors

345 ++ map patternPatch ctors

343 )

346 )

344

347

345− D.TypeAlias name tvars alias ->

348+ D.Alias name tvars alias ->

346 ( Just (node region name tvars alias)

349 ( Just (node region name tvars alias)

347 , case alias of

350 , case alias of

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

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

src/Canonicalize/Sort.hs+4−4

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

121 return let'

122

123

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

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

125ctors (A.A _ pattern) =

126 case pattern of

127 P.Var _ ->

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

149 rest = concatMap ctors ps

150

151

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

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

153bound pattern =

154 let

155 boundVars =

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

159

160

161bindingReorder

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

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

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

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

164bindingReorder (pattern, expr) =

165 do expr' <- reorder expr

166 bound pattern

src/Docs/Centralize.hs+7−7

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

14

15-- CENTRALIZE DOCUMENTATION

16

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

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

18centralize decls comment =

19 let

20 (Raw aliases types valueInfo fixities) =

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

46 }

47

48

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

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

50toRawDocs decls =

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

52

53

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

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

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

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

58 let

59 info =

60 ( maybeComment

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

66 in

67 docs { rawValues = newValues }

68

69− D.Definition _ ->

69+ D.Def _ ->

70 docs

71

72− D.Datatype name args ctors ->

72+ D.Union name args ctors ->

73 let

74 ctors' =

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

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

79 in

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

81

82− D.TypeAlias name args tipe ->

82+ D.Alias name args tipe ->

83 let

84 alias =

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

src/Nitpick/Pattern.hs+1−1

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

20 deriving (Eq)

21

22

23−fromCanonicalPattern :: P.CanonicalPattern -> Pattern

23+fromCanonicalPattern :: P.Canonical -> Pattern

24fromCanonicalPattern (A.A _ pattern) =

25 case pattern of

26 P.Data tag patterns ->

src/Nitpick/PatternMatches.hs+13−3

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

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

38

39

40+

40-- TAG DICT

41-- TAG DICT

41

42

43+

42type TagDict =

44type TagDict =

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

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

44

46

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

113 \found."

115 \found."

114

116

115

117

118+

116-- CHECK EXPRESSIONS

119-- CHECK EXPRESSIONS

117

120

121+

118checkExpression

122checkExpression

119 :: TagDict

123 :: TagDict

120 -> Canonical.Expr

124 -> Canonical.Expr

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

184 Result.ok ()

188 Result.ok ()

185

189

186

190

191+

187-- CHECK PATTERNS

192-- CHECK PATTERNS

188

193

194+

189checkPatterns

195checkPatterns

190 :: TagDict

196 :: TagDict

191 -> Region.Region

197 -> Region.Region

192 -> Error.Origin

198 -> Error.Origin

193− -> [Pattern.CanonicalPattern]

199+ -> [Pattern.Canonical]

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

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

195checkPatterns tagDict region origin patterns =

201checkPatterns tagDict region origin patterns =

196 checkPatternsHelp tagDict region origin [Anything] patterns

202 checkPatternsHelp tagDict region origin [Anything] patterns

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

201 -> Region.Region

207 -> Region.Region

202 -> Error.Origin

208 -> Error.Origin

203 -> [Pattern]

209 -> [Pattern]

204− -> [Pattern.CanonicalPattern]

210+ -> [Pattern.Canonical]

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

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

206checkPatternsHelp tagDict region origin unhandled patterns =

212checkPatternsHelp tagDict region origin unhandled patterns =

207 case (unhandled, patterns) of

213 case (unhandled, patterns) of

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

219filterPatterns

225filterPatterns

220 :: TagDict

226 :: TagDict

221 -> Region.Region

227 -> Region.Region

222− -> Pattern.CanonicalPattern

228+ -> Pattern.Canonical

223 -> [Pattern]

229 -> [Pattern]

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

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

225filterPatterns tagDict region pattern unhandled =

231filterPatterns tagDict region pattern unhandled =

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

241 unhandled

247 unhandled

242

248

243

249

250+

244-- PATTERN INTERSECTION

251-- PATTERN INTERSECTION

245

252

253+

246intersection :: Pattern -> Pattern -> Maybe Pattern

254intersection :: Pattern -> Pattern -> Maybe Pattern

247intersection pattern1 pattern2 =

255intersection pattern1 pattern2 =

248 case (pattern1, pattern2) of

256 case (pattern1, pattern2) of

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

298 Nothing

306 Nothing

299

307

300

308

309+

301-- PATTERN COMPLEMENT

310-- PATTERN COMPLEMENT

302

311

312+

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

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

304complement tagDict nitPattern =

314complement tagDict nitPattern =

305 case nitPattern of

315 case nitPattern of

src/Nitpick/TopLevelTypes.hs+5−5

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

20

21topLevelTypes

22 :: Map.Map String Type.Canonical

23− -> [Decl.ValidDecl]

23+ -> [Decl.Valid]

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

25topLevelTypes typeEnv validDecls =

26 do F.traverse_ (warnMissingAnnotation typeEnv) validDecls

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

31

32warnMissingAnnotation

33 :: Map.Map String Type.Canonical

34− -> Decl.ValidDecl

34+ -> Decl.Valid

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

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

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

39 case Map.lookup name typeEnv of

40 Nothing ->

41 return ()

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

49

50checkMainType

51 :: Map.Map String Type.Canonical

52− -> [Decl.ValidDecl]

52+ -> [Decl.Valid]

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

54checkMainType typeEnv decls =

55 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")) _ _)) : _ ->

57 case Map.lookup "main" typeEnv of

58 Nothing ->

59 return ()

src/Optimize/Case.hs+1−1

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

15-- OPTIMIZE A CASE EXPRESSION

16

17

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

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

19optimize variantDict exprName optBranches =

20 let

21 (patterns, indexedBranches) =

src/Optimize/DecisionTree.hs+3−3

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

24import qualified Reporting.Annotation as A

25

26

27−type CPattern = P.CanonicalPattern

27+type CPattern = P.Canonical

28

29

30-- COMPILE CASES

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

431

432

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

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

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

435 let

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

437 if weight == minWeight then

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

443 else

444 acc

445 in

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

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

447

448

449-- PATH PICKING HEURISTICS

src/Parse/Pattern.hs+8−8

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

13import qualified Reporting.Region as R

14

15

16−basic :: IParser P.RawPattern

16+basic :: IParser P.Raw

17basic =

18 addLocation $

19 choice

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

37 P.Var str

38

39

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

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

41asPattern patternParser =

42 do pattern <- patternParser

43

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

59 lowVar

60

61

62−record :: IParser P.RawPattern

62+record :: IParser P.Raw

63record =

64 addLocation

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

66

67

68−tuple :: IParser P.RawPattern

68+tuple :: IParser P.Raw

69tuple =

70 do (start, patterns, end) <-

71 located (parens (commaSep expr))

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

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

79

80

81−list :: IParser P.RawPattern

81+list :: IParser P.Raw

82list =

83 braces $

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

85 return (P.list end patterns)

86

87

88−term :: IParser P.RawPattern

88+term :: IParser P.Raw

89term =

90 choice [ record, tuple, list, basic ]

91 <?> "a pattern"

92

93

94−patternConstructor :: IParser P.RawPattern

94+patternConstructor :: IParser P.Raw

95patternConstructor =

96 addLocation $

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

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

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

102

103

104−expr :: IParser P.RawPattern

104+expr :: IParser P.Raw

105expr =

106 asPattern subPattern <?> "a pattern"

107 where

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

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

374 :: Env.Environment

375 -> R.Region

376 -> Canonical.Expr

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

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

378 -> Type

379 -> IO TypeConstraint

380constrainCase env region expr branches tipe =

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

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

14import Type.Type

15

16

17−constrain

18− :: Env.Environment

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

19− -> P.CanonicalPattern

20− -> Type

21− -> IO Fragment

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

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

23 let

19 let

24 equal patternError leftType rightType =

20 equal patternError leftType rightType =