git.iko.soy/elk
on master help sign in
Just use ByteStrings in Elm.Kernel instead of some Utf8 type
2975803Evan Czaplicki
compiler/src/Elm/Kernel.hs+40−38
compare with master
unifiedsplit
@@ -11,14 +11,14 @@ module Elm.Kernel
11
11
12import Control.Monad (liftM, liftM2)
12import Control.Monad (liftM, liftM2)
13import Data.Binary (Binary, get, put, getWord8, putWord8)
13import Data.Binary (Binary, get, put, getWord8, putWord8)
14−import qualified Data.ByteString as BS
14+import qualified Data.ByteString.Internal as B
15−import Data.Coerce (coerce)
16import qualified Data.List as List
15import qualified Data.List as List
17import qualified Data.Map as Map
16import qualified Data.Map as Map
18import qualified Data.Name as Name
17import qualified Data.Name as Name
19−import qualified Data.Utf8 as Utf8
20import Data.Word (Word8, Word16)
18import Data.Word (Word8, Word16)
21−import Foreign.Ptr (Ptr, plusPtr)
19+import Foreign.Ptr (Ptr, plusPtr, minusPtr)
20+import Foreign.ForeignPtr (ForeignPtr)
21+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
22
22
23import qualified AST.Source as Src
23import qualified AST.Source as Src
24import qualified Elm.ModuleName as ModuleName
24import qualified Elm.ModuleName as ModuleName
@@ -36,7 +36,7 @@ import qualified Reporting.Annotation as A
36
36
37
37
38data Chunk
38data Chunk
39− = JS (Utf8.VeryLong UNCHECKED)
39+ = JS B.ByteString
40 | ElmVar ModuleName.Canonical Name.Name
40 | ElmVar ModuleName.Canonical Name.Name
41 | JsVar Name.Name Name.Name
41 | JsVar Name.Name Name.Name
42 | ElmField Name.Name
42 | ElmField Name.Name
@@ -46,9 +46,6 @@ data Chunk
46 | Prod
46 | Prod
47
47
48
48
49−data UNCHECKED
50−
51−
52
49
53-- COUNT FIELDS
50-- COUNT FIELDS
54
51
@@ -83,13 +80,13 @@ type Foreigns =
83 Map.Map ModuleName.Raw Pkg.Name
80 Map.Map ModuleName.Raw Pkg.Name
84
81
85
82
86−fromByteString :: Pkg.Name -> Foreigns -> BS.ByteString -> Maybe Content
83+fromByteString :: Pkg.Name -> Foreigns -> B.ByteString -> Maybe Content
87fromByteString pkg foreigns bytes =
84fromByteString pkg foreigns bytes =
88− case P.fromByteString (parser pkg foreigns) bytes of
85+ case P.fromByteString (parser pkg foreigns) toError bytes of
89− P.Ok content _ ->
86+ Right content ->
90 Just content
87 Just content
91
88
92− P.Err () ->
89+ Left () ->
93 Nothing
90 Nothing
94
91
95
92
@@ -120,21 +117,21 @@ ignoreError _ _ _ =
120
117
121parseChunks :: VarTable -> Enums -> Fields -> Parser () [Chunk]
118parseChunks :: VarTable -> Enums -> Fields -> Parser () [Chunk]
122parseChunks vtable enums fields =
119parseChunks vtable enums fields =
123− P.Parser $ \(P.State pos end indent row col) cok _ cerr _ ->
120+ P.Parser $ \(P.State src pos end indent row col) cok _ cerr _ ->
124 let
121 let
125 (# chunks, newPos, newRow, newCol #) =
122 (# chunks, newPos, newRow, newCol #) =
126− chompChunks vtable enums fields pos end row col pos []
123+ chompChunks vtable enums fields src pos end row col pos []
127 in
124 in
128 if newPos == end then
125 if newPos == end then
129− cok chunks (P.State newPos end indent newRow newCol)
126+ cok chunks (P.State src newPos end indent newRow newCol)
130 else
127 else
131 cerr row col toError
128 cerr row col toError
132
129
133
130
134−chompChunks :: VarTable -> Enums -> Fields -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
131+chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
135−chompChunks vs es fs pos end row col lastPos revChunks =
132+chompChunks vs es fs src pos end row col lastPos revChunks =
136 if pos >= end then
133 if pos >= end then
137− let !js = Utf8.fromPtr lastPos end in
134+ let !js = toByteString src lastPos end in
138 (# reverse (JS js : revChunks), pos, row, col #)
135 (# reverse (JS js : revChunks), pos, row, col #)
139
136
140 else
137 else
@@ -145,24 +142,34 @@ chompChunks vs es fs pos end row col lastPos revChunks =
145 !pos3 = plusPtr pos 3
142 !pos3 = plusPtr pos 3
146 in
143 in
147 if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then
144 if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then
148− let !js = Utf8.fromPtr lastPos pos in
145+ let !js = toByteString src lastPos pos in
149− chompTag vs es fs pos3 end row (col + 3) (JS js : revChunks)
146+ chompTag vs es fs src pos3 end row (col + 3) (JS js : revChunks)
150 else
147 else
151− chompChunks vs es fs pos1 end row (col + 1) lastPos revChunks
148+ chompChunks vs es fs src pos1 end row (col + 1) lastPos revChunks
152
149
153 else if word == 0x0A {-\n-} then
150 else if word == 0x0A {-\n-} then
154− chompChunks vs es fs (plusPtr pos 1) end (row + 1) 1 lastPos revChunks
151+ chompChunks vs es fs src (plusPtr pos 1) end (row + 1) 1 lastPos revChunks
155
152
156 else
153 else
157 let
154 let
158 !newPos = plusPtr pos (getCharWidth pos end word)
155 !newPos = plusPtr pos (getCharWidth pos end word)
159 in
156 in
160− chompChunks vs es fs newPos end row (col + 1) lastPos revChunks
157+ chompChunks vs es fs src newPos end row (col + 1) lastPos revChunks
158+
159+
160+toByteString :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> B.ByteString
161+toByteString src pos end =
162+ let
163+ !off = minusPtr pos (unsafeForeignPtrToPtr src)
164+ !len = minusPtr end pos
165+ in
166+ B.PS src off len
167+
161
168
162
169
163-- relies on external checks in chompChunks
170-- relies on external checks in chompChunks
164−chompTag :: VarTable -> Enums -> Fields -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
171+chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
165−chompTag vs es fs pos end row col revChunks =
172+chompTag vs es fs src pos end row col revChunks =
166 let
173 let
167 (# newPos, newCol #) = Var.chompInnerChars pos end col
174 (# newPos, newCol #) = Var.chompInnerChars pos end col
168 !tagPos = plusPtr pos (-1)
175 !tagPos = plusPtr pos (-1)
@@ -172,7 +179,7 @@ chompTag vs es fs pos end row col revChunks =
172 let
179 let
173 !name = Name.fromPtr pos newPos
180 !name = Name.fromPtr pos newPos
174 in
181 in
175− chompChunks vs es fs newPos end row newCol newPos $
182+ chompChunks vs es fs src newPos end row newCol newPos $
176 ElmField name : revChunks
183 ElmField name : revChunks
177 else
184 else
178 let
185 let
@@ -183,7 +190,7 @@ chompTag vs es fs pos end row col revChunks =
183 (enum, newEnums) =
190 (enum, newEnums) =
184 lookupEnum (word - 0x30) name es
191 lookupEnum (word - 0x30) name es
185 in
192 in
186− chompChunks vs newEnums fs newPos end row newCol newPos $
193+ chompChunks vs newEnums fs src newPos end row newCol newPos $
187 JsEnum enum : revChunks
194 JsEnum enum : revChunks
188
195
189 else if 0x61 {-a-} <= word && word <= 0x7A {-z-} then
196 else if 0x61 {-a-} <= word && word <= 0x7A {-z-} then
@@ -191,19 +198,19 @@ chompTag vs es fs pos end row col revChunks =
191 (field, newFields) =
198 (field, newFields) =
192 lookupField name fs
199 lookupField name fs
193 in
200 in
194− chompChunks vs es newFields newPos end row newCol newPos $
201+ chompChunks vs es newFields src newPos end row newCol newPos $
195 JsField field : revChunks
202 JsField field : revChunks
196
203
197 else if name == "DEBUG" then
204 else if name == "DEBUG" then
198− chompChunks vs es fs newPos end row newCol newPos (Debug : revChunks)
205+ chompChunks vs es fs src newPos end row newCol newPos (Debug : revChunks)
199
206
200 else if name == "PROD" then
207 else if name == "PROD" then
201− chompChunks vs es fs newPos end row newCol newPos (Prod : revChunks)
208+ chompChunks vs es fs src newPos end row newCol newPos (Prod : revChunks)
202
209
203 else
210 else
204 case Map.lookup name vs of
211 case Map.lookup name vs of
205 Just chunk ->
212 Just chunk ->
206− chompChunks vs es fs newPos end row newCol newPos (chunk : revChunks)
213+ chompChunks vs es fs src newPos end row newCol newPos (chunk : revChunks)
207
214
208 Nothing ->
215 Nothing ->
209 (# revChunks, pos, row, col #)
216 (# revChunks, pos, row, col #)
@@ -335,7 +342,7 @@ toName (A.At _ exposed) =
335instance Binary Chunk where
342instance Binary Chunk where
336 put chunk =
343 put chunk =
337 case chunk of
344 case chunk of
338− JS a -> putWord8 0 >> put (coerce a :: Utf8.String)
345+ JS a -> putWord8 0 >> put a
339 ElmVar a b -> putWord8 1 >> put a >> put b
346 ElmVar a b -> putWord8 1 >> put a >> put b
340 JsVar a b -> putWord8 2 >> put a >> put b
347 JsVar a b -> putWord8 2 >> put a >> put b
341 ElmField a -> putWord8 3 >> put a
348 ElmField a -> putWord8 3 >> put a
@@ -347,7 +354,7 @@ instance Binary Chunk where
347 get =
354 get =
348 do word <- getWord8
355 do word <- getWord8
349 case word of
356 case word of
350− 0 -> liftM toJS get
357+ 0 -> liftM JS get
351 1 -> liftM2 ElmVar get get
358 1 -> liftM2 ElmVar get get
352 2 -> liftM2 JsVar get get
359 2 -> liftM2 JsVar get get
353 3 -> liftM ElmField get
360 3 -> liftM ElmField get
@@ -356,8 +363,3 @@ instance Binary Chunk where
356 6 -> return Debug
363 6 -> return Debug
357 7 -> return Prod
364 7 -> return Prod
358 _ -> error "problem deserializing Elm.Kernel.Chunk"
365 _ -> error "problem deserializing Elm.Kernel.Chunk"
359−
360−
361−toJS :: Utf8.String -> Chunk
362−toJS str =
363− JS (coerce str)