{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances #-}
module Scanner where
import GHC.Prim
import TokenDef
import UU.Scanner.Position
import UU.Scanner.Token
import UU.Parsing(InputState(..),Either'(..))
import Data.Maybe
import Data.List
import Data.Char
import UU.Scanner.GenToken
import Options (Options (..))

data Input = Input !Pos String (Maybe (Token, Input))

instance InputState Input Token Pos where
 splitStateE :: Input -> Either' Input Token
splitStateE input :: Input
input@(Input Pos
_ [Char]
_ Maybe (Token, Input)
next) =
                case Maybe (Token, Input)
next of
                     Maybe (Token, Input)
Nothing         -> forall state s. state -> Either' state s
Right' Input
input
                     Just (Token
s, Input
rest)  -> forall state s. s -> state -> Either' state s
Left' Token
s Input
rest
 splitState :: Input -> (# Token, Input #)
splitState (Input Pos
_ [Char]
_ Maybe (Token, Input)
next) =
                case Maybe (Token, Input)
next of
                     Maybe (Token, Input)
Nothing         -> forall a. HasCallStack => [Char] -> a
error [Char]
"splitState on empty input"
                     Just (Token
s, Input
rest)  -> (# Token
s, Input
rest #)
 getPosition :: Input -> Pos
getPosition (Input Pos
pos [Char]
_ Maybe (Token, Input)
next) =  case Maybe (Token, Input)
next of
                                    Just (Token
s,Input
_) -> forall k t v. GenToken k t v -> Pos
position Token
s
                                    Maybe (Token, Input)
Nothing    -> Pos
pos -- end of file


input :: Options -> Pos -> String -> Input
input :: Options -> Pos -> [Char] -> Input
input Options
opts Pos
pos [Char]
inp = Pos -> [Char] -> Maybe (Token, Input) -> Input
Input Pos
pos
                      [Char]
inp
                      (case Options -> Lexer Token
scan Options
opts Pos
pos [Char]
inp of
                             Maybe (Token, Pos, [Char])
Nothing      -> forall a. Maybe a
Nothing
                             Just (Token
s,Pos
p,[Char]
r) -> forall a. a -> Maybe a
Just (Token
s, Options -> Pos -> [Char] -> Input
input Options
opts Pos
p [Char]
r)
                      )

type Lexer s = Pos -> String -> Maybe (s,Pos,String)

scan :: Options -> Lexer Token
scan :: Options -> Lexer Token
scan Options
opts Pos
p0
  | forall p. Position p => p -> Column
column Pos
p0 forall a. Eq a => a -> a -> Bool
== Column
1 = Lexer Token
scanBeginOfLine Pos
p0
  | Bool
otherwise      = Lexer Token
scan Pos
p0
  where
    keywords' :: [[Char]]
keywords' = if Options -> Bool
lcKeywords Options
opts
                then forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [[Char]]
keywords
                else [[Char]]
keywords
    mkKeyword :: [Char] -> [Char]
mkKeyword [Char]
s | [Char]
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
lowercaseKeywords = [Char]
s
                | Bool
otherwise                  = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s

    scan :: Lexer Token
    scan :: Lexer Token
scan Pos
p []                        = forall a. Maybe a
Nothing
    scan Pos
p (Char
'/':Char
'/':[Char]
xs)
      | Options -> Bool
clean Options
opts
                                     = let ([Char]
com,[Char]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'\n') [Char]
xs
                                       in forall a. Column -> Pos -> (Pos -> a) -> a
advc' (Column
2forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
com) Pos
p Lexer Token
scan [Char]
rest
    scan Pos
p (Char
'-':Char
'-':[Char]
xs) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
xs Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. [a] -> a
head [Char]
xs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"<>!?#@:%$^&")
                                     = let ([Char]
com,[Char]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'\n') [Char]
xs
                                       in forall a. Column -> Pos -> (Pos -> a) -> a
advc' (Column
2forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
com) Pos
p Lexer Token
scan [Char]
rest
    scan Pos
p (Char
'{':Char
'-':[Char]
xs)              = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p (forall {a}.
(Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
ncomment Lexer Token
scan) [Char]
xs
    scan Pos
p (Char
'/':Char
'*':[Char]
xs) | Options -> Bool
clean Options
opts = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p (forall {a}.
(Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
cleancomment Lexer Token
scan) [Char]
xs
    scan Pos
p (Char
'{'    :[Char]
xs)              = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
1 Pos
p Lexer Token
codescrap [Char]
xs
    scan Pos
p (Char
'\CR':[Char]
xs)                = case [Char]
xs of
                                        Char
'\LF':[Char]
ys -> forall a. Pos -> (Pos -> a) -> a
newl' Pos
p Lexer Token
scanBeginOfLine [Char]
ys --ms newline
                                        [Char]
_        -> forall a. Pos -> (Pos -> a) -> a
newl' Pos
p Lexer Token
scanBeginOfLine [Char]
xs --mac newline
    scan Pos
p (Char
'\LF':[Char]
xs)                =  forall a. Pos -> (Pos -> a) -> a
newl' Pos
p Lexer Token
scanBeginOfLine [Char]
xs             --unix newline
    scan Pos
p (Char
x:[Char]
xs) | Char -> Bool
isSpace Char
x        = forall a. Char -> Pos -> (Pos -> a) -> a
updPos'  Char
x Pos
p Lexer Token
scan  [Char]
xs
    scan Pos
p [Char]
xs = forall a. a -> Maybe a
Just ([Char] -> (Token, Pos, [Char])
scan' [Char]
xs)
      where scan' :: [Char] -> (Token, Pos, [Char])
scan' (Char
'.' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"." Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'@' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"@" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
',' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"," Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'_' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"_" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'~' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"~" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'+' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"+" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'<' : Char
'-' : [Char]
rs)   = ([Char] -> Pos -> Token
reserved [Char]
"<-" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
'<' : Char
'=' : [Char]
rs)   = ([Char] -> Pos -> Token
reserved [Char]
"<=" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
'<' : Char
'<' : Char
'-' : [Char]
rs) = ([Char] -> Pos -> Token
reserved [Char]
"<<-" Pos
p, Column -> Pos -> Pos
advc Column
3 Pos
p, [Char]
rs)
            scan' (Char
'<' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"<" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'[' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"[" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
']' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"]" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'(' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"(" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
')' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
")" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
    --        scan' ('{'    :rs)       = (OBrace      p, advc 1 p, rs)
    --        scan' ('}'    :rs)       = (CBrace      p, advc 1 p, rs)

            scan' (Char
'\"' :[Char]
rs)         = let isOk :: Char -> Bool
isOk Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n'
                                           ([Char]
str,[Char]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOk [Char]
rs
                                       in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest Bool -> Bool -> Bool
|| forall a. [a] -> a
head [Char]
rest forall a. Eq a => a -> a -> Bool
/= Char
'"'
                                              then ([Char] -> Pos -> Token
errToken [Char]
"unterminated string literal"   Pos
p
                                                   , Column -> Pos -> Pos
advc (Column
1forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
str) Pos
p,[Char]
rest)
                                              else (EnumValToken -> [Char] -> Pos -> Token
valueToken EnumValToken
TkString [Char]
str Pos
p, Column -> Pos -> Pos
advc (Column
2forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
str) Pos
p, forall a. [a] -> [a]
tail [Char]
rest)

            scan' (Char
'=' : Char
'>' : [Char]
rs)   = ([Char] -> Pos -> Token
reserved [Char]
"=>" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
'=' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"=" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
':':Char
'=':[Char]
rs)       = ([Char] -> Pos -> Token
reserved [Char]
":=" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
':':Char
':':[Char]
rs)       = ([Char] -> Pos -> Token
reserved [Char]
"::" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
'∷':[Char]
rs)           = ([Char] -> Pos -> Token
reserved [Char]
"::" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)  -- recognize unicode double colons too
            scan' (Char
':' :[Char]
rs)                           = ([Char] -> Pos -> Token
reserved [Char]
":" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'|' :[Char]
rs)          = ([Char] -> Pos -> Token
reserved [Char]
"|" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)

            scan' (Char
'/':Char
'\\':[Char]
rs)      = ([Char] -> Pos -> Token
reserved [Char]
"/\\" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
'-':Char
'>' :[Char]
rs)      = ([Char] -> Pos -> Token
reserved [Char]
"->" Pos
p, Column -> Pos -> Pos
advc Column
2 Pos
p, [Char]
rs)
            scan' (Char
'-'     :[Char]
rs)      = ([Char] -> Pos -> Token
reserved [Char]
"-" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)
            scan' (Char
'*'     :[Char]
rs)      = ([Char] -> Pos -> Token
reserved [Char]
"*" Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)

            scan' (Char
'\''    :[Char]
rs) | Options -> Bool
ocaml Options
opts =  -- note: ocaml type variables are encoded as 'TkTextnm' tokens
              let ([Char]
var,[Char]
rest) = Options -> [Char] -> ([Char], [Char])
ident Options
opts [Char]
rs
                  str :: [Char]
str = Char
'\'' forall a. a -> [a] -> [a]
: [Char]
var
              in (EnumValToken -> [Char] -> Pos -> Token
valueToken EnumValToken
TkTextnm [Char]
str Pos
p, Column -> Pos -> Pos
advc (forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
str) Pos
p, [Char]
rest)

            scan' (Char
x:[Char]
rs) | Char -> Bool
isLower Char
x = let ([Char]
var,[Char]
rest) = Options -> [Char] -> ([Char], [Char])
ident Options
opts [Char]
rs
                                           str :: [Char]
str        = (Char
xforall a. a -> [a] -> [a]
:[Char]
var)
                                           tok :: Pos -> Token
tok | [Char]
str forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
keywords' = [Char] -> Pos -> Token
reserved ([Char] -> [Char]
mkKeyword [Char]
str)
                                               | Bool
otherwise            = EnumValToken -> [Char] -> Pos -> Token
valueToken EnumValToken
TkVarid [Char]
str
                                       in (Pos -> Token
tok Pos
p, Column -> Pos -> Pos
advc (forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
varforall a. Num a => a -> a -> a
+Column
1) Pos
p, [Char]
rest)
                         | Char -> Bool
isUpper Char
x = let ([Char]
var,[Char]
rest) = Options -> [Char] -> ([Char], [Char])
ident Options
opts [Char]
rs
                                           str :: [Char]
str        = (Char
xforall a. a -> [a] -> [a]
:[Char]
var)
                                           tok :: Pos -> Token
tok | [Char]
str forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
keywords' = [Char] -> Pos -> Token
reserved ([Char] -> [Char]
mkKeyword [Char]
str)
                                               | Bool
otherwise            = EnumValToken -> [Char] -> Pos -> Token
valueToken EnumValToken
TkConid [Char]
str
                                       in (Pos -> Token
tok Pos
p, Column -> Pos -> Pos
advc (forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
varforall a. Num a => a -> a -> a
+Column
1) Pos
p,[Char]
rest)
                         | Bool
otherwise = ([Char] -> Pos -> Token
errToken ([Char]
"unexpected character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Char
x) Pos
p, Column -> Pos -> Pos
advc Column
1 Pos
p, [Char]
rs)

    scanBeginOfLine :: Lexer Token
    scanBeginOfLine :: Lexer Token
scanBeginOfLine Pos
p (Char
'{' : Char
'-' : Char
' ' : Char
'L' : Char
'I' : Char
'N' : Char
'E' : Char
' ' : [Char]
xs)
      | [Char] -> Bool
isOkBegin [Char]
rs Bool -> Bool -> Bool
&& [Char] -> Bool
isOkEnd [Char]
rs'
          = Lexer Token
scan (Column -> Pos -> Pos
advc (Column
8 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
r forall a. Num a => a -> a -> a
+ Column
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Column
length [Char]
s forall a. Num a => a -> a -> a
+ Column
4) Pos
p') (forall a. Column -> [a] -> [a]
drop Column
4 [Char]
rs')
      | Bool
otherwise
          = forall a. a -> Maybe a
Just ([Char] -> Pos -> Token
errToken ([Char]
"Invalid LINE pragma: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
r) Pos
p, Column -> Pos -> Pos
advc Column
8 Pos
p, [Char]
xs)
      where
        ([Char]
r,[Char]
rs)   = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit [Char]
xs
        ([Char]
s, [Char]
rs') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'"') (forall a. Column -> [a] -> [a]
drop Column
2 [Char]
rs)
        p' :: Pos
p' = Column -> Column -> [Char] -> Pos
Pos (forall a. Read a => [Char] -> a
read [Char]
r forall a. Num a => a -> a -> a
- Column
1) (forall p. Position p => p -> Column
column Pos
p) [Char]
s    -- LINE pragma indicates the line number of the /next/ line!

        isOkBegin :: [Char] -> Bool
isOkBegin (Char
' ' : Char
'"' : [Char]
_) = Bool
True
        isOkBegin [Char]
_               = Bool
False

        isOkEnd :: [Char] -> Bool
isOkEnd (Char
'"' : Char
' ' : Char
'-' : Char
'}' : [Char]
_) = Bool
True
        isOkEnd [Char]
_         = Bool
False
    scanBeginOfLine Pos
p [Char]
xs
      = Lexer Token
scan Pos
p [Char]
xs


ident :: Options -> [Char] -> ([Char], [Char])
ident Options
opts = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isValid
 where isValid :: Char -> Bool
isValid Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
                   (Bool -> Bool
not (Options -> Bool
clean Options
opts) Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
== Char
'\'') Bool -> Bool -> Bool
|| (Options -> Bool
clean Options
opts Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
== Char
'`')

lowercaseKeywords :: [[Char]]
lowercaseKeywords = [[Char]
"loc",[Char]
"lhs", [Char]
"inst", [Char]
"optpragmas", [Char]
"imports", [Char]
"toplevel", [Char]
"datablock", [Char]
"recblock"]
keywords :: [[Char]]
keywords = [[Char]]
lowercaseKeywords forall a. [a] -> [a] -> [a]
++
           [ [Char]
"DATA", [Char]
"RECORD", [Char]
"EXT", [Char]
"ATTR", [Char]
"SEM",[Char]
"TYPE", [Char]
"USE", [Char]
"INCLUDE"
           , [Char]
"EXTENDS" -- marcos
           , [Char]
"SET",[Char]
"DERIVING",[Char]
"FOR", [Char]
"WRAPPER", [Char]
"NOCATAS", [Char]
"MAYBE", [Char]
"EITHER", [Char]
"MAP", [Char]
"INTMAP"
           , [Char]
"PRAGMA", [Char]
"SEMPRAGMA", [Char]
"MODULE", [Char]
"ATTACH", [Char]
"UNIQUEREF", [Char]
"INH", [Char]
"SYN", [Char]
"CHN"
           , [Char]
"AUGMENT", [Char]
"AROUND", [Char]
"MERGE", [Char]
"AS", [Char]
"SELF", [Char]
"INTSET"
           ]

ncomment :: (Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
ncomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p (Char
'-':Char
'}':[Char]
xs) = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p Pos -> [Char] -> Maybe (Token, Pos, [a])
c  [Char]
xs
ncomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p (Char
'{':Char
'-':[Char]
xs) = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p ((Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
ncomment ((Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
ncomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c)) [Char]
xs
ncomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p (Char
x:[Char]
xs)       = forall a. Char -> Pos -> (Pos -> a) -> a
updPos' Char
x Pos
p ((Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
ncomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c)  [Char]
xs
ncomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p []           = forall a. a -> Maybe a
Just ([Char] -> Pos -> Token
errToken [Char]
"unterminated nested comment" Pos
p, Pos
p,[])

cleancomment :: (Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
cleancomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p (Char
'*':Char
'/':[Char]
xs) = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p Pos -> [Char] -> Maybe (Token, Pos, [a])
c  [Char]
xs
cleancomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p (Char
'/':Char
'*':[Char]
xs) = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
2 Pos
p ((Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
cleancomment ((Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
cleancomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c)) [Char]
xs
cleancomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p (Char
x:[Char]
xs)       = forall a. Char -> Pos -> (Pos -> a) -> a
updPos' Char
x Pos
p ((Pos -> [Char] -> Maybe (Token, Pos, [a]))
-> Pos -> [Char] -> Maybe (Token, Pos, [a])
cleancomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c)  [Char]
xs
cleancomment Pos -> [Char] -> Maybe (Token, Pos, [a])
c Pos
p []           = forall a. a -> Maybe a
Just ([Char] -> Pos -> Token
errToken [Char]
"unterminated nested comment" Pos
p, Pos
p,[])

codescrap :: Lexer Token
codescrap Pos
p [Char]
xs = let (Pos
p2,[Char]
xs2,[Char]
sc) = forall {a}.
(Eq a, Num a) =>
a -> Pos -> [Char] -> (Pos, [Char], [Char])
codescrap' Integer
1 Pos
p [Char]
xs
                 in case [Char]
xs2 of
                         (Char
'}':[Char]
rest) -> forall a. a -> Maybe a
Just (EnumValToken -> [Char] -> Pos -> Token
valueToken EnumValToken
TkTextln [Char]
sc Pos
p,Column -> Pos -> Pos
advc Column
1 Pos
p2,[Char]
rest)
                         [Char]
_          -> forall a. a -> Maybe a
Just ([Char] -> Pos -> Token
errToken [Char]
"unterminated codescrap" Pos
p,Pos
p2,[Char]
xs2)


codescrap' :: a -> Pos -> [Char] -> (Pos, [Char], [Char])
codescrap' a
d Pos
p [] = (Pos
p,[],[])
{-
codescrap' d p ('{':'{':xs) = let (p2,xs2,sc) = advc' 2 p (codescrap' d) xs
                              in (p2,xs2,'{':' ':sc)
codescrap' d p ('}':'}':xs) = let (p2,xs2,sc) = advc' 2 p (codescrap' d) xs
                              in (p2,xs2,'}':' ':sc)
-}
codescrap' a
d Pos
p (Char
'{':[Char]
xs)     = let (Pos
p2,[Char]
xs2,[Char]
sc) = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
1 Pos
p (a -> Pos -> [Char] -> (Pos, [Char], [Char])
codescrap' (a
dforall a. Num a => a -> a -> a
+a
1)) [Char]
xs
                              in (Pos
p2,[Char]
xs2,Char
'{' forall a. a -> [a] -> [a]
: [Char]
sc)
codescrap' a
d Pos
p (Char
'}':[Char]
xs)     | a
d forall a. Eq a => a -> a -> Bool
== a
1 = (Pos
p,Char
'}'forall a. a -> [a] -> [a]
:[Char]
xs,[])
                            | Bool
otherwise = let (Pos
p2,[Char]
xs2,[Char]
sc) = forall a. Column -> Pos -> (Pos -> a) -> a
advc' Column
1 Pos
p (a -> Pos -> [Char] -> (Pos, [Char], [Char])
codescrap' (a
dforall a. Num a => a -> a -> a
-a
1)) [Char]
xs
                                          in (Pos
p2,[Char]
xs2,Char
'}' forall a. a -> [a] -> [a]
: [Char]
sc)
codescrap' a
d Pos
p (Char
x  :[Char]
xs)     = let (Pos
p2,[Char]
xs2,[Char]
sc) = forall a. Char -> Pos -> (Pos -> a) -> a
updPos' Char
x Pos
p (a -> Pos -> [Char] -> (Pos, [Char], [Char])
codescrap' a
d) [Char]
xs
                              in (Pos
p2,[Char]
xs2,Char
xforall a. a -> [a] -> [a]
:[Char]
sc)
--Literate Mode
scanLit :: [Char] -> ([[Char]], [Char])
scanLit [Char]
xs = ([[Char]]
fs, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Column, [Char]) -> (Column -> [Char]) -> Column -> [Char]
insNL (forall a b. a -> b -> a
const [Char]
"") [(Column, [Char])]
codeLns Column
1)
  where insNL :: (Column, [Char]) -> (Column -> [Char]) -> Column -> [Char]
insNL (Column
n,[Char]
line) Column -> [Char]
r = \Column
n1 -> forall a. Column -> a -> [a]
replicate (Column
nforall a. Num a => a -> a -> a
-Column
n1) Char
'\n' forall a. [a] -> [a] -> [a]
++ [Char]
line forall a. [a] -> [a] -> [a]
++ Column -> [Char]
r Column
n
        ([[Char]]
fs,[(Column, [Char])]
codeLns,[Any]
_) = forall {a} {a}. [(a, [Char])] -> ([[Char]], [(a, [Char])], [a])
getBlocks ([Column
1..] forall a b. [a] -> [b] -> [(a, b)]
`zip`  [Char] -> [[Char]]
toLines [Char]
xs)
        getBlocks :: [(a, [Char])] -> ([[Char]], [(a, [Char])], [a])
getBlocks [] = ([],[],[])
        getBlocks [(a, [Char])]
xs = let ([[Char]]
files1,[(a, [Char])]
txt1,[(a, [Char])]
r1) = forall {a}.
[(a, [Char])] -> ([[Char]], [(a, [Char])], [(a, [Char])])
getBlock [(a, [Char])]
xs
                           ([[Char]]
files2,[(a, [Char])]
txt2,[a]
r2) = [(a, [Char])] -> ([[Char]], [(a, [Char])], [a])
getBlocks [(a, [Char])]
r1
                       in ([[Char]]
files1forall a. [a] -> [a] -> [a]
++[[Char]]
files2, [(a, [Char])]
txt1forall a. [a] -> [a] -> [a]
++[(a, [Char])]
txt2, [a]
r2)


        getBlock :: [(a, [Char])] -> ([[Char]], [(a, [Char])], [(a, [Char])])
getBlock = [(a, [Char])] -> ([[Char]], [(a, [Char])], [(a, [Char])])
getLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall {a}. (a, [Char]) -> Bool
comment
        getLines :: [(a, [Char])] -> ([[Char]], [(a, [Char])], [(a, [Char])])
getLines [] = ([],[],[])
        getLines ((a
n,[Char]
l):[(a, [Char])]
ls) | [Char]
"\\begin{code}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = let ([(a, [Char])]
lns,[(a, [Char])]
rest) = forall {a}. [(a, [Char])] -> ([(a, [Char])], [(a, [Char])])
codelines [(a, [Char])]
ls
                                                               in ([],[(a, [Char])]
lns,[(a, [Char])]
rest)
                            | [Char]
"\\begin{Code}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = let ([(a, [Char])]
lns,[(a, [Char])]
rest) = forall {a}. [(a, [Char])] -> ([(a, [Char])], [(a, [Char])])
codeLines [(a, [Char])]
ls
                                                               in ([],[(a, [Char])]
lns,[(a, [Char])]
rest)
                            | [Char]
"\\IN{" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l        =
                                     let name :: [Char]
name = [Char] -> [Char]
getName [Char]
l
                                     in  ([[Char]
name],[],[(a, [Char])]
ls)
                            | Bool
otherwise = [(a, [Char])] -> ([[Char]], [(a, [Char])], [(a, [Char])])
getBlock [(a, [Char])]
ls
        comment :: (a, [Char]) -> Bool
comment = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"\\" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd

toLines     :: String -> [String]
toLines :: [Char] -> [[Char]]
toLines [Char]
""   = []
toLines [Char]
s    = let ([Char]
l,[Char]
s') = [Char] -> ([Char], [Char])
breakLine [Char]
s
               in [Char]
l forall a. a -> [a] -> [a]
:  [Char] -> [[Char]]
toLines [Char]
s'
breakLine :: [Char] -> ([Char], [Char])
breakLine [Char]
xs = case [Char]
xs of
                Char
'\CR' : [Char]
ys -> case [Char]
ys of
                                Char
'\LF' : [Char]
zs -> ([],[Char]
zs)
                                [Char]
_          -> ([],[Char]
ys)
                Char
'\LF' : [Char]
ys -> ([], [Char]
ys)
                Char
x     : [Char]
ys -> let ([Char]
l,[Char]
s) = [Char] -> ([Char], [Char])
breakLine [Char]
ys
                              in (Char
xforall a. a -> [a] -> [a]
:[Char]
l,[Char]
s)
                []         -> ([],[])

codelines :: [(a, [Char])] -> ([(a, [Char])], [(a, [Char])])
codelines [] = forall a. HasCallStack => [Char] -> a
error [Char]
"Unterminated literate code block"
codelines ((a
n,[Char]
l):[(a, [Char])]
ls) | [Char]
"\\end{code}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = ([],[(a, [Char])]
ls)
                     | Bool
otherwise                    = let ([(a, [Char])]
lns,[(a, [Char])]
r) = [(a, [Char])] -> ([(a, [Char])], [(a, [Char])])
codelines [(a, [Char])]
ls
                                                      in ((a
n,[Char]
l)forall a. a -> [a] -> [a]
:[(a, [Char])]
lns,[(a, [Char])]
r)

codeLines :: [(a, [Char])] -> ([(a, [Char])], [(a, [Char])])
codeLines [] = forall a. HasCallStack => [Char] -> a
error [Char]
"Unterminated literate Code block"
codeLines ((a
n,[Char]
l):[(a, [Char])]
ls) | [Char]
"\\end{Code}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
l = ([],[(a, [Char])]
ls)
                     | Bool
otherwise                    = let ([(a, [Char])]
lns,[(a, [Char])]
r) = [(a, [Char])] -> ([(a, [Char])], [(a, [Char])])
codeLines [(a, [Char])]
ls
                                                      in ((a
n,[Char]
l)forall a. a -> [a] -> [a]
:[(a, [Char])]
lns,[(a, [Char])]
r)

getName :: [Char] -> [Char]
getName [Char]
l = case [Char]
r of
   (Char
'}':[Char]
_) -> [Char]
nm
   [Char]
_       -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"missing '}' in \\IN"
 where ([Char]
nm,[Char]
r) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/=Char
'}') (forall a. Column -> [a] -> [a]
drop Column
4 [Char]
l)