a3ad7d2 · elk · git.iko.soy

git.iko.soy/elk

Make Elm.Name an opaque type

This means I can modify the implementation within the Elm.Name module without messing with everything else. This will allow experimentation with a faster / more compact representation for names.

commita3ad7d252ce6f3aed2d455e494f2f40e779851ea authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 29 Jan 2018, 17:50 (9 years ago) parent3a07bd6

25 files changed+227−188

compare with master

unifiedsplit

src/Canonicalize/Expression.hs+1−2

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

1515import qualified Data.List as List

1616import qualified Data.Map.Strict as Map

1717import qualified Data.Map.Strict.Internal as I

18−import qualified Data.Text as Text

1918

2019import qualified AST.Canonical as Can

2120import qualified AST.Source as Src

@@ -436,7 +435,7 @@ addDefNodes env nodes def =

436435 (\freeLocals warnings cbody ->

437436 let

438437 names = getPatternNames [] pattern

439− name = Text.cons '$' (Text.intercalate "$" (map A.toValue names))

438+ name = N.toCompositeName (map A.toValue names)

440439 node = ( Destruct cpattern cbody, name, Map.keys freeLocals )

441440 in

442441 good

src/Elm/Compiler/Module.hs+23−44

@@ -7,11 +7,9 @@ module Elm.Compiler.Module

88 -- module names

99 , Raw

10− , nameToPath

1110 , nameToString

12− , nameFromText

13− , hyphenate

14− , dehyphenate

11+ , nameToSlashPath

12+ , nameToHyphenPath

1513 , encode

1614 , decoder

1715

@@ -40,38 +38,37 @@ import qualified Json.Encode as Encode

4038type Raw = N.Name

4139

4240

43−nameToPath :: Raw -> FilePath

44−nameToPath name =

45− List.foldl1 (</>) (map Text.unpack (Text.splitOn "." name))

41+nameToString :: Raw -> String

42+nameToString =

43+ N.toString

4644

4745

48−nameToString :: Raw -> String

49−nameToString name =

50− Text.unpack name

46+nameToSlashPath :: Raw -> FilePath

47+nameToSlashPath name =

48+ List.foldl1 (</>) (map Text.unpack (Text.splitOn "." (N.toText name)))

5149

5250

53−nameFromText :: Text.Text -> Maybe Raw

54−nameFromText =

55− fromText '.'

51+nameToHyphenPath :: Raw -> FilePath

52+nameToHyphenPath name =

53+ Text.unpack (Text.replace "." "-" (N.toText name))

5654

5755

58−hyphenate :: Raw -> Text.Text

59−hyphenate name =

60− Text.replace "." "-" name

6156

57+-- JSON

6258

63−dehyphenate :: Text.Text -> Maybe Raw

64−dehyphenate =

65− fromText '-'

6659

60+encode :: Raw -> Encode.Value

61+encode =

62+ Encode.name

6763

68−fromText :: Char -> Text.Text -> Maybe Raw

69−fromText sep name =

70− let

71− chunks =

72− Text.splitOn (Text.singleton sep) name

73− in

74− if all isGoodChunk chunks then Just name else Nothing

64+

65+decoder :: Decode.Decoder Text.Text Raw

66+decoder =

67+ do txt <- Decode.text

68+ let chunks = Text.splitOn "." txt

69+ if all isGoodChunk chunks

70+ then Decode.succeed (N.fromText txt)

71+ else Decode.fail txt

7572

7673

7774isGoodChunk :: Text.Text -> Bool

@@ -89,21 +86,3 @@ isGoodChar char =

8986 Char.isAlphaNum char || char == '_'

9087

9188

92−

93−-- JSON

94−

95−

96−encode :: Raw -> Encode.Value

97−encode =

98− Encode.text

99−

100−

101−decoder :: Decode.Decoder Text.Text Raw

102−decoder =

103− do txt <- Decode.text

104− case nameFromText txt of

105− Just name ->

106− Decode.succeed name

107−

108− Nothing ->

109− Decode.fail txt

src/Elm/Compiler/Type.hs+12−13

@@ -14,7 +14,6 @@ module Elm.Compiler.Type

1414 where

1515

1616

17−import Data.Text (Text)

1817import qualified Data.Text as Text

1918import qualified Data.Text.Encoding as Text

2019import qualified Text.PrettyPrint as P

@@ -93,7 +92,7 @@ toDoc context tipe =

9392 _ -> P.parens lambda

9493

9594 Var name ->

96− P.text (Text.unpack name)

95+ P.text (N.toString name)

9796

9897 Unit ->

9998 "()"

@@ -111,13 +110,13 @@ toDoc context tipe =

111110 Type name args ->

112111 case args of

113112 [] ->

114− P.text (Text.unpack name)

113+ P.text (N.toString name)

115114

116115 _ ->

117116 let

118117 application =

119118 P.hang

120− (P.text (Text.unpack name))

119+ (P.text (N.toString name))

121120 2

122121 (P.sep $ map (toDoc InType) args)

123122 in

@@ -141,7 +140,7 @@ toDoc context tipe =

141140

142141 (fields, Just x) ->

143142 P.hang

144− ("{" <+> P.text (Text.unpack x) <+> "|")

143+ ("{" <+> P.text (N.toString x) <+> "|")

145144 4

146145 (P.sep

147146 [ P.sep (P.punctuate "," (map prettyField fields))

@@ -150,7 +149,7 @@ toDoc context tipe =

150149 )

151150 where

152151 prettyField (field, fieldType) =

153− P.text (Text.unpack field) <+> ":" <+> toDoc None fieldType

152+ P.text (N.toString field) <+> ":" <+> toDoc None fieldType

154153

155154

156155collectLambdas :: Type -> [Type]

@@ -160,7 +159,7 @@ collectLambdas tipe =

160159 _ -> [tipe]

161160

162161

163−flattenRecord :: Type -> ( [(Text, Type)], Maybe Text )

162+flattenRecord :: Type -> ( [(N.Name, Type)], Maybe N.Name )

164163flattenRecord tipe =

165164 case tipe of

166165 Var x ->

@@ -244,22 +243,22 @@ encodeMetadata (DebugMetadata msg aliases unions) =

244243

245244toAliasField :: Alias -> ( Text.Text, Encode.Value )

246245toAliasField (Alias name args tipe) =

247− name ==>

246+ N.toText name ==>

248247 Encode.object

249− [ "args" ==> Encode.list Encode.text args

248+ [ "args" ==> Encode.list Encode.name args

250249 , "type" ==> encode tipe

251250 ]

252251

253252

254253toUnionField :: Union -> ( Text.Text, Encode.Value )

255254toUnionField (Union name args constructors) =

256− name ==>

255+ N.toText name ==>

257256 Encode.object

258− [ "args" ==> Encode.list Encode.text args

257+ [ "args" ==> Encode.list Encode.name args

259258 , "tags" ==> Encode.object (map toCtorObject constructors)

260259 ]

261260

262261

263−toCtorObject :: (Text, [Type]) -> ( Text.Text, Encode.Value )

262+toCtorObject :: (N.Name, [Type]) -> ( Text.Text, Encode.Value )

264263toCtorObject (name, args) =

265− name ==> Encode.list encode args

264+ N.toText name ==> Encode.list encode args

src/Elm/Compiler/Type/Extract.hs+1−2

@@ -12,7 +12,6 @@ module Elm.Compiler.Type.Extract

1212import Data.Map ((!))

1313import qualified Data.Map as Map

1414import qualified Data.Maybe as Maybe

15−import Data.Monoid ((<>))

1615import qualified Data.Set as Set

1716

1817import qualified AST.Canonical as Can

@@ -76,7 +75,7 @@ extract astType =

7675

7776toPublicName :: ModuleName.Canonical -> N.Name -> N.Name

7877toPublicName (ModuleName.Canonical _ home) name =

79− home <> "." <> name

78+ N.sepBy 0x2E {- . -} home name

8079

8180

8281

src/Elm/Docs.hs+11−11

@@ -132,7 +132,7 @@ dictDecoder entryDecoder =

132132named :: D.Decoder Error a -> D.Decoder Error (N.Name, a)

133133named entryDecoder =

134134 (,)

135− <$> D.field "name" D.text

135+ <$> D.field "name" D.name

136136 <*> entryDecoder

137137

138138

@@ -153,9 +153,9 @@ typeDecoder =

153153encodeUnion :: (N.Name, Union) -> E.Value

154154encodeUnion (name, Union comment args cases) =

155155 E.object

156− [ "name" ==> E.text name

156+ [ "name" ==> E.name name

157157 , "comment" ==> E.text comment

158− , "args" ==> E.list E.text args

158+ , "args" ==> E.list E.name args

159159 , "cases" ==> E.list encodeCase cases

160160 ]

161161

@@ -164,19 +164,19 @@ union :: D.Decoder Error Union

164164union =

165165 Union

166166 <$> D.field "comment" D.text

167− <*> D.field "args" (D.list D.text)

167+ <*> D.field "args" (D.list D.name)

168168 <*> D.field "cases" (D.list caseDecoder)

169169

170170

171171encodeCase :: ( N.Name, [Type.Type] ) -> E.Value

172172encodeCase ( tag, args ) =

173− E.list id [ E.text tag, E.list Type.encode args ]

173+ E.list id [ E.name tag, E.list Type.encode args ]

174174

175175

176176caseDecoder :: D.Decoder Error ( N.Name, [Type.Type] )

177177caseDecoder =

178178 (,)

179− <$> D.index 0 D.text

179+ <$> D.index 0 D.name

180180 <*> D.index 1 (D.list typeDecoder)

181181

182182

@@ -187,9 +187,9 @@ caseDecoder =

187187encodeAlias :: (N.Name, Alias) -> E.Value

188188encodeAlias ( name, Alias comment args tipe) =

189189 E.object

190− [ "name" ==> E.text name

190+ [ "name" ==> E.name name

191191 , "comment" ==> E.text comment

192− , "args" ==> E.list E.text args

192+ , "args" ==> E.list E.name args

193193 , "type" ==> Type.encode tipe

194194 ]

195195

@@ -198,7 +198,7 @@ alias :: D.Decoder Error Alias

198198alias =

199199 Alias

200200 <$> D.field "comment" D.text

201− <*> D.field "args" (D.list D.text)

201+ <*> D.field "args" (D.list D.name)

202202 <*> D.field "type" typeDecoder

203203

204204

@@ -209,7 +209,7 @@ alias =

209209encodeValue :: (N.Name, Value) -> E.Value

210210encodeValue (name, Value comment tipe) =

211211 E.object

212− [ "name" ==> E.text name

212+ [ "name" ==> E.name name

213213 , "comment" ==> E.text comment

214214 , "type" ==> Type.encode tipe

215215 ]

@@ -229,7 +229,7 @@ value =

229229encodeBinop :: (N.Name, Binop) -> E.Value

230230encodeBinop (name, Binop comment tipe assoc prec) =

231231 E.object

232− [ "name" ==> E.text name

232+ [ "name" ==> E.name name

233233 , "comment" ==> E.text comment

234234 , "type" ==> Type.encode tipe

235235 , "associativity" ==> encodeAssoc assoc

src/Elm/Kernel.hs+10−12

@@ -10,9 +10,7 @@ module Elm.Kernel

1010import qualified Data.ByteString as B

1111import qualified Data.List as List

1212import qualified Data.Map as Map

13−import Data.Monoid ((<>))

1413import qualified Data.Set as Set

15−import qualified Data.Text as Text

1614import Data.Word (Word8)

1715

1816

@@ -66,7 +64,7 @@ parser importDict =

6664

6765

6866type VarTable =

69− Map.Map Text.Text Opt.KChunk

67+ Map.Map N.Name Opt.KChunk

7068

7169

7270data State =

@@ -83,7 +81,7 @@ addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =

8381 if ModuleName.isKernel home then

8482 case maybeAlias of

8583 Just _ ->

86− error ("Cannot use aliases on kernel import of: " ++ show home)

84+ error ("Cannot use aliases on kernel import of: " ++ N.toString home)

8785

8886 Nothing ->

8987 addKernelImport (ModuleName.getKernel home) exposing state

@@ -98,7 +96,7 @@ addImport importDict state (Src.Import (A.At _ home) maybeAlias exposing) =

9896 addNormalImport canonicalHome prefix exposing state

9997

10098 _ ->

101− error ("Cannot find kernel import of: " ++ show home)

99+ error ("Cannot find kernel import of: " ++ N.toString home)

102100

103101

104102-- INVARIANT: the `home` is the * in `Elm.Kernel.*`

@@ -107,7 +105,7 @@ addKernelImport :: N.Name -> Src.Exposing -> State -> State

107105addKernelImport home exposing (State vtable deps) =

108106 let

109107 addVar table name =

110− Map.insert (home <> "_" <> name) (Opt.JsVar home name) table

108+ Map.insert (N.sepBy 0x5F {- _ -} home name) (Opt.JsVar home name) table

111109 in

112110 State

113111 (List.foldl' addVar vtable (toNames exposing))

@@ -119,7 +117,7 @@ addNormalImport home prefix exposing state =

119117 let

120118 addVar (State vtable deps) name =

121119 State

122− (Map.insert (prefix <> "_" <> name) (Opt.ElmVar home name) vtable)

120+ (Map.insert (N.sepBy 0x5F {- _ -} prefix name) (Opt.ElmVar home name) vtable)

123121 (Set.insert (Opt.Global home name) deps)

124122 in

125123 List.foldl' addVar state (toNames exposing)

@@ -132,8 +130,8 @@ toPrefix home maybeAlias =

132130 alias

133131

134132 Nothing ->

135− if Text.isInfixOf "." home then

136− error ("kernel imports with dots need an alias: " ++ show home)

133+ if N.contains 0x2E {- . -} home then

134+ error ("kernel imports with dots need an alias: " ++ show (N.toString home))

137135 else

138136 home

139137

@@ -187,7 +185,7 @@ chompChunks vtable enums fields chunks =

187185 K.Import var ->

188186 case Map.lookup var vtable of

189187 Nothing ->

190− error ("Bad kernel symbol: " ++ Text.unpack var)

188+ error ("Bad kernel symbol: " ++ N.toString var)

191189

192190 Just chunk ->

193191 chompChunks vtable enums fields $

@@ -213,10 +211,10 @@ chompChunks vtable enums fields chunks =

213211

214212

215213type Fields =

216− Map.Map Text.Text Int

214+ Map.Map N.Name Int

217215

218216

219−lookupField :: Text.Text -> Fields -> (Int, Fields)

217+lookupField :: N.Name -> Fields -> (Int, Fields)

220218lookupField name fields =

221219 case Map.lookup name fields of

222220 Just n ->

src/Elm/Name.hs+88−20

@@ -2,16 +2,28 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Elm.Name

44 ( Name

5+ -- utilities

56 , length

7+ , contains

68 , startsWith

79 , drop

10+ -- conversions

11+ , toText

812 , toString

913 , toBuilder

14+ , toDotlessBuilder

1015 , toShort

16+ -- helpers

1117 , addIndex

1218 , addSafeIndex

1319 , toCompositeName

20+ , sepBy

21+ -- create

1422 , fromForeignPtr

23+ , fromString

24+ , fromLetter

25+ , fromText

26+ -- interned

1527 , int, float, bool, char, string

1628 , maybe, list, array, tuple, jsArray

1729 , task, router, cmd, sub, platform, browser

@@ -23,11 +35,12 @@ module Elm.Name

2335

2436

2537import Prelude hiding (drop, length, maybe, negate)

38+import Data.Binary

2639import qualified Data.ByteString.Builder as B

2740import qualified Data.ByteString.Internal as B

2841import qualified Data.ByteString.Short as S

2942import qualified Data.Char as Char

30−import qualified Data.Set as Set

43+import qualified Data.String as String

3144import qualified Data.Text as Text

3245import qualified Data.Text.Encoding as Text

3346import Data.Word (Word8)

@@ -38,32 +51,52 @@ import Foreign.ForeignPtr (ForeignPtr)

3851-- NAME

3952

4053

41−type Name = Text.Text

54+newtype Name = Name { _name :: Text.Text }

55+ deriving (Eq, Ord)

4256

4357

4458length :: Name -> Int

45−length =

46− Text.length

59+length (Name name) =

60+ Text.length name

61+

62+

63+contains :: Word8 -> Name -> Bool

64+contains word (Name name) =

65+ Text.isInfixOf (Text.singleton (Char.chr (fromIntegral word))) name

4766

4867

4968startsWith :: Name -> Name -> Bool

50−startsWith =

51− Text.isPrefixOf

69+startsWith (Name prefix) (Name name) =

70+ Text.isPrefixOf prefix name

5271

5372

5473drop :: Int -> Name -> Name

55−drop =

56− Text.drop

74+drop numBytes (Name name) =

75+ Name (Text.drop numBytes name)

76+

77+

78+

79+-- CONVERSIONS

80+

81+

82+toText :: Name -> Text.Text

83+toText (Name name) =

84+ name

5785

5886

5987toString :: Name -> String

60−toString =

61− Text.unpack

88+toString (Name name) =

89+ Text.unpack name

6290

6391

6492toBuilder :: Name -> B.Builder

65−toBuilder =

66− Text.encodeUtf8Builder

93+toBuilder (Name name) =

94+ Text.encodeUtf8Builder name

95+

96+

97+toDotlessBuilder :: Name -> B.Builder

98+toDotlessBuilder (Name name) =

99+ Text.encodeUtf8Builder (Text.replace "." "$" name)

67100

68101

69102toShort :: Name -> S.ShortByteString

@@ -72,31 +105,66 @@ toShort name =

72105

73106

74107addIndex :: Name -> Int -> Name

75−addIndex name index =

76− Text.append name (Text.pack (show index))

108+addIndex (Name name) index =

109+ Name (Text.append name (Text.pack (show index)))

77110

78111

79112addSafeIndex :: Name -> Int -> Name

80−addSafeIndex name index =

81− Text.append name $ Text.pack $

113+addSafeIndex (Name name) index =

114+ Name $ Text.append name $ Text.pack $

82115 if Char.isDigit (Text.last name) then

83116 '_' : show index

84117 else

85118 show index

86119

87120

88−toCompositeName :: Set.Set Name -> Name

121+toCompositeName :: [Name] -> Name

89122toCompositeName names =

90− Text.cons '$' (Text.intercalate "$" (Set.toList names))

123+ Name (Text.cons '$' (Text.intercalate "$" (map _name names)))

91124

92125

126+sepBy :: Word8 -> Name -> Name -> Name

127+sepBy sep (Name home) (Name name) =

128+ Name (Text.concat [ home, Text.singleton (Char.chr (fromIntegral sep)), name ])

93129

94−-- FROM PARSER

130+

131+

132+-- CREATE NAMES

95133

96134

97135fromForeignPtr :: ForeignPtr Word8 -> Int -> Int -> Name

98136fromForeignPtr fptr offset len =

99− Text.decodeUtf8 (B.PS fptr offset len)

137+ Name (Text.decodeUtf8 (B.PS fptr offset len))

138+

139+

140+fromString :: String -> Name

141+fromString str =

142+ Name (Text.pack str)

143+

144+

145+{- Takes a letter from 0 to 25 -}

146+fromLetter :: Int -> Name

147+fromLetter letter =

148+ Name (Text.singleton (Char.chr (97 + letter)))

149+

150+

151+fromText :: Text.Text -> Name

152+fromText =

153+ Name

154+

155+

156+

157+-- INSTANCES

158+

159+

160+instance String.IsString Name where

161+ fromString str =

162+ Name (Text.pack str)

163+

164+

165+instance Binary Name where

166+ put (Name name) = put name

167+ get = Name <$> get

100168

101169

102170

src/Generate/JavaScript.hs+7−6

@@ -16,6 +16,7 @@ import Data.Map ((!))

1616import qualified Data.Map as Map

1717import qualified Data.Set as Set

1818import qualified Data.Text as Text

19+import qualified Data.Text.Encoding as Text

1920

2021import qualified AST.Optimized as Opt

2122import qualified AST.Module.Name as ModuleName

@@ -434,7 +435,7 @@ generateExports mode interfaces (Trie maybeMain subs) =

434435 "{}"

435436

436437 (name, subTrie) : otherSubTries ->

437− "{'" <> N.toBuilder name <> "':"

438+ "{'" <> Text.encodeUtf8Builder name <> "':"

438439 <> generateExports mode interfaces subTrie

439440 <> List.foldl' (addSubTrie mode interfaces) "}" otherSubTries

440441 in

@@ -447,9 +448,9 @@ generateExports mode interfaces (Trie maybeMain subs) =

447448 JS.exprToBuilder initialize <> "(" <> object <> ")"

448449

449450

450−addSubTrie :: Name.Mode -> I.Interfaces -> B.Builder -> (N.Name, Trie) -> B.Builder

451+addSubTrie :: Name.Mode -> I.Interfaces -> B.Builder -> (Text.Text, Trie) -> B.Builder

451452addSubTrie mode interfaces end (name, trie) =

452− ",'" <> N.toBuilder name <> "':"

453+ ",'" <> Text.encodeUtf8Builder name <> "':"

453454 <> generateExports mode interfaces trie

454455 <> end

455456

@@ -461,7 +462,7 @@ addSubTrie mode interfaces end (name, trie) =

461462data Trie =

462463 Trie

463464 { _main :: Maybe (ModuleName.Canonical, Opt.Main)

464− , _subs :: Map.Map N.Name Trie

465+ , _subs :: Map.Map Text.Text Trie

465466 }

466467

467468

@@ -472,10 +473,10 @@ emptyTrie =

472473

473474addToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie

474475addToTrie home@(ModuleName.Canonical _ moduleName) main trie =

475− merge trie $ segmentsToTrie home (Text.splitOn "." moduleName) main

476+ merge trie $ segmentsToTrie home (Text.splitOn "." (N.toText moduleName)) main

476477

477478

478−segmentsToTrie :: ModuleName.Canonical -> [N.Name] -> Opt.Main -> Trie

479+segmentsToTrie :: ModuleName.Canonical -> [Text.Text] -> Opt.Main -> Trie

479480segmentsToTrie home segments main =

480481 case segments of

481482 [] ->

src/Generate/JavaScript/Name.hs+1−1

@@ -103,7 +103,7 @@ fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =

103103 Name $

104104 Text.encodeUtf8Builder (Text.replace "-" "_" user)

105105 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way

106− <> "$" <> N.toBuilder (Text.replace "." "$" home)

106+ <> "$" <> N.toDotlessBuilder home

107107 <> "$" <> N.toBuilder name

108108

109109

src/Json/Decode.hs+1−1

@@ -5,7 +5,7 @@ module Json.Decode

55 , Failure(..)

66 -- re-export from Json.Decode.Internals

77 , Json.Decoder, Json.Error(..), Json.Type(..)

8− , Json.string, Json.text, Json.bool, Json.int

8+ , Json.string, Json.text, Json.name, Json.bool, Json.int

99 , Json.list, Json.dict, Json.pairs, Json.maybe

1010 , Json.field, Json.at

1111 , Json.index

src/Json/Decode/Internals.hs+7−2

@@ -5,7 +5,7 @@ module Json.Decode.Internals

55 , Decoder(..)

66 , Error(..)

77 , Type(..)

8− , string, text, bool, int

8+ , string, text, name, bool, int

99 , list, dict, pairs

1010 , maybe

1111 , field, at

@@ -25,10 +25,10 @@ import qualified Data.Scientific as Sci

2525import qualified Data.Text as Text

2626import qualified Data.Vector as Vector

2727import Data.Vector ((!?))

28+import qualified Elm.Name as N

2829import qualified Json.Encode as E

2930

3031

31−

3232-- VALUE

3333

3434

@@ -93,6 +93,11 @@ text =

9393 Left (expecting value TString)

9494

9595

96+name :: Decoder e N.Name

97+name =

98+ N.fromText <$> text

99+

100+

96101bool :: Decoder e Bool

97102bool =

98103 Decoder $ \value ->

src/Json/Encode.hs+20−12

@@ -9,6 +9,7 @@ module Json.Encode

99 , array

1010 , object

1111 , text

12+ , name

1213 , bool

1314 , int

1415 , number

@@ -34,6 +35,8 @@ import qualified Data.Text.Encoding as Text

3435import qualified Data.Word as W

3536import System.IO (IOMode(WriteMode), withBinaryFile)

3637

38+import qualified Elm.Name as N

39+

3740

3841

3942-- VALUES

@@ -42,7 +45,7 @@ import System.IO (IOMode(WriteMode), withBinaryFile)

4245data Value

4346 = Array [Value]

4447 | Object [(Text.Text, Value)]

45− | String Text.Text

48+ | String B.Builder

4649 | Boolean Bool

4750 | Integer Int

4851 | Number Sci.Scientific

@@ -60,8 +63,13 @@ object =

6063

6164

6265text :: Text.Text -> Value

63−text =

64− String

66+text txt =

67+ String (encodeText txt)

68+

69+

70+name :: N.Name -> Value

71+name nm =

72+ String ("\"" <> N.toBuilder nm <> "\"")

6573

6674

6775bool :: Bool -> Value

@@ -142,12 +150,12 @@ encodeUgly value =

142150 Object (first : rest) ->

143151 let

144152 encodeEntry char (key, entry) =

145− B.char7 char <> encodeString key <> B.char7 ':' <> encodeUgly entry

153+ B.char7 char <> encodeText key <> B.char7 ':' <> encodeUgly entry

146154 in

147155 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'

148156

149− String txt ->

150− encodeString txt

157+ String builder ->

158+ builder

151159

152160 Boolean boolean ->

153161 B.string7 (if boolean then "true" else "false")

@@ -186,8 +194,8 @@ encodeHelp indent value =

186194 Object (first : rest) ->

187195 encodeObject indent first rest

188196

189− String txt ->

190− encodeString txt

197+ String builder ->

198+ builder

191199

192200 Boolean boolean ->

193201 B.string7 (if boolean then "true" else "false")

@@ -242,7 +250,7 @@ objectClose =

242250

243251encodeField :: BSC.ByteString -> (Text.Text, Value) -> B.Builder

244252encodeField indent (key, value) =

245− encodeString key <> B.string7 ": " <> encodeHelp indent value

253+ encodeText key <> B.string7 ": " <> encodeHelp indent value

246254

247255

248256

@@ -284,11 +292,11 @@ newline =

284292

285293

286294

287−-- ENCODE STRING

295+-- ENCODE TEXT

288296

289297

290−encodeString :: Text.Text -> B.Builder

291−encodeString txt =

298+encodeText :: Text.Text -> B.Builder

299+encodeText txt =

292300 B.char7 '"' <> Text.encodeUtf8BuilderEscaped escapeAscii txt <> B.char7 '"'

293301

294302

src/Optimize/Module.hs+1−1

@@ -307,7 +307,7 @@ addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph

307307addRecDefs home defs graph =

308308 let

309309 cycleValues = foldr addValueName Set.empty defs

310− dummyName = Opt.Global home (N.toCompositeName cycleValues)

310+ dummyName = Opt.Global home (N.toCompositeName (Set.toList cycleValues))

311311

312312 (deps, fields, State cyclicValuePairs newGraph) =

313313 Names.run $

src/Optimize/Names.hs+1−3

@@ -15,10 +15,8 @@ module Optimize.Names

1515 where

1616

1717

18−import Data.Monoid ((<>))

1918import qualified Data.Map as Map

2019import qualified Data.Set as Set

21−import qualified Data.Text as Text

2220

2321import qualified AST.Canonical as Can

2422import qualified AST.Optimized as Opt

@@ -52,7 +50,7 @@ run (Tracker k) =

5250generate :: Tracker N.Name

5351generate =

5452 Tracker $ \uid deps fields ok ->

55− ok (uid + 1) deps fields ("_n" <> Text.pack (show uid))

53+ ok (uid + 1) deps fields (N.addIndex "_n" uid)

5654

5755

5856registerKernel :: N.Name -> a -> Tracker a

src/Optimize/Port.hs+2−2

@@ -68,7 +68,7 @@ toEncoder tipe =

6868 encodeField (name, fieldType) =

6969 do encoder <- toEncoder fieldType

7070 let value = Opt.Call encoder [Opt.Access (Opt.VarLocal N.dollar) name]

71− return $ Opt.Tuple (Opt.Str name) value Nothing

71+ return $ Opt.Tuple (Opt.Str (N.toText name)) value Nothing

7272 in

7373 do object <- encode "object"

7474 keyValuePairs <- traverse encodeField (Map.toList fields)

@@ -305,7 +305,7 @@ fieldAndThen decoder (key, tipe) =

305305 return $

306306 Opt.Call andThen

307307 [ Opt.Function [key] decoder

308− , Opt.Call field [ Opt.Str key, typeDecoder ]

308+ , Opt.Call field [ Opt.Str (N.toText key), typeDecoder ]

309309 ]

310310

311311

src/Parse/Declaration.hs+5−5

@@ -7,11 +7,11 @@ module Parse.Declaration

77 where

10−import Data.Text (Text)

1110import qualified Data.Text.Encoding as Text

1211

1312import qualified AST.Source as Src

1413import qualified AST.Utils.Binop as Binop

14+import qualified Elm.Name as N

1515import qualified Parse.Expression as Expr

1616import qualified Parse.Pattern as Pattern

1717import Parse.Primitives

@@ -77,7 +77,7 @@ def_ start =

7777 ]

7878

7979

80−definitionHelp :: R.Position -> A.Located Text -> [Src.Pattern] -> SParser Src.Decl

80+definitionHelp :: R.Position -> A.Located N.Name -> [Src.Pattern] -> SParser Src.Decl

8181definitionHelp start name revArgs =

8282 oneOf

8383 [ do arg <- hint E.Arg Pattern.term

@@ -115,14 +115,14 @@ type_ start =

115115 ]

116116

117117

118−nameArgsEquals :: Parser (A.Located Text, [A.Located Text])

118+nameArgsEquals :: Parser (A.Located N.Name, [A.Located N.Name])

119119nameArgsEquals =

120120 do name <- addLocation Var.upper

121121 spaces

122122 nameArgsEqualsHelp name []

123123

124124

125−nameArgsEqualsHelp :: A.Located Text -> [A.Located Text] -> Parser (A.Located Text, [A.Located Text])

125+nameArgsEqualsHelp :: A.Located N.Name -> [A.Located N.Name] -> Parser (A.Located N.Name, [A.Located N.Name])

126126nameArgsEqualsHelp name args =

127127 oneOf

128128 [ do arg <- addLocation Var.lower

@@ -134,7 +134,7 @@ nameArgsEqualsHelp name args =

134134 ]

135135

136136

137−chompConstructors :: [(A.Located Text, [Src.Type])] -> R.Position -> SPos -> SParser [(A.Located Text, [Src.Type])]

137+chompConstructors :: [(A.Located N.Name, [Src.Type])] -> R.Position -> SPos -> SParser [(A.Located N.Name, [Src.Type])]

138138chompConstructors ctors end pos =

139139 oneOf

140140 [ do checkSpace pos

src/Parse/Module.hs+4−5

@@ -9,7 +9,6 @@ module Parse.Module

1010

1111import qualified Data.ByteString as B

12−import Data.Text (Text)

1312

1413import qualified AST.Source as Src

1514import qualified Elm.Compiler.Imports as Imports

@@ -137,7 +136,7 @@ chompManager =

137136 ]

138137

139138

140−chompCommand :: Parser (A.Located Text)

139+chompCommand :: Parser (A.Located N.Name)

141140chompCommand =

142141 do Keyword.command_

143142 P.spaces

@@ -146,7 +145,7 @@ chompCommand =

146145 P.addLocation Var.upper

147146

148147

149−chompSubscription :: Parser (A.Located Text)

148+chompSubscription :: Parser (A.Located N.Name)

150149chompSubscription =

151150 do Keyword.subscription_

152151 P.spaces

@@ -200,7 +199,7 @@ chompImports imports =

200199 ]

201200

202201

203−chompAs :: A.Located Text -> [Src.Import] -> Parser [Src.Import]

202+chompAs :: A.Located N.Name -> [Src.Import] -> Parser [Src.Import]

204203chompAs name imports =

205204 do Keyword.as_

206205 P.spaces

@@ -216,7 +215,7 @@ chompAs name imports =

216215 ]

217216

218217

219−chompExposing :: A.Located Text -> Maybe Text -> [Src.Import] -> Parser [Src.Import]

218+chompExposing :: A.Located N.Name -> Maybe N.Name -> [Src.Import] -> Parser [Src.Import]

220219chompExposing name maybeAlias imports =

221220 do Keyword.exposing_

222221 P.spaces

src/Parse/Primitives/Kernel.hs+3−4

@@ -9,7 +9,6 @@ module Parse.Primitives.Kernel

1010import Prelude hiding (length)

1111import qualified Data.ByteString.Internal as B

12−import Data.Text (Text)

1312import Data.Word (Word8)

1413import Foreign.ForeignPtr (ForeignPtr)

1514

@@ -24,11 +23,11 @@ import qualified Parse.Primitives.Variable as Var

2423

2524

2625data Special

27− = Enum Word8 Text

26+ = Enum Word8 N.Name

2827 | Prod

2928 | Debug

30− | Import Text

31− | JsField Text

29+ | Import N.Name

30+ | JsField N.Name

3231 | ElmField N.Name

3332

3433

src/Parse/Primitives/Shader.hs+3−2

@@ -7,11 +7,12 @@ module Parse.Primitives.Shader

77 where

10+import qualified Data.ByteString.Internal as B

1011import qualified Data.Text as Text

12+import qualified Data.Text.Encoding as Text

1113import Foreign.ForeignPtr (ForeignPtr)

1214import GHC.Word (Word8)

1315

14−import qualified Elm.Name as N

1516import Parse.Primitives.Internals (Parser(..), State(..), noError)

1617import qualified Parse.Primitives.Internals as I

1718import qualified Parse.Primitives.Symbol as Symbol

@@ -39,7 +40,7 @@ block =

3940 Ok newOffset newRow newCol ->

4041 let

4142 !size = newOffset - offset

42− !shader = N.fromForeignPtr fp offset size

43+ !shader = Text.decodeUtf8 (B.PS fp offset size)

4344 !newState = State fp (newOffset + 2) terminal indent newRow newCol ctx

4445 in

4546 cok shader newState noError

src/Parse/Primitives/Symbol.hs+1−2

@@ -17,7 +17,6 @@ import qualified Data.ByteString.Char8 as Char8

1717import qualified Data.Char as Char

1818import qualified Data.IntSet as IntSet

1919import qualified Data.Vector as Vector

20−import Data.Text (Text)

2120import Foreign.ForeignPtr (ForeignPtr)

2221import GHC.Word (Word8)

2322

@@ -55,7 +54,7 @@ underscore =

5554-- BINOP

5655

5756

58−binop :: Parser Text

57+binop :: Parser N.Name

5958binop =

6059 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->

6160 let !newOffset = chompOps fp offset terminal in

src/Parse/Primitives/Variable.hs+4−5

@@ -18,7 +18,6 @@ import Control.Exception (assert)

1818import Data.Bits ((.&.), (.|.), shiftL)

1919import qualified Data.Char as Char

2020import qualified Data.Set as Set

21−import Data.Text (Text)

2221import Foreign.ForeignPtr (ForeignPtr)

2322import GHC.Word (Word8)

2423

@@ -32,7 +31,7 @@ import qualified Reporting.Error.Syntax as E

3231-- LOCAL UPPER

3332

3433

35−upper :: Parser Text

34+upper :: Parser N.Name

3635upper =

3736 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->

3837 let (# newOffset, newCol #) = chompUpper fp offset terminal col in

@@ -47,7 +46,7 @@ upper =

4746-- LOCAL LOWER

4847

4948

50−lower :: Parser Text

49+lower :: Parser N.Name

5150lower =

5251 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->

5352 let (# newOffset, newCol #) = chompLower fp offset terminal col in

@@ -62,7 +61,7 @@ lower =

6261

6362

6463{-# NOINLINE reservedWords #-}

65−reservedWords :: Set.Set Text

64+reservedWords :: Set.Set N.Name

6665reservedWords =

6766 Set.fromList

6867 [ "if", "then", "else"

@@ -80,7 +79,7 @@ reservedWords =

8079-- MODULE NAME

8180

8281

83−moduleName :: Parser Text

82+moduleName :: Parser N.Name

8483moduleName =

8584 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->

8685 let (# newOffset, newCol #) = chompUpper fp offset terminal col in

src/Parse/Shader.hs+15−20

@@ -15,6 +15,7 @@ import qualified Text.Parsec.Error as Parsec

1515

1616import qualified AST.Source as Src

1717import qualified AST.Utils.Shader as Shader

18+import qualified Elm.Name as N

1819import qualified Reporting.Annotation as A

1920import qualified Reporting.Region as R

2021import Parse.Primitives (Parser, getPosition)

@@ -65,22 +66,16 @@ emptyShader =

6566 Shader.Shader Map.empty Map.empty Map.empty

6667

6768

68−addInput :: (GLS.StorageQualifier, Shader.Type, Text.Text) -> Shader.Shader -> Shader.Shader

69−addInput ( qual, tipe, name ) glDecls =

69+addInput :: (GLS.StorageQualifier, Shader.Type, String) -> Shader.Shader -> Shader.Shader

70+addInput (qual, tipe, name) glDecls =

7071 case qual of

71− GLS.Attribute ->

72− glDecls { Shader._attribute = Map.insert name tipe (Shader._attribute glDecls) }

72+ GLS.Attribute -> glDecls { Shader._attribute = Map.insert (N.fromString name) tipe (Shader._attribute glDecls) }

73+ GLS.Uniform -> glDecls { Shader._uniform = Map.insert (N.fromString name) tipe (Shader._uniform glDecls) }

74+ GLS.Varying -> glDecls { Shader._varying = Map.insert (N.fromString name) tipe (Shader._varying glDecls) }

75+ _ -> error "Should never happen due to `extractInputs` function"

7376

74− GLS.Uniform ->

75− glDecls { Shader._uniform = Map.insert name tipe (Shader._uniform glDecls) }

7677

77− GLS.Varying ->

78− glDecls { Shader._varying = Map.insert name tipe (Shader._varying glDecls) }

79−

80− _ -> error "Should never happen due to below filter"

81−

82−

83−extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, Text.Text)]

78+extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, String)]

8479extractInputs decl =

8580 case decl of

8681 GLS.Declaration

@@ -95,12 +90,12 @@ extractInputs decl =

9590 False -> []

9691 True ->

9792 case tipe of

98− GLS.Vec2 -> [(qual, Shader.V2, Text.pack name)]

99− GLS.Vec3 -> [(qual, Shader.V3, Text.pack name)]

100− GLS.Vec4 -> [(qual, Shader.V4, Text.pack name)]

101− GLS.Mat4 -> [(qual, Shader.M4, Text.pack name)]

102− GLS.Int -> [(qual, Shader.Int, Text.pack name)]

103− GLS.Float -> [(qual, Shader.Float, Text.pack name)]

104− GLS.Sampler2D -> [(qual, Shader.Texture, Text.pack name)]

93+ GLS.Vec2 -> [(qual, Shader.V2, name)]

94+ GLS.Vec3 -> [(qual, Shader.V3, name)]

95+ GLS.Vec4 -> [(qual, Shader.V4, name)]

96+ GLS.Mat4 -> [(qual, Shader.M4, name)]

97+ GLS.Int -> [(qual, Shader.Int, name)]

98+ GLS.Float -> [(qual, Shader.Float, name)]

99+ GLS.Sampler2D -> [(qual, Shader.Texture, name)]

105100 _ -> []

106101 _ -> []

src/Parse/Type.hs+3−5

@@ -7,15 +7,13 @@ module Parse.Type

77 where

10−import Data.Text (Text)

11−

1210import qualified AST.Source as Src

11+import qualified Elm.Name as N

1312import Parse.Primitives (Parser, SParser, addLocation, checkSpace, getPosition, hint, spaces, oneOf)

1413import qualified Parse.Primitives as P

1514import qualified Parse.Primitives.Symbol as Symbol

1615import qualified Parse.Primitives.Variable as Var

1716import Parse.Primitives.Whitespace (SPos, whitespace)

18−

1917import qualified Reporting.Annotation as A

2018import qualified Reporting.Error.Syntax as E

2119import qualified Reporting.Region as R

@@ -110,7 +108,7 @@ app start =

110108 return ( A.at start end tipe, end, pos )

111109

112110

113−unionConstructor :: SParser (A.Located Text, [Src.Type])

111+unionConstructor :: SParser (A.Located N.Name, [Src.Type])

114112unionConstructor =

115113 do start <- getPosition

116114 name <- Var.upper

@@ -204,7 +202,7 @@ record start =

204202 ]

205203

206204

207−type Field = ( A.Located Text, Src.Type )

205+type Field = ( A.Located N.Name, Src.Type )

208206

209207

210208chompFields :: [Field] -> Parser [Field]

src/Type/Type.hs+2−7

@@ -29,10 +29,8 @@ module Type.Type

2929

3030import Control.Monad.State.Strict (StateT, liftIO)

3131import qualified Control.Monad.State.Strict as State

32−import qualified Data.Char as Char

3332import Data.Foldable (foldrM)

3433import qualified Data.Map.Strict as Map

35−import qualified Data.Text as Text

3634import Data.Word (Word32)

3735

3836import qualified AST.Canonical as Can

@@ -469,11 +467,8 @@ getFreshNormal index taken =

469467 (postfix, letter) =

470468 quotRem index 26

471469

472− character =

473− Char.chr (97 + letter)

474−

475− name =

476− Text.pack (if postfix <= 0 then [character] else character : show postfix)

470+ chr = N.fromLetter letter

471+ name = if postfix <= 0 then chr else N.addIndex chr postfix

477472 in

478473 if Map.member name taken then

479474 getFreshNormal (index + 1) taken

src/Validate.hs+1−1

@@ -289,7 +289,7 @@ definitions sourceDefs =

289289 Result.throw (Error.TypeWithoutDefinition annRegion annotationName)

290290

291291

292−validateDefinition :: R.Region -> A.Located Text -> [Src.Pattern] -> Src.Expr -> Maybe Src.Type -> Result i w Valid.Def

292+validateDefinition :: R.Region -> A.Located N.Name -> [Src.Pattern] -> Src.Expr -> Maybe Src.Type -> Result i w Valid.Def

293293validateDefinition region name args expr maybeType =

294294 do validExpr <- expression expr

295295 return $ Valid.Define region name args validExpr maybeType