b93555a · elk · git.iko.soy

compiler/src/Compile.hs+6−10

compare with master

unifiedsplit

@@ -10,8 +10,6 @@ module Compile

10import qualified Data.ByteString as BS

11import qualified Data.Map as Map

12

13−import qualified AST.Source as Src

14−import qualified AST.Valid as Valid

15import qualified AST.Canonical as Can

13import qualified AST.Canonical as Can

16import qualified AST.Optimized as Opt

14import qualified AST.Optimized as Opt

17import qualified AST.Module.Name as ModuleName

15import qualified AST.Module.Name as ModuleName

@@ -62,13 +60,15 @@ compile flag pkg importDict interfaces source =

62 canonical <- Result.mapError Error.Canonicalize $

60 canonical <- Result.mapError Error.Canonicalize $

63 Canonicalize.canonicalize pkg importDict interfaces valid

61 Canonicalize.canonicalize pkg importDict interfaces valid

64

62

63+ let localizer = L.fromModule valid -- TODO should this be strict for GC?

64+

65 annotations <-

66− runTypeInference (Valid._imports valid) canonical

66+ runTypeInference localizer canonical

67

68 () <-

69 exhaustivenessCheck canonical

70

71− graph <- Result.mapError Error.Main $

71+ graph <- Result.mapError (Error.Main localizer) $

72 Optimize.optimize annotations canonical

73

74 documentation <-

@@ -86,17 +86,13 @@ compile flag pkg importDict interfaces source =

86-- TYPE INFERENCE

87

88

89−runTypeInference :: [Src.Import] -> Can.Module -> Result i (Map.Map N.Name Can.Annotation)

89+runTypeInference :: L.Localizer -> Can.Module -> Result i (Map.Map N.Name Can.Annotation)

90−runTypeInference imports canonical =

90+runTypeInference localizer canonical =

91 case unsafePerformIO (Type.run =<< Type.constrain canonical) of

92 Right annotations ->

93 Result.ok annotations

94

95 Left errors ->

96− let

97− localizer =

98− L.fromImports (ModuleName._module (Can._name canonical)) imports

99− in

100 Result.throw (Error.Type localizer errors)

96 Result.throw (Error.Type localizer errors)

101

97

102

98

compiler/src/Reporting/Error.hs+3−3

@@ -26,7 +26,7 @@ data Error

26 = Syntax Syntax.Error

27 | Canonicalize Canonicalize.Error

28 | Type L.Localizer [Type.Error]

29− | Main Main.Error

29+ | Main L.Localizer Main.Error

30 | Pattern [Pattern.Error]

31 | Docs Docs.Error

32

@@ -47,8 +47,8 @@ toReports source err =

47 Type localizer typeErrors ->

48 map (Type.toReport source localizer) typeErrors

49

50− Main mainError ->

50+ Main localizer mainError ->

51− [Main.toReport source mainError]

51+ [Main.toReport localizer source mainError]

52

53 Pattern patternErrors ->

54 map (Pattern.toReport source) patternErrors

compiler/src/Reporting/Error/Main.hs+4−3

@@ -14,6 +14,7 @@ import qualified Reporting.Error.Canonicalize as E

14import qualified Reporting.Region as R

15import qualified Reporting.Render.Code as Code

16import qualified Reporting.Render.Type as RT

17+import qualified Reporting.Render.Type.Localizer as L

17import qualified Reporting.Report as Report

18import qualified Reporting.Report as Report

18

19

20

@@ -31,8 +32,8 @@ data Error

31-- TO REPORT

32-- TO REPORT

32

33

34

34−toReport :: Code.Source -> Error -> Report.Report

35+toReport :: L.Localizer -> Code.Source -> Error -> Report.Report

35−toReport source err =

36+toReport localizer source err =

36 case err of

37 case err of

37 BadType region tipe ->

38 BadType region tipe ->

38 Report.Report "BAD MAIN TYPE" region [] $

39 Report.Report "BAD MAIN TYPE" region [] $

@@ -42,7 +43,7 @@ toReport source err =

42 ,

43 ,

43 D.stack

44 D.stack

44 [ "The type of `main` value I am seeing is:"

45 [ "The type of `main` value I am seeing is:"

45− , D.indent 4 $ D.dullyellow $ RT.canToDoc RT.None tipe

46+ , D.indent 4 $ D.dullyellow $ RT.canToDoc localizer RT.None tipe

46 , D.reflow $

47 , D.reflow $

47 "I only know how to handle Html, Svg, and Programs\

48 "I only know how to handle Html, Svg, and Programs\

48 \ though. Modify `main` to be one of those types of values!"

49 \ though. Modify `main` to be one of those types of values!"

compiler/src/Reporting/Render/Type.hs+17−16

@@ -23,6 +23,7 @@ import qualified Elm.Name as N

23import qualified Reporting.Annotation as A

24import qualified Reporting.Doc as D

25import Reporting.Doc ( Doc, (<+>), (<>) )

26+import qualified Reporting.Render.Type.Localizer as L

26

27

28

29

@@ -177,29 +178,29 @@ collectSrcArgs tipe =

177-- CANONICAL TYPE TO DOC

178-- CANONICAL TYPE TO DOC

178

179

180

180−canToDoc :: Context -> Can.Type -> Doc

181+canToDoc :: L.Localizer -> Context -> Can.Type -> Doc

181−canToDoc context tipe =

182+canToDoc localizer context tipe =

182 case tipe of

183 case tipe of

183 Can.TLambda arg1 result ->

184 Can.TLambda arg1 result ->

184 let

185 let

185 (arg2, rest) = collectArgs result

186 (arg2, rest) = collectArgs result

186 in

187 in

187 lambda context

188 lambda context

188− (canToDoc Func arg1)

189+ (canToDoc localizer Func arg1)

189− (canToDoc Func arg2)

190+ (canToDoc localizer Func arg2)

190− (map (canToDoc Func) rest)

191+ (map (canToDoc localizer Func) rest)

191

192

192 Can.TVar name ->

193 Can.TVar name ->

193 D.fromName name

194 D.fromName name

194

195

195 Can.TType (ModuleName.Canonical _ home) name args ->

196 Can.TType (ModuleName.Canonical _ home) name args ->

196 apply context

197 apply context

197− (D.fromName home <> "." <> D.fromName name)

198+ (L.toDoc localizer home name)

198− (map (canToDoc App) args)

199+ (map (canToDoc localizer App) args)

199

200

200 Can.TRecord fields ext ->

201 Can.TRecord fields ext ->

201 record

202 record

202− (map entryToDocs (Map.toList fields))

203+ (map (entryToDocs localizer) (Map.toList fields))

203 (fmap D.fromName ext)

204 (fmap D.fromName ext)

204

205

205 Can.TUnit ->

206 Can.TUnit ->

@@ -207,19 +208,19 @@ canToDoc context tipe =

207

208

208 Can.TTuple a b maybeC ->

209 Can.TTuple a b maybeC ->

209 tuple

210 tuple

210− (canToDoc None a)

211+ (canToDoc localizer None a)

211− (canToDoc None b)

212+ (canToDoc localizer None b)

212− (map (canToDoc None) (Maybe.maybeToList maybeC))

213+ (map (canToDoc localizer None) (Maybe.maybeToList maybeC))

213

214

214 Can.TAlias (ModuleName.Canonical _ home) name args _ ->

215 Can.TAlias (ModuleName.Canonical _ home) name args _ ->

215 apply context

216 apply context

216− (D.fromName home <> "." <> D.fromName name)

217+ (L.toDoc localizer home name)

217− (map (canToDoc App . snd) args)

218+ (map (canToDoc localizer App . snd) args)

218

219

220

220−entryToDocs :: (N.Name, Can.Type) -> (Doc, Doc)

221+entryToDocs :: L.Localizer -> (N.Name, Can.Type) -> (Doc, Doc)

221−entryToDocs (name, tipe) =

222+entryToDocs localizer (name, tipe) =

222− (D.fromName name, canToDoc None tipe)

223+ (D.fromName name, canToDoc localizer None tipe)

223

224

225

225collectArgs :: Can.Type -> (Can.Type, [Can.Type])

226collectArgs :: Can.Type -> (Can.Type, [Can.Type])

compiler/src/Reporting/Render/Type/Localizer.hs+6−5

@@ -5,7 +5,7 @@ module Reporting.Render.Type.Localizer

5 , toDoc

6 , empty

7 , fromNames

8− , fromImports

8+ , fromModule

9 )

10 where

11

@@ -14,6 +14,7 @@ import qualified Data.Map as Map

14import qualified Data.Set as Set

15

16import qualified AST.Source as Src

17+import qualified AST.Valid as Valid

17import qualified Elm.Name as N

18import qualified Elm.Name as N

18import Reporting.Doc ((<>))

19import Reporting.Doc ((<>))

19import qualified Reporting.Doc as D

20import qualified Reporting.Doc as D

@@ -77,13 +78,13 @@ fromNames names =

77

78

79

80

80−-- FROM IMPORTS

81+-- FROM MODULE

81

82

83

83−fromImports :: N.Name -> [Src.Import] -> Localizer

84+fromModule :: Valid.Module -> Localizer

84−fromImports self imports =

85+fromModule (Valid.Module name _ _ _ imports _ _ _ _ _) =

85 Localizer $ Map.fromList $

86 Localizer $ Map.fromList $

86− (self, Import Nothing All) : map toPair imports

87+ (name, Import Nothing All) : map toPair imports

87

88

89

89toPair :: Src.Import -> (N.Name, Import)

90toPair :: Src.Import -> (N.Name, Import)

compiler/src/Reporting/Warning.hs+4−3

@@ -18,6 +18,7 @@ import qualified Reporting.Region as R

18import qualified Reporting.Report as Report

19import qualified Reporting.Render.Code as Code

20import qualified Reporting.Render.Type as RT

21+import qualified Reporting.Render.Type.Localizer as L

21

22

23

24

@@ -37,8 +38,8 @@ data Context = Def | Pattern

37-- TO REPORT

38-- TO REPORT

38

39

40

40−toReport :: Code.Source -> Warning -> Report.Report

41+toReport :: L.Localizer -> Code.Source -> Warning -> Report.Report

41−toReport source warning =

42+toReport localizer source warning =

42 case warning of

43 case warning of

43 UnusedImport region moduleName ->

44 UnusedImport region moduleName ->

44 Report.Report "unused import" region [] $

45 Report.Report "unused import" region [] $

@@ -89,7 +90,7 @@ toReport source warning =

89 [ "I inferred the type annotation myself though! You can copy it into your code:"

90 [ "I inferred the type annotation myself though! You can copy it into your code:"

90 , D.green $ D.hang 4 $ D.sep $

91 , D.green $ D.hang 4 $ D.sep $

91 [ D.fromName name <> " :"

92 [ D.fromName name <> " :"

92− , RT.canToDoc RT.None inferredType

93+ , RT.canToDoc localizer RT.None inferredType

93 ]

94 ]

95 ]

95 )

96 )