{-# LANGUAGE BangPatterns, LambdaCase, OverloadedStrings, ScopedTypeVariables,
             TupleSections #-}
{-|
Module      : Htcc.Parser.Parsing.StmtExpr
Description : The C languge parser and AST constructor
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

The module of the statement expression (GNU extension: <https://gcc.gnu.org/onlinedocs/gcc/Statement-Exprs.html>)
-}
module Htcc.Parser.Parsing.StmtExpr (
    stmtExpr
) where

import           Control.Monad                            (when)
import           Control.Monad.Loops                      (unfoldrM)
import           Control.Monad.ST                         (runST)
import           Data.Bits                                hiding (shift)
import           Data.STRef                               (newSTRef, readSTRef,
                                                           writeSTRef)
import           Prelude                                  hiding (toInteger)

import           Htcc.Parser.AST
import           Htcc.Parser.ConstructionData
import           Htcc.Parser.ConstructionData.Scope.Utils (internalCE)
import {-# SOURCE #-} Htcc.Parser.Parsing.Core                 (stmt)
import           Htcc.Parser.Utils
import qualified Htcc.Tokenizer                           as HT
import           Htcc.Utils                               (maybeToRight, tshow)

-- | statement expression (GNU extension: <https://gcc.gnu.org/onlinedocs/gcc/Statement-Exprs.html>)
-- \[\text{stmt-expr}=\text{"("}\ \text{"\{"}\ \text{stmt}\ \text{stmt*}\ \text{"\}"}\ \text{")"}\]
stmtExpr :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
stmtExpr :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
stmtExpr ((_, HT.TKReserved "("):xs :: [TokenLC i]
xs@((_, HT.TKReserved "{"):_)) _ !ConstructionData i
scp = Either
  (Text, TokenLC i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ((Text, TokenLC i)
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
     (Text, TokenLC i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall e. e -> Maybe ~> Either e
maybeToRight (Text
internalCE, [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs) (Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall i.
(Integral i, Read i, Show i) =>
Text
-> Text
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
takeBrace "{" "}" [TokenLC i]
xs)) ((Either (TokenLC i) ([TokenLC i], [TokenLC i])
  -> ASTConstruction i)
 -> ASTConstruction i)
-> (Either (TokenLC i) ([TokenLC i], [TokenLC i])
    -> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$
    (TokenLC i -> ASTConstruction i)
-> (([TokenLC i], [TokenLC i]) -> ASTConstruction i)
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> ASTConstruction i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ((Text, TokenLC i) -> ASTConstruction i)
-> (TokenLC i -> (Text, TokenLC i))
-> TokenLC i
-> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("the statement expression is not closed",)) ((([TokenLC i], [TokenLC i]) -> ASTConstruction i)
 -> Either (TokenLC i) ([TokenLC i], [TokenLC i])
 -> ASTConstruction i)
-> (([TokenLC i], [TokenLC i]) -> ASTConstruction i)
-> Either (TokenLC i) ([TokenLC i], [TokenLC i])
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(sctk :: [TokenLC i]
sctk, ds :: [TokenLC i]
ds) -> case [TokenLC i]
ds of
        (_, HT.TKReserved ")"):ds' :: [TokenLC i]
ds' -> (forall s. ST s (ASTConstruction i)) -> ASTConstruction i
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ASTConstruction i)) -> ASTConstruction i)
-> (forall s. ST s (ASTConstruction i)) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ do
            STRef s (Maybe (Text, TokenLC i))
eri <- Maybe (Text, TokenLC i) -> ST s (STRef s (Maybe (Text, TokenLC i)))
forall a s. a -> ST s (STRef s a)
newSTRef Maybe (Text, TokenLC i)
forall a. Maybe a
Nothing
            STRef s (ConstructionData i)
v <- ConstructionData i -> ST s (STRef s (ConstructionData i))
forall a s. a -> ST s (STRef s a)
newSTRef (ConstructionData i -> ST s (STRef s (ConstructionData i)))
-> ConstructionData i -> ST s (STRef s (ConstructionData i))
forall a b. (a -> b) -> a -> b
$ ConstructionData i -> ConstructionData i
forall i. ConstructionData i -> ConstructionData i
succNest ConstructionData i
scp
            STRef s (ATree i)
lastA <- ATree i -> ST s (STRef s (ATree i))
forall a s. a -> ST s (STRef s a)
newSTRef ATree i
forall a. ATree a
ATEmpty
            [ATree i]
mk <- (([TokenLC i] -> ST s (Maybe (ATree i, [TokenLC i])))
 -> [TokenLC i] -> ST s [ATree i])
-> [TokenLC i]
-> ([TokenLC i] -> ST s (Maybe (ATree i, [TokenLC i])))
-> ST s [ATree i]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([TokenLC i] -> ST s (Maybe (ATree i, [TokenLC i])))
-> [TokenLC i] -> ST s [ATree i]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe (b, a))) -> a -> m [b]
unfoldrM ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
init ([TokenLC i] -> [TokenLC i]) -> [TokenLC i] -> [TokenLC i]
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail [TokenLC i]
sctk) (([TokenLC i] -> ST s (Maybe (ATree i, [TokenLC i])))
 -> ST s [ATree i])
-> ([TokenLC i] -> ST s (Maybe (ATree i, [TokenLC i])))
-> ST s [ATree i]
forall a b. (a -> b) -> a -> b
$ \ert :: [TokenLC i]
ert -> if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
ert then Maybe (ATree i, [TokenLC i]) -> ST s (Maybe (ATree i, [TokenLC i]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ATree i, [TokenLC i])
forall a. Maybe a
Nothing else do
                ConstructionData i
erscp <- STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
v
                ((ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
 -> ASTConstruction i -> ST s (Maybe (ATree i, [TokenLC i])))
-> ASTConstruction i
-> (ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
-> ST s (Maybe (ATree i, [TokenLC i]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Text, TokenLC i) -> ST s (Maybe (ATree i, [TokenLC i])))
-> (ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
-> ASTConstruction i
-> ST s (Maybe (ATree i, [TokenLC i]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (((Text, TokenLC i) -> ST s (Maybe (ATree i, [TokenLC i])))
 -> (ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
 -> ASTConstruction i
 -> ST s (Maybe (ATree i, [TokenLC i])))
-> ((Text, TokenLC i) -> ST s (Maybe (ATree i, [TokenLC i])))
-> (ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
-> ASTConstruction i
-> ST s (Maybe (ATree i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ \err :: (Text, TokenLC i)
err -> Maybe (ATree i, [TokenLC i])
forall a. Maybe a
Nothing Maybe (ATree i, [TokenLC i])
-> ST s () -> ST s (Maybe (ATree i, [TokenLC i]))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ STRef s (Maybe (Text, TokenLC i))
-> Maybe (Text, TokenLC i) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe (Text, TokenLC i))
eri ((Text, TokenLC i) -> Maybe (Text, TokenLC i)
forall a. a -> Maybe a
Just (Text, TokenLC i)
err)) ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
stmt [TokenLC i]
ert ATree i
forall a. ATree a
ATEmpty ConstructionData i
erscp) ((ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
 -> ST s (Maybe (ATree i, [TokenLC i])))
-> (ASTSuccess i -> ST s (Maybe (ATree i, [TokenLC i])))
-> ST s (Maybe (ATree i, [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ \(ert' :: [TokenLC i]
ert', erat' :: ATree i
erat', erscp' :: ConstructionData i
erscp') ->
                    (ATree i, [TokenLC i]) -> Maybe (ATree i, [TokenLC i])
forall a. a -> Maybe a
Just (ATree i
erat', [TokenLC i]
ert') Maybe (ATree i, [TokenLC i])
-> ST s () -> ST s (Maybe (ATree i, [TokenLC i]))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (STRef s (ConstructionData i) -> ConstructionData i -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (ConstructionData i)
v ConstructionData i
erscp' ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (case ATree i
erat' of ATEmpty -> Bool
False; _ -> Bool
True) (STRef s (ATree i) -> ATree i -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (ATree i)
lastA ATree i
erat'))
            ST s (Maybe (Text, TokenLC i))
-> (Maybe (Text, TokenLC i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (STRef s (Maybe (Text, TokenLC i)) -> ST s (Maybe (Text, TokenLC i))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe (Text, TokenLC i))
eri) ((Maybe (Text, TokenLC i) -> ST s (ASTConstruction i))
 -> ST s (ASTConstruction i))
-> (Maybe (Text, TokenLC i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
forall a b. (a -> b) -> a -> b
$ (ST s (ASTConstruction i)
 -> ((Text, TokenLC i) -> ST s (ASTConstruction i))
 -> Maybe (Text, TokenLC i)
 -> ST s (ASTConstruction i))
-> ((Text, TokenLC i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
-> Maybe (Text, TokenLC i)
-> ST s (ASTConstruction i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ST s (ASTConstruction i)
-> ((Text, TokenLC i) -> ST s (ASTConstruction i))
-> Maybe (Text, TokenLC i)
-> ST s (ASTConstruction i)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ASTConstruction i -> ST s (ASTConstruction i)
forall (m :: * -> *) a. Monad m => a -> m a
return (ASTConstruction i -> ST s (ASTConstruction i))
-> ((Text, TokenLC i) -> ASTConstruction i)
-> (Text, TokenLC i)
-> ST s (ASTConstruction i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left) (ST s (ASTConstruction i)
 -> Maybe (Text, TokenLC i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
-> Maybe (Text, TokenLC i)
-> ST s (ASTConstruction i)
forall a b. (a -> b) -> a -> b
$ do
                ConstructionData i
v' <- STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
v
                ((ATree i -> ASTConstruction i)
 -> ST s (ATree i) -> ST s (ASTConstruction i))
-> ST s (ATree i)
-> (ATree i -> ASTConstruction i)
-> ST s (ASTConstruction i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ATree i -> ASTConstruction i)
-> ST s (ATree i) -> ST s (ASTConstruction i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (STRef s (ATree i) -> ST s (ATree i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ATree i)
lastA) ((ATree i -> ASTConstruction i) -> ST s (ASTConstruction i))
-> (ATree i -> ASTConstruction i) -> ST s (ASTConstruction i)
forall a b. (a -> b) -> a -> b
$ \case
                        (ATNode ATExprStmt _ lhs :: ATree i
lhs _) -> ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds', ATKind i -> StorageClass i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i
atNoLeaf ([ATree i] -> ATKind i
forall a. [ATree a] -> ATKind a
ATStmtExpr ([ATree i] -> [ATree i]
forall a. [a] -> [a]
init [ATree i]
mk [ATree i] -> [ATree i] -> [ATree i]
forall a. [a] -> [a] -> [a]
++ [ATree i
lhs])) (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs), ConstructionData i -> ConstructionData i -> ConstructionData i
forall i.
ConstructionData i -> ConstructionData i -> ConstructionData i
fallBack ConstructionData i
scp ConstructionData i
v')
                        _ -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("void value not ignored as it ought to be. the statement expression starts here:", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs)
        _ -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ((Text, TokenLC i) -> ASTConstruction i)
-> (Text, TokenLC i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
sctk then ("expected ')' token. the statement expression starts here: ", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs) else
            ("expected ')' token after '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Token i -> Text
forall a. Show a => a -> Text
tshow (TokenLC i -> Token i
forall a b. (a, b) -> b
snd (TokenLC i -> Token i) -> TokenLC i -> Token i
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> TokenLC i
forall a. [a] -> a
last [TokenLC i]
sctk) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token", [TokenLC i] -> TokenLC i
forall a. [a] -> a
last [TokenLC i]
sctk)
stmtExpr xs :: [TokenLC i]
xs _ _ = (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left (Text
internalCE, [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
xs)