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

The function declaration
-}
module Htcc.Parser.Parsing.Global.Function (
    function
) where

import           Control.Monad.Loops                      (unfoldrM)
import           Control.Monad.ST                         (runST)
import           Data.Bits                                hiding (shift)
import           Data.List                                (find)
import           Data.List.Split                          (linesBy)
import           Data.Maybe                               (fromMaybe, isJust)
import           Data.STRef                               (newSTRef, readSTRef,
                                                           writeSTRef)
import           Prelude                                  hiding (toInteger)

import qualified Htcc.CRules.Types                        as CT
import           Htcc.Parser.AST
import           Htcc.Parser.ConstructionData
import           Htcc.Parser.ConstructionData.Scope.Utils (internalCE)
import {-# SOURCE #-} Htcc.Parser.Parsing.Core                 (stmt)
import {-# SOURCE #-} Htcc.Parser.Parsing.Global               (globalDef)
import           Htcc.Parser.Parsing.Type
import           Htcc.Parser.Utils
import qualified Htcc.Tokenizer                           as HT
import           Htcc.Utils                               (maybe', maybeToRight,
                                                           tshow)

-- |
-- \[
-- \begin{array}{ccc}
-- \text{function}&=&\text{pre-type}\ \text{declaration}\ \text{"("}\ \text{params?}\ \text{")"}\ \left(\text{"\{"}\ \text{stmt*}\ \text{"\}"}\ \mid\ \text{";"}\right)\\
-- \text{params}&=&\text{params}\left(\text{","}\ \text{param}\right)\text{*}\\
-- \text{param}&=&\text{pre-type}\ \text{declaration}\ \text{array-decl-suffix}
-- \end{array}
-- \]
function :: (Show i, Read i, Integral i, Bits i) => CT.StorageClass i -> Maybe (HT.TokenLC i) -> [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
function :: StorageClass i
-> Maybe (TokenLC i)
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
function funcType :: StorageClass i
funcType (Just cur :: TokenLC i
cur@(_, HT.TKIdent fname :: Text
fname)) tk :: [TokenLC i]
tk@((_, HT.TKReserved "("):_) at :: ATree i
at !ConstructionData i
sc = let scp :: ConstructionData i
scp = ConstructionData i -> ConstructionData i
forall i. ConstructionData i -> ConstructionData i
resetLocal ConstructionData i
sc in
    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
cur) (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]
 -> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i])))
-> [TokenLC i]
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail (TokenLC i
curTokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
tk))) ((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
. ("invalid function declaration/definition",)) ((([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
$ \(fndec :: [TokenLC i]
fndec, st :: [TokenLC i]
st) -> case [TokenLC i]
st of
            ((_, HT.TKReserved ";"):ds'' :: [TokenLC i]
ds'') -> Bool
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (Text, TokenLC i) (ConstructionData i)
forall i.
Num i =>
Bool
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addFunction Bool
False StorageClass i
funcType TokenLC i
cur ConstructionData i
scp Either (Text, TokenLC i) (ConstructionData i)
-> (ConstructionData i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [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
globalDef [TokenLC i]
ds'' ATree i
at -- for a function declaration -- TODO: read types of parameters and register them
            ((_, HT.TKReserved "{"):_) -> Either (Text, TokenLC i) (ConstructionData i)
-> (ConstructionData i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (Bool
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (Text, TokenLC i) (ConstructionData i)
forall i.
Num i =>
Bool
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ConstructionData i)
addFunction Bool
True StorageClass i
funcType TokenLC i
cur ConstructionData i
scp) ((ConstructionData i -> ASTConstruction i) -> ASTConstruction i)
-> (ConstructionData i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \scp' :: ConstructionData i
scp' -> [TokenLC i]
-> ConstructionData i
-> ([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)]
    -> ASTConstruction i)
-> ASTConstruction i
forall i b.
(Integral i, Show i, Read i, Bits i) =>
[(TokenLCNums i, Token i)]
-> ConstructionData i
-> ([(StorageClass i, Maybe (TokenLCNums i, Token i),
      [(TokenLCNums i, Token i)], ConstructionData i)]
    -> Either (ASTError i) b)
-> Either (ASTError i) b
checkErr [TokenLC i]
fndec ConstructionData i
scp' (([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
    ConstructionData i)]
  -> ASTConstruction i)
 -> ASTConstruction i)
-> ([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)]
    -> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \args :: [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
args -> (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 -- for a function definition
                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
scp'
                [ATree i]
mk <- (([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
    ConstructionData i)]
  -> ST
       s
       (Maybe
          (ATree i,
           [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
             ConstructionData i)])))
 -> [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)]
 -> ST s [ATree i])
-> [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)]
-> ([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)]
    -> ST
         s
         (Maybe
            (ATree i,
             [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
               ConstructionData i)])))
-> ST s [ATree i]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
   ConstructionData i)]
 -> ST
      s
      (Maybe
         (ATree i,
          [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
            ConstructionData i)])))
-> [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)]
-> ST s [ATree i]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe (b, a))) -> a -> m [b]
unfoldrM [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
args (([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
    ConstructionData i)]
  -> ST
       s
       (Maybe
          (ATree i,
           [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
             ConstructionData i)])))
 -> ST s [ATree i])
-> ([(StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)]
    -> ST
         s
         (Maybe
            (ATree i,
             [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
               ConstructionData i)])))
-> ST s [ATree i]
forall a b. (a -> b) -> a -> b
$ \args' :: [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
args' -> if [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
args' then Maybe
  (ATree i,
   [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)])
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData i)]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (ATree i,
   [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)])
forall a. Maybe a
Nothing else let arg :: (StorageClass i, Maybe (TokenLC i), [TokenLC i],
 ConstructionData i)
arg = [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i],
    ConstructionData i)
forall a. [a] -> a
head [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
args' in do
                -- About @t'@:
                -- An array of type T is equivalent to a pointer of type T in the context of function parameters.
                    Either (Text, TokenLC i) (ATree i, ConstructionData i)
m <- ((ConstructionData i
  -> Either (Text, TokenLC i) (ATree i, ConstructionData i))
 -> ST s (ConstructionData i)
 -> ST s (Either (Text, TokenLC i) (ATree i, ConstructionData i)))
-> ST s (ConstructionData i)
-> (ConstructionData i
    -> Either (Text, TokenLC i) (ATree i, ConstructionData i))
-> ST s (Either (Text, TokenLC i) (ATree i, ConstructionData i))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ConstructionData i
 -> Either (Text, TokenLC i) (ATree i, ConstructionData i))
-> ST s (ConstructionData i)
-> ST s (Either (Text, TokenLC i) (ATree i, ConstructionData i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
v) ((ConstructionData i
  -> Either (Text, TokenLC i) (ATree i, ConstructionData i))
 -> ST s (Either (Text, TokenLC i) (ATree i, ConstructionData i)))
-> (ConstructionData i
    -> Either (Text, TokenLC i) (ATree i, ConstructionData i))
-> ST s (Either (Text, TokenLC i) (ATree i, ConstructionData i))
forall a b. (a -> b) -> a -> b
$ \scp'' :: ConstructionData i
scp'' -> let (t :: StorageClass i
t, mident :: Maybe (TokenLC i)
mident, _, _) = (StorageClass i, Maybe (TokenLC i), [TokenLC i],
 ConstructionData i)
arg; t' :: StorageClass i
t' = StorageClass i -> Maybe (StorageClass i) -> StorageClass i
forall a. a -> Maybe a -> a
fromMaybe StorageClass i
t (Maybe (StorageClass i) -> StorageClass i)
-> Maybe (StorageClass i) -> StorageClass i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Maybe (StorageClass i)
forall (a :: * -> *) j.
(TypeKindBase a, CType (a j), IncompleteBase a) =>
a j -> Maybe (a j)
aboutArray StorageClass i
t in case Maybe (TokenLC i)
mident of
                        Nothing -> (Text, TokenLC i)
-> Either (Text, TokenLC i) (ATree i, ConstructionData i)
forall a b. a -> Either a b
Left ("anonymouse variable is not implemented yet", TokenLC i
cur) -- TODO
                        Just ident :: TokenLC i
ident -> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (Text, TokenLC i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addLVar StorageClass i
t' TokenLC i
ident ConstructionData i
scp''
                    (((ATree i, ConstructionData i)
  -> ST
       s
       (Maybe
          (ATree i,
           [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
             ConstructionData i)])))
 -> Either (Text, TokenLC i) (ATree i, ConstructionData i)
 -> ST
      s
      (Maybe
         (ATree i,
          [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
            ConstructionData i)])))
-> Either (Text, TokenLC i) (ATree i, ConstructionData i)
-> ((ATree i, ConstructionData i)
    -> ST
         s
         (Maybe
            (ATree i,
             [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
               ConstructionData i)])))
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData i)]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Text, TokenLC i)
 -> ST
      s
      (Maybe
         (ATree i,
          [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
            ConstructionData i)])))
-> ((ATree i, ConstructionData i)
    -> ST
         s
         (Maybe
            (ATree i,
             [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
               ConstructionData i)])))
-> Either (Text, TokenLC i) (ATree i, ConstructionData i)
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData i)]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe
  (ATree i,
   [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)])
-> ST s ()
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData i)]))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) Maybe
  (ATree i,
   [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)])
forall a. Maybe a
Nothing (ST s ()
 -> ST
      s
      (Maybe
         (ATree i,
          [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
            ConstructionData i)])))
-> ((Text, TokenLC i) -> ST s ())
-> (Text, TokenLC i)
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData i)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Maybe (Text, TokenLC i) -> ST s ())
-> ((Text, TokenLC i) -> Maybe (Text, TokenLC i))
-> (Text, TokenLC i)
-> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, TokenLC i) -> Maybe (Text, TokenLC i)
forall a. a -> Maybe a
Just)) Either (Text, TokenLC i) (ATree i, ConstructionData i)
m (((ATree i, ConstructionData i)
  -> ST
       s
       (Maybe
          (ATree i,
           [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
             ConstructionData i)])))
 -> ST
      s
      (Maybe
         (ATree i,
          [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
            ConstructionData i)])))
-> ((ATree i, ConstructionData i)
    -> ST
         s
         (Maybe
            (ATree i,
             [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
               ConstructionData i)])))
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData i)]))
forall a b. (a -> b) -> a -> b
$ \(vat :: ATree i
vat, scp'' :: ConstructionData i
scp'') -> (ATree i,
 [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
   ConstructionData i)])
-> Maybe
     (ATree i,
      [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
        ConstructionData i)])
forall a. a -> Maybe a
Just (ATree i
vat, [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
-> [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)]
forall a. [a] -> [a]
tail [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
  ConstructionData i)]
args') Maybe
  (ATree i,
   [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
     ConstructionData i)])
-> ST s ()
-> ST
     s
     (Maybe
        (ATree i,
         [(StorageClass i, Maybe (TokenLC i), [TokenLC i],
           ConstructionData 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
scp''
                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
$ ((ConstructionData i -> ASTConstruction i)
 -> ST s (ConstructionData i) -> ST s (ASTConstruction i))
-> ST s (ConstructionData i)
-> (ConstructionData i -> ASTConstruction i)
-> ST s (ASTConstruction i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ConstructionData i -> ASTConstruction i)
-> ST s (ConstructionData i) -> ST s (ASTConstruction i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
v) ((ConstructionData i -> ASTConstruction i)
 -> ST s (ASTConstruction i))
-> (ConstructionData i -> ASTConstruction i)
-> ST s (ASTConstruction i)
forall a b. (a -> b) -> a -> b
$ \v' :: ConstructionData i
v' -> ASTConstruction i
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([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]
st ATree i
at ConstructionData i
v') ((ASTSuccess i -> ASTConstruction i) -> ASTConstruction i)
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case -- Forbid void to return a value in a return type function.
                    (ert :: [TokenLC i]
ert, erat :: ATree i
erat@(ATNode (ATBlock block :: [ATree i]
block) _ _ _), erscp :: ConstructionData i
erscp)
                        | StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
funcType TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
forall i. TypeKind i
CT.CTVoid -> if Maybe (ATree i) -> Bool
forall a. Maybe a -> Bool
isJust ((ATree i -> Bool) -> [ATree i] -> Maybe (ATree i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ATree i -> Bool
forall a. ATree a -> Bool
isNonEmptyReturn [ATree i]
block) then
                            (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("The return type of function '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is void, but the statement returns a value", TokenLC i
cur) else
                                ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, Text -> Maybe [ATree i] -> StorageClass i -> ATree i -> ATree i
forall i.
Text -> Maybe [ATree i] -> StorageClass i -> ATree i -> ATree i
atDefFunc Text
fname (if [ATree i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ATree i]
mk then Maybe [ATree i]
forall a. Maybe a
Nothing else [ATree i] -> Maybe [ATree i]
forall a. a -> Maybe a
Just [ATree i]
mk) StorageClass i
funcType ATree i
erat, ConstructionData i
erscp)
                        | Bool
otherwise -> let fnode :: ATree i
fnode = Text -> Maybe [ATree i] -> StorageClass i -> ATree i -> ATree i
forall i.
Text -> Maybe [ATree i] -> StorageClass i -> ATree i -> ATree i
atDefFunc Text
fname (if [ATree i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ATree i]
mk then Maybe [ATree i]
forall a. Maybe a
Nothing else [ATree i] -> Maybe [ATree i]
forall a. a -> Maybe a
Just [ATree i]
mk) StorageClass i
funcType ATree i
erat in
                            ASTConstruction i
-> Maybe (ATree i)
-> (ATree i -> ASTConstruction i)
-> ASTConstruction i
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' (ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, ATree i
fnode, ConstructionData i
erscp)) ((ATree i -> Bool) -> [ATree i] -> Maybe (ATree i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ATree i -> Bool
forall a. ATree a -> Bool
isEmptyReturn [ATree i]
block) ((ATree i -> ASTConstruction i) -> ASTConstruction i)
-> (ATree i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ ASTConstruction i -> ATree i -> ASTConstruction i
forall a b. a -> b -> a
const (ASTConstruction i -> ATree i -> ASTConstruction i)
-> ASTConstruction i -> ATree i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$
                                ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, ATree i
fnode, Text -> TokenLC i -> ConstructionData i -> ConstructionData i
forall i.
Text -> TokenLC i -> ConstructionData i -> ConstructionData i
pushWarn ("The return type of function '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeKind i -> Text
forall a. Show a => a -> Text
tshow (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
funcType) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", but the statement returns no value") TokenLC i
cur ConstructionData i
erscp)
                    _ -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left (Text
internalCE, TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken)
            _ -> [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]
tk ATree i
at ConstructionData i
scp
    where
        checkErr :: [(TokenLCNums i, Token i)]
-> ConstructionData i
-> ([(StorageClass i, Maybe (TokenLCNums i, Token i),
      [(TokenLCNums i, Token i)], ConstructionData i)]
    -> Either (ASTError i) b)
-> Either (ASTError i) b
checkErr ar :: [(TokenLCNums i, Token i)]
ar !ConstructionData i
scp' f :: [(StorageClass i, Maybe (TokenLCNums i, Token i),
  [(TokenLCNums i, Token i)], ConstructionData i)]
-> Either (ASTError i) b
f = let ar' :: [(TokenLCNums i, Token i)]
ar' = [(TokenLCNums i, Token i)] -> [(TokenLCNums i, Token i)]
forall a. [a] -> [a]
init ([(TokenLCNums i, Token i)] -> [(TokenLCNums i, Token i)])
-> [(TokenLCNums i, Token i)] -> [(TokenLCNums i, Token i)]
forall a b. (a -> b) -> a -> b
$ [(TokenLCNums i, Token i)] -> [(TokenLCNums i, Token i)]
forall a. [a] -> [a]
tail [(TokenLCNums i, Token i)]
ar in if Bool -> Bool
not ([(TokenLCNums i, Token i)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TokenLCNums i, Token i)]
ar') Bool -> Bool -> Bool
&& (TokenLCNums i, Token i) -> Token i
forall a b. (a, b) -> b
snd ([(TokenLCNums i, Token i)] -> (TokenLCNums i, Token i)
forall a. [a] -> a
head [(TokenLCNums i, Token i)]
ar') Token i -> Token i -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Token i
forall i. Text -> Token i
HT.TKReserved "," then ASTError i -> Either (ASTError i) b
forall a b. a -> Either a b
Left ("unexpected ',' token", [(TokenLCNums i, Token i)] -> (TokenLCNums i, Token i)
forall a. [a] -> a
head [(TokenLCNums i, Token i)]
ar') else
            let args :: [[(TokenLCNums i, Token i)]]
args = ((TokenLCNums i, Token i) -> Bool)
-> [(TokenLCNums i, Token i)] -> [[(TokenLCNums i, Token i)]]
forall a. (a -> Bool) -> [a] -> [[a]]
linesBy ((Token i -> Token i -> Bool
forall a. Eq a => a -> a -> Bool
==Text -> Token i
forall i. Text -> Token i
HT.TKReserved ",") (Token i -> Bool)
-> ((TokenLCNums i, Token i) -> Token i)
-> (TokenLCNums i, Token i)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenLCNums i, Token i) -> Token i
forall a b. (a, b) -> b
snd) [(TokenLCNums i, Token i)]
ar' in ([(TokenLCNums i, Token i)]
 -> Either
      (ASTError i)
      (StorageClass i, Maybe (TokenLCNums i, Token i),
       [(TokenLCNums i, Token i)], ConstructionData i))
-> [[(TokenLCNums i, Token i)]]
-> Either
     (ASTError i)
     [(StorageClass i, Maybe (TokenLCNums i, Token i),
       [(TokenLCNums i, Token i)], ConstructionData i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLCNums i, Token i),
      [(TokenLCNums i, Token i)], ConstructionData i)
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either
     (ASTError i)
     (StorageClass i, Maybe (TokenLC i), [TokenLC i],
      ConstructionData i)
`takeType` ConstructionData i
scp') [[(TokenLCNums i, Token i)]]
args Either
  (ASTError i)
  [(StorageClass i, Maybe (TokenLCNums i, Token i),
    [(TokenLCNums i, Token i)], ConstructionData i)]
-> ([(StorageClass i, Maybe (TokenLCNums i, Token i),
      [(TokenLCNums i, Token i)], ConstructionData i)]
    -> Either (ASTError i) b)
-> Either (ASTError i) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(StorageClass i, Maybe (TokenLCNums i, Token i),
  [(TokenLCNums i, Token i)], ConstructionData i)]
-> Either (ASTError i) b
f
        aboutArray :: a j -> Maybe (a j)
aboutArray t :: a j
t
            | a j -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTArray a j
t = (TypeKind j -> TypeKind j) -> a j -> a j
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind TypeKind j -> TypeKind j
forall i. TypeKind i -> TypeKind i
CT.CTPtr (a j -> a j) -> Maybe (a j) -> Maybe (a j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a j -> Maybe (a j)
forall a. CType a => a -> Maybe a
CT.deref a j
t
            | a j -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
CT.isIncompleteArray a j
t = a j -> Maybe (a j)
forall a. a -> Maybe a
Just (a j -> Maybe (a j)) -> a j -> Maybe (a j)
forall a b. (a -> b) -> a -> b
$ (TypeKind j -> TypeKind j) -> a j -> a j
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind (\(CT.CTIncomplete (CT.IncompleteArray t' :: TypeKind j
t')) -> TypeKind j -> TypeKind j
forall i. TypeKind i -> TypeKind i
CT.CTPtr TypeKind j
t') a j
t
            | Bool
otherwise = Maybe (a j)
forall a. Maybe a
Nothing
function _ _ 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)