{-# 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 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

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

newtype Str0 = Str0 Str -- null terminated

type S = Ptr Word8

char :: S -> Char
char :: S -> Char
char 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 S
x = S
x S -> Int -> S
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1

{-# INLINE dropWhile0 #-}
dropWhile0 :: (Char -> Bool) -> Str0 -> Str0
dropWhile0 :: (Char -> Bool) -> Str0 -> Str0
dropWhile0 Char -> Bool
f 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 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 Char -> Bool
f (Str0 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
$ \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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 Addr#
a) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\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 Char -> Bool
f (Str0 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
$ \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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 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 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 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 Str0
x = (Str0 -> Char
head0 Str0
x, Str0 -> Str0
tail0 Str0
x)

take0 :: Int -> Str0 -> Str
take0 :: Int -> Str0 -> Str
take0 Int
i (Str0 Str
x) = (Char -> Bool) -> Str -> Str
BS.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\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 Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' 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 Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char -> Bool
isVar Char
x

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

dropN :: Str0 -> Str0
dropN :: Str0 -> Str0
dropN Str0
x = if Str0 -> Char
head0 Str0
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\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
== Char
' ')


lexerFile :: Maybe FilePath -> IO [Lexeme]
lexerFile :: Maybe String -> IO [Lexeme]
lexerFile 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 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 String
"\n\n\0"

lexerLoop :: Str0 -> [Lexeme]
lexerLoop :: Str0 -> [Lexeme]
lexerLoop Str0
c_x | (Char
c,Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
c_x = case Char
c of
    Char
'\r' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    Char
'\n' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    Char
' ' -> Str0 -> [Lexeme]
lexBind (Str0 -> [Lexeme]) -> Str0 -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
    Char
'#' -> 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
/= Char
'\n') Str0
x
    Char
'b' | Just Str0
x <- String -> Str0 -> Maybe Str0
strip String
"uild " Str0
x -> Str0 -> [Lexeme]
lexBuild Str0
x
    Char
'r' | Just Str0
x <- String -> Str0 -> Maybe Str0
strip String
"ule " Str0
x -> Str0 -> [Lexeme]
lexRule Str0
x
    Char
'd' | Just Str0
x <- String -> Str0 -> Maybe Str0
strip String
"efault " Str0
x -> Str0 -> [Lexeme]
lexDefault Str0
x
    Char
'p' | Just Str0
x <- String -> Str0 -> Maybe Str0
strip String
"ool " Str0
x -> Str0 -> [Lexeme]
lexPool Str0
x
    Char
'i' | Just Str0
x <- String -> Str0 -> Maybe Str0
strip String
"nclude " Str0
x -> Str0 -> [Lexeme]
lexInclude Str0
x
    Char
's' | Just Str0
x <- String -> Str0 -> Maybe Str0
strip String
"ubninja " Str0
x -> Str0 -> [Lexeme]
lexSubninja Str0
x
    Char
'\0' -> []
    Char
_ -> Str0 -> [Lexeme]
lexDefine Str0
c_x
    where
        strip :: String -> Str0 -> Maybe Str0
strip String
str (Str0 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 Str0
c_x | (Char
c,Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
c_x = case Char
c of
    Char
'\r' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    Char
'\n' -> Str0 -> [Lexeme]
lexerLoop Str0
x
    Char
'#' -> 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
/= Char
'\n') Str0
x
    Char
'\0' -> []
    Char
_ -> (Str -> Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxBind Str -> Expr -> Lexeme
LexBind Str0
c_x

lexBuild :: Str0 -> [Lexeme]
lexBuild :: Str0 -> [Lexeme]
lexBuild Str0
x
    | ([Expr]
outputs,Str0
x) <- Bool -> Str0 -> ([Expr], Str0)
lexxExprs Bool
True Str0
x
    , (Str
rule,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
    , ([Expr]
deps,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 Str0
x
    | ([Expr]
files,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 Str -> Expr -> Lexeme
ctor Str0
x
    | (Str
var,Str0
x) <- (Char -> Bool) -> Str0 -> (Str, Str0)
span0 Char -> Bool
isVarDot Str0
x
    , (Char
'=',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
    , (Expr
exp,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 Str -> Expr -> Lexeme
_ Str0
x = String -> [Lexeme]
forall a. HasCallStack => String -> a
error (String -> [Lexeme]) -> String -> [Lexeme]
forall a b. (a -> b) -> a -> b
$ String
"Ninja parse failed when parsing binding, " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Str -> String
forall a. Show a => a -> String
show (Int -> Str0 -> Str
take0 Int
100 Str0
x)

lexxFile :: (Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxFile :: (Expr -> Lexeme) -> Str0 -> [Lexeme]
lexxFile Expr -> Lexeme
ctor Str0
x
    | (Expr
exp,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 Str -> Lexeme
ctor Str0
x
    | (Str
name,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 Bool
stopColon Str0
x = case Bool -> Bool -> Str0 -> (Expr, Str0)
lexxExpr Bool
stopColon Bool
True Str0
x of
    (Expr
a,Str0
c_x) | Char
c <- Str0 -> Char
head0 Str0
c_x, Str0
x <- Str0 -> Str0
tail0 Str0
c_x -> case Char
c of
        Char
' ' -> 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
        Char
':' | Bool
stopColon -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a Str0
x
        Char
_ | Bool
stopColon -> String -> ([Expr], Str0)
forall a. HasCallStack => String -> a
error String
"Ninja parsing, expected a colon"
        Char
'\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
        Char
'\n' -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a Str0
x
        Char
'\0' -> Expr -> Str0 -> ([Expr], Str0)
forall b. Expr -> b -> ([Expr], b)
new Expr
a Str0
c_x
        Char
_ -> String -> ([Expr], Str0)
forall a. HasCallStack => String -> a
error String
"Ninja parsing, unexpected expression"
    where
        new :: Expr -> b -> ([Expr], b)
new Expr
a 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 []) ([Expr], b)
x = ([Expr], b)
x
        add Expr
a ([Expr]
as,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 Bool
stopColon 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 [Expr
x] = Expr
x
        exprs [Expr]
xs = [Expr] -> Expr
Exprs [Expr]
xs

        special :: Char -> Bool
special = case (Bool
stopColon, Bool
stopSpace) of
            (Bool
True , Bool
True ) -> \Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
':' Bool -> Bool -> Bool
&& (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0')
            (Bool
True , Bool
False) -> \Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
':' Bool -> Bool -> Bool
&& (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'             Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0')
            (Bool
False, Bool
True ) -> \Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'$' Bool -> Bool -> Bool
&& (            Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0')
            (Bool
False, Bool
False) -> \Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'$' Bool -> Bool -> Bool
&& (                        Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0')
        f :: Str0 -> ([Expr], Str0)
f Str0
x = case (Char -> Bool) -> Str0 -> (Str, Str0)
break00 Char -> Bool
special Str0
x of (Str
a,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

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

        g :: Str0 -> ([Expr], Str0)
g Str0
x | Str0 -> Char
head0 Str0
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' = ([], Str0
x)
        g Str0
x | Str0
c_x <- Str0 -> Str0
tail0 Str0
x, (Char
c,Str0
x) <- Str0 -> (Char, Str0)
list0 Str0
c_x = case Char
c of
            Char
'$' -> Str -> Expr
Lit (Char -> Str
BS.singleton Char
'$') Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            Char
' ' -> Str -> Expr
Lit (Char -> Str
BS.singleton Char
' ') Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            Char
':' -> Str -> Expr
Lit (Char -> Str
BS.singleton Char
':') Expr -> ([Expr], Str0) -> ([Expr], Str0)
forall a b. a -> ([a], b) -> ([a], b)
$: Str0 -> ([Expr], Str0)
f Str0
x
            Char
'\n' -> Str0 -> ([Expr], Str0)
f (Str0 -> ([Expr], Str0)) -> Str0 -> ([Expr], Str0)
forall a b. (a -> b) -> a -> b
$ Str0 -> Str0
dropSpace Str0
x
            Char
'\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
            Char
'{' | (Str
name,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, (Char
'}',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
            Char
_ | (Str
name,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
            Char
_ -> String -> ([Expr], Str0)
forall a. HasCallStack => String -> a
error String
"Ninja parsing, unexpect $ followed by unexpected stuff"

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

splitLineCont :: Str0 -> (Str, Str0)
splitLineCont :: Str0 -> (Str, Str0)
splitLineCont 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 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 ([Str]
c,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 (Str
a,Str0
b) = Str0 -> (Str, Str0)
splitLineCR Str0
x

splitLineCR :: Str0 -> (Str, Str0)
splitLineCR :: Str0 -> (Str, Str0)
splitLineCR Str0
x = if Char -> Str
BS.singleton Char
'\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 (Str
a,Str0
b) = (Char -> Bool) -> Str0 -> (Str, Str0)
break0 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Str0
x