module HsTokenScanner where
import HsToken
import UU.Scanner.Position
import Data.List(sort)
import UU.Util.BinaryTrees
import CommonTypes
import Data.Maybe
import Data.Char

isAGesc :: Char -> Bool
isAGesc :: Char -> Bool
isAGesc Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'@'

lexTokens :: Options -> Pos -> String -> [HsToken]
lexTokens :: Options -> Pos -> String -> [HsToken]
lexTokens = [String]
-> [String]
-> String
-> String
-> Options
-> Pos
-> String
-> [HsToken]
scanTokens forall {a}. [a]
keywordstxt [String]
keywordsops String
specialchars String
opchars
  where keywordstxt :: [a]
keywordstxt   =  []
        keywordsops :: [String]
keywordsops   =  [String
".",String
"=", String
":=", String
":",String
"|",String
"@"]
        specialchars :: String
specialchars  =  String
";()[],_{}`"
        opchars :: String
opchars       =  String
"!#$%&*+./<=>?@\\^|-~:"


scanTokens :: [String] -> [String] -> String -> String -> Options -> Pos -> String -> [HsToken]
scanTokens :: [String]
-> [String]
-> String
-> String
-> Options
-> Pos
-> String
-> [HsToken]
scanTokens [String]
keywordstxt [String]
keywordsops String
specchars String
opchars Options
opts Pos
pos String
input
  = Pos -> String -> [HsToken]
doScan Pos
pos String
input

 where
   locatein :: Ord a => [a] -> a -> Bool
   locatein :: forall a. Ord a => [a] -> a -> Bool
locatein [a]
es = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> Ordering) -> BinSearchTree a -> b -> Maybe a
btLocateIn forall a. Ord a => a -> a -> Ordering
compare (forall av. [av] -> BinSearchTree av
tab2tree (forall a. Ord a => [a] -> [a]
sort [a]
es))
   iskw :: String -> Bool
iskw     = forall a. Ord a => [a] -> a -> Bool
locatein [String]
keywordstxt
   isop :: String -> Bool
isop     = forall a. Ord a => [a] -> a -> Bool
locatein [String]
keywordsops
   isSymb :: Char -> Bool
isSymb   = forall a. Ord a => [a] -> a -> Bool
locatein String
specchars
   -- See http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators
   isOpsym :: Char -> Bool
isOpsym  Char
c = forall a. Ord a => [a] -> a -> Bool
locatein String
opchars Char
c
                -- For unicode operators
                Bool -> Bool -> Bool
|| (Bool -> Bool
not (Char -> Bool
isAscii Char
c) Bool -> Bool -> Bool
&& (Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c))

   isIdStart :: Char -> Bool
isIdStart Char
c = Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'

   isIdChar :: Char -> Bool
isIdChar Char
c =  Char -> Bool
isAlphaNum Char
c
              Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''
              Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'

   scanIdent :: Pos -> String -> (String, Pos, String)
scanIdent Pos
p String
s = let (String
name,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isIdChar String
s
                   in (String
name,Int -> Pos -> Pos
advc (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name) Pos
p,String
rest)

   doScan :: Pos -> String -> [HsToken]
doScan Pos
_ []      = []
   doScan Pos
p (Char
c:String
s)   | Char -> Bool
isSpace Char
c = let (String
sp,String
next) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
s
                                 in  Pos -> String -> [HsToken]
doScan (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Pos -> Pos
updPos)  Pos
p (Char
cforall a. a -> [a] -> [a]
:String
sp)) String
next
   doScan Pos
p (Char
c:Char
d:String
s) | Char -> Bool
isAGesc Char
c Bool -> Bool -> Bool
&& Char -> Bool
isIdStart Char
d =
                                 let (String
fld,Pos
p2,String
rest) = Pos -> String -> (String, Pos, String)
scanIdent (Int -> Pos -> Pos
advc Int
2 Pos
p) String
s
                                     field :: String
field = Char
dforall a. a -> [a] -> [a]
:String
fld
                                 in case String
rest of
                                      (Char
'.':Char
r:String
rs)
                                          | Char -> Bool
isIdStart Char
r -> let (String
at,Pos
p3,String
rest2) = Pos -> String -> (String, Pos, String)
scanIdent (Int -> Pos -> Pos
advc Int
2 Pos
p2) String
rs
                                                               attr :: String
attr = Char
r forall a. a -> [a] -> [a]
: String
at
                                                           in Identifier -> Identifier -> Pos -> Maybe String -> HsToken
AGField (String -> Pos -> Identifier
Ident String
field Pos
p) (String -> Pos -> Identifier
Ident String
attr Pos
p) Pos
p forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan Pos
p3 String
rest2
                                      String
_                 -> Identifier -> Pos -> Maybe String -> HsToken
AGLocal (String -> Pos -> Identifier
Ident String
field Pos
p) Pos
p forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan Pos
p2 String
rest

   doScan Pos
p (Char
'/':Char
'/':String
s) | Options -> Bool
clean Options
opts  = Pos -> String -> [HsToken]
doScan Pos
p (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s)
   doScan Pos
p (Char
'/':Char
'*':String
s) | Options -> Bool
clean Options
opts  = forall a. Int -> Pos -> (Pos -> a) -> a
advc' Int
2 Pos
p ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexCleanNest Pos -> String -> [HsToken]
doScan) String
s   -- }
   doScan Pos
p (Char
'-':Char
'-':String
s)  = Pos -> String -> [HsToken]
doScan Pos
p (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
s)
   doScan Pos
p (Char
'{':Char
'-':String
s)  = forall a. Int -> Pos -> (Pos -> a) -> a
advc' Int
2 Pos
p ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest Pos -> String -> [HsToken]
doScan) String
s   -- }
   doScan Pos
p (Char
'"':String
ss)
     = let (String
s,Int
swidth,String
rest) = String -> (String, Int, String)
scanString String
ss
       in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest Bool -> Bool -> Bool
|| forall a. [a] -> a
head String
rest forall a. Eq a => a -> a -> Bool
/= Char
'"'
             then String -> Pos -> HsToken
Err String
"Unterminated string literal" Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' Int
swidth Pos
p Pos -> String -> [HsToken]
doScan String
rest
             else String -> Pos -> HsToken
StrToken String
s Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' (Int
swidthforall a. Num a => a -> a -> a
+Int
2) Pos
p Pos -> String -> [HsToken]
doScan (forall a. [a] -> [a]
tail String
rest)

   doScan Pos
p (Char
'\'':String
ss)
     | Options -> Bool
clean Options
opts = let (String
str,Int
nswidth,String
rest) = String -> (String, Int, String)
scanQualName String
ss
                    in  String -> Pos -> HsToken
HsToken (Char
'\'' forall a. a -> [a] -> [a]
: String
str forall a. [a] -> [a] -> [a]
++ String
"'") Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' (Int
nswidth forall a. Num a => a -> a -> a
+ Int
2) Pos
p Pos -> String -> [HsToken]
doScan (forall a. [a] -> [a]
tail String
rest)
     | Bool
otherwise
     = let (Maybe Char
mc,Int
cwidth,String
rest) = String -> (Maybe Char, Int, String)
scanChar String
ss
       in case Maybe Char
mc of
            Maybe Char
Nothing -> String -> Pos -> HsToken
Err String
"Error in character literal" Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' Int
cwidth Pos
p Pos -> String -> [HsToken]
doScan String
rest
            Just Char
c  -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest Bool -> Bool -> Bool
|| forall a. [a] -> a
head String
rest forall a. Eq a => a -> a -> Bool
/= Char
'\''
                          then String -> Pos -> HsToken
Err String
"Unterminated character literal" Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' (Int
cwidthforall a. Num a => a -> a -> a
+Int
1) Pos
p Pos -> String -> [HsToken]
doScan String
rest
                          else String -> Pos -> HsToken
CharToken  [Char
c] Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' (Int
cwidthforall a. Num a => a -> a -> a
+Int
2) Pos
p Pos -> String -> [HsToken]
doScan (forall a. [a] -> [a]
tail String
rest)
   doScan Pos
p cs :: String
cs@(Char
c:String
s)

     | Char -> Bool
isIdStart Char
c Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
c
         = let (String
name', Pos
p', String
s')    = Pos -> String -> (String, Pos, String)
scanIdent (Int -> Pos -> Pos
advc Int
1 Pos
p) String
s
               name :: String
name               = Char
cforall a. a -> [a] -> [a]
:String
name'
               tok :: HsToken
tok                = if String -> Bool
iskw String
name
                                    then String -> Pos -> HsToken
HsToken String
name Pos
p               -- keyword
                                    else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name' Bool -> Bool -> Bool
&& Char -> Bool
isSymb Char
c
                                    then String -> Pos -> HsToken
HsToken [Char
c] Pos
p                -- '_'
                                    else String -> Pos -> HsToken
HsToken String
name Pos
p               -- varid / conid
           in HsToken
tok forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan Pos
p' String
s'
     | Char -> Bool
isOpsym Char
c = let (String
name, String
s') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOpsym String
cs
                       tok :: HsToken
tok | String -> Bool
isop String
name = String -> Pos -> HsToken
HsToken String
name Pos
p
                           | Bool
otherwise = String -> Pos -> HsToken
HsToken String
name Pos
p
                   in HsToken
tok forall a. a -> [a] -> [a]
: Pos -> String -> [HsToken]
doScan (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Pos -> Pos
updPos)  Pos
p String
name)  String
s'
     | Char -> Bool
isDigit Char
c = let (Int
base,String
digs,Int
width,String
s') = String -> (Int, String, Int, String)
getNumber String
cs
                       number :: String
number = case Int
base of
                          Int
8  -> String
"0o"forall a. [a] -> [a] -> [a]
++String
digs
                          Int
10 -> String
digs
                          Int
16 -> String
"0x"forall a. [a] -> [a] -> [a]
++String
digs
                          Int
_  -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Base " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
base forall a. [a] -> [a] -> [a]
++ String
" is not supported."
                   in  String -> Pos -> HsToken
HsToken String
number Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' Int
width Pos
p Pos -> String -> [HsToken]
doScan String
s'
     | Char -> Bool
isSymb Char
c = String -> Pos -> HsToken
HsToken [Char
c] Pos
p forall a. a -> [a] -> [a]
: forall a. Int -> Pos -> (Pos -> a) -> a
advc' Int
1 Pos
p Pos -> String -> [HsToken]
doScan String
s
     | Bool
otherwise = String -> Pos -> HsToken
Err (String
"Unexpected character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c) Pos
p forall a. a -> [a] -> [a]
: forall a. Char -> Pos -> (Pos -> a) -> a
updPos'  Char
c Pos
p Pos -> String -> [HsToken]
doScan String
s

lexNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest Pos -> String -> [HsToken]
cont Pos
pos String
inp = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
cont Pos
pos String
inp
 where lexNest' :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'{':Char
'-':String
s) = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c) (Int -> Pos -> Pos
advc Int
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'-':Char
'}':String
s) = Pos -> String -> [HsToken]
c (Int -> Pos -> Pos
advc Int
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
x:String
s)       = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c (Char -> Pos -> Pos
updPos  Char
x Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
_ Pos
_ []          = [String -> Pos -> HsToken
Err String
"Unterminated nested comment" Pos
pos]

lexCleanNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexCleanNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexCleanNest Pos -> String -> [HsToken]
cont Pos
pos String
inp = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
cont Pos
pos String
inp
 where lexNest' :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'/':Char
'*':String
s) = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' ((Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c) (Int -> Pos -> Pos
advc Int
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
'*':Char
'/':String
s) = Pos -> String -> [HsToken]
c (Int -> Pos -> Pos
advc Int
2 Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
c Pos
p (Char
x:String
s)       = (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken]
lexNest' Pos -> String -> [HsToken]
c (Char -> Pos -> Pos
updPos  Char
x Pos
p) String
s
       lexNest' Pos -> String -> [HsToken]
_ Pos
_ []          = [String -> Pos -> HsToken
Err String
"Unterminated nested comment" Pos
pos]

scanString :: String -> (String, Int, String)
scanString :: String -> (String, Int, String)
scanString []            = (String
"",Int
0,[])
scanString (Char
'\\':Char
'&':String
xs) = let (String
str,Int
w,String
r) = String -> (String, Int, String)
scanString String
xs
                           in (String
str,Int
wforall a. Num a => a -> a -> a
+Int
2,String
r)
scanString (Char
'\'':String
xs)     = let (String
str,Int
w,String
r) = String -> (String, Int, String)
scanString String
xs
                           in (Char
'\''forall a. a -> [a] -> [a]
: String
str,Int
wforall a. Num a => a -> a -> a
+Int
1,String
r)
scanString String
xs = let (Maybe Char
ch,Int
cw,String
cr) = String -> (Maybe Char, Int, String)
getchar String
xs
                    (String
str,Int
w,String
r)  = String -> (String, Int, String)
scanString String
cr
--                    str' = maybe "" (:str) ch
                in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"",Int
0,String
xs) (\Char
c -> (Char
cforall a. a -> [a] -> [a]
:String
str,Int
cwforall a. Num a => a -> a -> a
+Int
w,String
r)) Maybe Char
ch

scanQualName :: String -> (String, Int, String)
scanQualName :: String -> (String, Int, String)
scanQualName []          = (String
"",Int
0,[])
scanQualName r :: String
r@(Char
'\'':String
_)  = (String
"",Int
0,String
r)
scanQualName String
xs          = let (Maybe Char
ch,Int
cw,String
cr) = String -> (Maybe Char, Int, String)
getchar String
xs
                               (String
str,Int
w,String
r)  = String -> (String, Int, String)
scanQualName String
cr
                           in  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"",Int
0,String
xs) (\Char
c -> (Char
cforall a. a -> [a] -> [a]
:String
str,Int
cwforall a. Num a => a -> a -> a
+Int
w,String
r)) Maybe Char
ch

scanChar :: String -> (Maybe Char, Int, String)
scanChar :: String -> (Maybe Char, Int, String)
scanChar (Char
'"' :String
xs) = (forall a. a -> Maybe a
Just Char
'"',Int
1,String
xs)
scanChar String
xs        = String -> (Maybe Char, Int, String)
getchar String
xs

getchar :: String -> (Maybe Char, Int, String)
getchar :: String -> (Maybe Char, Int, String)
getchar []          = (forall a. Maybe a
Nothing,Int
0,[])
getchar s :: String
s@(Char
'\n':String
_ ) = (forall a. Maybe a
Nothing,Int
0,String
s )
getchar s :: String
s@(Char
'\t':String
_ ) = (forall a. Maybe a
Nothing,Int
0,String
s)
getchar s :: String
s@(Char
'\'':String
_ ) = (forall a. Maybe a
Nothing,Int
0,String
s)
getchar s :: String
s@(Char
'"' :String
_ ) = (forall a. Maybe a
Nothing,Int
0,String
s)
getchar   (Char
'\\':String
xs) = let (Maybe Char
c,Int
l,String
r) = String -> (Maybe Char, Int, String)
getEscChar String
xs
                      in (Maybe Char
c,Int
lforall a. Num a => a -> a -> a
+Int
1,String
r)
getchar (Char
x:String
xs)      = (forall a. a -> Maybe a
Just Char
x,Int
1,String
xs)

getEscChar :: String -> (Maybe Char, Int, String)
getEscChar :: String -> (Maybe Char, Int, String)
getEscChar [] = (forall a. Maybe a
Nothing,Int
0,[])
getEscChar s :: String
s@(Char
x:String
xs) | Char -> Bool
isDigit Char
x = let (Int
base,String
n,Int
len,String
rest) = String -> (Int, String, Int, String)
getNumber String
s
                                      val :: Int
val = Int -> String -> Int
readn Int
base  String
n
                                  in  if Int
val forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
val forall a. Ord a => a -> a -> Bool
<= Int
255
                                         then (forall a. a -> Maybe a
Just (Int -> Char
chr Int
val),Int
len, String
rest)
                                         else (forall a. Maybe a
Nothing,Int
1,String
rest)
                    | Bool
otherwise = case Char
x forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, Char)]
cntrChars of
                                 Maybe Char
Nothing -> (forall a. Maybe a
Nothing,Int
0,String
s)
                                 Just Char
c  -> (forall a. a -> Maybe a
Just Char
c,Int
1,String
xs)
  where cntrChars :: [(Char, Char)]
cntrChars = [(Char
'a',Char
'\a'),(Char
'b',Char
'\b'),(Char
'f',Char
'\f'),(Char
'n',Char
'\n'),(Char
'r',Char
'\r'),(Char
't',Char
'\t')
                    ,(Char
'v',Char
'\v'),(Char
'\\',Char
'\\'),(Char
'"',Char
'\"'),(Char
'\'',Char
'\'')]

readn :: Int -> String -> Int
readn :: Int -> String -> Int
readn Int
base String
n = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
r Char
x  -> Char -> Int
value Char
x forall a. Num a => a -> a -> a
+ Int
base forall a. Num a => a -> a -> a
* Int
r) Int
0 String
n

getNumber :: String -> (Int,String,Int,String)
getNumber :: String -> (Int, String, Int, String)
getNumber [] = forall a. HasCallStack => String -> a
error String
"Empty string"
getNumber cs :: String
cs@(Char
c:String
s)
  | Char
c forall a. Eq a => a -> a -> Bool
/= Char
'0'               = (Int, String, Int, String)
num10
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s                 = (Int, String, Int, String)
const0
  | Char
hs forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
hs forall a. Eq a => a -> a -> Bool
== Char
'X' = (Int, String, Int, String)
num16
  | Char
hs forall a. Eq a => a -> a -> Bool
== Char
'o' Bool -> Bool -> Bool
|| Char
hs forall a. Eq a => a -> a -> Bool
== Char
'O' = (Int, String, Int, String)
num8
  | Bool
otherwise              = (Int, String, Int, String)
num10
  where (Char
hs:String
ts) = String
s
        const0 :: (Int, String, Int, String)
const0 = (Int
10, String
"0",Int
1,String
s)
        num10 :: (Int, String, Int, String)
num10  = let (String
n,String
r) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs
                 in (Int
10,String
n,forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n,String
r)
        num16 :: (Int, String, Int, String)
num16   = (Char -> Bool) -> String -> Int -> (Int, String, Int, String)
readNum Char -> Bool
isHexaDigit  String
ts Int
16
        num8 :: (Int, String, Int, String)
num8    = (Char -> Bool) -> String -> Int -> (Int, String, Int, String)
readNum Char -> Bool
isOctalDigit String
ts Int
8
        readNum :: (Char -> Bool) -> String -> Int -> (Int, String, Int, String)
readNum Char -> Bool
p String
ts' Int
tk
          = let (String
n,String
rs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
p String
ts'
            in  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n then (Int, String, Int, String)
const0
                          else (Int
tk, String
n, Int
2forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n,String
rs)

isHexaDigit :: Char -> Bool
isHexaDigit :: Char -> Bool
isHexaDigit  Char
d = Char -> Bool
isDigit Char
d Bool -> Bool -> Bool
|| (Char
d forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
d forall a. Ord a => a -> a -> Bool
<= Char
'F') Bool -> Bool -> Bool
|| (Char
d forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
d forall a. Ord a => a -> a -> Bool
<= Char
'f')
isOctalDigit :: Char -> Bool
isOctalDigit :: Char -> Bool
isOctalDigit Char
d = Char
d forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
d forall a. Ord a => a -> a -> Bool
<= Char
'7'

value :: Char -> Int
value :: Char -> Int
value Char
c | Char -> Bool
isDigit Char
c = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
        | Char -> Bool
isUpper Char
c = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
10
        | Char -> Bool
isLower Char
c = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
10
value Char
_ = forall a. HasCallStack => String -> a
error String
"Not a valid value"