@@ -1,278 +1,537 @@
1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2−{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
1+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}
2+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, UnboxedTuples #-}
33module Json.Decode
4− ( parse
5− -- re-export from Json.Decode.Internals
6− , Json.Decoder
7− , Json.string, Json.text, Json.name, Json.bool, Json.int
8− , Json.list, Json.dict, Json.pairs, Json.maybe
9− , Json.field, Json.at
10− , Json.pair
11− , Json.map, Json.map2, Json.mapError
12− , Json.succeed, Json.fail
13− , Json.andThen, Json.oneOf
4+ ( fromByteString
5+ , fromFile
6+ , Decoder
7+ , string
8+ , bool
9+ , int
10+ , list, pair
11+ , dict, pairs, field
12+ , oneOf
13+ , failure
14+ , mapError
1415 )
1516 where
1617
1718
18−import Prelude hiding (length)
19−import qualified Data.ByteString.Char8 as Char8
20−import qualified Data.ByteString.Internal as B
21−import qualified Data.Text as Text
22−import qualified Data.Text.Encoding as Text
23−import Foreign.ForeignPtr (ForeignPtr)
24−import GHC.Word (Word8(..))
19+import qualified Data.ByteString as B
20+import qualified Data.List as List
21+import qualified Data.Map as Map
22+import qualified Data.Utf8 as Utf8
23+import Data.Word (Word8, Word16)
24+import Foreign.Ptr (Ptr, plusPtr, minusPtr)
2525
26−import qualified Json.Decode.Error as DecodeError
27−import qualified Json.Decode.Internals as Json
26+import qualified Parse.Keyword as K
2827import qualified Parse.Primitives as P
29−import qualified Parse.Primitives.Internals as I
30−import Parse.Primitives.Internals (Parser(..), State(..), noError)
31−import qualified Parse.Primitives.Keyword as Keyword
32−import qualified Parse.Primitives.Number as Number
33−import qualified Parse.Primitives.Symbol as Symbol
34−import qualified Reporting.Doc as D
35−import qualified Reporting.Error.Syntax as E
36−import qualified Reporting.Region as R
37−import qualified Reporting.Render.Code as Code
28+import qualified Reporting.Error.Json as E
3829
3930
4031
41−-- PARSE
32+-- RUNNERS
4233
4334
44−parse :: String -> (e -> [D.Doc]) -> Json.Decoder e a -> B.ByteString -> Either D.Doc a
45−parse rootName userErrorToDocs (Json.Decoder run) bytestring =
46− let
47− source =
48− Code.toSource (Text.replace "\t" " " (Text.decodeUtf8 bytestring))
35+fromByteString :: Decoder e a -> B.ByteString -> Either (E.Error e) a
36+fromByteString decoder src =
37+ fromAST decoder (P.fromByteString pFile src)
4938
50− toDoc err =
51− DecodeError.toDoc rootName source userErrorToDocs err
52− in
53− case P.run jsonFile bytestring of
54− Left err ->
55− Left (toDoc (DecodeError.BadJson err))
5639
57− Right value ->
58− case run value of
59− Left err ->
60− Left (toDoc (DecodeError.BadContent err))
40+fromFile :: Decoder e a -> FilePath -> IO (Either (E.Error e) a)
41+fromFile decoder path =
42+ fromAST decoder <$> P.fromFile pFile path
6143
62− Right answer ->
63− Right answer
6444
45+fromAST :: Decoder e a -> P.Result E.Context E.ParseExpectation AST -> Either (E.Error e) a
46+fromAST (Decoder decode) parserResult =
47+ case parserResult of
48+ P.Ok ast _ ->
49+ decode ast Right (Left . E.DecodeProblem)
6550
51+ P.Err row col ctx expectation ->
52+ Left (E.ParseProblem row col ctx expectation)
6653
67−-- JSON
6854
6955
70−jsonFile :: Parser Json.Value
71−jsonFile =
72− do spaces
73− value <- jsonValue
74− spaces
75− P.endOfFile
76− return value
56+-- DECODERS
7757
7858
79−jsonValue :: Parser Json.Value
80−jsonValue =
81− do start <- P.getPosition
82− I.oneOf
83− [ Json.String <$> string
84− , object start
85− , array start
86− , number
87− , Keyword.jsonTrue >> return Json.TRUE
88− , Keyword.jsonFalse >> return Json.FALSE
89− , Keyword.jsonNull >> return Json.NULL
90− ]
59+newtype Decoder e a =
60+ Decoder (forall b. AST -> (a -> b) -> (E.Problem e -> b) -> b)
9161
9262
9363
94−-- OBJECT
64+-- INSTANCES
9565
9666
97−object :: R.Position -> Parser Json.Value
98−object start =
99− do Symbol.leftCurly
100− P.inContext start E.ExprRecord $
101− do spaces
102− I.oneOf
103− [ do entry <- field
104− spaces
105− objectHelp [entry]
106− , do Symbol.rightCurly
107− return (Json.Object [])
108− ]
67+instance Functor (Decoder e) where
68+ {-# INLINE fmap #-}
69+ fmap func (Decoder decodeA) =
70+ Decoder $ \ast ok err ->
71+ let
72+ ok' a = ok (func a)
73+ in
74+ decodeA ast ok' err
10975
11076
111−objectHelp :: [(Text.Text, Json.Value)] -> Parser Json.Value
112−objectHelp revEntries =
113− I.oneOf
114− [
115− do Symbol.comma
116− spaces
117− entry <- field
118− spaces
119− objectHelp (entry:revEntries)
120− ,
121− do Symbol.rightCurly
122− return (Json.Object (reverse revEntries))
123− ]
77+instance Applicative (Decoder e) where
78+ {-# INLINE pure #-}
79+ pure = return
12480
81+ {-# INLINE (<*>) #-}
82+ (<*>) (Decoder decodeFunc) (Decoder decodeArg) =
83+ Decoder $ \ast ok err ->
84+ let
85+ okF func =
86+ let
87+ okA arg = ok (func arg)
88+ in
89+ decodeArg ast okA err
90+ in
91+ decodeFunc ast okF err
12592
126−field :: Parser (Text.Text, Json.Value)
127−field =
128− do key <- string
129− spaces
130− Symbol.hasType
131− spaces
132− value <- jsonValue
133− return (key, value)
13493
94+instance Monad (Decoder e) where
95+ {-# INLINE return #-}
96+ return a =
97+ Decoder $ \_ ok _ ->
98+ ok a
13599
100+ {-# INLINE (>>=) #-}
101+ (>>=) (Decoder decodeA) callback =
102+ Decoder $ \ast ok err ->
103+ let
104+ ok' a =
105+ case callback a of
106+ Decoder decodeB -> decodeB ast ok err
107+ in
108+ decodeA ast ok' err
136109
137−-- ARRAY
138110
139111
140−array :: R.Position -> Parser Json.Value
141−array start =
142− do Symbol.leftSquare
143− P.inContext start E.ExprList $
144− do spaces
145− I.oneOf
146− [ do entry <- jsonValue
147− spaces
148− arrayHelp 1 [entry]
149− , do Symbol.rightSquare
150− return (Json.Array [])
151− ]
112+-- STRINGS
152113
153114
154−arrayHelp :: Int -> [Json.Value] -> Parser Json.Value
155−arrayHelp !length revEntries =
156− I.oneOf
157− [
158− do Symbol.comma
159− spaces
160− entry <- jsonValue
161− spaces
162− arrayHelp (length + 1) (entry:revEntries)
163− ,
164− do Symbol.rightSquare
165− return $ Json.Array $ reverse revEntries
166− ]
115+string :: Decoder e Utf8.String
116+string =
117+ Decoder $ \ast ok err ->
118+ case ast of
119+ String bits ->
120+ ok bits
121+
122+ _ ->
123+ err (E.Expecting E.TString)
124+
125+
126+
127+-- BOOL
128+
129+
130+bool :: Decoder e Bool
131+bool =
132+ Decoder $ \ast ok err ->
133+ case ast of
134+ TRUE ->
135+ ok True
136+
137+ FALSE ->
138+ ok False
139+
140+ _ ->
141+ err (E.Expecting E.TBool)
142+
143+
144+
145+-- INT
146+
147+
148+int :: Decoder e Int
149+int =
150+ Decoder $ \ast ok err ->
151+ case ast of
152+ Int n ->
153+ ok n
154+
155+ _ ->
156+ err (E.Expecting E.TInt)
167157
168158
169159
170−-- NUMBER
160+-- ARRAYS
171161
172162
173−number :: Parser Json.Value
174−number =
175− Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
176− if offset < terminal then
163+list :: Decoder e a -> Decoder e [a]
164+list decoder =
165+ Decoder $ \ast ok err ->
166+ case ast of
167+ Array asts ->
168+ listHelp decoder ok err 0 asts []
169+
170+ _ ->
171+ err (E.Expecting E.TArray)
172+
177173
174+listHelp :: Decoder e a -> ([a] -> b) -> (E.Problem e -> b) -> Int -> [AST] -> [a] -> b
175+listHelp decoder@(Decoder decodeA) ok err !i asts revs =
176+ case asts of
177+ [] ->
178+ ok (reverse revs)
179+
180+ ast:asts ->
178181 let
179− !word = I.unsafeIndex fp offset
180− !offset1 = offset + 1
182+ ok' a = listHelp decoder ok err (i+1) asts (a:revs)
183+ err' e = err (E.Index i e)
181184 in
182− if word <= 0x39 {- 9 -} && word >= 0x31 {- 1 -} then
183− case Number.chompInt fp offset1 terminal (fromIntegral (word - 0x30 {- 0 -})) of
184− Number.Err newOffset problem ->
185− cerr (E.ParseError row (col + (newOffset - offset)) problem)
185+ decodeA ast ok' err'
186+
186187
187− Number.OkInt newOffset n ->
188+pair :: Decoder e a -> Decoder e b -> Decoder e (a,b)
189+pair (Decoder decodeA) (Decoder decodeB) =
190+ Decoder $ \ast ok err ->
191+ case ast of
192+ Array vs ->
193+ case vs of
194+ [astA,astB] ->
188195 let
189− !newState = State fp newOffset terminal indent row (col + (newOffset - offset)) ctx
196+ err0 e = err (E.Index 0 e)
197+ ok0 a =
198+ let
199+ err1 e = err (E.Index 1 e)
200+ ok1 b = ok (a,b)
201+ in
202+ decodeB astB ok1 err1
190203 in
191− cok (Json.Integer n) newState noError
204+ decodeA astA ok0 err0
205+
206+ _ ->
207+ err (E.Expecting (E.TArrayPair (length vs)))
208+
209+ _ ->
210+ err (E.Expecting E.TArray)
211+
212+
213+
214+-- OBJECT
215+
216+
217+dict :: Decoder e a -> Decoder e (Map.Map Utf8.String a)
218+dict decoder =
219+ Map.fromList <$> pairs decoder
220+
192221
193− Number.OkFloat newOffset ->
222+pairs :: Decoder e a -> Decoder e [(Utf8.String, a)]
223+pairs decoder =
224+ Decoder $ \ast ok err ->
225+ case ast of
226+ Object kvs ->
227+ pairsHelp decoder ok err kvs []
228+
229+ _ ->
230+ err (E.Expecting E.TObject)
231+
232+
233+pairsHelp :: Decoder e a -> ([(Utf8.String, a)] -> b) -> (E.Problem e -> b) -> [(Utf8.String, AST)] -> [(Utf8.String, a)] -> b
234+pairsHelp decoder@(Decoder decodeA) ok err kvs revs =
235+ case kvs of
236+ [] ->
237+ ok (reverse revs)
238+
239+ (key, ast) : kvs ->
240+ let
241+ ok' a = pairsHelp decoder ok err kvs ((key,a):revs)
242+ err' e = err (E.Field key e)
243+ in
244+ decodeA ast ok' err'
245+
246+
247+field :: Utf8.String -> Decoder e a -> Decoder e a
248+field key (Decoder decodeA) =
249+ Decoder $ \ast ok err ->
250+ case ast of
251+ Object kvs ->
252+ case List.lookup key kvs of
253+ Just v ->
194254 let
195− !length = newOffset - offset
196− !scientific = read $ Char8.unpack $ B.PS fp offset length
197− !newState = State fp newOffset terminal indent row (col + length) ctx
255+ err' e = err (E.Field key e)
198256 in
199− cok (Json.Float scientific) newState noError
257+ decodeA v ok err'
200258
201− else if word == 0x30 {- 0 -} then
202− cok (Json.Integer 0) (State fp offset1 terminal indent row (col + 1) ctx) noError
259+ Nothing ->
260+ err (E.Expecting (E.TObjectWith key))
261+
262+ _ ->
263+ err (E.Expecting E.TObject)
264+
265+
266+
267+-- ONE OF
268+
269+
270+oneOf :: [Decoder e a] -> Decoder e a
271+oneOf decoders =
272+ Decoder $ \ast ok err ->
273+ case decoders of
274+ Decoder decodeA : decoders ->
275+ let
276+ err' e =
277+ oneOfHelp ast ok err decoders e []
278+ in
279+ decodeA ast ok err'
280+
281+ [] ->
282+ error "Ran into (Json.Decode.oneOf [])"
283+
284+
285+oneOfHelp :: AST -> (a -> b) -> (E.Problem e -> b) -> [Decoder e a] -> E.Problem e -> [E.Problem e] -> b
286+oneOfHelp ast ok err decoders e es =
287+ case decoders of
288+ Decoder decodeA : decoders ->
289+ let
290+ err' e' =
291+ oneOfHelp ast ok err decoders e' (e:es)
292+ in
293+ decodeA ast ok err'
294+
295+ [] ->
296+ err (oneOfError [] e es)
297+
298+
299+oneOfError :: [E.Problem e] -> E.Problem e -> [E.Problem e] -> E.Problem e
300+oneOfError errors err es =
301+ case es of
302+ [] ->
303+ E.OneOf err errors
304+
305+ e:es ->
306+ oneOfError (err:errors) e es
307+
308+
309+
310+-- FAILURE
311+
312+
313+failure :: e -> Decoder e a
314+failure e =
315+ Decoder $ \_ _ err ->
316+ err (E.Failure e)
317+
318+
319+
320+-- ERRORS
203321
204− else
205− eerr noError
206322
323+mapError :: (e -> e') -> Decoder e a -> Decoder e' a
324+mapError func (Decoder decodeA) =
325+ Decoder $ \ast ok err ->
326+ let
327+ err' e = err (mapErrorHelp func e)
328+ in
329+ decodeA ast ok err'
330+
331+
332+mapErrorHelp :: (e -> e') -> E.Problem e -> E.Problem e'
333+mapErrorHelp func err =
334+ case err of
335+ E.Field k e -> E.Field k (mapErrorHelp func e)
336+ E.Index i e -> E.Index i (mapErrorHelp func e)
337+ E.OneOf e es -> E.OneOf (mapErrorHelp func e) (map (mapErrorHelp func) es)
338+ E.Failure e -> E.Failure (func e)
339+ E.Expecting e -> E.Expecting e
340+
341+
342+
343+-- AST
344+
345+
346+data AST
347+ = Array [AST]
348+ | Object [(Utf8.String, AST)]
349+ | String Utf8.String
350+ | Int Int
351+ | TRUE
352+ | FALSE
353+ | NULL
354+
355+
356+
357+-- PARSE
358+
359+
360+type Parser a =
361+ P.Parser E.Context E.ParseExpectation a
362+
363+
364+pFile :: Parser AST
365+pFile =
366+ do spaces
367+ value <- pValue
368+ spaces
369+ endOfFile
370+ return value
371+
372+
373+pValue :: Parser AST
374+pValue =
375+ P.oneOf E.Value
376+ [ fmap String pString
377+ , pObject
378+ , pArray
379+ , pInt
380+ , K.k4 0x74 0x72 0x75 0x65 E.Bool >> return TRUE
381+ , K.k5 0x66 0x61 0x6C 0x73 0x65 E.Bool >> return FALSE
382+ , K.k4 0x6E 0x75 0x6C 0x6C E.Null >> return NULL
383+ ]
384+
385+
386+endOfFile :: Parser ()
387+endOfFile =
388+ P.Parser $ \state@(P.State pos end _ row col ctx) _ eok _ eerr ->
389+ if pos < end then
390+ eerr row col ctx E.EndOfFile
207391 else
208− eerr noError
392+ eok () state
209393
210394
211395
396+-- OBJECT
397+
398+
399+pObject :: Parser AST
400+pObject =
401+ do P.word1 0x7B {- { -} E.ObjectStart
402+ spaces
403+ P.oneOf E.ObjectMore
404+ [ do entry <- pField
405+ spaces
406+ pObjectHelp [entry]
407+ , do P.word1 0x7D {-}-} E.ObjectEnd
408+ return (Object [])
409+ ]
410+
411+
412+pObjectHelp :: [(Utf8.String, AST)] -> Parser AST
413+pObjectHelp revEntries =
414+ P.oneOf E.ObjectMore
415+ [
416+ do P.word1 0x2C {-,-} E.ObjectMore
417+ spaces
418+ entry <- pField
419+ spaces
420+ pObjectHelp (entry:revEntries)
421+ ,
422+ do P.word1 0x7D {-}-} E.ObjectEnd
423+ return (Object (reverse revEntries))
424+ ]
425+
426+
427+pField :: Parser (Utf8.String, AST)
428+pField =
429+ do key <- pString
430+ spaces
431+ P.word1 0x3A {-:-} E.Colon
432+ spaces
433+ value <- pValue
434+ return (key, value)
435+
436+
437+
438+-- ARRAY
439+
440+
441+pArray :: Parser AST
442+pArray =
443+ do P.word1 0x5B {-[-} E.ArrayStart
444+ spaces
445+ P.oneOf E.ArrayMore
446+ [ do entry <- pValue
447+ spaces
448+ pArrayHelp 1 [entry]
449+ , do P.word1 0x5D {-]-} E.ArrayEnd
450+ return (Array [])
451+ ]
452+
453+
454+pArrayHelp :: Int -> [AST] -> Parser AST
455+pArrayHelp !len revEntries =
456+ P.oneOf E.ArrayMore
457+ [
458+ do P.word1 0x2C {-,-} E.ArrayMore
459+ spaces
460+ entry <- pValue
461+ spaces
462+ pArrayHelp (len + 1) (entry:revEntries)
463+ ,
464+ do P.word1 0x5D {-]-} E.ArrayEnd
465+ return (Array (reverse revEntries))
466+ ]
467+
468+
212469
213470-- STRING
214471
215472
216−string :: Parser Text.Text
217−string =
218− Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
219− if offset < terminal && I.unsafeIndex fp offset == 0x22 {- " -} then
473+pString :: Parser Utf8.String
474+pString =
475+ P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->
476+ if pos < end && P.unsafeIndex pos == 0x22 {-"-} then
220477
221478 let
222− !offset1 = offset + 1
223− in
224− case stringHelp fp offset1 terminal row (col + 1) of
225− Err err ->
226− cerr err
479+ !pos1 = plusPtr pos 1
227480
228− Ok newOffset newRow newCol ->
481+ (# status, newPos, newRow, newCol #) =
482+ pStringHelp pos1 end row (col + 1)
483+ in
484+ case status of
485+ GoodString ->
229486 let
230− !newState = State fp newOffset terminal indent newRow newCol ctx
231− !content = Text.decodeUtf8 (B.PS fp offset1 (newOffset - offset1 - 1))
487+ !newState = P.State newPos end indent newRow newCol ctx
488+ !content = Utf8.fromPtr pos1 (plusPtr newPos (-1))
232489 in
233− cok content newState noError
490+ cok content newState
491+
492+ BadStringEnd ->
493+ cerr newRow newCol ctx E.StringEnd
234494
235495 else
236− eerr noError
496+ eerr row col ctx E.StringStart
237497
238498
239−data StringResult
240− = Err E.ParseError
241− | Ok !Int !Int !Int
499+data StringStatus
500+ = GoodString
501+ | BadStringEnd
242502
243503
244−stringHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> StringResult
245−stringHelp fp offset terminal row col =
246− if offset >= terminal then
247− Err (E.ParseError row col E.EndOfFile_String)
504+pStringHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# StringStatus, Ptr Word8, Word16, Word16 #)
505+pStringHelp pos end row col =
506+ if pos >= end then
507+ (# BadStringEnd, pos, row, col #)
248508
249509 else
250− case I.unsafeIndex fp offset of
251− 0x22 {- " -} ->
252− Ok (offset + 1) row (col + 1)
510+ case P.unsafeIndex pos of
511+ 0x22 {-"-} ->
512+ (# GoodString, plusPtr pos 1, row, col + 1 #)
253513
254− 0x0A {- \n -} ->
255− Err (E.ParseError row col E.NewLineInString)
514+ 0x0A {-\n-} ->
515+ (# BadStringEnd, pos, row, col #)
256516
257− 0x5C {- \ -} ->
517+ 0x5C {-\-} ->
258518 let
259− !offset1 = offset + 1
519+ !pos1 = plusPtr pos 1
260520 in
261− if offset1 < terminal then
521+ if pos1 < end then
262522
263523 let
264− !word = I.unsafeIndex fp offset1
265− !newOffset = offset1 + I.getCharWidth fp offset1 terminal word
524+ !word = P.unsafeIndex pos1
525+ !newPos = plusPtr pos1 (P.getCharWidth pos1 end word)
266526 in
267− stringHelp fp newOffset terminal row (col + 2)
527+ pStringHelp newPos end row (col + 2)
268528
269529 else
270− Err (E.ParseError (row + 1) col E.EndOfFile_String)
530+ (# BadStringEnd, pos1, row + 1, col #)
271531
272532 word ->
273− let !newOffset = offset + I.getCharWidth fp offset terminal word in
274− stringHelp fp newOffset terminal row (col + 1)
275−
533+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in
534+ pStringHelp newPos end row (col + 1)
276535
277536
278537
@@ -281,27 +540,107 @@ stringHelp fp offset terminal row col =
281540
282541spaces :: Parser ()
283542spaces =
284− Parser $ \(State fp offset terminal indent row col ctx) cok _ _ _ ->
543+ P.Parser $ \state@(P.State pos end indent row col ctx) cok eok _ _ ->
285544 let
286− (# newOffset, newRow, newCol #) =
287− eatSpaces fp offset terminal row col
288−
289− !newState =
290− State fp newOffset terminal indent newRow newCol ctx
545+ (# newPos, newRow, newCol #) =
546+ eatSpaces pos end row col
291547 in
292− cok () newState noError
548+ if pos == newPos then
549+ eok () state
550+ else
551+ let
552+ !newState =
553+ P.State newPos end indent newRow newCol ctx
554+ in
555+ cok () newState
293556
294557
295−eatSpaces :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> (# Int, Int, Int #)
296−eatSpaces fp offset terminal row col =
297− if offset >= terminal then
298− (# offset, row, col #)
558+eatSpaces :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Ptr Word8, Word16, Word16 #)
559+eatSpaces pos end row col =
560+ if pos >= end then
561+ (# pos, row, col #)
299562
300563 else
301− case I.unsafeIndex fp offset of
302− 0x20 {- -} -> eatSpaces fp (offset + 1) terminal row (col + 1)
303− 0x09 {- \t -} -> eatSpaces fp (offset + 1) terminal row (col + 1)
304− 0x0A {- \n -} -> eatSpaces fp (offset + 1) terminal (row + 1) 1
305− 0x0D {- \r -} -> eatSpaces fp (offset + 1) terminal row col
564+ case P.unsafeIndex pos of
565+ 0x20 {- -} -> eatSpaces (plusPtr pos 1) end row (col + 1)
566+ 0x09 {-\t-} -> eatSpaces (plusPtr pos 1) end row (col + 1)
567+ 0x0A {-\n-} -> eatSpaces (plusPtr pos 1) end (row + 1) 1
568+ 0x0D {-\r-} -> eatSpaces (plusPtr pos 1) end row col
306569 _ ->
307− (# offset, row, col #)
570+ (# pos, row, col #)
571+
572+
573+
574+-- INTS
575+
576+
577+pInt :: Parser AST
578+pInt =
579+ P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->
580+ if pos >= end then
581+ eerr row col ctx E.IntStart
582+
583+ else
584+ let !word = P.unsafeIndex pos in
585+ if not (isDecimalDigit word) then
586+ eerr row col ctx E.IntStart
587+
588+ else if word == 0x30 {-0-} then
589+
590+ let
591+ !pos1 = plusPtr pos 1
592+ !newState = P.State pos1 end indent row (col + 1) ctx
593+ in
594+ if pos1 < end then
595+ let !word1 = P.unsafeIndex pos1 in
596+ if isDecimalDigit word1 then
597+ cerr row (col + 1) ctx E.NoLeadingZeros
598+ else if word1 == 0x2E {-.-} then
599+ cerr row (col + 1) ctx E.NoFloats
600+ else
601+ cok (Int 0) newState
602+ else
603+ cok (Int 0) newState
604+
605+ else
606+ let
607+ (# status, n, newPos #) =
608+ chompInt (plusPtr pos 1) end (fromIntegral (word - 0x30 {-0-}))
609+
610+ !len = fromIntegral (minusPtr newPos pos)
611+ in
612+ case status of
613+ GoodInt ->
614+ let
615+ !newState =
616+ P.State newPos end indent row (col + len) ctx
617+ in
618+ cok (Int n) newState
619+
620+ BadIntEnd ->
621+ cerr row (col + len) ctx E.NoFloats
622+
623+
624+data IntStatus = GoodInt | BadIntEnd
625+
626+
627+chompInt :: Ptr Word8 -> Ptr Word8 -> Int -> (# IntStatus, Int, Ptr Word8 #)
628+chompInt pos end n =
629+ if pos < end then
630+ let !word = P.unsafeIndex pos in
631+ if isDecimalDigit word then
632+ let !m = 10 * n + fromIntegral (word - 0x30 {-0-}) in
633+ chompInt (plusPtr pos 1) end m
634+ else if word == 0x2E {-.-} || word == 0x65 {-e-} || word == 0x45 {-E-} then
635+ (# BadIntEnd, n, pos #)
636+ else
637+ (# GoodInt, n, pos #)
638+
639+ else
640+ (# GoodInt, n, pos #)
641+
642+
643+{-# INLINE isDecimalDigit #-}
644+isDecimalDigit :: Word8 -> Bool
645+isDecimalDigit word =
646+ word <= 0x39 {-9-} && word >= 0x30 {-0-}