@@ -11,14 +11,14 @@ module Elm.Kernel
1111
1212import Control.Monad (liftM, liftM2)
1313import Data.Binary (Binary, get, put, getWord8, putWord8)
14−import qualified Data.ByteString as BS
15−import Data.Coerce (coerce)
14+import qualified Data.ByteString.Internal as B
1615import qualified Data.List as List
1716import qualified Data.Map as Map
1817import qualified Data.Name as Name
19−import qualified Data.Utf8 as Utf8
2018import 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)
2222
2323import qualified AST.Source as Src
2424import qualified Elm.ModuleName as ModuleName
@@ -36,7 +36,7 @@ import qualified Reporting.Annotation as A
3636
3737
3838data Chunk
39− = JS (Utf8.VeryLong UNCHECKED)
39+ = JS B.ByteString
4040 | ElmVar ModuleName.Canonical Name.Name
4141 | JsVar Name.Name Name.Name
4242 | ElmField Name.Name
@@ -46,9 +46,6 @@ data Chunk
4646 | Prod
4747
4848
49−data UNCHECKED
50−
51−
5249
5350-- COUNT FIELDS
5451
@@ -83,13 +80,13 @@ type Foreigns =
8380 Map.Map ModuleName.Raw Pkg.Name
8481
8582
86−fromByteString :: Pkg.Name -> Foreigns -> BS.ByteString -> Maybe Content
83+fromByteString :: Pkg.Name -> Foreigns -> B.ByteString -> Maybe Content
8784fromByteString pkg foreigns bytes =
88− case P.fromByteString (parser pkg foreigns) bytes of
89− P.Ok content _ ->
85+ case P.fromByteString (parser pkg foreigns) toError bytes of
86+ Right content ->
9087 Just content
9188
92− P.Err () ->
89+ Left () ->
9390 Nothing
9491
9592
@@ -120,21 +117,21 @@ ignoreError _ _ _ =
120117
121118parseChunks :: VarTable -> Enums -> Fields -> Parser () [Chunk]
122119parseChunks 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 _ ->
124121 let
125122 (# 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 []
127124 in
128125 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)
130127 else
131128 cerr row col toError
132129
133130
134−chompChunks :: VarTable -> Enums -> Fields -> 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 =
131+chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
132+chompChunks vs es fs src pos end row col lastPos revChunks =
136133 if pos >= end then
137− let !js = Utf8.fromPtr lastPos end in
134+ let !js = toByteString src lastPos end in
138135 (# reverse (JS js : revChunks), pos, row, col #)
139136
140137 else
@@ -145,24 +142,34 @@ chompChunks vs es fs pos end row col lastPos revChunks =
145142 !pos3 = plusPtr pos 3
146143 in
147144 if pos3 <= end && unsafeIndex pos1 == 0x5F {-_-} then
148− let !js = Utf8.fromPtr lastPos pos in
149− chompTag vs es fs pos3 end row (col + 3) (JS js : revChunks)
145+ let !js = toByteString src lastPos pos in
146+ chompTag vs es fs src pos3 end row (col + 3) (JS js : revChunks)
150147 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
152149
153150 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
155152
156153 else
157154 let
158155 !newPos = plusPtr pos (getCharWidth pos end word)
159156 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+
161168
162169
163170-- relies on external checks in chompChunks
164−chompTag :: VarTable -> Enums -> Fields -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
165−chompTag vs es fs pos end row col revChunks =
171+chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
172+chompTag vs es fs src pos end row col revChunks =
166173 let
167174 (# newPos, newCol #) = Var.chompInnerChars pos end col
168175 !tagPos = plusPtr pos (-1)
@@ -172,7 +179,7 @@ chompTag vs es fs pos end row col revChunks =
172179 let
173180 !name = Name.fromPtr pos newPos
174181 in
175− chompChunks vs es fs newPos end row newCol newPos $
182+ chompChunks vs es fs src newPos end row newCol newPos $
176183 ElmField name : revChunks
177184 else
178185 let
@@ -183,7 +190,7 @@ chompTag vs es fs pos end row col revChunks =
183190 (enum, newEnums) =
184191 lookupEnum (word - 0x30) name es
185192 in
186− chompChunks vs newEnums fs newPos end row newCol newPos $
193+ chompChunks vs newEnums fs src newPos end row newCol newPos $
187194 JsEnum enum : revChunks
188195
189196 else if 0x61 {-a-} <= word && word <= 0x7A {-z-} then
@@ -191,19 +198,19 @@ chompTag vs es fs pos end row col revChunks =
191198 (field, newFields) =
192199 lookupField name fs
193200 in
194− chompChunks vs es newFields newPos end row newCol newPos $
201+ chompChunks vs es newFields src newPos end row newCol newPos $
195202 JsField field : revChunks
196203
197204 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)
199206
200207 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)
202209
203210 else
204211 case Map.lookup name vs of
205212 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)
207214
208215 Nothing ->
209216 (# revChunks, pos, row, col #)
@@ -335,7 +342,7 @@ toName (A.At _ exposed) =
335342instance Binary Chunk where
336343 put chunk =
337344 case chunk of
338− JS a -> putWord8 0 >> put (coerce a :: Utf8.String)
345+ JS a -> putWord8 0 >> put a
339346 ElmVar a b -> putWord8 1 >> put a >> put b
340347 JsVar a b -> putWord8 2 >> put a >> put b
341348 ElmField a -> putWord8 3 >> put a
@@ -347,7 +354,7 @@ instance Binary Chunk where
347354 get =
348355 do word <- getWord8
349356 case word of
350− 0 -> liftM toJS get
357+ 0 -> liftM JS get
351358 1 -> liftM2 ElmVar get get
352359 2 -> liftM2 JsVar get get
353360 3 -> liftM ElmField get
@@ -356,8 +363,3 @@ instance Binary Chunk where
356363 6 -> return Debug
357364 7 -> return Prod
358365 _ -> error "problem deserializing Elm.Kernel.Chunk"
359−
360−
361−toJS :: Utf8.String -> Chunk
362−toJS str =
363− JS (coerce str)