on c19392f help sign in
elk/src/Parse/Primitives/Number.hs
267 lines 6.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE BangPatterns, UnboxedTuples #-}
3module Parse.Primitives.Number
4 ( number
5 , chompHex
6 )
7 where
10import Prelude hiding (length)
11import qualified Data.ByteString.Char8 as Char8
12import qualified Data.ByteString.Internal as B
13import Foreign.ForeignPtr (ForeignPtr)
14import GHC.Word (Word8)
16import qualified AST.Literal as L
17import Parse.Primitives.Internals (Parser(..), State(..), noError)
18import qualified Parse.Primitives.Internals as I
19import qualified Parse.Primitives.Variable as Var
20import qualified Reporting.Error.Syntax as E
24-- HELPERS
27isDirtyEnd :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Bool
28isDirtyEnd fp offset terminal word =
29 Var.getInnerWidthHelp fp offset terminal word > 0
32{-# INLINE isDecimalDigit #-}
33isDecimalDigit :: Word8 -> Bool
34isDecimalDigit word =
35 word <= 0x39 {- 9 -} && word >= 0x30 {- 0 -}
39-- NUMBERS
42number :: Parser L.Literal
43number =
44 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
45 if offset >= terminal then
46 eerr noError
48 else
49 let !word = I.unsafeIndex fp offset in
50 if not (isDecimalDigit word) then
51 eerr noError
53 else
54 let
55 outcome =
56 if word == 0x30 {- 0 -} then
57 chompZero fp (offset + 1) terminal
58 else
59 chompInt fp (offset + 1) terminal (fromIntegral (word - 0x30 {- 0 -}))
60 in
61 case outcome of
62 Err newOffset problem ->
63 cerr (E.ParseError row (col + (newOffset - offset)) problem)
65 OkInt newOffset n ->
66 let
67 !integer = L.IntNum n
68 !newState = State fp newOffset terminal indent row (col + (newOffset - offset)) ctx
69 in
70 cok integer newState noError
72 OkFloat newOffset ->
73 let
74 !length = newOffset - offset
75 !float = L.FloatNum $ read $ Char8.unpack $ B.PS fp offset length
76 !newState = State fp newOffset terminal indent row (col + length) ctx
77 in
78 cok float newState noError
82-- CHOMP OUTCOME
85data Outcome
86 = Err { _offset :: Int, _problem :: E.Problem }
87 | OkInt { _offset :: Int, _value :: Int }
88 | OkFloat { _offset :: Int }
92-- CHOMP INT
95chompInt :: ForeignPtr Word8 -> Int -> Int -> Int -> Outcome
96chompInt fp !offset terminal !n =
97 if offset >= terminal then
99 OkInt offset n
101 else
103 let
104 !word = I.unsafeIndex fp offset
105 in
106 if isDecimalDigit word then
107 chompInt fp (offset + 1) terminal (10 * n + fromIntegral (word - 0x30 {- 0 -}))
109 else if word == 0x2E {- . -} then
110 chompFraction fp (offset + 1) terminal
112 else if word == 0x65 {- e -} || word == 0x45 {- E -} then
113 chompExponent fp (offset + 1) terminal
115 else if isDirtyEnd fp offset terminal word then
116 Err offset E.BadNumberEnd
118 else
119 OkInt offset n
123-- CHOMP FRACTION
126chompFraction :: ForeignPtr Word8 -> Int -> Int -> Outcome
127chompFraction fp offset terminal =
128 if offset >= terminal then
129 Err offset E.BadNumberDot
131 else if isDecimalDigit (I.unsafeIndex fp offset) then
132 chompFractionHelp fp (offset + 1) terminal
134 else
135 Err offset E.BadNumberDot
138chompFractionHelp :: ForeignPtr Word8 -> Int -> Int -> Outcome
139chompFractionHelp fp offset terminal =
140 if offset >= terminal then
141 OkFloat offset
143 else
144 let !word = I.unsafeIndex fp offset in
145 if isDecimalDigit word then
146 chompFractionHelp fp (offset + 1) terminal
148 else if word == 0x65 {- e -} || word == 0x45 {- E -} then
149 chompExponent fp (offset + 1) terminal
151 else if isDirtyEnd fp offset terminal word then
152 Err offset E.BadNumberEnd
154 else
155 OkFloat offset
159-- CHOMP EXPONENT
162chompExponent :: ForeignPtr Word8 -> Int -> Int -> Outcome
163chompExponent fp offset terminal =
164 if offset >= terminal then
165 Err offset E.BadNumberExp
167 else
168 let !word = I.unsafeIndex fp offset in
169 if isDecimalDigit word then
170 chompExponentHelp fp (offset + 1) terminal
172 else if word == 0x2B {- + -} || word == 0x2D {- - -} then
174 let !offset1 = offset + 1 in
175 if offset1 < terminal && isDecimalDigit (I.unsafeIndex fp offset1) then
176 chompExponentHelp fp (offset + 2) terminal
177 else
178 Err offset E.BadNumberExp
180 else
181 Err offset E.BadNumberExp
184chompExponentHelp :: ForeignPtr Word8 -> Int -> Int -> Outcome
185chompExponentHelp fp offset terminal =
186 if offset >= terminal then
187 OkFloat offset
189 else if isDecimalDigit (I.unsafeIndex fp offset) then
190 chompExponentHelp fp (offset + 1) terminal
192 else
193 OkFloat offset
197-- CHOMP ZERO
200chompZero :: ForeignPtr Word8 -> Int -> Int -> Outcome
201chompZero fp offset terminal =
202 if offset >= terminal then
203 OkInt offset 0
205 else
206 let !word = I.unsafeIndex fp offset in
207 if word == 0x78 {- x -} then
208 chompHexInt fp (offset + 1) terminal
210 else if word == 0x2E {- . -} then
211 chompFraction fp (offset + 1) terminal
213 else if isDecimalDigit word then
214 Err offset E.BadNumberZero
216 else if isDirtyEnd fp offset terminal word then
217 Err offset E.BadNumberEnd
219 else
220 OkInt offset 0
223chompHexInt :: ForeignPtr Word8 -> Int -> Int -> Outcome
224chompHexInt fp offset terminal =
225 let (# newOffset, answer #) = chompHex fp offset terminal in
226 if answer < 0 then
227 Err newOffset E.BadNumberHex
228 else
229 OkInt newOffset answer
233-- CHOMP HEX
236-- Return -1 if it has NO digits
237-- Return -2 if it has BAD digits
239{-# INLINE chompHex #-}
240chompHex :: ForeignPtr Word8 -> Int -> Int -> (# Int, Int #)
241chompHex fp offset terminal =
242 chompHexHelp fp offset terminal (-1) 0
245chompHexHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> (# Int, Int #)
246chompHexHelp fp offset terminal answer accumulator =
247 if offset >= terminal then
248 (# offset, answer #)
249 else
250 let
251 !newAnswer =
252 stepHex fp offset terminal (I.unsafeIndex fp offset) accumulator
253 in
254 if newAnswer < 0 then
255 (# offset, if newAnswer == -1 then answer else -2 #)
256 else
257 chompHexHelp fp (offset + 1) terminal newAnswer newAnswer
260{-# INLINE stepHex #-}
261stepHex :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int -> Int
262stepHex fp offset terminal word acc
263 | 0x30 {- 0 -} <= word && word <= 0x39 {- 9 -} = 16 * acc + fromIntegral (word - 0x30 {- 0 -})
264 | 0x61 {- a -} <= word && word <= 0x66 {- f -} = 16 * acc + 10 + fromIntegral (word - 0x61 {- a -})
265 | 0x41 {- A -} <= word && word <= 0x46 {- F -} = 16 * acc + 10 + fromIntegral (word - 0x41 {- A -})
266 | isDirtyEnd fp offset terminal word = -2
267 | True = -1