e53128c · elk · git.iko.soy

git.iko.soy/elk

Convert Canonicalization phase from String to Text

commite53128ce919db2bd755fbe6a6452284ff6ce52dc authorEvan Czaplicki <evancz@users.noreply.github.com> dateSun 4 Dec 2016, 20:20 (10 years ago) parent99c8f4a

9 files changed+153−137

compare with master

unifiedsplit

src/Canonicalize.hs+33−25 src/Canonicalize/Binops.hs+2−1 src/Canonicalize/Body.hs+15−9 src/Canonicalize/Effects.hs+6−5 src/Canonicalize/Environment.hs+21−16 src/Canonicalize/Setup.hs+18−14 src/Canonicalize/Sort.hs+20−19 src/Canonicalize/Type.hs+13−10 src/Canonicalize/Variable.hs+25−38

src/Canonicalize.hs+33−25

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

77import qualified Data.Maybe as Maybe

88import qualified Data.Set as Set

99import qualified Data.Foldable as T

10+import qualified Data.Text as Text

11+import Data.Text (Text)

1012

1113import Elm.Utils ((|>))

1214

@@ -78,7 +80,7 @@ module' allCanonicalImports interfaces modul =

7880 canonicalDecls

7981

8082 centralizedDocs =

81− A.map (fmap (Docs.centralize canonicalDecls)) docs

83+ fmap (A.map (Docs.centralize canonicalDecls)) docs

8284

8385 typeToPair (A.A _ (D.Type name args body)) =

8486 ( name, (args, body) )

@@ -88,7 +90,7 @@ module' allCanonicalImports interfaces modul =

8890 in

8991 do program <- Result.mapError Error.Canonicalize getProgram

9092 canonicalImports <- filterImports uses imports

91− Result.accumulate (Result.One (Env.toDealiaser env)) $

93+ Result.accumulate (Result.One (Env.toLocalizer env)) $

9294 modul {

9395 Module.info =

9496 Module.Info

@@ -164,7 +166,7 @@ resolveExports fullList (Var.Listing partialList open) =

164166 <*> allUnique partialList

165167

166168

167−getValueExport :: [String] -> Set.Set String -> A.Located String -> CResult Var.Value

169+getValueExport :: [Text] -> Set.Set Text -> A.Located Text -> CResult Var.Value

168170getValueExport allValues allValuesSet (A.A region name) =

169171 if Set.member name allValuesSet then

170172 Result.ok (Var.Value name)

@@ -172,7 +174,7 @@ getValueExport allValues allValuesSet (A.A region name) =

172174 manyNotFound region [name] allValues

173175

174176

175−getAliasExport :: [String] -> [String] -> [String] -> A.Located String -> CResult [Var.Value]

177+getAliasExport :: [Text] -> [Text] -> [Text] -> A.Located Text -> CResult [Var.Value]

176178getAliasExport allValues allAliases adtTypes (A.A region alias) =

177179 if alias `elem` allAliases then

178180

@@ -189,9 +191,9 @@ getAliasExport allValues allAliases adtTypes (A.A region alias) =

189191

190192

191193getAdtExport

192− :: [(String, Var.Listing String)]

193− -> [String]

194− -> A.Located (String, Var.Listing String)

194+ :: [(Text, Var.Listing Text)]

195+ -> [Text]

196+ -> A.Located (Text, Var.Listing Text)

195197 -> CResult Var.Value

196198getAdtExport allAdts adtTypes (A.A region (name, Var.Listing ctors open)) =

197199 case List.lookup name allAdts of

@@ -209,21 +211,25 @@ getAdtExport allAdts adtTypes (A.A region (name, Var.Listing ctors open)) =

209211 manyNotFound region unfoundCtors allCtors

210212

211213

212−manyNotFound :: Region.Region -> [String] -> [String] -> CResult a

214+manyNotFound :: Region.Region -> [Text] -> [Text] -> CResult a

213215manyNotFound region nameList possibilities =

214216 Result.throwMany (map (notFound region possibilities) nameList)

215217

216218

217−notFound :: Region.Region -> [String] -> String -> A.Located CError.Error

218−notFound region possibilities name =

219− A.A region $ CError.Export name $

220− ErrorHelp.nearbyNames id name possibilities

219+notFound :: Region.Region -> [Text] -> Text -> A.Located CError.Error

220+notFound region possibilities badName =

221+ let

222+ badNameString =

223+ Text.unpack badName

224+ in

225+ A.A region $ CError.Export badNameString $

226+ ErrorHelp.nearbyNames id badNameString (map Text.unpack possibilities)

221227

222228

223229allUnique :: [A.Located Var.Value] -> CResult ()

224230allUnique statedExports =

225231 let

226− valueToString value =

232+ valueToText value =

227233 case value of

228234 Var.Value name -> name

229235 Var.Alias name -> name

@@ -235,7 +241,7 @@ allUnique statedExports =

235241 isUnique value allRegions =

236242 case allRegions of

237243 region : _ : _ ->

238− Result.throw region (CError.DuplicateExport (valueToString value))

244+ Result.throw region (CError.DuplicateExport (valueToText value))

239245

240246 _ ->

241247 Result.ok ()

@@ -284,7 +290,7 @@ maybeUnzip3 tuples =

284290

285291splitValue

286292 :: Var.Value

287− -> ( Maybe String, Maybe String, Maybe (String, Var.Listing String) )

293+ -> ( Maybe Text, Maybe Text, Maybe (Text, Var.Listing Text) )

288294splitValue value =

289295 case value of

290296 Var.Value name ->

@@ -300,9 +306,9 @@ splitValue value =

300306splitLocatedValue

301307 :: A.Located Var.Value

302308 ->

303− ( Maybe (A.Located String)

304− , Maybe (A.Located String)

305− , Maybe (A.Located (String, Var.Listing String))

309+ ( Maybe (A.Located Text)

310+ , Maybe (A.Located Text)

311+ , Maybe (A.Located (Text, Var.Listing Text))

306312 )

307313splitLocatedValue (A.A region value) =

308314 case value of

@@ -414,7 +420,9 @@ canonicalizeExpr env (A.A region validExpr) =

414420 C.Var <$> Canon.variable region env x

415421

416422 Src.Ctor name exprs ->

417− C.Ctor name <$> traverse go exprs

423+ C.Ctor

424+ <$> Canon.variable region env name

425+ <*> traverse go exprs

418426

419427 Src.List exprs ->

420428 C.List <$> traverse go exprs

@@ -433,8 +441,8 @@ canonicalizeExpr env (A.A region validExpr) =

433441

434442canonicalizeFields

435443 :: Env.Env

436− -> (A.Located String, Src.ValidExpr)

437− -> CResult (String, C.Expr)

444+ -> (A.Located Text, Src.ValidExpr)

445+ -> CResult (Text, C.Expr)

438446canonicalizeFields env (A.A _ key, expr) =

439447 (\value -> (key, value)) <$> canonicalizeExpr env expr

440448

@@ -462,8 +470,8 @@ canonicalizePattern env (A.A region ptrn) =

462470 P.Alias x p ->

463471 P.Alias x <$> canonicalizePattern env p

464472

465− P.Data (Var.Raw name) patterns ->

466− P.Data

473+ P.Ctor (Var.Raw name) patterns ->

474+ P.Ctor

467475 <$> Canon.pvar region env name (length patterns)

468476 <*> traverse (canonicalizePattern env) patterns

469477

@@ -475,7 +483,7 @@ canonicalizePattern env (A.A region ptrn) =

475483canonicalizeBinop

476484 :: Region.Region

477485 -> Env.Env

478− -> [(Src.ValidExpr, A.Located String)]

486+ -> [(Src.ValidExpr, A.Located Text)]

479487 -> Src.ValidExpr

480488 -> CResult C.Expr'

481489canonicalizeBinop region env srcOps srcLast =

@@ -490,7 +498,7 @@ canonicalizeBinop region env srcOps srcLast =

490498 A.drop <$> Binops.flatten region expr ops

491499

492500

493−binopHelp :: Env.Env -> (Src.ValidExpr, A.Located String) -> CResult (C.Expr, Binops.Op)

501+binopHelp :: Env.Env -> (Src.ValidExpr, A.Located Text) -> CResult (C.Expr, Binops.Op)

494502binopHelp env (expr, op) =

495503 (,)

496504 <$> canonicalizeExpr env expr

src/Canonicalize/Binops.hs+2−1

@@ -3,6 +3,7 @@ module Canonicalize.Binops ( Op(..), canonicalize, flatten ) where

44import Prelude hiding (last)

55import qualified Data.Map as Map

6+import Data.Text (Text)

78import AST.Declaration (Assoc(..))

89import qualified AST.Expression.Canonical as C

@@ -28,7 +29,7 @@ data Op =

2829 }

2930

3031

31−canonicalize :: Env.Env -> A.Located String -> Var.Result Op

32+canonicalize :: Env.Env -> A.Located Text -> Var.Result Op

3233canonicalize env (A.A region op) =

3334 do name <- Var.variable region env op

3435 let (assoc, prec) = Map.findWithDefault (L, 9) name (Env._infixes env)

src/Canonicalize/Body.hs+15−9

@@ -1,7 +1,10 @@

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Canonicalize.Body (flatten) where

45import qualified Data.Maybe as Maybe

6+import qualified Data.Text as Text

7+import Data.Text (Text)

69import qualified AST.Declaration as Decl

710import qualified AST.Effects as Effects

@@ -51,7 +54,7 @@ unionToDefs moduleName (A.A (region,_) (Decl.Type name tvars constructors)) =

5154 tagToDef (tag, tipes) =

5255 let

5356 vars =

54− take (length tipes) infiniteArgs

57+ generateArgs (length tipes) []

5558

5659 tbody =

5760 Type.App

@@ -60,7 +63,7 @@ unionToDefs moduleName (A.A (region,_) (Decl.Type name tvars constructors)) =

6063

6164 body =

6265 A.A region $

63− C.Ctor tag (map (A.A region . C.localVar) vars)

66+ C.Ctor (Var.fromModule moduleName tag) (map (A.A region . C.localVar) vars)

6467 in

6568 definition tag (buildFunction vars body) region (foldr Type.Lambda tbody tipes)

6669 in

@@ -82,7 +85,7 @@ aliasToDefs moduleName (A.A (region,_) (Decl.Type name tvars tipe)) =

8285 map snd fields

8386

8487 vars =

85− take (length args) infiniteArgs

88+ generateArgs (length args) []

8689

8790 record =

8891 A.A region $

@@ -94,12 +97,15 @@ aliasToDefs moduleName (A.A (region,_) (Decl.Type name tvars tipe)) =

9497 Nothing

9598

9699

97−infiniteArgs :: [String]

98−infiniteArgs =

99− map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show (n :: Int)) [1..]

100+generateArgs :: Int -> [Text] -> [Text]

101+generateArgs n args =

102+ if n == 0 then

103+ args

104+ else

105+ generateArgs (n - 1) (Text.pack ('v' : show n) : args)

100106

101107

102−buildFunction :: [String] -> C.Expr -> C.Expr

108+buildFunction :: [Text] -> C.Expr -> C.Expr

103109buildFunction vars body@(A.A ann _) =

104110 foldr

105111 (\pattern expr -> A.A ann (C.Lambda pattern expr))

@@ -107,7 +113,7 @@ buildFunction vars body@(A.A ann _) =

107113 (map (A.A ann . P.Var) vars)

108114

109115

110−definition :: String -> C.Expr -> Region -> Type.Canonical -> C.Def

116+definition :: Text -> C.Expr -> Region -> Type.Canonical -> C.Def

111117definition name expr@(A.A ann _) region tipe =

112118 C.Def

113119 region

@@ -165,7 +171,7 @@ portToDef (A.A (region, _) (Effects.PortCanonical name kind tipe)) =

165171 definition name (A.A region (toPortExpr name kind)) region tipe

166172

167173

168−toPortExpr :: String -> Effects.Kind -> C.Expr'

174+toPortExpr :: Text -> Effects.Kind -> C.Expr'

169175toPortExpr name kind =

170176 case kind of

171177 Effects.Outgoing tipe ->

src/Canonicalize/Effects.hs+6−5

@@ -1,7 +1,8 @@

11module Canonicalize.Effects (canonicalize, toValues, checkPortType) where

33import qualified Data.Foldable as F

4−import qualified Data.Traversable as T

4+import qualified Data.Text as Text

5+import Data.Text (Text)

67import qualified AST.Effects as Effects

78import qualified AST.Type as T

@@ -46,7 +47,7 @@ canonicalize env effects =

4647 Result.ok (Effects.Manager (Env.getPackage env) info)

4748

4849 Effects.Port rawPorts ->

49− Effects.Port <$> T.traverse (canonicalizeRawPort env) rawPorts

50+ Effects.Port <$> traverse (canonicalizeRawPort env) rawPorts

5051

5152

5253canonicalizeRawPort

@@ -59,7 +60,7 @@ canonicalizeRawPort env (A.A ann (Effects.PortRaw name rawType)) =

5960 Result.ok (A.A ann (Effects.PortCanonical name kind tipe))

6061

6162

62−figureOutKind :: R.Region -> String -> T.Canonical -> Result Effects.Kind

63+figureOutKind :: R.Region -> Text -> T.Canonical -> Result Effects.Kind

6364figureOutKind region name rootType =

6465 case T.deepDealias rootType of

6566 T.Lambda outgoingType (T.App (T.Type effect) [T.Var _])

@@ -76,9 +77,9 @@ figureOutKind region name rootType =

7677 Result.throw region (Error.BadPort name rootType)

7778

7879

79−makeError :: R.Region -> String -> T.Canonical -> Maybe String -> A.Located Error.Error

80+makeError :: R.Region -> Text -> T.Canonical -> Maybe String -> A.Located Error.Error

8081makeError region name tipe maybeMessage =

81− A.A region (Error.port name tipe maybeMessage)

82+ A.A region (Error.port (Text.unpack name) tipe maybeMessage)

8283

8384

8485

src/Canonicalize/Environment.hs+21−16

@@ -1,11 +1,12 @@

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Canonicalize.Environment

34 ( Env(..)

45 , getPackage

56 , insert

67 , Patch(..), fromPatches, addPattern

78 , builtinPatches

8− , toDealiaser

9+ , toLocalizer

910 )

1011 where

1112

@@ -13,6 +14,8 @@ import qualified Data.List as List

1314import qualified Data.Map as Map

1415import qualified Data.Maybe as Maybe

1516import qualified Data.Set as Set

17+import qualified Data.Text as Text

18+import Data.Text (Text)

1619

1720import qualified AST.Declaration as Decl

1821import qualified AST.Module.Name as ModuleName

@@ -20,6 +23,7 @@ import qualified AST.Pattern as P

2023import qualified AST.Type as Type

2124import qualified AST.Variable as Var

2225import qualified Elm.Package as Pkg

26+import qualified Reporting.Render.Type as RT

2327

2428

2529

@@ -30,14 +34,14 @@ data Env = Env

3034 { _home :: ModuleName.Canonical

3135 , _values :: Dict Var.Canonical

3236 , _unions :: Dict Var.Canonical

33− , _aliases :: Dict (Var.Canonical, [String], Type.Canonical)

37+ , _aliases :: Dict (Var.Canonical, [Text], Type.Canonical)

3438 , _patterns :: Dict (Var.Canonical, Int)

3539 , _infixes :: Map.Map Var.Canonical (Decl.Assoc, Int)

3640 }

3741

3842

3943type Dict a =

40− Map.Map String (Set.Set a)

44+ Map.Map Text (Set.Set a)

4145

4246

4347fromPatches :: ModuleName.Canonical -> [Patch] -> Env

@@ -64,10 +68,10 @@ getPackage env =

6468

6569

6670data Patch

67− = Value String Var.Canonical

68− | Union String Var.Canonical

69− | Alias String (Var.Canonical, [String], Type.Canonical)

70− | Pattern String (Var.Canonical, Int)

71+ = Value Text Var.Canonical

72+ | Union Text Var.Canonical

73+ | Alias Text (Var.Canonical, [Text], Type.Canonical)

74+ | Pattern Text (Var.Canonical, Int)

7175 | Infix Var.Canonical Decl.Assoc Int

7276

7377

@@ -99,7 +103,7 @@ addPatch patch env =

99103 env { _infixes = Map.insert name (assoc, prec) (_infixes env) }

100104

101105

102−insert :: (Ord a) => String -> a -> Dict a -> Dict a

106+insert :: (Ord a) => Text -> a -> Dict a -> Dict a

103107insert key value =

104108 Map.insertWith Set.union key (Set.singleton value)

105109

@@ -128,29 +132,29 @@ builtinPatches =

128132 tuples =

129133 map toTuple [0..9]

130134

131− toTuple :: Int -> (String, Int)

135+ toTuple :: Int -> (Text, Int)

132136 toTuple n =

133− ("_Tuple" ++ show n, n)

137+ ( Text.pack ("_Tuple" ++ show n), n )

134138

135139

136140

137141-- TO TYPE DEALIASER

138142

139143

140−toDealiaser :: Env -> Map.Map String String

141−toDealiaser (Env _ _ unions aliases _ _) =

144+toLocalizer :: Env -> RT.Localizer

145+toLocalizer (Env _ _ unions aliases _ _) =

142146 let

143147 dealiasUnion (localName, canonicalSet) =

144148 case Set.toList canonicalSet of

145149 [canonicalName] ->

146− Just (Var.toString canonicalName, localName)

150+ Just (canonicalName, localName)

147151 _ ->

148152 Nothing

149153

150154 dealiasAlias (localName, canonicalSet) =

151155 case Set.toList canonicalSet of

152156 [(canonicalName,_,_)] ->

153− Just (Var.toString canonicalName, localName)

157+ Just (canonicalName, localName)

154158 _ ->

155159 Nothing

156160

@@ -161,6 +165,7 @@ toDealiaser (Env _ _ unions aliases _ _) =

161165 Maybe.mapMaybe dealiasAlias (Map.toList aliases)

162166

163167 add (key,value) dict =

164− Map.insertWith (\v v' -> if length v < length v' then v else v') key value dict

168+ Map.insertWith (\v v' -> if Text.length v < Text.length v' then v else v') key value dict

165169 in

166− foldr add Map.empty (unionPairs ++ aliasPairs)

170+ Map.map Text.unpack $

171+ foldr add Map.empty (unionPairs ++ aliasPairs)

src/Canonicalize/Setup.hs+18−14

@@ -1,4 +1,5 @@

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Canonicalize.Setup (environment) where

45import Control.Arrow (second)

@@ -6,6 +7,9 @@ import Control.Monad (foldM)

67import qualified Data.Graph as Graph

78import qualified Data.Map as Map

89import qualified Data.Maybe as Maybe

10+import Data.Monoid ((<>))

11+import qualified Data.Text as Text

12+import Data.Text (Text)

913

1014import qualified AST.Declaration as D

1115import qualified AST.Effects as Effects

@@ -96,13 +100,13 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

96100 listing

97101

98102 qualifier =

99− maybe (ModuleName.toString rawImportName) id maybeAlias

103+ maybe (Text.pack (ModuleName.toString rawImportName)) id maybeAlias

100104

101105 infixPatches =

102106 map (infixToPatch (Var.fromModule importName)) (Module.iFixities interface)

103107

104108 qualifiedPatches =

105− interfaceToPatches importName (qualifier ++ ".") interface

109+ interfaceToPatches importName (qualifier <> ".") interface

106110

107111 unqualifiedPatches =

108112 if open then

@@ -114,11 +118,11 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

114118 (++) (infixPatches ++ qualifiedPatches) <$> unqualifiedPatches

115119

116120

117−interfaceToPatches :: ModuleName.Canonical -> String -> Module.Interface -> [Env.Patch]

121+interfaceToPatches :: ModuleName.Canonical -> Text -> Module.Interface -> [Env.Patch]

118122interfaceToPatches moduleName prefix interface =

119123 let

120124 genericPatch mkPatch name value =

121− mkPatch (prefix ++ name) value

125+ mkPatch (prefix <> name) value

122126

123127 patch mkPatch name =

124128 genericPatch mkPatch name (Var.fromModule moduleName name)

@@ -171,7 +175,7 @@ valueToPatches region moduleName interface value =

171175 notFound getNames x =

172176 Module.iExports interface

173177 |> getNames

174− |> Error.nearbyNames id x

178+ |> Error.nearbyNames Text.unpack x

175179 |> Error.valueNotFound (ModuleName._module moduleName) x

176180 |> Result.throw region

177181 in

@@ -247,10 +251,10 @@ valueToPatches region moduleName interface value =

247251

248252

249253type Node =

250− ( (R.Region, String, [String], Type.Raw), String, [String] )

254+ ( (R.Region, Text, [Text], Type.Raw), Text, [Text] )

251255

252256

253−node :: R.Region -> String -> [String] -> Type.Raw -> Node

257+node :: R.Region -> Text -> [Text] -> Type.Raw -> Node

254258node region name tvars alias =

255259 ((region, name, tvars, alias), name, edges alias)

256260 where

@@ -280,7 +284,7 @@ addTypeAliases moduleName typeAliasNodes initialEnv =

280284addTypeAlias

281285 :: ModuleName.Canonical

282286 -> Env.Env

283− -> Graph.SCC (R.Region, String, [String], Type.Raw)

287+ -> Graph.SCC (R.Region, Text, [Text], Type.Raw)

284288 -> Result Env.Env

285289addTypeAlias moduleName env scc =

286290 case scc of

@@ -362,7 +366,7 @@ declsToPatches moduleName (D.Decls defs unions aliases infixes) =

362366 )

363367

364368

365−infixToPatch :: (String -> Var.Canonical) -> D.Infix -> Env.Patch

369+infixToPatch :: (Text -> Var.Canonical) -> D.Infix -> Env.Patch

366370infixToPatch toVar (D.Infix name assoc prec) =

367371 Env.Infix (toVar name) assoc prec

368372

@@ -425,16 +429,16 @@ restrictToPublicApi interface =

425429 exports =

426430 Module.iExports interface

427431

428− unions :: [(String, Var.Listing String)]

432+ unions :: [(Text, Var.Listing Text)]

429433 unions =

430434 Var.getUnions exports

431435

432− ctors :: [String]

436+ ctors :: [Text]

433437 ctors =

434438 concatMap (\(_, Var.Listing ctorList _) -> ctorList) unions

435439

436440

437−get :: Map.Map String a -> String -> Maybe (String, a)

441+get :: Map.Map Text a -> Text -> Maybe (Text, a)

438442get dict key =

439443 case Map.lookup key dict of

440444 Nothing ->

@@ -446,8 +450,8 @@ get dict key =

446450

447451trimUnions

448452 :: Module.Interface

449− -> (String, Var.Listing String)

450− -> Maybe (String, Module.UnionInfo String)

453+ -> (Text, Var.Listing Text)

454+ -> Maybe (Text, Module.UnionInfo Text)

451455trimUnions interface (name, Var.Listing exportedCtors _) =

452456 case Map.lookup name (Module.iUnions interface) of

453457 Nothing ->

src/Canonicalize/Sort.hs+20−19

@@ -6,6 +6,7 @@ import qualified Data.Graph as Graph

66import qualified Data.Map as Map

77import qualified Data.Maybe as Maybe

88import qualified Data.Set as Set

9+import Data.Text (Text)

910

1011import qualified AST.Expression.Canonical as C

1112import qualified AST.Pattern as P

@@ -30,9 +31,9 @@ definitions expression =

3031

3132data LocalVars =

3233 LocalVars

33− { _immediate :: Set.Set String

34− , _delayed :: Set.Set String

35− , _tags :: Set.Set String

34+ { _immediate :: Set.Set Text

35+ , _delayed :: Set.Set Text

36+ , _tags :: Set.Set Text

3637 }

3738

3839

@@ -44,7 +45,7 @@ instance Monoid LocalVars where

4445 LocalVars (Set.union i1 i2) (Set.union d1 d2) (Set.union t1 t2)

4546

4647

47−addTag :: String -> a -> R.Result LocalVars w e a

48+addTag :: Text -> a -> R.Result LocalVars w e a

4849addTag name value =

4950 R.accumulate (LocalVars Set.empty Set.empty (Set.singleton name)) value

5051

@@ -70,7 +71,7 @@ capture pattern result =

7071 captureVars (P.boundVarSet pattern) result

7172

7273

73−captureVars :: Set.Set String -> R.Result LocalVars w e a -> R.Result LocalVars w e a

74+captureVars :: Set.Set Text -> R.Result LocalVars w e a -> R.Result LocalVars w e a

7475captureVars bound (R.Result (LocalVars immediate delayed tags) warnings result) =

7576 let

7677 localVars =

@@ -106,8 +107,8 @@ reorder (A.A region expression) =

106107 C.Case expr cases ->

107108 C.Case <$> reorder expr <*> traverse (bindingReorder (,)) cases

108109

109− C.Ctor name exprs ->

110− addTag name =<< (C.Ctor name <$> traverse reorder exprs)

110+ C.Ctor ctor@(V.Canonical _ name) exprs ->

111+ addTag name =<< (C.Ctor ctor <$> traverse reorder exprs)

111112

112113 -- Just pipe the reorder though

113114 C.Literal _ ->

@@ -195,7 +196,7 @@ addPatternTags pattern value =

195196 R.accumulate (LocalVars Set.empty Set.empty (getPatternTags pattern)) value

196197

197198

198−getPatternTags :: P.Canonical -> Set.Set String

199+getPatternTags :: P.Canonical -> Set.Set Text

199200getPatternTags (A.A _ pattern) =

200201 case pattern of

201202 P.Var _ ->

@@ -213,7 +214,7 @@ getPatternTags (A.A _ pattern) =

213214 P.Literal _ ->

214215 Set.empty

215216

216− P.Data (V.Canonical home name) patterns ->

217+ P.Ctor (V.Canonical home name) patterns ->

217218 let

218219 freeCtors =

219220 Set.unions (map getPatternTags patterns)

@@ -238,7 +239,7 @@ getPatternTags (A.A _ pattern) =

238239

239240reorderDefs

240241 :: [C.Def]

241− -> R.Result () w E.Error (Set.Set String, [[C.Def]], LocalVars)

242+ -> R.Result () w E.Error (Set.Set Text, [[C.Def]], LocalVars)

242243reorderDefs defs =

243244 do rawNodes <- sequenceA $ zipWith toRawNode [0..] defs

244245 let boundVarDict = toBoundVarDict rawNodes

@@ -258,12 +259,12 @@ toRawNode index (C.Def region pattern body maybeType) =

258259 toRawNodeHelp <$> R.Result () warnings answer

259260

260261

261−toBoundVarDict :: [(C.Def, Int, a)] -> Map.Map String Int

262+toBoundVarDict :: [(C.Def, Int, a)] -> Map.Map Text Int

262263toBoundVarDict defAndDeps =

263264 Map.fromList (concatMap toBoundVarDictHelp defAndDeps)

264265

265266

266−toBoundVarDictHelp :: (C.Def, Int, a) -> [(String, Int)]

267+toBoundVarDictHelp :: (C.Def, Int, a) -> [(Text, Int)]

267268toBoundVarDictHelp (C.Def _ pattern _ _, key, _) =

268269 map (\(A.A _ name) -> (name, key)) (P.boundVars pattern)

269270

@@ -273,8 +274,8 @@ toBoundVarDictHelp (C.Def _ pattern _ _, key, _) =

273274

274275

275276toNode

276− :: (deps -> [String])

277− -> Map.Map String Int

277+ :: (deps -> [Text])

278+ -> Map.Map Text Int

278279 -> (C.Def, Int, deps)

279280 -> (C.Def, Int, [Int])

280281toNode toVars boundVarDict (def, index, deps) =

@@ -285,12 +286,12 @@ toNode toVars boundVarDict (def, index, deps) =

285286 ( def, index, localDeps )

286287

287288

288−immediateOnly :: LocalVars -> [String]

289+immediateOnly :: LocalVars -> [Text]

289290immediateOnly (LocalVars immediate _ _) =

290291 Set.toList immediate

291292

292293

293−allVars :: LocalVars -> [String]

294+allVars :: LocalVars -> [Text]

294295allVars (LocalVars immediate delayed tags) =

295296 Set.toList immediate ++ Set.toList delayed ++ Set.toList tags

296297

@@ -300,7 +301,7 @@ allVars (LocalVars immediate delayed tags) =

300301

301302

302303detectLoops

303− :: Map.Map String Int

304+ :: Map.Map Text Int

304305 -> [(C.Def, Int, LocalVars)]

305306 -> R.Result () w E.Error ()

306307detectLoops boundVarDict rawNodes =

@@ -329,9 +330,9 @@ detectLoopsHelp scc =

329330

330331

331332groupDefs

332− :: Map.Map String Int

333+ :: Map.Map Text Int

333334 -> [(C.Def, Int, LocalVars)]

334− -> ( Set.Set String, [[C.Def]], LocalVars )

335+ -> ( Set.Set Text, [[C.Def]], LocalVars )

335336groupDefs boundVarDict rawNodes =

336337 let

337338 allLocalVars =

src/Canonicalize/Type.hs+13−10

@@ -1,18 +1,21 @@

11{-# OPTIONS_GHC -Wall #-}

22module Canonicalize.Type (tipe) where

4−import qualified Data.Traversable as Trav

4+import Data.Text (Text)

66import qualified AST.Type as T

77import qualified AST.Variable as Var

8−

8+import qualified Canonicalize.Environment as Env

9+import qualified Canonicalize.Variable as Canonicalize

10+import Canonicalize.Variable (Result)

911import qualified Reporting.Annotation as A

1012import qualified Reporting.Error.Canonicalize as Error

1113import qualified Reporting.Region as R

1214import qualified Reporting.Result as Result

13−import qualified Canonicalize.Environment as Env

14−import qualified Canonicalize.Variable as Canonicalize

15−import Canonicalize.Variable (Result)

15+

16+

17+

18+-- CANONICALIZE TYPES

1619

1720

1821tipe :: Env.Env -> T.Raw -> Result T.Canonical

@@ -38,7 +41,7 @@ tipe env annType@(A.A _ typ) =

3841 T.Lambda <$> go a <*> go b

3942

4043 T.RRecord fields ext ->

41− T.Record <$> Trav.traverse goField fields <*> Trav.traverse go ext

44+ T.Record <$> traverse goField fields <*> traverse go ext

4245

4346

4447canonicalizeApp :: Env.Env -> T.Raw -> [T.Raw] -> Result T.Canonical

@@ -50,7 +53,7 @@ canonicalizeApp env annFunc@(A.A region func) args =

5053 _ ->

5154 T.App

5255 <$> tipe env annFunc

53− <*> Trav.traverse (tipe env) args

56+ <*> traverse (tipe env) args

5457

5558 where

5659 canonicalizeWithTvar tvar =

@@ -64,13 +67,13 @@ canonicalizeApp env annFunc@(A.A region func) args =

6467 Result.ok (T.Type name)

6568

6669 _ ->

67− T.App (T.Type name) <$> Trav.traverse (tipe env) args

70+ T.App (T.Type name) <$> traverse (tipe env) args

6871

6972

7073canonicalizeAlias

7174 :: R.Region

7275 -> Env.Env

73− -> (Var.Canonical, [String], T.Canonical)

76+ -> (Var.Canonical, [Text], T.Canonical)

7477 -> [T.Raw]

7578 -> Result T.Canonical

7679canonicalizeAlias region env (name, tvars, dealiasedTipe) types =

@@ -88,5 +91,5 @@ canonicalizeAlias region env (name, tvars, dealiasedTipe) types =

8891 Result.throw region (Error.alias name tvarsLen typesLen)

8992

9093 else

91− toAlias <$> Trav.traverse (tipe env) types

94+ toAlias <$> traverse (tipe env) types

9295

src/Canonicalize/Variable.hs+25−38

@@ -1,9 +1,12 @@

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Canonicalize.Variable (Result, variable, tvar, pvar) where

45import qualified Data.Either as Either

56import qualified Data.Map as Map

67import qualified Data.Set as Set

8+import qualified Data.Text as Text

9+import Data.Text (Text)

710

811import qualified AST.Helpers as Help

912import qualified AST.Module.Name as ModuleName

@@ -45,7 +48,7 @@ logVar var =

4548-- FINDERS

4649

4750

48−variable :: R.Region -> Env.Env -> String -> Result Var.Canonical

51+variable :: R.Region -> Env.Env -> Text -> Result Var.Canonical

4952variable region env var =

5053 case toVarName var of

5154 Right (name, varName) | ModuleName.isNative name ->

@@ -70,15 +73,7 @@ variable region env var =

7073 notFound region "variable" (Map.keys (Env._values env)) var

7174

7275

73−tvar

74− :: R.Region

75− -> Env.Env

76− -> String

77− -> Result

78− (Either

79− Var.Canonical

80− (Var.Canonical, [String], Type.Canonical)

81− )

76+tvar :: R.Region -> Env.Env -> Text -> Result (Either Var.Canonical (Var.Canonical, [Text], Type.Canonical))

8277tvar region env var =

8378 case unions ++ aliases of

8479 [] -> notFound region "type" (Map.keys (Env._unions env) ++ Map.keys (Env._aliases env)) var

@@ -97,7 +92,7 @@ tvar region env var =

9792 Right (v,_,_) -> v

9893

9994

100−pvar :: R.Region -> Env.Env -> String -> Int -> Result Var.Canonical

95+pvar :: R.Region -> Env.Env -> Text -> Int -> Result Var.Canonical

10196pvar region env var actualArgs =

10297 case Set.toList <$> Map.lookup var (Env._patterns env) of

10398 Just [value] ->

@@ -121,7 +116,7 @@ pvar region env var actualArgs =

121116-- FOUND

122117

123118

124−preferLocals :: R.Region -> Env.Env -> String -> [Var.Canonical] -> String -> Result Var.Canonical

119+preferLocals :: R.Region -> Env.Env -> Text -> [Var.Canonical] -> Text -> Result Var.Canonical

125120preferLocals region env =

126121 preferLocals' region env id

127122

@@ -130,9 +125,9 @@ preferLocals'

130125 :: R.Region

131126 -> Env.Env

132127 -> (a -> Var.Canonical)

133− -> String

128+ -> Text

134129 -> [a]

135− -> String

130+ -> Text

136131 -> Result a

137132preferLocals' region env extract kind possibilities var =

138133 case filter (isLocal (Env._home env) . extract) possibilities of

@@ -156,7 +151,7 @@ preferLocals' region env extract kind possibilities var =

156151 ambiguous possibleVars =

157152 Result.throw region (Error.variable kind var Error.Ambiguous vars)

158153 where

159− vars = map (Var.toString . extract) possibleVars

154+ vars = map (Text.pack . Var.toString . extract) possibleVars

160155

161156

162157isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool

@@ -190,26 +185,26 @@ isTopLevel (Var.Canonical home _) =

190185

191186

192187type VarName =

193− Either String (ModuleName.Raw, String)

188+ Either Text (ModuleName.Raw, Text)

194189

195190

196−toVarName :: String -> VarName

191+toVarName :: Text -> VarName

197192toVarName var =

198− case Help.splitDots var of

193+ case Text.splitOn "." var of

199194 [x] -> Left x

200− xs -> Right (init xs, last xs)

195+ xs -> Right (Text.intercalate "." (init xs), last xs)

201196

202197

203198noQualifier :: VarName -> String

204199noQualifier name =

205200 case name of

206− Left x -> x

207− Right (_, x) -> x

201+ Right (_, x) -> Text.unpack x

202+ Left x -> Text.unpack x

208203

209204

210−qualifiedToString :: (ModuleName.Raw, String) -> String

205+qualifiedToString :: (ModuleName.Raw, Text) -> Text

211206qualifiedToString (modul, name) =

212− ModuleName.toString modul ++ "." ++ name

207+ Text.pack (ModuleName.toString modul ++ "." ++ Text.unpack name)

213208

214209

215210isOp :: VarName -> Bool

@@ -221,7 +216,7 @@ isOp name =

221216-- NOT FOUND

222217

223218

224−notFound :: R.Region -> String -> [String] -> String -> Result a

219+notFound :: R.Region -> Text -> [Text] -> Text -> Result a

225220notFound region kind possibilities var =

226221 let name =

227222 toVarName var

@@ -240,7 +235,7 @@ notFound region kind possibilities var =

240235 Result.throw region (Error.variable kind var problem suggestions)

241236

242237

243−exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [String])

238+exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [Text])

244239exposedProblem name possibleNames =

245240 let (exposed, qualified) =

246241 possibleNames

@@ -253,30 +248,22 @@ exposedProblem name possibleNames =

253248 )

254249

255250

256−qualifiedProblem

257− :: ModuleName.Raw

258− -> String

259− -> [(ModuleName.Raw, String)]

260− -> (Error.VarProblem, [String])

251+qualifiedProblem :: ModuleName.Raw -> Text -> [(ModuleName.Raw, Text)] -> (Error.VarProblem, [Text])

261252qualifiedProblem moduleName name allQualified =

262253 let availableModules =

263254 Set.fromList (map fst allQualified)

264−

265− moduleNameString =

266− ModuleName.toString moduleName

267255 in

268256 case Set.member moduleName availableModules of

269257 True ->

270− ( Error.QualifiedUnknown moduleNameString name

258+ ( Error.QualifiedUnknown moduleName name

271259 , allQualified

272260 |> filter ((==) moduleName . fst)

273261 |> map snd

274− |> Error.nearbyNames id name

262+ |> Error.nearbyNames Text.unpack name

275263 )

276264

277265 False ->

278− ( Error.UnknownQualifier moduleNameString name

266+ ( Error.UnknownQualifier moduleName name

279267 , Set.toList availableModules

280− |> map ModuleName.toString

281− |> Error.nearbyNames id moduleNameString

268+ |> Error.nearbyNames Text.unpack moduleName

282269 )