module Language.Haskell.Lexer.Utils
  ( module Language.Haskell.Lexer.Utils
  , Token(..)
  ) where

import Language.Haskell.Lexer.Tokens

gotEOF :: [a] -> [(Token,[a])]
gotEOF :: forall a. [a] -> [(Token, [a])]
gotEOF [] = []
gotEOF [a]
as = [(Token
GotEOF, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
as)]

gotError :: [a] -> [a] -> [(Token, [a])]
gotError :: forall a. [a] -> [a] -> [(Token, [a])]
gotError [a]
as [a]
is =
  (Token
ErrorToken, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
as)(Token, [a]) -> [(Token, [a])] -> [(Token, [a])]
forall a. a -> [a] -> [a]
:
  if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
is then [(Token
GotEOF,[])] else [(Token
TheRest,[a]
is{-reverse (take 80 is)-})]

-- Inlining the call to output does not make a big difference.
--output token as cont = (token, reverse as):cont

-- Not reversing the token string seems to save about 10% of the time with HBC.
-- The difference in speed seems insignificant with ghc-6.0.1 -O.

output :: t -> [a] -> [(t, [a])] -> [(t, [a])]
output :: forall t a. t -> [a] -> [(t, [a])] -> [(t, [a])]
output t
token [a]
as [(t, [a])]
cont = (t
token,[a] -> [a]
forall a. [a] -> [a]
reverse [a]
as)(t, [a]) -> [(t, [a])] -> [(t, [a])]
forall a. a -> [a] -> [a]
:[(t, [a])]
cont

-- This avoids constructing a closure for the call to reverse.
-- This saves about 10% too.
{-
output token as cont =
    rev as []
  where
    rev [] as' = (token,as'):cont
    rev (a:as) as' = rev as (a:as')
--}

nestedComment :: [Char] -> [Char] -> (([a] -> [a] -> [(Token, [a])])
              -> [Char] -> [Char] -> [(Token, [Char])]) -> [(Token, [Char])]

nestedComment :: forall a.
[Char]
-> [Char]
-> (([a] -> [a] -> [(Token, [a])])
    -> [Char] -> [Char] -> [(Token, [Char])])
-> [(Token, [Char])]
nestedComment [Char]
as' [Char]
is' ([a] -> [a] -> [(Token, [a])])
-> [Char] -> [Char] -> [(Token, [Char])]
next = Int -> [Char] -> [Char] -> [(Token, [Char])]
forall {t}.
(Eq t, Num t) =>
t -> [Char] -> [Char] -> [(Token, [Char])]
nest (Int
0::Int) [Char]
as' [Char]
is'
  where
    nest :: t -> [Char] -> [Char] -> [(Token, [Char])]
nest t
n [Char]
as [Char]
is =
      case [Char]
is of
        Char
'-' : Char
'}' : [Char]
is1   -> if t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
                               then ([a] -> [a] -> [(Token, [a])])
-> [Char] -> [Char] -> [(Token, [Char])]
next [a] -> [a] -> [(Token, [a])]
forall a. [a] -> [a] -> [(Token, [a])]
gotError (Char
'}'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
as) [Char]
is1
                               else t -> [Char] -> [Char] -> [(Token, [Char])]
nest (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Char
'}'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
as) [Char]
is1
        Char
'{' : Char
'-' : [Char]
is1   -> t -> [Char] -> [Char] -> [(Token, [Char])]
nest (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) (Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'{'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
as) [Char]
is1
        Char
c : [Char]
is1           -> t -> [Char] -> [Char] -> [(Token, [Char])]
nest t
n (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
as) [Char]
is1
        []                -> [Char] -> [Char] -> [(Token, [Char])]
forall a. [a] -> [a] -> [(Token, [a])]
gotError [Char]
as [Char]
is -- EOF inside comment