{-# LANGUAGE CPP, LambdaCase, OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
-- | Line expansion is the core input token processing
-- logic. Object-like macros are substituted, and function-like macro
-- applications are expanded.
module Hpp.Expansion (expandLineState) where
import Control.Monad.Trans.Class (lift)
import Data.Bool (bool)
import Data.Foldable (foldl', traverse_)
import Data.List (delete)
import Data.Maybe (listToMaybe, mapMaybe)
#if __GLASGOW_HASKELL__ < 808
import Data.Monoid ((<>))
#endif
import Data.String (fromString)
import Hpp.Config (Config, curFileName,
                   getDateString, getTimeString, prepDate, prepTime)
import Hpp.Env (deleteKey)
import Hpp.Parser (Parser, ParserT, precede, replace, await, onIsomorphism,
                   onElements, droppingWhile, awaitJust, evalParse)
import Hpp.StringSig (stringify, uncons, isEmpty, toChars)
import Hpp.Tokens (Token(..), notImportant, isImportant, detokenize)
import Hpp.Types (hppConfig, hppLineNum, getState, HasHppState, HasError(..), HasEnv(..), Scan(..), Error(..), Macro(..),
                  TOKEN, String, lookupMacro)
import Prelude hiding (String)

-- | Extract the 'TOKEN' payload from a 'Scan'.
unscan :: Scan -> Maybe TOKEN
unscan :: Scan -> Maybe TOKEN
unscan (Scan TOKEN
t) = TOKEN -> Maybe TOKEN
forall a. a -> Maybe a
Just TOKEN
t
unscan (Rescan TOKEN
t) = TOKEN -> Maybe TOKEN
forall a. a -> Maybe a
Just TOKEN
t
unscan Scan
_ = Maybe TOKEN
forall a. Maybe a
Nothing

isSpaceScan :: Scan -> Bool
isSpaceScan :: Scan -> Bool
isSpaceScan = Bool -> (TOKEN -> Bool) -> Maybe TOKEN -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TOKEN -> Bool
forall s. Token s -> Bool
notImportant (Maybe TOKEN -> Bool) -> (Scan -> Maybe TOKEN) -> Scan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scan -> Maybe TOKEN
unscan

isImportantScan :: Scan -> Bool
isImportantScan :: Scan -> Bool
isImportantScan = Bool -> (TOKEN -> Bool) -> Maybe TOKEN -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TOKEN -> Bool
forall s. Token s -> Bool
isImportant (Maybe TOKEN -> Bool) -> (Scan -> Maybe TOKEN) -> Scan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scan -> Maybe TOKEN
unscan

expandLineState :: (Monad m, HasHppState m, HasEnv m, HasError m)
                => Parser m [TOKEN] [TOKEN]
expandLineState :: Parser m [TOKEN] [TOKEN]
expandLineState =
  do HppState
st <- StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m HppState
forall (m :: * -> *). HasHppState m => m HppState
getState
     let ln :: LineNum
ln = HppState -> LineNum
hppLineNum HppState
st
         cfg :: Config
cfg = HppState -> Config
hppConfig HppState
st
     Config -> LineNum -> Parser m [TOKEN] [TOKEN]
forall (m :: * -> *).
(HasError m, Monad m, HasEnv m) =>
Config -> LineNum -> Parser m [TOKEN] [TOKEN]
expandLine Config
cfg LineNum
ln


-- | Expand all macros to the end of the current line or until all
-- in-progress macro invocations are complete, whichever comes last.
expandLine :: (HasError m, Monad m, HasEnv m)
           => Config -> Int -> Parser m [TOKEN] [TOKEN]
expandLine :: Config -> LineNum -> Parser m [TOKEN] [TOKEN]
expandLine Config
cfg LineNum
lineNum =
  (Scan -> Maybe TOKEN) -> [Scan] -> [TOKEN]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Scan -> Maybe TOKEN
unscan ([Scan] -> [TOKEN])
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [Scan]
-> Parser m [TOKEN] [TOKEN]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ParserT m (Input m [[TOKEN]]) TOKEN [Scan]
-> StateT (Source m (Input m [[TOKEN]]) [TOKEN]) m [Scan]
forall (m :: * -> *) i r.
Monad m =>
ParserT m (Input m [[i]]) i r -> Parser m [i] r
onElements ((TOKEN -> Scan)
-> (Scan -> Maybe TOKEN)
-> ParserT m ([Scan], Input m [[TOKEN]]) Scan [Scan]
-> ParserT m (Input m [[TOKEN]]) TOKEN [Scan]
forall (m :: * -> *) a b src r.
Monad m =>
(a -> b)
-> (b -> Maybe a) -> ParserT m ([b], src) b r -> ParserT m src a r
onIsomorphism TOKEN -> Scan
Scan Scan -> Maybe TOKEN
unscan (Bool
-> Config
-> LineNum
-> ParserT m ([Scan], Input m [[TOKEN]]) Scan [Scan]
forall (m :: * -> *) src.
(HasError m, Monad m, HasEnv m) =>
Bool -> Config -> LineNum -> ParserT m src Scan [Scan]
expandLine' Bool
True Config
cfg LineNum
lineNum))

expandLine' :: forall m src. (HasError m, Monad m, HasEnv m)
            => Bool -> Config -> Int -> ParserT m src Scan [Scan]
expandLine' :: Bool -> Config -> LineNum -> ParserT m src Scan [Scan]
expandLine' Bool
oneLine Config
cfg LineNum
lineNum = ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go [Scan] -> [Scan]
forall a. a -> a
id []
  where go :: ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
        go :: ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go [Scan] -> [Scan]
acc [String]
mask = ParserT m src Scan (Maybe Scan)
forall (m :: * -> *) src i. Monad m => ParserT m src i (Maybe i)
await ParserT m src Scan (Maybe Scan)
-> (Maybe Scan -> ParserT m src Scan [Scan])
-> ParserT m src Scan [Scan]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT m src Scan [Scan]
-> (Scan -> ParserT m src Scan [Scan])
-> Maybe Scan
-> ParserT m src Scan [Scan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> ParserT m src Scan [Scan])
-> [Scan] -> ParserT m src Scan [Scan]
forall a b. (a -> b) -> a -> b
$ [Scan] -> [Scan]
acc []) Scan -> ParserT m src Scan [Scan]
aux
          where aux :: Scan -> ParserT m src Scan [Scan]
                aux :: Scan -> ParserT m src Scan [Scan]
aux Scan
tok = case Scan
tok of
                  Unmask String
name -> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) (String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete String
name [String]
mask)
                  Mask String
name -> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) (String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mask)
                  Scan (Important String
t) -> do [Scan]
ts <- Config -> LineNum -> String -> Scan -> ParserT m src Scan [Scan]
forall (m :: * -> *) src.
(Monad m, HasError m, HasEnv m) =>
Config -> LineNum -> String -> Scan -> ParserT m src Scan [Scan]
expandMacro Config
cfg LineNum
lineNum String
t Scan
tok
                                           if [Scan]
ts [Scan] -> [Scan] -> Bool
forall a. Eq a => a -> a -> Bool
== [Scan
tok]
                                           then ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) [String]
mask
                                           else [Scan] -> ParserT m src Scan ()
forall (m :: * -> *) i src. Monad m => [i] -> ParserT m src i ()
precede [Scan]
ts ParserT m src Scan ()
-> ParserT m src Scan [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go [Scan] -> [Scan]
acc [String]
mask
                  Rescan (Important String
t) ->
                    do Env
oldEnv <- m Env -> StateT (Source m src Scan) m Env
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Env -> StateT (Source m src Scan) m Env)
-> m Env -> StateT (Source m src Scan) m Env
forall a b. (a -> b) -> a -> b
$
                                 do Env
env <- m Env
forall (m :: * -> *). HasEnv m => m Env
getEnv
                                    Env -> m ()
forall (m :: * -> *). HasEnv m => Env -> m ()
setEnv (Env -> m ()) -> Env -> m ()
forall a b. (a -> b) -> a -> b
$ (Env -> String -> Env) -> Env -> [String] -> Env
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((String -> Env -> Env) -> Env -> String -> Env
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Env -> Env
forall a. String -> HashMap String a -> HashMap String a
deleteKey) Env
env [String]
mask
                                    Env -> m Env
forall (m :: * -> *) a. Monad m => a -> m a
return Env
env
                       [Scan]
ts <- Config -> LineNum -> String -> Scan -> ParserT m src Scan [Scan]
forall (m :: * -> *) src.
(Monad m, HasError m, HasEnv m) =>
Config -> LineNum -> String -> Scan -> ParserT m src Scan [Scan]
expandMacro Config
cfg LineNum
lineNum String
t Scan
tok
                       m () -> ParserT m src Scan ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ParserT m src Scan ()) -> m () -> ParserT m src Scan ()
forall a b. (a -> b) -> a -> b
$ Env -> m ()
forall (m :: * -> *). HasEnv m => Env -> m ()
setEnv Env
oldEnv
                       if [Scan]
ts [Scan] -> [Scan] -> Bool
forall a. Eq a => a -> a -> Bool
== [Scan
tok]
                       then ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) [String]
mask
                       else [Scan] -> ParserT m src Scan ()
forall (m :: * -> *) i src. Monad m => [i] -> ParserT m src i ()
precede [Scan]
ts ParserT m src Scan ()
-> ParserT m src Scan [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go [Scan] -> [Scan]
acc [String]
mask
                  Scan (Other String
"\n")
                    | Bool
oneLine -> [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> [Scan]
acc [Scan
tok])
                    | Bool
otherwise -> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) [String]
mask
                  Rescan (Other String
"\n")
                    | Bool
oneLine -> [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> [Scan]
acc [Scan
tok])
                    | Bool
otherwise -> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) [String]
mask
                  Scan
_ -> ([Scan] -> [Scan]) -> [String] -> ParserT m src Scan [Scan]
go ([Scan] -> [Scan]
acc ([Scan] -> [Scan]) -> ([Scan] -> [Scan]) -> [Scan] -> [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) [String]
mask

-- | Parse a function application. Arguments are separated by commas,
-- and the application runs until the balanced closing parenthesis. If
-- this is not an application, 'Nothing' is returned.
appParse :: (Monad m, HasError m)
         => ParserT m src Scan (Maybe [[Scan]])
appParse :: ParserT m src Scan (Maybe [[Scan]])
appParse = (Scan -> Bool) -> ParserT m src Scan ()
forall (m :: * -> *) i src.
Monad m =>
(i -> Bool) -> ParserT m src i ()
droppingWhile Scan -> Bool
isSpaceScan ParserT m src Scan ()
-> ParserT m src Scan (Maybe [[Scan]])
-> ParserT m src Scan (Maybe [[Scan]])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT m src Scan (Maybe [[Scan]])
forall src. StateT (Source m src Scan) m (Maybe [[Scan]])
checkApp
  where imp :: Scan -> Bool
imp = Bool -> (TOKEN -> Bool) -> Maybe TOKEN -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True TOKEN -> Bool
forall s. Token s -> Bool
notImportant (Maybe TOKEN -> Bool) -> (Scan -> Maybe TOKEN) -> Scan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scan -> Maybe TOKEN
unscan
        checkApp :: StateT (Source m src Scan) m (Maybe [[Scan]])
checkApp = do Maybe Scan
tok <- (Scan -> Bool) -> ParserT m src Scan ()
forall (m :: * -> *) i src.
Monad m =>
(i -> Bool) -> ParserT m src i ()
droppingWhile Scan -> Bool
imp ParserT m src Scan ()
-> StateT (Source m src Scan) m (Maybe Scan)
-> StateT (Source m src Scan) m (Maybe Scan)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT (Source m src Scan) m (Maybe Scan)
forall (m :: * -> *) src i. Monad m => ParserT m src i (Maybe i)
await
                      case Maybe Scan
tok Maybe Scan -> (Scan -> Maybe TOKEN) -> Maybe TOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scan -> Maybe TOKEN
unscan of
                        Just (Important String
"(") -> StateT (Source m src Scan) m (Maybe [[Scan]])
forall src. StateT (Source m src Scan) m (Maybe [[Scan]])
goApp
                        Maybe TOKEN
_ -> (Scan -> ParserT m src Scan ())
-> Maybe Scan -> ParserT m src Scan ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Scan -> ParserT m src Scan ()
forall (m :: * -> *) i src. Monad m => i -> ParserT m src i ()
replace Maybe Scan
tok ParserT m src Scan ()
-> StateT (Source m src Scan) m (Maybe [[Scan]])
-> StateT (Source m src Scan) m (Maybe [[Scan]])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [[Scan]] -> StateT (Source m src Scan) m (Maybe [[Scan]])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [[Scan]]
forall a. Maybe a
Nothing
        getArg :: ([[Scan]] -> c) -> StateT (Source m src Scan) m c
getArg [[Scan]] -> c
acc = do [Scan]
arg <- ([Scan] -> [Scan])
-> StateT (Source m src Scan) m [Scan]
-> StateT (Source m src Scan) m [Scan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Scan] -> [Scan]
trimScan StateT (Source m src Scan) m [Scan]
forall (m :: * -> *) src.
(Monad m, HasError m) =>
ParserT m src Scan [Scan]
argParse
                        Scan
tok <- String -> ParserT m src Scan Scan
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"appParse getArg"
                        case Scan -> Maybe TOKEN
unscan Scan
tok of
                          Just (Important String
")") -> c -> StateT (Source m src Scan) m c
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Scan]] -> c
acc [[Scan]
arg])
                          Maybe TOKEN
_ -> Scan -> ParserT m src Scan ()
forall (m :: * -> *) i src. Monad m => i -> ParserT m src i ()
replace Scan
tok ParserT m src Scan ()
-> StateT (Source m src Scan) m c -> StateT (Source m src Scan) m c
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([[Scan]] -> c) -> StateT (Source m src Scan) m c
getArg ([[Scan]] -> c
acc ([[Scan]] -> c) -> ([[Scan]] -> [[Scan]]) -> [[Scan]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Scan]
arg[Scan] -> [[Scan]] -> [[Scan]]
forall a. a -> [a] -> [a]
:))
        goApp :: StateT (Source m src Scan) m (Maybe [[Scan]])
goApp = ([[Scan]] -> Maybe [[Scan]])
-> StateT (Source m src Scan) m [[Scan]]
-> StateT (Source m src Scan) m (Maybe [[Scan]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Scan]] -> Maybe [[Scan]]
forall a. a -> Maybe a
Just (([[Scan]] -> [[Scan]]) -> StateT (Source m src Scan) m [[Scan]]
forall (m :: * -> *) c src.
(Monad m, HasError m) =>
([[Scan]] -> c) -> StateT (Source m src Scan) m c
getArg [[Scan]] -> [[Scan]]
forall a. a -> a
id)

-- | Emit the tokens of a single argument. Returns 'True' if this is
-- the final argument in an application (indicated by an unbalanced
-- closing parenthesis.
argParse :: (Monad m, HasError m) => ParserT m src Scan [Scan]
argParse :: ParserT m src Scan [Scan]
argParse = ([Scan] -> [Scan]) -> ParserT m src Scan [Scan]
forall (m :: * -> *) c src.
(Monad m, HasError m) =>
([Scan] -> c) -> StateT (Source m src Scan) m c
go [Scan] -> [Scan]
forall a. a -> a
id
  where go :: ([Scan] -> c) -> StateT (Source m src Scan) m c
go [Scan] -> c
acc = do Scan
tok <- String -> ParserT m src Scan Scan
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"argParse"
                    case Scan -> Maybe TOKEN
unscan Scan
tok of
                      Just (Important String
s)
                        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
")" -> Scan -> ParserT m src Scan ()
forall (m :: * -> *) i src. Monad m => i -> ParserT m src i ()
replace Scan
tok ParserT m src Scan ()
-> StateT (Source m src Scan) m c -> StateT (Source m src Scan) m c
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> StateT (Source m src Scan) m c
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> c
acc [])
                        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"," -> c -> StateT (Source m src Scan) m c
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> c
acc [])
                        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"(" -> do [Scan]
ts <- ([Scan] -> [Scan])
-> StateT (Source m src Scan) m [Scan]
-> StateT (Source m src Scan) m [Scan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:) StateT (Source m src Scan) m [Scan]
forall (m :: * -> *) src.
(Monad m, HasError m) =>
ParserT m src Scan [Scan]
parenthetical
                                         ([Scan] -> c) -> StateT (Source m src Scan) m c
go ([Scan] -> c
acc ([Scan] -> c) -> ([Scan] -> [Scan]) -> [Scan] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Scan]
ts[Scan] -> [Scan] -> [Scan]
forall a. [a] -> [a] -> [a]
++))
                        | Bool
otherwise -> ([Scan] -> c) -> StateT (Source m src Scan) m c
go ([Scan] -> c
acc ([Scan] -> c) -> ([Scan] -> [Scan]) -> [Scan] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:))
                      Maybe TOKEN
_ -> ([Scan] -> c) -> StateT (Source m src Scan) m c
go ([Scan] -> c
acc ([Scan] -> c) -> ([Scan] -> [Scan]) -> [Scan] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:))

-- | Kick this off after an opening parenthesis and it will yield
-- every token up to the closing parenthesis.
parenthetical :: (Monad m, HasError m) => ParserT m src Scan [Scan]
parenthetical :: ParserT m src Scan [Scan]
parenthetical = ([Scan] -> [Scan]) -> LineNum -> ParserT m src Scan [Scan]
forall a (m :: * -> *) c src.
(Eq a, Num a, Monad m, HasError m) =>
([Scan] -> c) -> a -> StateT (Source m src Scan) m c
go [Scan] -> [Scan]
forall a. a -> a
id (LineNum
1::Int)
  where go :: ([Scan] -> c) -> a -> StateT (Source m src Scan) m c
go [Scan] -> c
acc a
0 = c -> StateT (Source m src Scan) m c
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> c
acc [])
        go [Scan] -> c
acc a
n = do Scan
tok <- String -> ParserT m src Scan Scan
forall (m :: * -> *) src i.
(Monad m, HasError m) =>
String -> ParserT m src i i
awaitJust String
"parenthetical"
                      case Scan -> Maybe TOKEN
unscan Scan
tok of
                        Just (Important String
"(") -> ([Scan] -> c) -> a -> StateT (Source m src Scan) m c
go ([Scan] -> c
acc ([Scan] -> c) -> ([Scan] -> [Scan]) -> [Scan] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
                        Just (Important String
")") -> ([Scan] -> c) -> a -> StateT (Source m src Scan) m c
go ([Scan] -> c
acc ([Scan] -> c) -> ([Scan] -> [Scan]) -> [Scan] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1)
                        Maybe TOKEN
_ -> ([Scan] -> c) -> a -> StateT (Source m src Scan) m c
go ([Scan] -> c
acc ([Scan] -> c) -> ([Scan] -> [Scan]) -> [Scan] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan
tokScan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:)) a
n

argError :: Int -> String -> Int -> [String] -> Error
argError :: LineNum -> String -> LineNum -> [String] -> Error
argError LineNum
lineNum String
name LineNum
arity [String]
args =
  LineNum -> String -> Error
TooFewArgumentsToMacro LineNum
lineNum (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
  String -> String
forall s. Stringy s => s -> String
toChars String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> LineNum -> String
forall a. Show a => a -> String
show LineNum
arity String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
args

-- | Returns 'Nothing' if this isn't an application; @Left args@ if we
-- parsed arguments @args@, but there is an arity mismatch; or @Right
-- tokens@ if the function application expanded successfully.
expandFunction :: (Monad m, HasError m)
               => String -> Int -> ([([Scan],String)] -> [Scan])
               -> (forall r'. [String] -> ParserT m src Scan r')
               -> ([Scan] -> ParserT m src Scan [Scan])
               -> ParserT m src Scan (Maybe [Scan])
expandFunction :: String
-> LineNum
-> ([([Scan], String)] -> [Scan])
-> (forall r'. [String] -> ParserT m src Scan r')
-> ([Scan] -> ParserT m src Scan [Scan])
-> ParserT m src Scan (Maybe [Scan])
expandFunction String
name LineNum
arity [([Scan], String)] -> [Scan]
f forall r'. [String] -> ParserT m src Scan r'
mkErr [Scan] -> ParserT m src Scan [Scan]
expand =
  do Maybe [[Scan]]
margs <- ParserT m src Scan (Maybe [[Scan]])
forall (m :: * -> *) src.
(Monad m, HasError m) =>
ParserT m src Scan (Maybe [[Scan]])
appParse
     case Maybe [[Scan]]
margs of
       Maybe [[Scan]]
Nothing -> Maybe [Scan] -> ParserT m src Scan (Maybe [Scan])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Scan]
forall a. Maybe a
Nothing
       Just [[Scan]]
args
         | [[Scan]] -> LineNum
forall (t :: * -> *) a. Foldable t => t a -> LineNum
length [[Scan]]
args LineNum -> LineNum -> Bool
forall a. Eq a => a -> a -> Bool
/= LineNum
arity -> [String] -> ParserT m src Scan (Maybe [Scan])
forall r'. [String] -> ParserT m src Scan r'
mkErr ([String] -> ParserT m src Scan (Maybe [Scan]))
-> [String] -> ParserT m src Scan (Maybe [Scan])
forall a b. (a -> b) -> a -> b
$
                                   ([Scan] -> String) -> [[Scan]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([TOKEN] -> String
forall s. Monoid s => [Token s] -> s
detokenize ([TOKEN] -> String) -> ([Scan] -> [TOKEN]) -> [Scan] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan -> Maybe TOKEN) -> [Scan] -> [TOKEN]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Scan -> Maybe TOKEN
unscan) [[Scan]]
args
         | Bool
otherwise ->
           do [[Scan]]
args' <- ([Scan] -> ParserT m src Scan [Scan])
-> [[Scan]] -> StateT (Source m src Scan) m [[Scan]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Scan] -> ParserT m src Scan [Scan]
expand [[Scan]]
args
              let raw :: [String]
raw = ([Scan] -> String) -> [[Scan]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([TOKEN] -> String
forall s. Monoid s => [Token s] -> s
detokenize ([TOKEN] -> String) -> ([Scan] -> [TOKEN]) -> [Scan] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scan -> Maybe TOKEN) -> [Scan] -> [TOKEN]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Scan -> Maybe TOKEN
unscan) [[Scan]]
args
              Maybe [Scan] -> ParserT m src Scan (Maybe [Scan])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Scan] -> ParserT m src Scan (Maybe [Scan]))
-> ([Scan] -> Maybe [Scan])
-> [Scan]
-> ParserT m src Scan (Maybe [Scan])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Scan] -> Maybe [Scan]
forall a. a -> Maybe a
Just ([Scan] -> ParserT m src Scan (Maybe [Scan]))
-> [Scan] -> ParserT m src Scan (Maybe [Scan])
forall a b. (a -> b) -> a -> b
$ String -> Scan
Mask String
name Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
: [([Scan], String)] -> [Scan]
f ([[Scan]] -> [String] -> [([Scan], String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Scan]]
args' [String]
raw) [Scan] -> [Scan] -> [Scan]
forall a. [a] -> [a] -> [a]
++ [String -> Scan
Unmask String
name]

-- lookupEnv :: (Monad m, HasEnv m)
--           => String -> ParserT m src Scan (Maybe Macro)
-- lookupEnv s = lift $ getEnv >>= traverse aux . lookupKey s
--   where aux (m, env') = setEnv env' >> return m

expandMacro :: (Monad m, HasError m, HasEnv m)
            => Config -> Int -> String -> Scan -> ParserT m src Scan [Scan]
expandMacro :: Config -> LineNum -> String -> Scan -> ParserT m src Scan [Scan]
expandMacro Config
cfg LineNum
lineNum String
name Scan
tok =
  case String
name of
    String
"__LINE__" -> String -> ParserT m src Scan [Scan]
forall (m :: * -> *). Monad m => String -> m [Scan]
simple (String -> ParserT m src Scan [Scan])
-> (String -> String) -> String -> ParserT m src Scan [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. IsString a => String -> a
fromString (String -> ParserT m src Scan [Scan])
-> String -> ParserT m src Scan [Scan]
forall a b. (a -> b) -> a -> b
$ LineNum -> String
forall a. Show a => a -> String
show LineNum
lineNum
    String
"__FILE__" -> String -> ParserT m src Scan [Scan]
forall (m :: * -> *). Monad m => String -> m [Scan]
simple (String -> ParserT m src Scan [Scan])
-> (String -> String) -> String -> ParserT m src Scan [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall s. Stringy s => s -> s
stringify (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. IsString a => String -> a
fromString (String -> ParserT m src Scan [Scan])
-> String -> ParserT m src Scan [Scan]
forall a b. (a -> b) -> a -> b
$ Config -> String
curFileName Config
cfg
    String
"__DATE__" -> String -> ParserT m src Scan [Scan]
forall (m :: * -> *). Monad m => String -> m [Scan]
simple (String -> ParserT m src Scan [Scan])
-> (DateString -> String)
-> DateString
-> ParserT m src Scan [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall s. Stringy s => s -> s
stringify (String -> String)
-> (DateString -> String) -> DateString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. IsString a => String -> a
fromString (String -> String)
-> (DateString -> String) -> DateString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateString -> String
getDateString (DateString -> ParserT m src Scan [Scan])
-> DateString -> ParserT m src Scan [Scan]
forall a b. (a -> b) -> a -> b
$ Config -> DateString
prepDate Config
cfg
    String
"__TIME__" -> String -> ParserT m src Scan [Scan]
forall (m :: * -> *). Monad m => String -> m [Scan]
simple (String -> ParserT m src Scan [Scan])
-> (TimeString -> String)
-> TimeString
-> ParserT m src Scan [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall s. Stringy s => s -> s
stringify (String -> String)
-> (TimeString -> String) -> TimeString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. IsString a => String -> a
fromString (String -> String)
-> (TimeString -> String) -> TimeString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeString -> String
getTimeString (TimeString -> ParserT m src Scan [Scan])
-> TimeString -> ParserT m src Scan [Scan]
forall a b. (a -> b) -> a -> b
$ Config -> TimeString
prepTime Config
cfg
    String
_ -> do Maybe Macro
mm <- m (Maybe Macro) -> StateT (Source m src Scan) m (Maybe Macro)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m (Maybe Macro)
forall (m :: * -> *).
(HasEnv m, Monad m) =>
String -> m (Maybe Macro)
lookupMacro String
name)
            case Maybe Macro
mm of
              Maybe Macro
Nothing -> [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return [Scan
tok]
              Just Macro
m ->
                case Macro
m of
                  Object [TOKEN]
t' ->
                    [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Scan] -> ParserT m src Scan [Scan])
-> [Scan] -> ParserT m src Scan [Scan]
forall a b. (a -> b) -> a -> b
$ String -> Scan
Mask String
name Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
: (TOKEN -> Scan) -> [TOKEN] -> [Scan]
forall a b. (a -> b) -> [a] -> [b]
map TOKEN -> Scan
Rescan ([TOKEN] -> [TOKEN]
forall s. Stringy s => [Token s] -> [Token s]
spaced [TOKEN]
t') [Scan] -> [Scan] -> [Scan]
forall a. [a] -> [a] -> [a]
++ [String -> Scan
Unmask String
name]
                  Function LineNum
arity [([Scan], String)] -> [Scan]
f ->
                    let ex :: ParserT m src Scan [Scan]
ex = Bool -> Config -> LineNum -> ParserT m src Scan [Scan]
forall (m :: * -> *) src.
(HasError m, Monad m, HasEnv m) =>
Bool -> Config -> LineNum -> ParserT m src Scan [Scan]
expandLine' Bool
False Config
cfg LineNum
lineNum
                        err :: [String] -> StateT (Source m src Scan) m a
err = m a -> StateT (Source m src Scan) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT (Source m src Scan) m a)
-> ([String] -> m a) -> [String] -> StateT (Source m src Scan) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> m a
forall (m :: * -> *) a. HasError m => Error -> m a
throwError
                            (Error -> m a) -> ([String] -> Error) -> [String] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineNum -> String -> LineNum -> [String] -> Error
argError LineNum
lineNum String
name LineNum
arity
                    in do Maybe [Scan]
mts <- String
-> LineNum
-> ([([Scan], String)] -> [Scan])
-> (forall r'. [String] -> ParserT m src Scan r')
-> ([Scan] -> ParserT m src Scan [Scan])
-> ParserT m src Scan (Maybe [Scan])
forall (m :: * -> *) src.
(Monad m, HasError m) =>
String
-> LineNum
-> ([([Scan], String)] -> [Scan])
-> (forall r'. [String] -> ParserT m src Scan r')
-> ([Scan] -> ParserT m src Scan [Scan])
-> ParserT m src Scan (Maybe [Scan])
expandFunction String
name LineNum
arity [([Scan], String)] -> [Scan]
f forall r'. [String] -> ParserT m src Scan r'
err
                                                (m [Scan] -> ParserT m src Scan [Scan]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Scan] -> ParserT m src Scan [Scan])
-> ([Scan] -> m [Scan]) -> [Scan] -> ParserT m src Scan [Scan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser m Scan [Scan] -> [Scan] -> m [Scan]
forall (m :: * -> *) i o. Monad m => Parser m i o -> [i] -> m o
evalParse Parser m Scan [Scan]
forall src. ParserT m src Scan [Scan]
ex)
                          case Maybe [Scan]
mts of
                            Maybe [Scan]
Nothing -> [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return [Scan
tok]
                            Just [Scan]
ts -> [Scan] -> ParserT m src Scan [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return [Scan]
ts
  where simple :: String -> m [Scan]
simple String
s = [Scan] -> m [Scan]
forall (m :: * -> *) a. Monad m => a -> m a
return [TOKEN -> Scan
Rescan (String -> TOKEN
forall s. s -> Token s
Important String
s)]
        -- Avoid accidentally merging tokens like @'-'@
        spaced :: [Token s] -> [Token s]
spaced [Token s]
xs = [Token s]
pre [Token s] -> [Token s] -> [Token s]
forall a. Semigroup a => a -> a -> a
<> [Token s]
pos
          where importantChar :: Token s -> Bool
importantChar (Important s
t) =
                  case s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons s
t of
                    Maybe (Char, s)
Nothing -> Bool
False
                    Just (Char
c,s
t') -> Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
oops Bool -> Bool -> Bool
&& s -> Bool
forall s. Stringy s => s -> Bool
isEmpty s
t'
                importantChar Token s
_ = Bool
False
                pre :: [Token s]
pre = [Token s] -> [Token s] -> Bool -> [Token s]
forall a. a -> a -> Bool -> a
bool [Token s]
xs (s -> Token s
forall s. s -> Token s
Other s
" "Token s -> [Token s] -> [Token s]
forall a. a -> [a] -> [a]
:[Token s]
xs)(Bool -> [Token s]) -> Bool -> [Token s]
forall a b. (a -> b) -> a -> b
$
                      (Bool -> (Token s -> Bool) -> Maybe (Token s) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Token s -> Bool
forall s. Stringy s => Token s -> Bool
importantChar (Maybe (Token s) -> Bool) -> Maybe (Token s) -> Bool
forall a b. (a -> b) -> a -> b
$ [Token s] -> Maybe (Token s)
forall a. [a] -> Maybe a
listToMaybe [Token s]
xs)
                pos :: [Token s]
pos = [Token s] -> [Token s] -> Bool -> [Token s]
forall a. a -> a -> Bool -> a
bool [] [s -> Token s
forall s. s -> Token s
Other s
" "] (Bool -> [Token s]) -> Bool -> [Token s]
forall a b. (a -> b) -> a -> b
$
                      (Bool -> (Token s -> Bool) -> Maybe (Token s) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Token s -> Bool
forall s. Stringy s => Token s -> Bool
importantChar (Maybe (Token s) -> Bool) -> Maybe (Token s) -> Bool
forall a b. (a -> b) -> a -> b
$ [Token s] -> Maybe (Token s)
forall a. [a] -> Maybe a
listToMaybe ([Token s] -> [Token s]
forall a. [a] -> [a]
reverse [Token s]
xs))
                oops :: String
oops = String
"-+*.><" :: [Char]

-- | Trim whitespace from both ends of a sequence of 'Scan' tokens.
trimScan :: [Scan] -> [Scan]
trimScan :: [Scan] -> [Scan]
trimScan [] = []
trimScan (Scan
t:[Scan]
ts) | Scan -> Bool
isSpaceScan Scan
t = [Scan] -> [Scan]
trimScan [Scan]
ts
                | Scan -> Bool
isImportantScan Scan
t = Scan
t Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
: Maybe Scan -> [Scan] -> [Scan]
trimScanAux Maybe Scan
forall a. Maybe a
Nothing [Scan]
ts
                | Bool
otherwise = Scan
t Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
: [Scan] -> [Scan]
trimScan [Scan]
ts

-- | Collapse internal whitespace to single spaces, and trim trailing
-- space.
trimScanAux :: Maybe Scan -> [Scan] -> [Scan]
trimScanAux :: Maybe Scan -> [Scan] -> [Scan]
trimScanAux Maybe Scan
_ [] = []
trimScanAux Maybe Scan
spc (Scan
t : [Scan]
ts)
  | Scan -> Bool
isSpaceScan Scan
t = Maybe Scan -> [Scan] -> [Scan]
trimScanAux (Scan -> Maybe Scan
forall a. a -> Maybe a
Just (TOKEN -> Scan
Scan (String -> TOKEN
forall s. s -> Token s
Other String
" "))) [Scan]
ts
  | Scan -> Bool
isImportantScan Scan
t = [Scan] -> (Scan -> [Scan]) -> Maybe Scan -> [Scan]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
:[]) Maybe Scan
spc [Scan] -> [Scan] -> [Scan]
forall a. [a] -> [a] -> [a]
++ (Scan
t Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
: Maybe Scan -> [Scan] -> [Scan]
trimScanAux Maybe Scan
forall a. Maybe a
Nothing [Scan]
ts)
  | Bool
otherwise = Scan
t Scan -> [Scan] -> [Scan]
forall a. a -> [a] -> [a]
: Maybe Scan -> [Scan] -> [Scan]
trimScanAux Maybe Scan
spc [Scan]
ts