-----------------------------------------------------------------------------
-- |
-- 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 (x :: Char
x:xs :: String
xs) | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='#'     = Mode -> String -> String -> [String]
tok Mode
Cpp     ['#'] 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 Cpp   acc :: String
acc ('\\':'\n':ys :: String
ys)   = Mode -> String -> String -> [String]
tok Mode
Cpp ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
ys
    tok _     acc :: String
acc ('\n':'#':ys :: 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 ['#'] String
ys
    tok _     acc :: String
acc ('\n':ys :: 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 _     acc :: String
acc []               = String -> String
forall a. [a] -> [a]
reverse String
accString -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
    tok mode :: Mode
mode  acc :: String
acc (y :: Char
y:ys :: 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 ('\n':xs :: String
xs) = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
reslash String
xs
reslash (x :: Char
x:xs :: 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 _ s :: String
s = String -> WordStyle
Other String
s

deWordStyle :: WordStyle -> String
deWordStyle :: WordStyle -> String
deWordStyle (Ident _ i :: String
i) = String
i
deWordStyle (Other i :: String
i)   = String
i
deWordStyle (Cmd _)     = "\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 _        _             _    _     [] = []
tokenise stripEol :: Bool
stripEol stripComments :: Bool
stripComments ansi :: Bool
ansi lang :: Bool
lang ((pos :: Posn
pos,str :: String
str):pos_strs :: [(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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\n':'#':xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('-':'-':xs :: 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 "--" Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('{':'-':xs :: 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 0) "-{" Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('/':'*':xs :: 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 "  " Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('/':'/':xs :: 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 "  " Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('"':xs :: 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 '"') ['"'] Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\'':'\'':xs :: 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 "''" Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\'':xs :: String
xs@('\\':_)) = 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 '\'') "'" Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\'':x :: Char
x:'\'':xs :: 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
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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\'':xs :: 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 "'" Posn
p [(Posn, String)]
ls String
xs
  haskell Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 pred :: Char -> Bool
pred ws :: Posn -> String -> WordStyle
ws) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 _ ws :: Posn -> String -> WordStyle
ws) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls xs :: 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 c :: Char
c) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\\':x :: Char
x:xs :: String
xs)
                        | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\\'   = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Char -> SubMode
String Char
c) ('\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\\'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 -> String -> String
forall a. a -> [a] -> [a]
:String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (String c :: Char
c) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 LineComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls xs :: String
xs@('\n':_) = 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 LineComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 n :: Int
n) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('{':'-':xs :: String
xs)
                                    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Int -> SubMode
NestComment (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))
                                                            ("-{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (NestComment 0) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('-':'}':xs :: String
xs)
                                    = String -> [WordStyle] -> [WordStyle]
emit ("}-"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 n :: Int
n) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('-':'}':xs :: String
xs)
                                    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell (Int -> SubMode
NestComment (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1))
                                                            ("}-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
acc) Posn
p [(Posn, String)]
ls String
xs
  haskell (NestComment n :: Int
n) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 CComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('*':'/':xs :: String
xs)  = String -> [WordStyle] -> [WordStyle]
emit ("  "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 CComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 CLineComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls xs :: String
xs@('\n':_)= 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 CLineComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (_:xs :: String
xs)    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
CLineComment (' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc)
                                                                       Posn
p [(Posn, String)]
ls String
xs
  haskell mode :: SubMode
mode acc :: String
acc _ ((p :: Posn
p,l :: String
l):ls :: [(Posn, String)]
ls) []        = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
haskell SubMode
mode String
acc Posn
p [(Posn, String)]
ls ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
l)
  haskell _    acc :: String
acc _ [] []                = 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 mode :: SubMode
mode next :: SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
next word :: String
word line :: [String]
line pos :: Posn
pos remaining :: [(Posn, String)]
remaining input :: 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 Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('/':'*':xs :: String
xs)   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Int -> SubMode
NestComment 0) "" (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('/':'/':xs :: String
xs)   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
LineComment "  " (String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp Any w :: String
w l :: [String]
l ((p :: Posn
p,l' :: String
l'):ls :: [(Posn, String)]
ls) ('\\':[])  = 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 [] ("\n"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
wString -> [String] -> [String]
*/*[String]
l) Posn
p [(Posn, String)]
ls String
l'
    lexcpp Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('\\':'\n':xs :: String
xs) = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] ("\n"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
wString -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls xs :: String
xs@('\n':_)    = 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 Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('"':xs :: String
xs)       = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] ("\""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
wString -> [String] -> [String]
*/*[String]
l)) [(Posn, String)]
ls String
xs
    lexcpp Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('\'':xs :: String
xs)      = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any [] ("'"String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
wString -> [String] -> [String]
*/*[String]
l)) [(Posn, String)]
ls String
xs
    lexcpp Any [] l :: [String]
l ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 pred :: Char -> Bool
pred _) w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 _ _) w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls xs :: 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 c :: Char
c) w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('\\':x :: Char
x:xs :: String
xs)
                    | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\\'   = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp (Char -> SubMode
String Char
c) ('\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\\'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 -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp (String c :: Char
c) w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 LineComment w :: String
w l :: [String]
l ((p :: Posn
p,l' :: String
l'):ls :: [(Posn, String)]
ls) ('\\':[])
                             = 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 [] (('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w)String -> [String] -> [String]
*/*[String]
l) Posn
pos [(Posn, String)]
ls String
l'
    lexcpp LineComment w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('\\':'\n':xs :: String
xs)
                                = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
LineComment [] (('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w)String -> [String] -> [String]
*/*[String]
l) [(Posn, String)]
ls String
xs
    lexcpp LineComment w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls xs :: String
xs@('\n':_) = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
Any String
w [String]
l [(Posn, String)]
ls String
xs
    lexcpp LineComment w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls (_:xs :: String
xs)      = SubMode
-> String -> [String] -> [(Posn, String)] -> String -> [WordStyle]
lexcpp SubMode
LineComment (' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
w) [String]
l [(Posn, String)]
ls String
xs
    lexcpp (NestComment _) w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls ('*':'/':xs :: 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 n :: Int
n) w :: String
w l :: [String]
l ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 mode :: SubMode
mode w :: String
w l :: [String]
l ((p :: Posn
p,l' :: String
l'):ls :: [(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 ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
l')
    lexcpp _    _ _ []          []        = []

    -- 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('\n':'#':xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('/':'*':xs :: 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 "  " Posn
p [(Posn, String)]
ls String
xs
  plaintext Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('/':'/':xs :: 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 "  " Posn
p [(Posn, String)]
ls String
xs
  plaintext Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 Any acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 pred :: Char -> Bool
pred ws :: Posn -> String -> WordStyle
ws) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 _ ws :: Posn -> String -> WordStyle
ws) acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls xs :: 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 CComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls ('*':'/':xs :: String
xs) = String -> [WordStyle] -> [WordStyle]
emit ("  "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 CComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (x :: Char
x:xs :: 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 CLineComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls xs :: String
xs@('\n':_)
                                        = 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 CLineComment acc :: String
acc p :: Posn
p ls :: [(Posn, String)]
ls (_:xs :: String
xs)= SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
CLineComment (' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc)
                                                                       Posn
p [(Posn, String)]
ls String
xs
  plaintext mode :: SubMode
mode acc :: String
acc _ ((p :: Posn
p,l :: String
l):ls :: [(Posn, String)]
ls) []    = SubMode
-> String -> Posn -> [(Posn, String)] -> String -> [WordStyle]
plaintext SubMode
mode String
acc Posn
p [(Posn, String)]
ls ('\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
l)
  plaintext _    acc :: String
acc _ [] []            = 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 x :: 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` "_`"
  ident1 :: Char -> Bool
ident1 x :: 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` "'_`"
  symbol :: Char -> Bool
symbol x :: Char
x = Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ":!#$%&*+./<=>?@\\^|-~"
  single :: Char -> Bool
single x :: Char
x = Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "(),[];{}"
  space :: Char -> Bool
space  x :: Char
x = Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` " \t"
  -- conversion of comment text to whitespace
  white :: Char -> Char
white '\n' = '\n'
  white '\r' = '\r'
  white _    = ' '
  -- emit a token (if there is one) from the accumulator
  emit :: String -> [WordStyle] -> [WordStyle]
emit ""  = [WordStyle] -> [WordStyle]
forall a. a -> a
id
  emit xs :: 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]
*/* l :: [String]
l = [String]
l
  w :: String
w */* l :: [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 p :: 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 x :: String
x:xs :: [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 xss :: [WordStyle]
xss                          = [WordStyle]
xss
    call :: [WordStyle] -> Maybe ([[WordStyle]], [WordStyle])
call (Other "(":xs :: [WordStyle]
xs)   = (Int
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
forall a.
(Eq a, Num a) =>
a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args (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 _                = Maybe ([[WordStyle]], [WordStyle])
forall a. Maybe a
Nothing
    args :: a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args 0 w :: [WordStyle]
w acc :: [[WordStyle]]
acc (   Other ")" :xs :: [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 0 w :: [WordStyle]
w acc :: [[WordStyle]]
acc (   Other "," :xs :: [WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args 0     []   ([WordStyle] -> [[WordStyle]] -> [[WordStyle]]
addone [WordStyle]
w [[WordStyle]]
acc) ([WordStyle] -> [WordStyle]
skip [WordStyle]
xs)
    args n :: a
n w :: [WordStyle]
w acc :: [[WordStyle]]
acc (x :: WordStyle
x@(Other "("):xs :: [WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args (a
na -> a -> a
forall a. Num a => a -> a -> a
+1) (WordStyle
xWordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:[WordStyle]
w)         [[WordStyle]]
acc    [WordStyle]
xs
    args n :: a
n w :: [WordStyle]
w acc :: [[WordStyle]]
acc (x :: WordStyle
x@(Other ")"):xs :: [WordStyle]
xs)  = a
-> [WordStyle]
-> [[WordStyle]]
-> [WordStyle]
-> Maybe ([[WordStyle]], [WordStyle])
args (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) (WordStyle
xWordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
:[WordStyle]
w)         [[WordStyle]]
acc    [WordStyle]
xs
    args n :: a
n w :: [WordStyle]
w acc :: [[WordStyle]]
acc (   Ident _ v :: String
v :xs :: [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 n :: a
n w :: [WordStyle]
w acc :: [[WordStyle]]
acc (x :: WordStyle
x@(Other _)  :xs :: [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 _ _ _   _                   = Maybe ([[WordStyle]], [WordStyle])
forall a. Maybe a
Nothing
    addone :: [WordStyle] -> [[WordStyle]] -> [[WordStyle]]
addone w :: [WordStyle]
w acc :: [[WordStyle]]
acc = [WordStyle] -> [WordStyle]
forall a. [a] -> [a]
reverse ([WordStyle] -> [WordStyle]
skip [WordStyle]
w)[WordStyle] -> [[WordStyle]] -> [[WordStyle]]
forall a. a -> [a] -> [a]
: [[WordStyle]]
acc