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

The Global variable declaration
-}
module Htcc.Parser.Parsing.Global.Var (
    var
) where

import           Data.Bits                                       hiding (shift)
import           Prelude                                         hiding
                                                                  (toInteger)

import qualified Htcc.CRules.Types                               as CT
import           Htcc.Parser.AST
import           Htcc.Parser.ConstructionData
import           Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)
import           Htcc.Parser.ConstructionData.Scope.Utils        (internalCE)
import qualified Htcc.Parser.ConstructionData.Scope.Var          as PV
import {-# SOURCE #-} Htcc.Parser.Parsing.Core                        (conditional)
import           Htcc.Parser.Parsing.Type
import qualified Htcc.Tokenizer                                  as HT
import           Htcc.Utils                                      (maybeToRight,
                                                                  tshow)

gvarInit :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> CT.StorageClass i -> HT.TokenLC i -> ConstructionData i -> Either (ASTError i) ([HT.TokenLC i], ConstructionData i)
gvarInit :: [TokenLC i]
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
gvarInit xs :: [TokenLC i]
xs ty :: StorageClass i
ty ident :: TokenLC i
ident sc :: ConstructionData i
sc = do
    (ds :: [TokenLC i]
ds, ast :: ATree i
ast, sc' :: ConstructionData i
sc') <- [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
conditional [TokenLC i]
xs ATree i
forall a. ATree a
ATEmpty ConstructionData i
sc
    case (ATree i -> ATKind i
forall a. ATree a -> ATKind a
atkind ATree i
ast, ATree i -> ATKind i
forall a. ATree a -> ATKind a
atkind (ATree i -> ATree i
forall a. ATree a -> ATree a
atL ATree i
ast)) of
        (ATAddr, ATGVar _ name :: Text
name) -> ([TokenLC i]
ds,) (ConstructionData i -> ([TokenLC i], ConstructionData i))
-> ((ATree i, ConstructionData i) -> ConstructionData i)
-> (ATree i, ConstructionData i)
-> ([TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i, ConstructionData i) -> ConstructionData i
forall a b. (a, b) -> b
snd ((ATree i, ConstructionData i)
 -> ([TokenLC i], ConstructionData i))
-> Either (ASTError i) (ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> Text
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> Text
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
gvarInitWithOG StorageClass i
ty TokenLC i
ident Text
name ConstructionData i
sc'
        (ATAddr, _) -> ASTError i -> Either (ASTError i) ([TokenLC i], ConstructionData i)
forall a b. a -> Either a b
Left ("invalid initializer in global variable", [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
ds)
        (ATGVar t :: StorageClass i
t name :: Text
name, _)
            | StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTArray StorageClass i
t -> ([TokenLC i]
ds,) (ConstructionData i -> ([TokenLC i], ConstructionData i))
-> ((ATree i, ConstructionData i) -> ConstructionData i)
-> (ATree i, ConstructionData i)
-> ([TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i, ConstructionData i) -> ConstructionData i
forall a b. (a, b) -> b
snd ((ATree i, ConstructionData i)
 -> ([TokenLC i], ConstructionData i))
-> Either (ASTError i) (ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> Text
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> Text
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
gvarInitWithOG StorageClass i
ty TokenLC i
ident Text
name ConstructionData i
sc'
            | Bool
otherwise -> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
gvarInitWithVal [TokenLC i]
ds ConstructionData i
sc'
        _ -> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
gvarInitWithVal [TokenLC i]
ds ConstructionData i
sc'
    where
        gvarInitWithOG :: StorageClass i
-> TokenLC i
-> Text
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
gvarInitWithOG ty' :: StorageClass i
ty' from :: TokenLC i
from to :: Text
to = StorageClass i
-> TokenLC i
-> GVarInitWith i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> GVarInitWith i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addGVarWith StorageClass i
ty' TokenLC i
from (Text -> GVarInitWith i
forall i. Text -> GVarInitWith i
PV.GVarInitWithOG Text
to)
        gvarInitWithVal :: [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
gvarInitWithVal ds :: [TokenLC i]
ds sc' :: ConstructionData i
sc' = do
            (ds' :: [TokenLC i]
ds', cval :: i
cval) <- (Maybe (ASTError i) -> Either (ASTError i) ([TokenLC i], i))
-> (([TokenLC i], i) -> Either (ASTError i) ([TokenLC i], i))
-> Either (Maybe (ASTError i)) ([TokenLC i], i)
-> Either (ASTError i) ([TokenLC i], i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either (ASTError i) ([TokenLC i], i)
-> (ASTError i -> Either (ASTError i) ([TokenLC i], i))
-> Maybe (ASTError i)
-> Either (ASTError i) ([TokenLC i], i)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ASTError i -> Either (ASTError i) ([TokenLC i], i)
forall a b. a -> Either a b
Left ("initializer element is not constant", [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
ds)) ASTError i -> Either (ASTError i) ([TokenLC i], i)
forall a b. a -> Either a b
Left) ([TokenLC i], i) -> Either (ASTError i) ([TokenLC i], i)
forall a b. b -> Either a b
Right (Either (Maybe (ASTError i)) ([TokenLC i], i)
 -> Either (ASTError i) ([TokenLC i], i))
-> Either (Maybe (ASTError i)) ([TokenLC i], i)
-> Either (ASTError i) ([TokenLC i], i)
forall a b. (a -> b) -> a -> b
$ [TokenLC i]
-> ConstructionData i
-> Either (Maybe (ASTError i)) ([TokenLC i], i)
forall i.
(Bits i, Integral i, Show i, Read i) =>
[TokenLC i]
-> ConstructionData i -> Either (ConstantResult i) ([TokenLC i], i)
constantExp [TokenLC i]
xs ConstructionData i
sc'
            ([TokenLC i]
ds',) (ConstructionData i -> ([TokenLC i], ConstructionData i))
-> ((ATree i, ConstructionData i) -> ConstructionData i)
-> (ATree i, ConstructionData i)
-> ([TokenLC i], ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i, ConstructionData i) -> ConstructionData i
forall a b. (a, b) -> b
snd ((ATree i, ConstructionData i)
 -> ([TokenLC i], ConstructionData i))
-> Either (ASTError i) (ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass i
-> TokenLC i
-> GVarInitWith i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> GVarInitWith i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addGVarWith StorageClass i
ty TokenLC i
ident (i -> GVarInitWith i
forall i. i -> GVarInitWith i
PV.GVarInitWithVal i
cval) ConstructionData i
sc'

-- | \[
-- \text{global-var} = \text{pre-type}\ \text{declaration}\ \text{array-decl-suffix}\ \text{";"}
-- \]
var :: (Show i, Read i, Integral i, Bits i) => CT.StorageClass i -> Maybe (HT.TokenLC i) -> [HT.TokenLC i] -> ConstructionData i -> ASTConstruction i
var :: StorageClass i
-> Maybe (TokenLC i)
-> [TokenLC i]
-> ConstructionData i
-> ASTConstruction i
var ty :: StorageClass i
ty (Just cur :: TokenLC i
cur@(_, HT.TKIdent _)) xs :: [TokenLC i]
xs !ConstructionData i
scp = case [TokenLC i]
xs of
    (_, HT.TKReserved "="):ds :: [TokenLC i]
ds -> do -- for initializing
        StorageClass i
ty' <- (Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("defining global variables with a incomplete type", TokenLC i
cur) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
ty ConstructionData i
scp)
        (ds' :: [TokenLC i]
ds', nsc :: ConstructionData i
nsc) <- [TokenLC i]
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (Text, TokenLC i) ([TokenLC i], ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i]
-> StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ConstructionData i)
gvarInit [TokenLC i]
ds StorageClass i
ty' TokenLC i
cur ConstructionData i
scp
        case [TokenLC i]
ds' of
            (_, HT.TKReserved ";"):ds'' :: [TokenLC i]
ds'' -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall (m :: * -> *) a. Monad m => a -> m a
return ([TokenLC i]
ds'', ATree i
forall a. ATree a
ATEmpty, ConstructionData i
nsc)
            _ -> (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]
ds' then
                ("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
cur) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token", [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
ds') else
                    ("expected ';' token" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
ds' then "" else " before '" 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
head [TokenLC i]
ds') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token"), [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
ds')
    (_, HT.TKReserved ";"):ds :: [TokenLC i]
ds -> do -- for non initializing
        StorageClass i
ty' <- (Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("defining global variables with a incomplete type", TokenLC i
cur) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
ty ConstructionData i
scp)
        ([TokenLC i]
ds, ATree i
forall a. ATree a
ATEmpty,) (ConstructionData i -> ([TokenLC i], ATree i, ConstructionData i))
-> ((ATree i, ConstructionData i) -> ConstructionData i)
-> (ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i, ConstructionData i) -> ConstructionData i
forall a b. (a, b) -> b
snd ((ATree i, ConstructionData i)
 -> ([TokenLC i], ATree i, ConstructionData i))
-> Either (Text, TokenLC i) (ATree i, ConstructionData i)
-> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
addGVar StorageClass i
ty' TokenLC i
cur ConstructionData i
scp
    _ -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("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
cur) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token", TokenLC i
cur)
var _ _ 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)