{-# LANGUAGE PatternGuards #-}
-- {-# OPTIONS_GHC -O2 #-} -- fails with GHC 7.10
-- {-# OPTIONS_GHC -ddump-simpl #-}

-- | Lexing is a slow point, the code below is optimised
module Development.Ninja.Lexer(Lexeme(..), lexerFile) where

import Control.Applicative
import Data.Tuple.Extra
import Data.Char
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Unsafe as BS
import Development.Ninja.Type
import qualified Data.ByteString.Internal as Internal
import System.IO.Unsafe
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts
import Prelude

---------------------------------------------------------------------
-- LIBRARY BITS

newtype Str0 = Str0 Str -- null terminated

type S = Ptr Word8

char :: S -> Char
char :: S -> Char
char x :: S
x = Word8 -> Char
Internal.w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ IO Word8 -> Word8
forall a. IO a -> a
unsafePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ S -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek S
x

next :: S -> S
next :: S -> S
next x :: S
x = S
x S -> Int -> S
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1

{-# INLINE dropWhile0 #-}
dropWhile0 :: (Char -> Bool) -> Str0 -> Str0
dropWhile0 :: (Char -> Bool) -> Str0 -> Str0
dropWhile0 f :: Char -> Bool
f x :: Str0
x = (Str, Str0) -> Str0
forall a b. (a, b) -> b
snd ((Str, Str0) -> Str0) -> (Str, Str0) -> Str0
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Str0 -> (Str, Str0)
span0 Char -> Bool
f Str0
x

{-# INLINE span0 #-}
span0 :: (Char -> Bool) -> Str0 -> (Str, Str0)
span0 :: (Char -> Bool) -> Str0 -> (Str, Str0)
span0 f :: Char -> Bool
f = (Char -> Bool) -> Str0 -> (Str, Str0)
break0 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)

{-# INLINE break0 #-}
break0 :: (Char -> Bool) -> Str0 -> (Str, Str0)
break0 :: (Char -> Bool) -> Str0 -> (Str, Str0)
break0 f :: Char -> Bool
f (Str0 bs :: Str
bs) = (Int -> Str -> Str
BS.unsafeTake Int
i Str
bs, Str -> Str0
Str0 (Str -> Str0) -> Str -> Str0
forall a b. (a -> b) -> a -> b
$ Int -> Str -> Str
BS.unsafeDrop Int
i Str
bs)
    where
        i :: Int
i = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ Str -> (CString -> IO Int) -> IO Int
forall a. Str -> (CString -> IO a) -> IO a
BS.unsafeUseAsCString Str
bs ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ptr :: CString
ptr -> do
            let start :: S
start = CString -> S
forall a b. Ptr a -> Ptr b
castPtr CString
ptr :: S
            let end :: Addr#
end = S -> Addr#
go S
start
            Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
end Ptr Any -> S -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S
start

        go :: S -> Addr#
go s :: S
s@(Ptr a :: Addr#
a) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0' Bool -> Bool -> Bool
|| Char -> Bool
f Char
c = Addr#
a
                     | Bool
otherwise = S -> Addr#
go (S -> S
next S
s)
            where c :: Char
c = S -> Char
char S
s

{-# INLINE break00 #-}
-- The predicate must return true for '\0'
break00 :: (Char -> Bool) -> Str0 -> (Str, Str0)
break00 :: (Char -> Bool) -> Str0 -> (Str, Str0)
break00 f :: Char -> Bool
f (Str0 bs :: Str
bs) = (Int -> Str -> Str
BS.unsafeTake Int
i Str
bs, Str -> Str0
Str0 (Str -> Str0) -> Str -> Str0
forall a b. (a -> b) -> a -> b
$ Int -> Str -> Str
BS.unsafeDrop Int
i Str
bs)
    where
        i :: Int
i = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ Str -> (CString -> IO Int) -> IO Int
forall a. Str -> (CString -> IO a) -> IO a
BS.unsafeUseAsCString Str
bs ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ptr :: CString
ptr -> do
            let start :: S
start = CString -> S
forall a b. Ptr a -> Ptr b
castPtr CString
ptr :: S
            let end :: Addr#
end = S -> Addr#
go S
start
            Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
end Ptr Any -> S -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S
start

        go :: S -> Addr#
go s :: S
s@(Ptr a :: Addr#
a) | Char -> Bool
f Char
c = Addr#
a
                     | Bool
otherwise = S -> Addr#
go (S -> S
next S
s)
            where c :: Char
c = S -> Char
char S
s

head0 :: Str0 -> Char
head0 :: Str0 -> Char
head0 (Str0 x :: Str
x) = Word8 -> Char
Internal.w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ Str -> Word8
BS.unsafeHead Str
x

tail0 :: Str0 -> Str0
tail0 :: Str0 -> Str0
tail0 (Str0 x :: Str
x) = Str -> Str0
Str0 (Str -> Str0) -> Str -> Str0
forall a b. (a -> b) -> a -> b
$ Str -> Str
BS.unsafeTail Str
x

list0 :: Str0 -> (Char, Str0)
list0 :: Str0 -> (Char, Str0)
list0 x :: Str0
x = (Str0 -> Char
head0 Str0
x, Str0 -> Str0
tail0 Str0
x)

take0 :: Int -> Str0 -> Str
take0 :: Int -> Str0 -> Str
take0 i :: Int
i (Str0 x :: Str
x) = (Char -> Bool) -> Str -> Str
BS.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\0') (Str -> Str) -> Str -> Str
forall a b. (a -> b) -> a -> b
$ Int -> Str -> Str
BS.take Int
i Str
x


---------------------------------------------------------------------
-- ACTUAL LEXER

-- Lex each line separately, rather than each lexeme
data Lexeme
    = LexBind Str Expr -- [indent]foo = bar
    | LexBuild [Expr] Str [Expr] -- build foo: bar | baz || qux (| and || are represented as Expr)
    | LexInclude Expr -- include file
    | LexSubninja Expr -- include file
    | LexRule Str -- rule name
    | LexPool Str -- pool name
    | LexDefault [Expr] -- default foo bar
    | LexDefine Str Expr -- foo = bar
      deriving Int -> Lexeme -> ShowS
[Lexeme] -> ShowS
Lexeme -> String
(Int -> Lexeme -> ShowS)
-> (Lexeme -> String) -> ([Lexeme] -> ShowS) -> Show Lexeme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lexeme] -> ShowS
$cshowList :: [Lexeme] -> ShowS
show :: Lexeme -> String
$cshow :: Lexeme -> String
showsPrec :: Int -> Lexeme -> ShowS
$cshowsPrec :: Int -> Lexeme -> ShowS
Show

isVar, isVarDot :: Char -> Bool
isVar :: Char -> Bool
isVar x :: Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x
isVarDot :: Char -> Bool
isVarDot x :: Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char -> Bool
isVar Char
x

endsDollar :: Str -> Bool
endsDollar :: Str -> Bool
endsDollar = Str -> Str -> Bool
BS.isSuffixOf (Char -> Str
BS.singleton '$')

dropN :: Str0 -> Str0
dropN :: Str0 -> Str0
dropN x :: Str0
x = if Str0 -> Char
head0 Str0
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' then Str0 -> Str0
tail0 Str0
x else Str0
x

dropSpace :: Str0 -> Str0
dropSpace :: Str0 -> Str0
dropSpace = (Char -> Bool) -> Str0 -> Str0
dropWhile0 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')


lexerFile :: Maybe FilePath -> IO [Lexeme]
lexerFile :: Maybe String -> IO [Lexeme]
lexerFile file :: Maybe String
file = Str -> [Lexeme]
lexer (Str -> [Lexeme]) -> IO Str -> IO [Lexeme]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Str -> (String -> IO Str) -> Maybe String -> IO Str
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Str
BS.getContents String -> IO Str
BS.readFile Maybe String
file

lexer :: Str -> [Lexeme]
lexer :: Str -> [Lexeme]
lexer x :: Str
x = Str0 -> [Lexeme]
lexerLoop (Str0 -> [Lexeme]) -> Str0 -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ Str -> Str0
Str0 (Str -> Str0) -> Str -> Str0
forall a b. (a -> b) -> a -> b
$ Str
x Str -> Str -> Str
`BS.append` String -> Str
BS.pack "\n\n\0"

lexerLoop :: Str0 -> [Lexeme]
lexerLoop :: Str0 -> [Lexeme]
lexerLoop c_x :: Str0
c_x | (c :: Char
c,x :: Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
c_x = case Char
c of
    '\r' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    '\n' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    ' ' -> Str0 -> [Lexeme]
lexBind (Str0 -> [Lexeme]) -> Str0 -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    '#' -> Str0 -> [Lexeme]
lexerLoop (Str0 -> [Lexeme]) -> Str0 -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Str0 -> Str0
dropWhile0 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n') Str0
x
    'b' | Just x :: Str0
x <- String -> Str0 -> Maybe Str0
strip "uild " Str0
x -> Str0 -> [Lexeme]
lexBuild Str0
x
    'r' | Just x :: Str0
x <- String -> Str0 -> Maybe Str0
strip "ule " Str0
x -> Str0 -> [Lexeme]
lexRule Str0
x
    'd' | Just x :: Str0
x <- String -> Str0 -> Maybe Str0
strip "efault " Str0
x -> Str0 -> [Lexeme]
lexDefault Str0
x
    'p' | Just x :: Str0
x <- String -> Str0 -> Maybe Str0
strip "ool " Str0
x -> Str0 -> [Lexeme]
lexPool Str0
x
    'i' | Just x :: Str0
x <- String -> Str0 -> Maybe Str0
strip "nclude " Str0
x -> Str0 -> [Lexeme]
lexInclude Str0
x
    's' | Just x :: Str0
x <- String -> Str0 -> Maybe Str0
strip "ubninja " Str0
x -> Str0 -> [Lexeme]
lexSubninja Str0
x
    '\0' -> []
    _ -> Str0 -> [Lexeme]
lexDefine Str0
c_x
    where
        strip :: String -> Str0 -> Maybe Str0
strip str :: String
str (Str0 x :: Str
x) = if Str
b Str -> Str -> Bool
`BS.isPrefixOf` Str
x then Str0 -> Maybe Str0
forall a. a -> Maybe a
Just (Str0 -> Maybe Str0) -> Str0 -> Maybe Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str -> Str0
Str0 (Str -> Str0) -> Str -> Str0
forall a b. (a -> b) -> a -> b
$ Int -> Str -> Str
BS.drop (Str -> Int
BS.length Str
b) Str
x else Maybe Str0
forall a. Maybe a
Nothing
            where b :: Str
b = String -> Str
BS.pack String
str

lexBind :: Str0 -> [Lexeme]
lexBind :: Str0 -> [Lexeme]
lexBind c_x :: Str0
c_x | (c :: Char
c,x :: Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
c_x = case Char
c of
    '\r' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    '\n' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    '#' -> Str0 -> [Lexeme]
lexerLoop (Str0 -> [Lexeme]) -> Str0 -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Str0 -> Str0
dropWhile0 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n') Str0
x
    '\0' -> []
    _ -> (Str -> Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxBind Str -> Expr -> Lexeme
LexBind Str0
c_x

lexBuild :: Str0 -> [Lexeme]
lexBuild :: Str0 -> [Lexeme]
lexBuild x :: Str0
x
    | (outputs :: [Expr]
outputs,x :: Str0
x) <- Bool -> Str0 -> ([Expr], Str0)
lexxExprs Bool
True Str0
x
    , (rule :: Str
rule,x :: Str0
x) <- (Char -> Bool) -> Str0 -> (Str, Str0)
span0 Char -> Bool
isVarDot (Str0 -> (Str, Str0)) -> Str0 -> (Str, Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
jumpCont (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    , (deps :: [Expr]
deps,x :: Str0
x) <- Bool -> Str0 -> ([Expr], Str0)
lexxExprs Bool
False (Str0 -> ([Expr], Str0)) -> Str0 -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    = [Expr] -> Str -> [Expr] -> Lexeme
LexBuild [Expr]
outputs Str
rule [Expr]
deps Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Str0 -> [Lexeme]
lexerLoop Str0
x

lexDefault :: Str0 -> [Lexeme]
lexDefault :: Str0 -> [Lexeme]
lexDefault x :: Str0
x
    | (files :: [Expr]
files,x :: Str0
x) <- Bool -> Str0 -> ([Expr], Str0)
lexxExprs Bool
False Str0
x
    = [Expr] -> Lexeme
LexDefault [Expr]
files Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Str0 -> [Lexeme]
lexerLoop Str0
x

lexRule, lexPool, lexInclude, lexSubninja, lexDefine :: Str0 -> [Lexeme]
lexRule :: Str0 -> [Lexeme]
lexRule = (Str -> Lexeme) -> Str0 -> [Lexeme]
lexxName Str -> Lexeme
LexRule
lexPool :: Str0 -> [Lexeme]
lexPool = (Str -> Lexeme) -> Str0 -> [Lexeme]
lexxName Str -> Lexeme
LexPool
lexInclude :: Str0 -> [Lexeme]
lexInclude = (Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxFile Expr -> Lexeme
LexInclude
lexSubninja :: Str0 -> [Lexeme]
lexSubninja = (Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxFile Expr -> Lexeme
LexSubninja
lexDefine :: Str0 -> [Lexeme]
lexDefine = (Str -> Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxBind Str -> Expr -> Lexeme
LexDefine

lexxBind :: (Str -> Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxBind :: (Str -> Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxBind ctor :: Str -> Expr -> Lexeme
ctor x :: Str0
x
    | (var :: Str
var,x :: Str0
x) <- (Char -> Bool) -> Str0 -> (Str, Str0)
span0 Char -> Bool
isVarDot Str0
x
    , ('=',x :: Str0
x) <- Str0 -> (Char, Str0)
list0 (Str0 -> (Char, Str0)) -> Str0 -> (Char, Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
jumpCont (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    , (exp :: Expr
exp,x :: Str0
x) <- Bool -> Bool -> Str0 -> (Expr, Str0)
lexxExpr Bool
False Bool
False (Str0 -> (Expr, Str0)) -> Str0 -> (Expr, Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
jumpCont (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    = Str -> Expr -> Lexeme
ctor Str
var Expr
exp Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Str0 -> [Lexeme]
lexerLoop Str0
x
lexxBind _ x :: Str0
x = String -> [Lexeme]
forall a. HasCallStack => String -> a
error (String -> [Lexeme]) -> String -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ (String, Str) -> String
forall a. Show a => a -> String
show ("parse failed when parsing binding", Int -> Str0 -> Str
take0 100 Str0
x)

lexxFile :: (Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxFile :: (Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxFile ctor :: Expr -> Lexeme
ctor x :: Str0
x
    | (exp :: Expr
exp,rest :: Str0
rest) <- Bool -> Bool -> Str0 -> (Expr, Str0)
lexxExpr Bool
False Bool
False (Str0 -> (Expr, Str0)) -> Str0 -> (Expr, Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    = Expr -> Lexeme
ctor Expr
exp Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Str0 -> [Lexeme]
lexerLoop Str0
rest

lexxName :: (Str -> Lexeme) -> Str0 -> [Lexeme]
lexxName :: (Str -> Lexeme) -> Str0 -> [Lexeme]
lexxName ctor :: Str -> Lexeme
ctor x :: Str0
x
    | (name :: Str
name,rest :: Str0
rest) <- Str0 -> (Str, Str0)
splitLineCont Str0
x
    = Str -> Lexeme
ctor Str
name Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Str0 -> [Lexeme]
lexerLoop Str0
rest


lexxExprs :: Bool -> Str0 -> ([Expr], Str0)
lexxExprs :: Bool -> Str0 -> ([Expr], Str0)
lexxExprs stopColon :: Bool
stopColon x :: Str0
x = case Bool -> Bool -> Str0 -> (Expr, Str0)
lexxExpr Bool
stopColon Bool
True Str0
x of
    (a :: Expr
a,c_x :: Str0
c_x) | Char
c <- Str0 -> Char
head0 Str0
c_x, Str0
x <- Str0 -> Str0
tail0 Str0
c_x -> case Char
c of
        ' ' -> Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall b. Expr -> ([Expr], b) -> ([Expr], b)
add Expr
a (([Expr], Str0) -> ([Expr], Str0))
-> ([Expr], Str0) -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Bool -> Str0 -> ([Expr], Str0)
lexxExprs Bool
stopColon (Str0 -> ([Expr], Str0)) -> Str0 -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
        ':' | Bool
stopColon -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a Str0
x
        _ | Bool
stopColon -> String -> ([Expr], Str0)
forall a. HasCallStack => String -> a
error "expected a colon"
        '\r' -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a (Str0 -> ([Expr], Str0)) -> Str0 -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropN Str0
x
        '\n' -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a Str0
x
        '\0' -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a Str0
c_x
    where
        new :: Expr -> b -> ([Expr], b)
new a :: Expr
a x :: b
x = Expr -> ([Expr], b) -> ([Expr], b)
forall b. Expr -> ([Expr], b) -> ([Expr], b)
add Expr
a ([], b
x)
        add :: Expr -> ([Expr], b) -> ([Expr], b)
add (Exprs []) x :: ([Expr], b)
x = ([Expr], b)
x
        add a :: Expr
a (as :: [Expr]
as,x :: b
x) = (Expr
aExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
as,b
x)


{-# NOINLINE lexxExpr #-}
lexxExpr :: Bool -> Bool -> Str0 -> (Expr, Str0) -- snd will start with one of " :\n\r" or be empty
lexxExpr :: Bool -> Bool -> Str0 -> (Expr, Str0)
lexxExpr stopColon :: Bool
stopColon stopSpace :: Bool
stopSpace = ([Expr] -> Expr) -> ([Expr], Str0) -> (Expr, Str0)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first [Expr] -> Expr
exprs (([Expr], Str0) -> (Expr, Str0))
-> (Str0 -> ([Expr], Str0)) -> Str0 -> (Expr, Str0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str0 -> ([Expr], Str0)
f
    where
        exprs :: [Expr] -> Expr
exprs [x :: Expr
x] = Expr
x
        exprs xs :: [Expr]
xs = [Expr] -> Expr
Exprs [Expr]
xs

        special :: Char -> Bool
special = case (Bool
stopColon, Bool
stopSpace) of
            (True , True ) -> \x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= ':' Bool -> Bool -> Bool
&& (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0')
            (True , False) -> \x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= ':' Bool -> Bool -> Bool
&& (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':'             Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0')
            (False, True ) -> \x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '$' Bool -> Bool -> Bool
&& (            Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0')
            (False, False) -> \x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '$' Bool -> Bool -> Bool
&& (                        Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0')
        f :: Str0 -> ([Expr], Str0)
f x :: Str0
x = case (Char -> Bool) -> Str0 -> (Str, Str0)
break00 Char -> Bool
special Str0
x of (a :: Str
a,x :: Str0
x) -> if Str -> Bool
BS.null Str
a then Str0 -> ([Expr], Str0)
g Str0
x else Str -> Expr
Lit Str
a Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
g Str0
x

        x :: a
x $: :: a -> ([a], b) -> ([a], b)
$: (xs :: [a]
xs,y :: b
y) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,b
y)

        g :: Str0 -> ([Expr], Str0)
g x :: Str0
x | Str0 -> Char
head0 Str0
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '$' = ([], Str0
x)
        g x :: Str0
x | Str0
c_x <- Str0 -> Str0
tail0 Str0
x, (c :: Char
c,x :: Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
c_x = case Char
c of
            '$' -> Str -> Expr
Lit (Char -> Str
BS.singleton '$') Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            ' ' -> Str -> Expr
Lit (Char -> Str
BS.singleton ' ') Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            ':' -> Str -> Expr
Lit (Char -> Str
BS.singleton ':') Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            '\n' -> Str0 -> ([Expr], Str0)
f (Str0 -> ([Expr], Str0)) -> Str0 -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
            '\r' -> Str0 -> ([Expr], Str0)
f (Str0 -> ([Expr], Str0)) -> Str0 -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropN Str0
x
            '{' | (name :: Str
name,x :: Str0
x) <- (Char -> Bool) -> Str0 -> (Str, Str0)
span0 Char -> Bool
isVarDot Str0
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Str -> Bool
BS.null Str
name, ('}',x :: Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
x -> Str -> Expr
Var Str
name Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            _ | (name :: Str
name,x :: Str0
x) <- (Char -> Bool) -> Str0 -> (Str, Str0)
span0 Char -> Bool
isVar Str0
c_x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Str -> Bool
BS.null Str
name -> Str -> Expr
Var Str
name Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            _ -> String -> ([Expr], Str0)
forall a. HasCallStack => String -> a
error "Unexpect $ followed by unexpected stuff"

jumpCont :: Str0 -> Str0
jumpCont :: Str0 -> Str0
jumpCont o :: Str0
o
    | Char
'$' <- Str0 -> Char
head0 Str0
o
    , let x :: Str0
x = Str0 -> Str0
tail0 Str0
o
    = case Str0 -> Char
head0 Str0
x of
        '\n' -> Str0 -> Str0
dropSpace (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
tail0 Str0
x
        '\r' -> Str0 -> Str0
dropSpace (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropN (Str0 -> Str0) -> Str0 -> Str0
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
tail0 Str0
x
        _ -> Str0
o
    | Bool
otherwise = Str0
o

splitLineCont :: Str0 -> (Str, Str0)
splitLineCont :: Str0 -> (Str, Str0)
splitLineCont x :: Str0
x = ([Str] -> Str) -> ([Str], Str0) -> (Str, Str0)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first [Str] -> Str
BS.concat (([Str], Str0) -> (Str, Str0)) -> ([Str], Str0) -> (Str, Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> ([Str], Str0)
f Str0
x
    where
        f :: Str0 -> ([Str], Str0)
f x :: Str0
x = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Str -> Bool
endsDollar Str
a then ([Str
a], Str0
b) else let (c :: [Str]
c,d :: Str0
d) = Str0 -> ([Str], Str0)
f (Str0 -> ([Str], Str0)) -> Str0 -> ([Str], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
b in (Str -> Str
BS.init Str
a Str -> [Str] -> [Str]
forall a. a -> [a] -> [a]
: [Str]
c, Str0
d)
            where (a :: Str
a,b :: Str0
b) = Str0 -> (Str, Str0)
splitLineCR Str0
x

splitLineCR :: Str0 -> (Str, Str0)
splitLineCR :: Str0 -> (Str, Str0)
splitLineCR x :: Str0
x = if Char -> Str
BS.singleton '\r' Str -> Str -> Bool
`BS.isSuffixOf` Str
a then (Str -> Str
BS.init Str
a, Str0 -> Str0
dropN Str0
b) else (Str
a, Str0 -> Str0
dropN Str0
b)
    where (a :: Str
a,b :: Str0
b) = (Char -> Bool) -> Str0 -> (Str, Str0)
break0 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n') Str0
x