-----------------------------------------------------------------------------
-- |
-- Module      :  Tokenise
-- Copyright   :  2004 Malcolm Wallace
-- Licence     :  LGPL
--
-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability   :  experimental
-- Portability :  All
--
-- The purpose of this module is to lex a source file (language
-- unspecified) into tokens such that cpp can recognise a replaceable
-- symbol or macro-use, and do the right thing.
-----------------------------------------------------------------------------

module Language.Preprocessor.Cpphs.Tokenise
  ( linesCpp
  , reslash
  , tokenise
  , WordStyle(..)
  , deWordStyle
  , parseMacroCall
  ) where

import Data.Char
import Language.Preprocessor.Cpphs.HashDefine
import Language.Preprocessor.Cpphs.Position

-- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.
--   The main difference is that in Cpp mode we should recognise line
--   continuation characters.
data Mode = Haskell | Cpp

-- | linesCpp is, broadly speaking, Prelude.lines, except that
--   on a line beginning with a \#, line continuation characters are
--   recognised.  In a line continuation, the newline character is
--   preserved, but the backslash is not.
linesCpp :: String -> [String]
linesCpp :: String -> [String]
linesCpp  []                 = []
linesCpp (Char
x:String
xs) | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'#'     = Mode -> String -> String -> [String]
tok Mode
Cpp     [Char
'#'] String
xs
                | Bool
otherwise  = Mode -> String -> String -> [String]
tok Mode
Haskell [] (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
  where
    tok :: Mode -> String -> String -> [String]
tok Mode
Cpp   String
acc (Char
'\\':Char
'\n':String
ys)   = Mode -> String -> String -> [String]
tok Mode
Cpp (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
ys
    tok Mode
_     String
acc (Char
'\n':Char
'#':String
ys)    = String -> String
forall a. [a] -> [a]
reverse String
accString -> [String] -> [String]
forall a. a -> [a] -> [a]
: Mode -> String -> String -> [String]
tok Mode
Cpp [Char
'#'] String
ys
    tok Mode
_     String
acc (Char
'\n':String
ys)        = String -> String
forall a. [a] -> [a]
reverse String
accString -> [String] -> [String]
forall a. a -> [a] -> [a]
: Mode -> String -> String -> [String]
tok Mode
Haskell [] String
ys
    tok Mode
_     String
acc []               = String -> String
forall a. [a] -> [a]
reverse String
accString -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
    tok Mode
mode  String
acc (Char
y:String
ys)           = Mode -> String -> String -> [String]
tok Mode
mode (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
ys

-- | Put back the line-continuation characters.
reslash :: String -> String
reslash :: String -> String
reslash (Char
'\n':String
xs) = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
reslash String
xs
reslash (Char
x:String
xs)    = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
: String -> String
reslash String
xs
reslash   []      = []

----
-- | Submodes are required to deal correctly with nesting of lexical
--   structures.
data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)
             | String Char | LineComment | NestComment Int
             | CComment | CLineComment

-- | Each token is classified as one of Ident, Other, or Cmd:
--   * Ident is a word that could potentially match a macro name.
--   * Cmd is a complete cpp directive (\#define etc).
--   * Other is anything else.
data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)
  deriving (WordStyle -> WordStyle -> Bool
(WordStyle -> WordStyle -> Bool)
-> (WordStyle -> WordStyle -> Bool) -> Eq WordStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordStyle -> WordStyle -> Bool
$c/= :: WordStyle -> WordStyle -> Bool
== :: WordStyle -> WordStyle -> Bool
$c== :: WordStyle -> WordStyle -> Bool
Eq,Int -> WordStyle -> String -> String
[WordStyle] -> String -> String
WordStyle -> String
(Int -> WordStyle -> String -> String)
-> (WordStyle -> String)
-> ([WordStyle] -> String -> String)
-> Show WordStyle
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WordStyle] -> String -> String
$cshowList :: [WordStyle] -> String -> String
show :: WordStyle -> String
$cshow :: WordStyle -> String
showsPrec :: Int -> WordStyle -> String -> String
$cshowsPrec :: Int -> WordStyle -> String -> String
Show)
other :: Posn -> String -> WordStyle
other :: Posn -> String -> WordStyle
other Posn
_ String
s = String -> WordStyle
Other String
s

deWordStyle :: WordStyle -> String
deWordStyle :: WordStyle -> String
deWordStyle (Ident Posn
_ String
i) = String
i
deWordStyle (Other String
i)   = String
i
deWordStyle (Cmd Maybe HashDefine
_)     = String
"\n"

-- | tokenise is, broadly-speaking, Prelude.words, except that:
--    * the input is already divided into lines
--    * each word-like "token" is categorised as one of {Ident,Other,Cmd}
--    * \#define's are parsed and returned out-of-band using the Cmd variant
--    * All whitespace is preserved intact as tokens.
--    * C-comments are converted to white-space (depending on first param)
--    * Parens and commas are tokens in their own right.
--    * Any cpp line continuations are respected.
--   No errors can be raised.
--   The inverse of tokenise is (concatMap deWordStyle).
tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]
tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn, String)] -> [WordStyle]
tokenise Bool
_        Bool
_             Bool
_    Bool
_     [] = []
tokenise Bool
stripEol Bool
stripComments Bool
ansi Bool
lang ((Posn
pos,String
str):[(Posn, String)]
pos_strs) =
    (if Bool
lang then SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell else SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext) SubMode
Any [] Posn
pos [(Posn, String)]
pos_strs String
str
 where
    -- rules to lex Haskell
  haskell :: SubMode -> String -> Posn -> [(Posn,String)]
             -> String -> [WordStyle]
  haskell :: SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'\n':Char
'#':String
xs)      = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$  -- emit "\n" $
                                            SubMode
-> (SubMode
    -> String -> Posn -> [(Posn, String)] -> String -> [WordStyle])
-> String
-> [String]
-> Posn
-> [(Posn, String)]
-> String
-> [WordStyle]
cpp SubMode
Any SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell [] [] Posn
p [(Posn, String)]
ls String
xs
    -- warning: non-maximal munch on comment
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'-':Char
'-':String
xs)       = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
LineComment String
"--" Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'{':Char
'-':String
xs)       = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Int -> SubMode
NestComment Int
0) String
"-{" Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'/':Char
'*':String
xs)
                          | Bool
stripComments = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
CComment String
"  " Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'/':Char
'/':String
xs)
                          | Bool
stripEol      = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
CLineComment String
"  " Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'"':String
xs)           = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Char -> SubMode
String Char
'"') [Char
'"'] Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'\'':Char
'\'':String
xs)     = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ -- TH type quote
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any String
"''" Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'\'':xs :: String
xs@(Char
'\\':String
_)) = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ -- escaped char literal
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Char -> SubMode
String Char
'\'') String
"'" Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'\'':Char
x:Char
'\'':String
xs)   = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ -- character literal
                                            String -> [WordStyle] -> [WordStyle]
emit [Char
'\'', Char
x, Char
'\''] ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'\'':String
xs)          = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ -- TH name quote
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any String
"'" Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
single Char
x  = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ String -> [WordStyle] -> [WordStyle]
emit [Char
x] ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
space Char
x   = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
space Posn -> String -> WordStyle
other) [Char
x]
                                                                        Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
symbol Char
x  = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
symbol Posn -> String -> WordStyle
other) [Char
x]
                                                                        Posn
p [(Posn, String)]
ls String
xs
 -- haskell Any [] p ls (x:xs) | ident0 x  = id $
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
ident0 Char
x  = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
ident1 Posn -> String -> WordStyle
Ident) [Char
x]
                                                                        Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)             = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs

  haskell pre :: SubMode
pre@(Pred Char -> Bool
pred Posn -> String -> WordStyle
ws) String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)
                        | Char -> Bool
pred Char
x    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
pre (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (Pred Char -> Bool
_ Posn -> String -> WordStyle
ws) String
acc Posn
p [(Posn, String)]
ls String
xs   = Posn -> String -> WordStyle
ws Posn
p (String -> String
forall a. [a] -> [a]
reverse String
acc)WordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:
                                      SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell (String Char
c) String
acc Posn
p [(Posn, String)]
ls (Char
'\\':Char
x:String
xs)
                        | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\\'   = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Char -> SubMode
String Char
c) (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
                        | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c      = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Char -> SubMode
String Char
c) (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (String Char
c) String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)
                        | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c      = String -> [WordStyle] -> [WordStyle]
emit (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
                        | Bool
otherwise = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Char -> SubMode
String Char
c) (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
LineComment String
acc Posn
p [(Posn, String)]
ls xs :: String
xs@(Char
'\n':String
_) = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
LineComment String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)      = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
LineComment (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (NestComment Int
n) String
acc Posn
p [(Posn, String)]
ls (Char
'{':Char
'-':String
xs)
                                    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Int -> SubMode
NestComment (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
                                                            (String
"-{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (NestComment Int
0) String
acc Posn
p [(Posn, String)]
ls (Char
'-':Char
'}':String
xs)
                                    = String -> [WordStyle] -> [WordStyle]
emit (String
"}-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell (NestComment Int
n) String
acc Posn
p [(Posn, String)]
ls (Char
'-':Char
'}':String
xs)
                                    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Int -> SubMode
NestComment (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                                                            (String
"}-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (NestComment Int
n) String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Int -> SubMode
NestComment Int
n) (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc)
                                                                        Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
CComment String
acc Posn
p [(Posn, String)]
ls (Char
'*':Char
'/':String
xs)  = String -> [WordStyle] -> [WordStyle]
emit (String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                            SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
CComment String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)        = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
CComment (Char -> Char
white Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
CLineComment String
acc Posn
p [(Posn, String)]
ls xs :: String
xs@(Char
'\n':String
_)= String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
CLineComment String
acc Posn
p [(Posn, String)]
ls (Char
_:String
xs)    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
CLineComment (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc)
                                                                       Posn
p [(Posn, String)]
ls String
xs
  haskell SubMode
mode String
acc Posn
_ ((Posn
p,String
l):[(Posn, String)]
ls) []        = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
mode String
acc Posn
p [(Posn, String)]
ls (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
l)
  haskell SubMode
_    String
acc Posn
_ [] []                = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ []

  -- rules to lex Cpp
  cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]
                     -> String -> [WordStyle])
         -> String -> [String] -> Posn -> [(Posn,String)]
         -> String -> [WordStyle]
  cpp :: SubMode
-> (SubMode
    -> String -> Posn -> [(Posn, String)] -> String -> [WordStyle])
-> String
-> [String]
-> Posn
-> [(Posn, String)]
-> String
-> [WordStyle]
cpp SubMode
mode SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
next String
word [String]
line Posn
pos [(Posn, String)]
remaining String
input =
    SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
mode String
word [String]
line [(Posn, String)]
remaining String
input
   where
    lexcpp :: SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls (Char
'/':Char
'*':String
xs)   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Int -> SubMode
NestComment Int
0) String
"" (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls (Char
'/':Char
'/':String
xs)   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
LineComment String
"  " (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp SubMode
Any String
w [String]
l ((Posn
p,String
l'):[(Posn, String)]
ls) (Char
'\\':[])  = SubMode
-> (SubMode
    -> String -> Posn -> [(Posn, String)] -> String -> [WordStyle])
-> String
-> [String]
-> Posn
-> [(Posn, String)]
-> String
-> [WordStyle]
cpp SubMode
Any SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
next [] (String
"\n"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
wString -> [String] -> [String]
*/*[String]
l) Posn
p [(Posn, String)]
ls String
l'
    lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls (Char
'\\':Char
'\n':String
xs) = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] (String
"\n"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls xs :: String
xs@(Char
'\n':String
_)    = Maybe HashDefine -> WordStyle
Cmd (Bool -> [String] -> Maybe HashDefine
parseHashDefine Bool
ansi
                                                           ([String] -> [String]
forall a. [a] -> [a]
reverse (String
wString -> [String] -> [String]
*/*[String]
l)))WordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:
                                       SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
next SubMode
Any [] Posn
pos [(Posn, String)]
ls String
xs
 -- lexcpp Any w l ls ('"':xs)     = lexcpp (String '"') ['"'] (w*/*l) ls xs
 -- lexcpp Any w l ls ('\'':xs)    = lexcpp (String '\'') "'"  (w*/*l) ls xs
    lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls (Char
'"':String
xs)       = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] (String
"\""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
wString -> [String] -> [String]
*/*[String]
l)) [(Posn, String)]
ls String
xs
    lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls (Char
'\'':String
xs)      = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] (String
"'"String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
wString -> [String] -> [String]
*/*[String]
l)) [(Posn, String)]
ls String
xs
    lexcpp SubMode
Any [] [String]
l [(Posn, String)]
ls (Char
x:String
xs)
                    | Char -> Bool
ident0 Char
x  = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
ident1 Posn -> String -> WordStyle
Ident) [Char
x] [String]
l [(Posn, String)]
ls String
xs
 -- lexcpp Any w l ls (x:xs) | ident0 x  = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs
    lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls (Char
x:String
xs)
                    | Char -> Bool
single Char
x  = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] ([Char
x]String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
                    | Char -> Bool
space Char
x   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
space Posn -> String -> WordStyle
other) [Char
x] (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
                    | Char -> Bool
symbol Char
x  = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
symbol Posn -> String -> WordStyle
other) [Char
x] (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
                    | Bool
otherwise = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp pre :: SubMode
pre@(Pred Char -> Bool
pred Posn -> String -> WordStyle
_) String
w [String]
l [(Posn, String)]
ls (Char
x:String
xs)
                    | Char -> Bool
pred Char
x    = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
pre (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp (Pred Char -> Bool
_ Posn -> String -> WordStyle
_) String
w [String]
l [(Posn, String)]
ls String
xs = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp (String Char
c) String
w [String]
l [(Posn, String)]
ls (Char
'\\':Char
x:String
xs)
                    | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\\'   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Char -> SubMode
String Char
c) (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
                    | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c      = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Char -> SubMode
String Char
c) (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp (String Char
c) String
w [String]
l [(Posn, String)]
ls (Char
x:String
xs)
                    | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c      = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] ((Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
w)String -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
                    | Bool
otherwise = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Char -> SubMode
String Char
c) (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp SubMode
LineComment String
w [String]
l ((Posn
p,String
l'):[(Posn, String)]
ls) (Char
'\\':[])
                             = SubMode
-> (SubMode
    -> String -> Posn -> [(Posn, String)] -> String -> [WordStyle])
-> String
-> [String]
-> Posn
-> [(Posn, String)]
-> String
-> [WordStyle]
cpp SubMode
LineComment SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
next [] ((Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w)String -> [String] -> [String]
*/*[String]
l) Posn
pos [(Posn, String)]
ls String
l'
    lexcpp SubMode
LineComment String
w [String]
l [(Posn, String)]
ls (Char
'\\':Char
'\n':String
xs)
                                = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
LineComment [] ((Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w)String -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp SubMode
LineComment String
w [String]
l [(Posn, String)]
ls xs :: String
xs@(Char
'\n':String
_) = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls String
xs
    lexcpp SubMode
LineComment String
w [String]
l [(Posn, String)]
ls (Char
_:String
xs)      = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
LineComment (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp (NestComment Int
_) String
w [String]
l [(Posn, String)]
ls (Char
'*':Char
'/':String
xs)
                                          = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp (NestComment Int
n) String
w [String]
l [(Posn, String)]
ls (Char
x:String
xs)  = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Int -> SubMode
NestComment Int
n) (Char -> Char
white Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l
                                                                        [(Posn, String)]
ls String
xs
    lexcpp SubMode
mode String
w [String]
l ((Posn
p,String
l'):[(Posn, String)]
ls) []        = SubMode
-> (SubMode
    -> String -> Posn -> [(Posn, String)] -> String -> [WordStyle])
-> String
-> [String]
-> Posn
-> [(Posn, String)]
-> String
-> [WordStyle]
cpp SubMode
mode SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
next String
w [String]
l Posn
p [(Posn, String)]
ls (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
l')
    lexcpp SubMode
_    String
_ [String]
_ []          []        = []

    -- rules to lex non-Haskell, non-cpp text
  plaintext :: SubMode -> String -> Posn -> [(Posn,String)]
            -> String -> [WordStyle]
  plaintext :: SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'\n':Char
'#':String
xs)  = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$  -- emit "\n" $
                                          SubMode
-> (SubMode
    -> String -> Posn -> [(Posn, String)] -> String -> [WordStyle])
-> String
-> [String]
-> Posn
-> [(Posn, String)]
-> String
-> [WordStyle]
cpp SubMode
Any SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext [] [] Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'/':Char
'*':String
xs)
                           | Bool
stripComments = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
CComment String
"  " Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
'/':Char
'/':String
xs)
                                | Bool
stripEol = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
CLineComment String
"  " Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
single Char
x = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ String -> [WordStyle] -> [WordStyle]
emit [Char
x] ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
space Char
x  = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
space Posn -> String -> WordStyle
other) [Char
x]
                                                                        Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs) | Char -> Bool
ident0 Char
x = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext ((Char -> Bool) -> (Posn -> String -> WordStyle) -> SubMode
Pred Char -> Bool
ident1 Posn -> String -> WordStyle
Ident) [Char
x]
                                                                        Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
Any String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)            = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
Any (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  plaintext pre :: SubMode
pre@(Pred Char -> Bool
pred Posn -> String -> WordStyle
ws) String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)
                                | Char -> Bool
pred Char
x   = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
pre (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  plaintext (Pred Char -> Bool
_ Posn -> String -> WordStyle
ws) String
acc Posn
p [(Posn, String)]
ls String
xs        = Posn -> String -> WordStyle
ws Posn
p (String -> String
forall a. [a] -> [a]
reverse String
acc)WordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
CComment String
acc Posn
p [(Posn, String)]
ls (Char
'*':Char
'/':String
xs) = String -> [WordStyle] -> [WordStyle]
emit (String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$
                                             SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
CComment String
acc Posn
p [(Posn, String)]
ls (Char
x:String
xs)       = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
CComment (Char -> Char
white Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
CLineComment String
acc Posn
p [(Posn, String)]
ls xs :: String
xs@(Char
'\n':String
_)
                                        = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
Any [] Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
CLineComment String
acc Posn
p [(Posn, String)]
ls (Char
_:String
xs)= SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
CLineComment (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc)
                                                                       Posn
p [(Posn, String)]
ls String
xs
  plaintext SubMode
mode String
acc Posn
_ ((Posn
p,String
l):[(Posn, String)]
ls) []    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
mode String
acc Posn
p [(Posn, String)]
ls (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
l)
  plaintext SubMode
_    String
acc Posn
_ [] []            = String -> [WordStyle] -> [WordStyle]
emit String
acc ([WordStyle] -> [WordStyle]) -> [WordStyle] -> [WordStyle]
forall a b. (a -> b) -> a -> b
$ []

  -- predicates for lexing Haskell.
  ident0 :: Char -> Bool
ident0 Char
x = Char -> Bool
isAlpha Char
x    Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"_`"
  ident1 :: Char -> Bool
ident1 Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"'_`"
  symbol :: Char -> Bool
symbol Char
x = Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
":!#$%&*+./<=>?@\\^|-~"
  single :: Char -> Bool
single Char
x = Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"(),[];{}"
  space :: Char -> Bool
space  Char
x = Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \t"
  -- conversion of comment text to whitespace
  white :: Char -> Char
white Char
'\n' = Char
'\n'
  white Char
'\r' = Char
'\r'
  white Char
_    = Char
' '
  -- emit a token (if there is one) from the accumulator
  emit :: String -> [WordStyle] -> [WordStyle]
emit String
""  = [WordStyle] -> [WordStyle]
forall a. a -> a
id
  emit String
xs  = (String -> WordStyle
Other (String -> String
forall a. [a] -> [a]
reverse String
xs)WordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:)
  -- add a reversed word to the accumulator
  String
"" */* :: String -> [String] -> [String]
*/* [String]
l = [String]
l
  String
w */* [String]
l  = String -> String
forall a. [a] -> [a]
reverse String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
l
  -- help out broken Haskell compilers which need balanced numbers of C
  -- comments in order to do import chasing :-)  ----->   */*


-- | Parse a possible macro call, returning argument list and remaining input
parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]],[WordStyle])
parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]], [WordStyle])
parseMacroCall Posn
p = [WordStyle] -> Maybe ([[WordStyle]], [WordStyle])
call ([WordStyle] -> Maybe ([[WordStyle]], [WordStyle]))
-> ([WordStyle] -> [WordStyle])
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WordStyle] -> [WordStyle]
skip
  where
    skip :: [WordStyle] -> [WordStyle]
skip (Other String
x:[WordStyle]
xs) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
x = [WordStyle] -> [WordStyle]
skip [WordStyle]
xs
    skip [WordStyle]
xss                          = [WordStyle]
xss
    call :: [WordStyle] -> Maybe ([[WordStyle]], [WordStyle])
call (Other String
"(":[WordStyle]
xs)   = (Int
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
forall a.
(Eq a, Num a) =>
a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args (Int
0::Int) [] [] ([WordStyle] -> Maybe ([[WordStyle]], [WordStyle]))
-> ([WordStyle] -> [WordStyle])
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WordStyle] -> [WordStyle]
skip) [WordStyle]
xs
    call [WordStyle]
_                = Maybe ([[WordStyle]], [WordStyle])
forall a. Maybe a
Nothing
    args :: a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args a
0 [WordStyle]
w [[WordStyle]]
acc (   Other String
")" :[WordStyle]
xs)  = ([[WordStyle]], [WordStyle]) -> Maybe ([[WordStyle]], [WordStyle])
forall a. a -> Maybe a
Just ([[WordStyle]] -> [[WordStyle]]
forall a. [a] -> [a]
reverse ([WordStyle] -> [[WordStyle]] -> [[WordStyle]]
addone [WordStyle]
w [[WordStyle]]
acc), [WordStyle]
xs)
    args a
0 [WordStyle]
w [[WordStyle]]
acc (   Other String
"," :[WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args a
0     []   ([WordStyle] -> [[WordStyle]] -> [[WordStyle]]
addone [WordStyle]
w [[WordStyle]]
acc) ([WordStyle] -> [WordStyle]
skip [WordStyle]
xs)
    args a
n [WordStyle]
w [[WordStyle]]
acc (x :: WordStyle
x@(Other String
"("):[WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) (WordStyle
xWordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:[WordStyle]
w)         [[WordStyle]]
acc    [WordStyle]
xs
    args a
n [WordStyle]
w [[WordStyle]]
acc (x :: WordStyle
x@(Other String
")"):[WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) (WordStyle
xWordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:[WordStyle]
w)         [[WordStyle]]
acc    [WordStyle]
xs
    args a
n [WordStyle]
w [[WordStyle]]
acc (   Ident Posn
_ String
v :[WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args a
n     (Posn -> String -> WordStyle
Ident Posn
p String
vWordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:[WordStyle]
w) [[WordStyle]]
acc    [WordStyle]
xs
    args a
n [WordStyle]
w [[WordStyle]]
acc (x :: WordStyle
x@(Other String
_)  :[WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args a
n     (WordStyle
xWordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:[WordStyle]
w)         [[WordStyle]]
acc    [WordStyle]
xs
    args a
_ [WordStyle]
_ [[WordStyle]]
_   [WordStyle]
_                   = Maybe ([[WordStyle]], [WordStyle])
forall a. Maybe a
Nothing
    addone :: [WordStyle] -> [[WordStyle]] -> [[WordStyle]]
addone [WordStyle]
w [[WordStyle]]
acc = [WordStyle] -> [WordStyle]
forall a. [a] -> [a]
reverse ([WordStyle] -> [WordStyle]
skip [WordStyle]
w)[WordStyle] -> [[WordStyle]] -> [[WordStyle]]
forall a. a -> [a] -> [a]
: [[WordStyle]]
acc