{-# LANGUAGE CPP, LambdaCase, OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
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)
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
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
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)
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]
:))
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
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]
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)]
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]
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
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