{-# LANGUAGE BangPatterns, LambdaCase, OverloadedStrings, ScopedTypeVariables,
TupleSections #-}
module Htcc.Parser.Parsing.Core (
program,
globalDef,
stmt,
inners,
logicalOr,
logicalAnd,
bitwiseOr,
bitwiseXor,
bitwiseAnd,
shift,
add,
term,
cast,
unary,
factor,
relational,
equality,
conditional,
assign,
expr,
parse,
ASTs,
ASTSuccess,
ASTConstruction,
ASTResult,
stackSize
) where
import Control.Monad (forM)
import Control.Monad.Loops (unfoldrM)
import Control.Monad.ST (runST)
import Data.Bits hiding (shift)
import qualified Data.ByteString as B
import Data.Either (isLeft, lefts,
rights)
import Data.Foldable (Foldable (..))
import Data.List (find)
import Data.Maybe (fromJust,
fromMaybe)
import qualified Data.Set as S
import Data.STRef (newSTRef,
readSTRef,
writeSTRef)
import qualified Data.Text as T
import Data.Tuple.Extra (dupe, first,
second, snd3,
uncurry3)
import Numeric.Natural
import Prelude hiding
(toInteger)
import qualified Htcc.CRules.Types as CT
import Htcc.Parser.AST
import Htcc.Parser.ConstructionData
import Htcc.Parser.ConstructionData.Scope (LookupVarResult (..),
Scoped (..))
import qualified Htcc.Parser.ConstructionData.Scope.Function as PSF
import Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)
import Htcc.Parser.ConstructionData.Scope.Utils (internalCE)
import qualified Htcc.Parser.ConstructionData.Scope.Var as PV
import Htcc.Parser.Parsing.Global
import Htcc.Parser.Parsing.StmtExpr
import Htcc.Parser.Parsing.Type
import Htcc.Parser.Parsing.Typedef
import Htcc.Parser.Utils
import qualified Htcc.Tokenizer as HT
import Htcc.Utils (first3,
first4,
maybe',
maybeToRight,
second3,
third3,
toInteger,
toNatural,
tshow)
{-# INLINE varDecl #-}
varDecl :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ConstructionData i -> ASTConstruction i
varDecl :: [TokenLC i] -> ConstructionData i -> ASTConstruction i
varDecl tk :: [TokenLC i]
tk scp :: ConstructionData i
scp = [TokenLC i]
-> ConstructionData i
-> Either
(ASTError i)
(StorageClass i, Maybe (TokenLC i), [TokenLC 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 [TokenLC i]
tk ConstructionData i
scp Either
(ASTError i)
(StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> ((StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> Either
(ASTError i)
(StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i))
-> Either
(ASTError i)
(StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TokenLC i
-> (StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> Either
(ASTError i)
(StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
forall i a a c.
(Eq i, Show a) =>
(a, a)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
validDecl ([TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
tk) Either
(ASTError i)
(StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> ((StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> ASTConstruction i
varDecl'
where
varDecl' :: (StorageClass i, Maybe (TokenLC i), [TokenLC i],
ConstructionData i)
-> ASTConstruction i
varDecl' (_, Nothing, (_, HT.TKReserved ";"):ds :: [TokenLC i]
ds, scp' :: ConstructionData i
scp') = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i
forall a. ATree a
ATEmpty, ConstructionData i
scp')
varDecl' (t :: StorageClass i
t, Just ident :: TokenLC i
ident, (_, HT.TKReserved ";"):ds :: [TokenLC i]
ds, scp' :: ConstructionData i
scp') = ASTError i
-> Maybe (StorageClass i) -> Either (ASTError i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("declaration with incomplete type", TokenLC i
ident) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp) Either (ASTError i) (StorageClass i)
-> (StorageClass i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t' :: StorageClass i
t' ->
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError 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' Either (ASTError i) (ATree i, ConstructionData i)
-> ((ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(lat :: ATree i
lat, scp'' :: ConstructionData i
scp'') -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i -> ATree i
forall i. ATree i -> ATree i
atNull ATree i
lat, ConstructionData i
scp'')
varDecl' (t :: StorageClass i
t, Just ident :: TokenLC i
ident, (_, HT.TKReserved "="):ds :: [TokenLC i]
ds, scp' :: ConstructionData i
scp') = ASTConstruction i
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (Assign i
-> StorageClass i
-> TokenLC i
-> [TokenLC i]
-> ConstructionData i
-> ASTConstruction i
forall i.
(Read i, Show i, Integral i, Bits i) =>
Assign i
-> StorageClass i
-> TokenLC i
-> [TokenLC i]
-> ConstructionData i
-> ASTConstruction i
varInit Assign i
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
assign StorageClass i
t TokenLC i
ident [TokenLC i]
ds ConstructionData i
scp') ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
((_, HT.TKReserved ";"):ds' :: [TokenLC i]
ds', at :: ATree i
at, sc :: ConstructionData i
sc) -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds', ATree i
at, ConstructionData i
sc)
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ';' token, the subject iteration statement starts here:", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
tk)
varDecl' (_, _, ds :: [TokenLC i]
ds, _) = ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError 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 unqualified-id", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
tk) else ("expected unqualified-id 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] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ds)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton '\'', [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ds)
validDecl :: (a, a)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
validDecl _ tnt :: (StorageClass i, Maybe (a, a), c, ConstructionData i)
tnt@(t :: StorageClass i
t, Just ident :: (a, a)
ident, _, scp' :: ConstructionData i
scp') = Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Maybe (StorageClass i)
-> (StorageClass i
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' ((StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. b -> Either a b
Right (StorageClass i, Maybe (a, a), c, ConstructionData i)
tnt) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp') ((StorageClass i
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> (StorageClass i
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \t' :: StorageClass i
t' -> if StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
t TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
forall i. TypeKind i
CT.CTVoid then
(Text, (a, a))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. a -> Either a b
Left ("variable or field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
ident) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' declarated void", (a, a)
ident) else (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. b -> Either a b
Right ((StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ (StorageClass i -> StorageClass i)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a e b c d. (a -> e) -> (a, b, c, d) -> (e, b, c, d)
first4 (StorageClass i -> StorageClass i -> StorageClass i
forall a b. a -> b -> a
const StorageClass i
t') (StorageClass i, Maybe (a, a), c, ConstructionData i)
tnt
validDecl errPlaceholder :: (a, a)
errPlaceholder tnt :: (StorageClass i, Maybe (a, a), c, ConstructionData i)
tnt@(t :: StorageClass i
t, _, _, scp' :: ConstructionData i
scp') = Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Maybe (StorageClass i)
-> (StorageClass i
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' ((StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. b -> Either a b
Right (StorageClass i, Maybe (a, a), c, ConstructionData i)
tnt) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp') ((StorageClass i
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> (StorageClass i
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \t' :: StorageClass i
t' -> if StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
t TypeKind i -> TypeKind i -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind i
forall i. TypeKind i
CT.CTVoid then
(Text, (a, a))
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. a -> Either a b
Left ("declarations of type void is invalid in this context", (a, a)
errPlaceholder) else (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. b -> Either a b
Right ((StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i))
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> Either
(Text, (a, a))
(StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ (StorageClass i -> StorageClass i)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
-> (StorageClass i, Maybe (a, a), c, ConstructionData i)
forall a e b c d. (a -> e) -> (a, b, c, d) -> (e, b, c, d)
first4 (StorageClass i -> StorageClass i -> StorageClass i
forall a b. a -> b -> a
const StorageClass i
t') (StorageClass i, Maybe (a, a), c, ConstructionData i)
tnt
program :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ConstructionData i -> Either (ASTError i) (ASTs i, ConstructionData i)
program :: [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (ASTs i, ConstructionData i)
program [] !ConstructionData i
scp = (ASTs i, ConstructionData i)
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall a b. b -> Either a b
Right ([], ConstructionData i
scp)
program xs :: [TokenLC i]
xs !ConstructionData i
scp = (ASTError i -> Either (ASTError i) (ASTs i, ConstructionData i))
-> (([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) (ASTs i, ConstructionData i))
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ASTError i -> Either (ASTError i) (ASTs i, ConstructionData i)
forall a b. a -> Either a b
Left (\(ys :: [TokenLC i]
ys, atn :: ATree i
atn, !ConstructionData i
scp') -> (ASTs i -> ASTs i)
-> (ASTs i, ConstructionData i) -> (ASTs i, ConstructionData i)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (ATree i
atnATree i -> ASTs i -> ASTs i
forall a. a -> [a] -> [a]
:) ((ASTs i, ConstructionData i) -> (ASTs i, ConstructionData i))
-> Either (ASTError i) (ASTs i, ConstructionData i)
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (ASTs i, ConstructionData i)
program [TokenLC i]
ys ConstructionData i
scp') (Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) (ASTs i, ConstructionData i))
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
globalDef [TokenLC i]
xs ATree i
forall a. ATree a
ATEmpty ConstructionData i
scp
stmt :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
stmt :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
stmt ((_, HT.TKReturn):(_, HT.TKReserved ";"):xs :: [TokenLC i]
xs) _ scp :: ConstructionData i
scp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, StorageClass i -> ATree i -> ATree i
forall i. StorageClass i -> ATree i -> ATree i
atReturn (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCUndef TypeKind i
forall i. TypeKind i
CT.CTUndef) ATree i
forall a. ATree a
ATEmpty, ConstructionData i
scp)
stmt (cur :: TokenLC i
cur@(_, HT.TKReturn):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved ";"):ys :: [TokenLC i]
ys -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ys, StorageClass i -> ATree i -> ATree i
forall i. StorageClass i -> ATree i -> ATree i
atReturn (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCUndef TypeKind i
forall i. TypeKind i
CT.CTUndef) ATree i
erat, ConstructionData i
erscp)
ert' :: [TokenLC i]
ert' -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ Text -> TokenLC i -> [TokenLC i] -> ASTError i
forall i. Show i => Text -> TokenLC i -> [TokenLC i] -> ASTError i
expectedMessage ";" TokenLC i
cur [TokenLC i]
ert'
stmt (cur :: TokenLC i
cur@(_, HT.TKIf):(_, HT.TKReserved "("):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved ")"):ys :: [TokenLC i]
ys -> ASTConstruction i
-> (([TokenLC i], ATree 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
stmt [TokenLC i]
ys ATree i
erat ConstructionData i
erscp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \x :: ([TokenLC i], ATree i, ConstructionData i)
x -> case (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATree i -> ATree i -> ATree i
forall i. ATree i -> ATree i -> ATree i
atIf ATree i
erat) ([TokenLC i], ATree i, ConstructionData i)
x of
((_, HT.TKElse):zs :: [TokenLC i]
zs, eerat :: ATree i
eerat, eerscp :: ConstructionData i
eerscp) -> (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATree i -> ATree i -> ATree i
forall i. ATree i -> ATree i -> ATree i
atElse ATree i
eerat) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
zs ATree i
eerat ConstructionData i
eerscp
zs :: ([TokenLC i], ATree i, ConstructionData i)
zs -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i], ATree i, ConstructionData i)
zs
ert' :: [TokenLC i]
ert' -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ Text -> TokenLC i -> [TokenLC i] -> ASTError i
forall i. Show i => Text -> TokenLC i -> [TokenLC i] -> ASTError i
expectedMessage ")" TokenLC i
cur [TokenLC i]
ert'
stmt (cur :: TokenLC i
cur@(_, HT.TKWhile):(_, HT.TKReserved "("):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved ")"):ys :: [TokenLC i]
ys -> (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATree i -> ATree i -> ATree i
forall i. ATree i -> ATree i -> ATree i
atWhile ATree i
erat) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
ys ATree i
erat ConstructionData i
erscp
ert' :: [TokenLC i]
ert' -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ Text -> TokenLC i -> [TokenLC i] -> ASTError i
forall i. Show i => Text -> TokenLC i -> [TokenLC i] -> ASTError i
expectedMessage ")" TokenLC i
cur [TokenLC i]
ert'
stmt xxs :: [TokenLC i]
xxs@(cur :: TokenLC i
cur@(_, HT.TKFor):(_, HT.TKReserved "("):_) _ !ConstructionData i
scp = Either (ASTError 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
(>>=) (ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
(ASTError 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] -> [TokenLC i]
forall a. [a] -> [a]
tail [TokenLC i]
xxs))) ((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 (ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> (TokenLC i -> ASTError i) -> TokenLC i -> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("expected ')' token. The subject iteration statement starts here:",)) ((([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
$ \(forSt :: [TokenLC i]
forSt, ds :: [TokenLC i]
ds) -> ASTConstruction i
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i] -> ConstructionData i -> ASTConstruction i
initSect ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
init [TokenLC i]
forSt)) (ConstructionData i -> ASTConstruction i)
-> ConstructionData i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ ConstructionData i -> ConstructionData i
forall i. ConstructionData i -> ConstructionData i
succNest ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(fxs :: [TokenLC i]
fxs, finit :: ATree i
finit, fscp' :: ConstructionData i
fscp') ->
ASTConstruction i
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i] -> ConstructionData i -> ASTConstruction i
condSect [TokenLC i]
fxs ConstructionData i
fscp') ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(fxs' :: [TokenLC i]
fxs', fcond :: ATree i
fcond, fscp'' :: ConstructionData i
fscp'') -> ASTConstruction i
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i] -> ConstructionData i -> ASTConstruction i
forall a.
(Show a, Read a, Integral a, Bits a) =>
[TokenLC a]
-> ConstructionData a
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
incrSect [TokenLC i]
fxs' ConstructionData i
fscp'') ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
([], fincr :: ATree i
fincr, fscp''' :: ConstructionData i
fscp''') ->
let fnd :: [ATKindFor i]
fnd = (ATKindFor i -> Bool) -> [ATKindFor i] -> [ATKindFor i]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x' :: ATKindFor i
x' -> case ATKindFor i -> ATree i
forall a. ATKindFor a -> ATree a
fromATKindFor ATKindFor i
x' of ATEmpty -> Bool
False; x'' :: ATree i
x'' -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ATree i -> Bool
forall a. ATree a -> Bool
isEmptyExprStmt ATree i
x'') [ATree i -> ATKindFor i
forall a. ATree a -> ATKindFor a
ATForInit ATree i
finit, ATree i -> ATKindFor i
forall a. ATree a -> ATKindFor a
ATForCond ATree i
fcond, ATree i -> ATKindFor i
forall a. ATree a -> ATKindFor a
ATForIncr ATree i
fincr]
mkk :: [ATKindFor i]
mkk = [ATKindFor i]
-> (ATKindFor i -> [ATKindFor i])
-> Maybe (ATKindFor i)
-> [ATKindFor i]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ATree i -> ATKindFor i
forall a. ATree a -> ATKindFor a
ATForCond (i -> ATree i
forall i. i -> ATree i
atNumLit 1) ATKindFor i -> [ATKindFor i] -> [ATKindFor i]
forall a. a -> [a] -> [a]
: [ATKindFor i]
fnd) ([ATKindFor i] -> ATKindFor i -> [ATKindFor i]
forall a b. a -> b -> a
const [ATKindFor i]
fnd) (Maybe (ATKindFor i) -> [ATKindFor i])
-> Maybe (ATKindFor i) -> [ATKindFor i]
forall a b. (a -> b) -> a -> b
$ (ATKindFor i -> Bool) -> [ATKindFor i] -> Maybe (ATKindFor i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ATKindFor i -> Bool
forall a. ATKindFor a -> Bool
isATForCond [ATKindFor i]
fnd in case [TokenLC i]
ds of
((_, HT.TKReserved ";"):ys :: [TokenLC i]
ys) -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ys, [ATKindFor i] -> ATree i
forall i. [ATKindFor i] -> ATree i
atFor [ATKindFor i]
mkk, ConstructionData i -> ConstructionData i -> ConstructionData i
forall i.
ConstructionData i -> ConstructionData i -> ConstructionData i
fallBack ConstructionData i
scp ConstructionData i
fscp''')
_ -> (ConstructionData i -> ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
third3 (ConstructionData i -> ConstructionData i -> ConstructionData i
forall i.
ConstructionData i -> ConstructionData i -> ConstructionData i
fallBack ConstructionData i
scp) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 ([ATKindFor i] -> ATree i
forall i. [ATKindFor i] -> ATree i
atFor ([ATKindFor i] -> ATree i)
-> (ATree i -> [ATKindFor i]) -> ATree i -> ATree i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ATKindFor i]
mkk [ATKindFor i] -> [ATKindFor i] -> [ATKindFor i]
forall a. [a] -> [a] -> [a]
++) ([ATKindFor i] -> [ATKindFor i])
-> (ATree i -> [ATKindFor i]) -> ATree i -> [ATKindFor i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATKindFor i -> [ATKindFor i] -> [ATKindFor i]
forall a. a -> [a] -> [a]
:[]) (ATKindFor i -> [ATKindFor i])
-> (ATree i -> ATKindFor i) -> ATree i -> [ATKindFor i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree i -> ATKindFor i
forall a. ATree a -> ATKindFor a
ATForStmt) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
ds ATree i
forall a. ATree a
ATEmpty ConstructionData i
fscp'''
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("unexpected end of for statement", TokenLC i
cur)
where
initSect :: [TokenLC i] -> ConstructionData i -> ASTConstruction i
initSect [] _ = ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("the iteration statement for must be `for (expression_opt; expression_opt; expression_opt) statement`. See section 6.8.5.", TokenLC i
cur)
initSect ((_, HT.TKReserved ";"):ds :: [TokenLC i]
ds) fsc :: ConstructionData i
fsc = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i
forall a. ATree a
ATEmpty, ConstructionData i
fsc)
initSect forSect :: [TokenLC i]
forSect fsc :: ConstructionData i
fsc
| TokenLC i -> ConstructionData i -> Bool
forall i. TokenLC i -> ConstructionData i -> Bool
isTypeName ([TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
forSect) ConstructionData i
fsc = [TokenLC i] -> ConstructionData i -> ASTConstruction i
forall a.
(Show a, Read a, Integral a, Bits a) =>
[TokenLC a]
-> ConstructionData a
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
varDecl [TokenLC i]
forSect ConstructionData i
fsc
| Bool
otherwise = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
forSect ATree i
forall a. ATree a
ATEmpty ConstructionData i
fsc) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(x :: [TokenLC i]
x, y :: ATree i
y, z :: ConstructionData i
z) -> case [TokenLC i]
x of
(_, HT.TKReserved ";"):ds :: [TokenLC i]
ds -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i -> ATree i
forall i. ATree i -> ATree i
atExprStmt ATree i
y, ConstructionData i
z)
_ -> if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
x then ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ';' token", TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken) else ASTError 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 -> Token i) -> TokenLC i -> Token i
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
x)
condSect :: [TokenLC i] -> ConstructionData i -> ASTConstruction i
condSect [] _ = ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("the iteration statement for must be `for (expression_opt; expression_opt; expression_opt) statement`. See section 6.8.5.", TokenLC i
cur)
condSect ((_, HT.TKReserved ";"):ds :: [TokenLC i]
ds) fsc :: ConstructionData i
fsc = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i
forall a. ATree a
ATEmpty, ConstructionData i
fsc)
condSect forSect :: [TokenLC i]
forSect fsc :: ConstructionData i
fsc = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
forSect ATree i
forall a. ATree a
ATEmpty ConstructionData i
fsc) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
((_, HT.TKReserved ";"):ds :: [TokenLC i]
ds, y :: ATree i
y, z :: ConstructionData i
z) -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i
y, ConstructionData i
z)
(x :: [TokenLC i]
x, _, _) -> if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
x then ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ';' token", TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken) else ASTError 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 -> Token i) -> TokenLC i -> Token i
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
x)
incrSect :: [TokenLC a]
-> ConstructionData a
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
incrSect [] fsc :: ConstructionData a
fsc = ([TokenLC a], ATree a, ConstructionData a)
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
forall a b. b -> Either a b
Right ([], ATree a
forall a. ATree a
ATEmpty, ConstructionData a
fsc)
incrSect forSect :: [TokenLC a]
forSect fsc :: ConstructionData a
fsc = (ATree a -> ATree a)
-> ([TokenLC a], ATree a, ConstructionData a)
-> ([TokenLC a], ATree a, ConstructionData a)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 ATree a -> ATree a
forall i. ATree i -> ATree i
atExprStmt (([TokenLC a], ATree a, ConstructionData a)
-> ([TokenLC a], ATree a, ConstructionData a))
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TokenLC a]
-> ATree a
-> ConstructionData a
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
expr [TokenLC a]
forSect ATree a
forall a. ATree a
ATEmpty ConstructionData a
fsc
stmt xxs :: [TokenLC i]
xxs@(cur :: TokenLC i
cur@(_, HT.TKReserved "{"):_) _ !ConstructionData i
scp = Either (ASTError 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
(>>=) (ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
(ASTError 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]
xxs)) ((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 (ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> (TokenLC i -> ASTError i) -> TokenLC i -> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("the compound statement 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) -> (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 (ASTError i))
eri <- Maybe (ASTError i) -> ST s (STRef s (Maybe (ASTError i)))
forall a s. a -> ST s (STRef s a)
newSTRef Maybe (ASTError 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
[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
(ASTError i -> ST s (Maybe (ATree i, [TokenLC i])))
-> (([TokenLC i], ATree i, ConstructionData 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 (\err :: ASTError 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 (ASTError i)) -> Maybe (ASTError i) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe (ASTError i))
eri (ASTError i -> Maybe (ASTError i)
forall a. a -> Maybe a
Just ASTError i
err)) (\(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') (ASTConstruction i -> ST s (Maybe (ATree i, [TokenLC i])))
-> ASTConstruction i -> ST s (Maybe (ATree i, [TokenLC i]))
forall a b. (a -> b) -> a -> 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]
ert ATree i
forall a. ATree a
ATEmpty ConstructionData i
erscp
ST s (Maybe (ASTError i))
-> (Maybe (ASTError 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 (ASTError i)) -> ST s (Maybe (ASTError i))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe (ASTError i))
eri) ((Maybe (ASTError i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i))
-> (Maybe (ASTError i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
forall a b. (a -> b) -> a -> b
$ (ST s (ASTConstruction i)
-> (ASTError i -> ST s (ASTConstruction i))
-> Maybe (ASTError i)
-> ST s (ASTConstruction i))
-> (ASTError i -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
-> Maybe (ASTError i)
-> ST s (ASTConstruction i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ST s (ASTConstruction i)
-> (ASTError i -> ST s (ASTConstruction i))
-> Maybe (ASTError 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))
-> (ASTError i -> ASTConstruction i)
-> ASTError i
-> ST s (ASTConstruction i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left) (ST s (ASTConstruction i)
-> Maybe (ASTError i) -> ST s (ASTConstruction i))
-> ST s (ASTConstruction i)
-> Maybe (ASTError i)
-> ST s (ASTConstruction i)
forall a b. (a -> b) -> a -> b
$ ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right (([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> (ConstructionData i
-> ([TokenLC i], ATree i, ConstructionData i))
-> ConstructionData i
-> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TokenLC i]
ds, [ATree i] -> ATree i
forall i. [ATree i] -> ATree i
atBlock [ATree i]
mk,) (ConstructionData i -> ([TokenLC i], ATree i, ConstructionData i))
-> (ConstructionData i -> ConstructionData i)
-> ConstructionData i
-> ([TokenLC i], ATree i, ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructionData i -> ConstructionData i -> ConstructionData i
forall i.
ConstructionData i -> ConstructionData i -> ConstructionData i
fallBack ConstructionData i
scp (ConstructionData i -> ASTConstruction i)
-> ST s (ConstructionData i) -> ST s (ASTConstruction i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
v
stmt ((_, HT.TKReserved ";"):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, ATree i
atn, ConstructionData i
scp)
stmt (cur :: TokenLC i
cur@(_, HT.TKBreak):xs :: [TokenLC i]
xs) _ scp :: ConstructionData i
scp = case [TokenLC i]
xs of
(_, HT.TKReserved ";"):ds :: [TokenLC i]
ds -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i
forall a. ATree a
atBreak, ConstructionData i
scp)
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ';' token after 'break' token", TokenLC i
cur)
stmt (cur :: TokenLC i
cur@(_, HT.TKContinue):xs :: [TokenLC i]
xs) _ scp :: ConstructionData i
scp = case [TokenLC i]
xs of
(_, HT.TKReserved ";"):ds :: [TokenLC i]
ds -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, ATree i
forall a. ATree a
atContinue, ConstructionData i
scp)
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ';' token after 'continue' token", TokenLC i
cur)
stmt (cur :: TokenLC i
cur@(_, HT.TKSwitch):xs :: [TokenLC i]
xs) atn :: ATree i
atn scp :: ConstructionData i
scp = case [TokenLC i]
xs of
(_, HT.TKReserved "("):xs' :: [TokenLC i]
xs' -> ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
xs' ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
(cur1 :: TokenLC i
cur1@(_, HT.TKReserved ")"):xs'' :: [TokenLC i]
xs'', cond :: ATree i
cond, scp' :: ConstructionData i
scp') ->
ASTConstruction i
-> (([TokenLC i], ATree 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
stmt [TokenLC i]
xs'' ATree i
forall a. ATree a
ATEmpty (ConstructionData i
scp' { isSwitchStmt :: Bool
isSwitchStmt = Bool
True })) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
(xs''' :: [TokenLC i]
xs''', ATNode (ATBlock ats :: [ATree i]
ats) t :: StorageClass i
t _ _, scp'' :: ConstructionData i
scp'') -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs''', ATree i -> [ATree i] -> StorageClass i -> ATree i
forall i. ATree i -> [ATree i] -> StorageClass i -> ATree i
atSwitch ATree i
cond [ATree i]
ats StorageClass i
t, ConstructionData i
scp'' { isSwitchStmt :: Bool
isSwitchStmt = Bool
False })
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected compound statement after the token ')'", TokenLC i
cur1)
(xs'' :: [TokenLC i]
xs'', _, _) -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not ([TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
xs'') then ("expected token ')' 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]
xs') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs') else ("expected ')' token", TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken)
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected token '(' after the token 'switch'", TokenLC i
cur)
stmt (cur :: TokenLC i
cur@(_, HT.TKCase):xs :: [TokenLC i]
xs) atn :: ATree i
atn scp :: ConstructionData i
scp
| ConstructionData i -> Bool
forall i. ConstructionData i -> Bool
isSwitchStmt ConstructionData i
scp = ((([TokenLC i], i) -> ASTConstruction i)
-> Either (Maybe (ASTError i)) ([TokenLC i], i)
-> ASTConstruction i)
-> Either (Maybe (ASTError i)) ([TokenLC i], i)
-> (([TokenLC i], i) -> ASTConstruction i)
-> ASTConstruction i
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe (ASTError i) -> ASTConstruction i)
-> (([TokenLC i], i) -> ASTConstruction i)
-> Either (Maybe (ASTError i)) ([TokenLC i], i)
-> ASTConstruction i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> (Maybe (ASTError i) -> ASTError i)
-> Maybe (ASTError i)
-> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTError i -> Maybe (ASTError i) -> ASTError i
forall a. a -> Maybe a -> a
fromMaybe ("expected constant expression after 'case' token", TokenLC i
cur))) ([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
scp) ((([TokenLC i], i) -> ASTConstruction i) -> ASTConstruction i)
-> (([TokenLC i], i) -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
((_, HT.TKReserved ":"):ds :: [TokenLC i]
ds, val :: i
val) -> (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (i -> i -> ATree i -> ATree i
forall i. i -> i -> ATree i -> ATree i
atCase 0 i
val) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
ds ATree i
atn ConstructionData i
scp
(ds :: [TokenLC i]
ds, _) -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not ([TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
ds) then ("expected ':' token 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
<> "'", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ds) else ("expected ':' token", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ds)
| Bool
otherwise = ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("stray 'case'", TokenLC i
cur)
stmt (cur :: TokenLC i
cur@(_, HT.TKDefault):(_, HT.TKReserved ":"):xs :: [TokenLC i]
xs) atn :: ATree i
atn scp :: ConstructionData i
scp
| ConstructionData i -> Bool
forall i. ConstructionData i -> Bool
isSwitchStmt ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (i -> ATree i -> ATree i
forall i. i -> ATree i -> ATree i
atDefault 0) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
xs ATree i
atn ConstructionData i
scp
| Bool
otherwise = ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("stray 'default'", TokenLC i
cur)
stmt (cur :: TokenLC i
cur@(_, HT.TKGoto):xs :: [TokenLC i]
xs) _ scp :: ConstructionData i
scp = case [TokenLC i]
xs of
(_, HT.TKIdent ident :: Text
ident):(_, HT.TKReserved ";"):ds :: [TokenLC i]
ds -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ds, Text -> ATree i
forall i. Text -> ATree i
atGoto Text
ident, ConstructionData i
scp)
(_, HT.TKIdent ident :: Text
ident):_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ';' token after the identifier '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur)
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected identifier after the 'goto' token", TokenLC i
cur)
stmt ((_, HT.TKIdent ident :: Text
ident):(_, HT.TKReserved ":"):xs :: [TokenLC i]
xs) _ scp :: ConstructionData i
scp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, Text -> ATree i
forall i. Text -> ATree i
atLabel Text
ident, ConstructionData i
scp)
stmt xs :: [TokenLC i]
xs@((_, HT.TKTypedef):_) _ scp :: ConstructionData i
scp = [TokenLC i] -> ConstructionData i -> ASTConstruction i
forall i a.
(Integral i, Show i, Read i, Bits i) =>
[(TokenLCNums i, Token i)]
-> ConstructionData i
-> Either
(ASTError i)
([(TokenLCNums i, Token i)], ATree a, ConstructionData i)
typedef [TokenLC i]
xs ConstructionData i
scp
stmt tk :: [TokenLC i]
tk atn :: ATree i
atn !ConstructionData i
scp
| Bool -> Bool
not ([TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
tk) Bool -> Bool -> Bool
&& TokenLC i -> ConstructionData i -> Bool
forall i. TokenLC i -> ConstructionData i -> Bool
isTypeName ([TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
tk) ConstructionData i
scp = [TokenLC i] -> ConstructionData i -> ASTConstruction i
forall a.
(Show a, Read a, Integral a, Bits a) =>
[TokenLC a]
-> ConstructionData a
-> Either (ASTError a) ([TokenLC a], ATree a, ConstructionData a)
varDecl [TokenLC i]
tk ConstructionData i
scp
| Bool
otherwise = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
tk ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved ";"):ys :: [TokenLC i]
ys -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ys, ATree i -> ATree i
forall i. ATree i -> ATree i
atExprStmt ATree i
erat, ConstructionData i
erscp)
ert' :: [TokenLC i]
ert' -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ Text -> TokenLC i -> [TokenLC i] -> ASTError i
forall i. Show i => Text -> TokenLC i -> [TokenLC i] -> ASTError i
expectedMessage ";" (if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
tk then TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken else [TokenLC i] -> TokenLC i
forall a. [a] -> a
last [TokenLC i]
tk) [TokenLC i]
ert'
{-# INLINE expr #-}
expr :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
expr :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
expr tk :: [TokenLC i]
tk at :: ATree i
at cd :: ConstructionData i
cd = [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
assign [TokenLC i]
tk ATree i
at ConstructionData i
cd 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)
-> ASTSuccess i -> ASTConstruction i
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 [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
f
where
f :: [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
f ((_, HT.TKReserved ","):xs :: [TokenLC i]
xs) at' :: ATree i
at' cd' :: ConstructionData i
cd' = [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
assign [TokenLC i]
xs ATree i
at' ConstructionData i
cd' Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i))
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([TokenLC i]
-> ATree i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
f (([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i))
-> (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (\x :: ATree i
x -> StorageClass i -> ATree i -> ATree i -> ATree i
forall i. StorageClass i -> ATree i -> ATree i -> ATree i
atComma (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
x) (ATree i -> ATree i
forall i. ATree i -> ATree i
atExprStmt ATree i
at') ATree i
x)
f tk' :: [TokenLC i]
tk' at' :: ATree i
at' cd' :: ConstructionData i
cd' = ([TokenLC i], ATree i, ConstructionData i)
-> Either (ASTError i) ([TokenLC i], ATree i, ConstructionData i)
forall a b. b -> Either a b
Right ([TokenLC i]
tk', ATree i
at', ConstructionData i
cd')
assign :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
assign :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
assign xs :: [TokenLC i]
xs atn :: ATree i
atn scp :: ConstructionData i
scp = 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
conditional [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((ASTSuccess i -> ASTConstruction i) -> ASTConstruction i)
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved "="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "*="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATMulAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "/="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATDivAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "&="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATAndAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "|="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATOrAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "^="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATXorAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "<<="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATShlAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved ">>="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode ATKind i
forall a. ATKind a
ATShrAssign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "+="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode (ATKind i
-> (StorageClass i -> ATKind i)
-> Maybe (StorageClass i)
-> ATKind i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ATKind i
forall a. ATKind a
ATAddAssign (ATKind i -> StorageClass i -> ATKind i
forall a b. a -> b -> a
const ATKind i
forall a. ATKind a
ATAddPtrAssign) (Maybe (StorageClass i) -> ATKind i)
-> Maybe (StorageClass i) -> ATKind i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat)) [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
(_, HT.TKReserved "-="):ys :: [TokenLC i]
ys -> ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode (ATKind i
-> (StorageClass i -> ATKind i)
-> Maybe (StorageClass i)
-> ATKind i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ATKind i
forall a. ATKind a
ATSubAssign (ATKind i -> StorageClass i -> ATKind i
forall a b. a -> b -> a
const ATKind i
forall a. ATKind a
ATSubPtrAssign) (Maybe (StorageClass i) -> ATKind i)
-> Maybe (StorageClass i) -> ATKind i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat)) [TokenLC i]
ys ATree i
erat ConstructionData i
erscp
_ -> ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, ATree i
erat, ConstructionData i
erscp)
where
nextNode :: ATKind i
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
nextNode atk :: ATKind i
atk ys :: [TokenLC i]
ys erat :: ATree i
erat erscp :: ConstructionData i
erscp = 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
assign [TokenLC i]
ys ATree i
erat ConstructionData i
erscp) ((ASTSuccess i -> ASTConstruction i) -> ASTConstruction i)
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(zs :: [TokenLC i]
zs, erat' :: ATree i
erat', erscp' :: ConstructionData i
erscp') ->
Either (ASTError i) (ATree i)
-> (ATree i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (TokenLC i -> ATree i -> Either (ASTError i) (ATree i)
forall i.
Eq i =>
TokenLC i -> ATree i -> Either (ASTError i) (ATree i)
validAssign (if Bool -> Bool
not ([TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
zs) then [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
zs else if Bool -> Bool
not ([TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
ys) then [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ys else if Bool -> Bool
not ([TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
xs) then [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs else TokenLC i
forall i. Num i => TokenLC i
HT.emptyToken) ATree i
erat') ((ATree i -> ASTConstruction i) -> ASTConstruction i)
-> (ATree i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \erat'' :: ATree i
erat'' ->
ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
zs, ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
atk (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) ATree i
erat ATree i
erat'', ConstructionData i
erscp')
conditional :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
conditional :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
conditional xs :: [TokenLC i]
xs atn :: ATree i
atn scp :: ConstructionData i
scp = 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
logicalOr [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((ASTSuccess i -> ASTConstruction i) -> ASTConstruction i)
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, cond :: ATree i
cond, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved "?"):(_, HT.TKReserved ":"):ds :: [TokenLC i]
ds -> (ATree i -> ATree i) -> ASTSuccess i -> ASTSuccess i
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (StorageClass i -> ATree i -> ATree i -> ATree i -> ATree i
forall i.
StorageClass i -> ATree i -> ATree i -> ATree i -> ATree i
atConditional (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
cond) ATree i
cond ATree i
forall a. ATree a
ATEmpty) (ASTSuccess i -> ASTSuccess i)
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
conditional [TokenLC i]
ds ATree i
cond ConstructionData i
erscp
cur :: TokenLC i
cur@(_, HT.TKReserved "?"):ds :: [TokenLC i]
ds -> 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
expr [TokenLC i]
ds ATree i
cond ConstructionData i
erscp) ((ASTSuccess i -> ASTConstruction i) -> ASTConstruction i)
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert' :: [TokenLC i]
ert', thn :: ATree i
thn, erscp' :: ConstructionData i
erscp') -> case [TokenLC i]
ert' of
(_, HT.TKReserved ":"):ds' :: [TokenLC i]
ds' -> (ATree i -> ATree i) -> ASTSuccess i -> ASTSuccess i
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (StorageClass i -> ATree i -> ATree i -> ATree i -> ATree i
forall i.
StorageClass i -> ATree i -> ATree i -> ATree i -> ATree i
atConditional (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
thn) ATree i
cond ATree i
thn) (ASTSuccess i -> ASTSuccess i)
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
conditional [TokenLC i]
ds' ATree i
thn ConstructionData i
erscp'
ds' :: [TokenLC i]
ds' -> if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
ds' then (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ':' token for this '?'", TokenLC i
cur) else (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected ':' 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] -> 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 a. [a] -> a
head [TokenLC i]
ds')
_ -> ASTSuccess i -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, ATree i
cond, ConstructionData i
erscp)
inners :: ([HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i) -> [(T.Text, ATKind i)] -> [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
inners :: ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners _ _ [] atn :: ATree i
atn scp :: ConstructionData i
scp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([], ATree i
atn, ConstructionData i
scp)
inners f :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f cs :: [(Text, ATKind i)]
cs xs :: [TokenLC i]
xs atn :: ATree i
atn scp :: ConstructionData i
scp = (ASTError i -> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
-> ASTConstruction i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners' [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f [(Text, ATKind i)]
cs)) (ASTConstruction i -> ASTConstruction i)
-> ASTConstruction i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f [TokenLC i]
xs ATree i
atn ConstructionData i
scp
where
inners' :: ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners' _ _ [] at :: ATree i
at ars :: ConstructionData i
ars = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([], ATree i
at, ConstructionData i
ars)
inners' g :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
g ds :: [(Text, ATKind i)]
ds ys :: [TokenLC i]
ys at :: ATree i
at ars :: ConstructionData i
ars = ASTConstruction i
-> Maybe (Text, ATKind i)
-> ((Text, ATKind i) -> ASTConstruction i)
-> ASTConstruction i
forall b a. b -> Maybe a -> (a -> b) -> b
maybe' (([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ys, ATree i
at, ConstructionData i
ars)) (((Text, ATKind i) -> Bool)
-> [(Text, ATKind i)] -> Maybe (Text, ATKind i)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(c :: Text
c, _) -> case TokenLC i -> Token i
forall a b. (a, b) -> b
snd ([TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ys) of HT.TKReserved cc :: Text
cc -> Text
cc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c; _ -> Bool
False) [(Text, ATKind i)]
ds) (((Text, ATKind i) -> ASTConstruction i) -> ASTConstruction i)
-> ((Text, ATKind i) -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(_, k :: ATKind i
k) ->
(ASTError i -> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
-> ASTConstruction i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (((ATree i -> ConstructionData i -> ASTConstruction i)
-> ATree i -> ConstructionData i -> ASTConstruction i)
-> (ATree i -> ConstructionData i -> ASTConstruction i, ATree i,
ConstructionData i)
-> ASTConstruction i
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (ATree i -> ConstructionData i -> ASTConstruction i)
-> ATree i -> ConstructionData i -> ASTConstruction i
forall a. a -> a
id ((ATree i -> ConstructionData i -> ASTConstruction i, ATree i,
ConstructionData i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> (ATree i -> ConstructionData i -> ASTConstruction i, ATree i,
ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> (ATree i -> ConstructionData i -> ASTConstruction i, ATree i,
ConstructionData i)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
first3 (([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners' [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f [(Text, ATKind i)]
cs) (([TokenLC i], ATree i, ConstructionData i)
-> (ATree i -> ConstructionData i -> ASTConstruction i, ATree i,
ConstructionData i))
-> (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> (ATree i -> ConstructionData i -> ASTConstruction i, ATree i,
ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
k (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt) ATree i
at)) (ASTConstruction i -> ASTConstruction i)
-> ASTConstruction i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
g ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail [TokenLC i]
ys) ATree i
at ConstructionData i
ars
logicalOr :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
logicalOr :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
logicalOr = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
logicalAnd [("||", ATKind i
forall a. ATKind a
ATLOr)]
logicalAnd :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
logicalAnd :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
logicalAnd = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
bitwiseOr [("&&", ATKind i
forall a. ATKind a
ATLAnd)]
bitwiseOr :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
bitwiseOr :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
bitwiseOr = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
bitwiseXor [("|", ATKind i
forall a. ATKind a
ATOr)]
bitwiseXor :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
bitwiseXor :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
bitwiseXor = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
bitwiseAnd [("^", ATKind i
forall a. ATKind a
ATXor)]
bitwiseAnd :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
bitwiseAnd :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
bitwiseAnd = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
equality [("&", ATKind i
forall a. ATKind a
ATAnd)]
equality :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
equality :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
equality = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
relational [("==", ATKind i
forall a. ATKind a
ATEQ), ("!=", ATKind i
forall a. ATKind a
ATNEQ)]
relational :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
relational :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
relational = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
shift [("<", ATKind i
forall a. ATKind a
ATLT), ("<=", ATKind i
forall a. ATKind a
ATLEQ), (">", ATKind i
forall a. ATKind a
ATGT), (">=", ATKind i
forall a. ATKind a
ATGEQ)]
shift :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
shift :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
shift = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
add [("<<", ATKind i
forall a. ATKind a
ATShl), (">>", ATKind i
forall a. ATKind a
ATShr)]
add :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
add :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
add xs :: [TokenLC i]
xs atn :: ATree i
atn scp :: ConstructionData i
scp = 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
term [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((ASTSuccess i -> ASTConstruction i) -> ASTConstruction i)
-> (ASTSuccess i -> ASTConstruction i) -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> ASTSuccess i -> ASTConstruction i
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 [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
add'
where
add' :: [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
add' (cur :: TokenLC i
cur@(_, HT.TKReserved "+"):ys :: [TokenLC i]
ys) era :: ATree i
era ars :: ConstructionData i
ars = Either (Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
term [TokenLC i]
ys ATree i
era ConstructionData i
ars) ((([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> (([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \zz :: ([TokenLC i], ATree i, ConstructionData i)
zz ->
(Text, TokenLC i)
-> Maybe (ATree i) -> Either (Text, TokenLC i) (ATree i)
forall e. e -> Maybe ~> Either e
maybeToRight ("invalid operands", TokenLC i
cur) (ATree i -> ATree i -> Maybe (ATree i)
forall i.
(Eq i, Ord i, Show i) =>
ATree i -> ATree i -> Maybe (ATree i)
addKind ATree i
era (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ([TokenLC i], ATree i, ConstructionData i) -> ATree i
forall a b c. (a, b, c) -> b
snd3 ([TokenLC i], ATree i, ConstructionData i)
zz) Either (Text, TokenLC i) (ATree i)
-> (ATree i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \nat :: ATree i
nat -> ((ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a. a -> a
id ((ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ ([TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
first3 [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
add' (([TokenLC i], ATree i, ConstructionData i)
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATree i -> ATree i -> ATree i
forall a b. a -> b -> a
const ATree i
nat) ([TokenLC i], ATree i, ConstructionData i)
zz
add' (cur :: TokenLC i
cur@(_, HT.TKReserved "-"):ys :: [TokenLC i]
ys) era :: ATree i
era ars :: ConstructionData i
ars = Either (Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) ([TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
term [TokenLC i]
ys ATree i
era ConstructionData i
ars) ((([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> (([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \zz :: ([TokenLC i], ATree i, ConstructionData i)
zz ->
(Text, TokenLC i)
-> Maybe (ATree i) -> Either (Text, TokenLC i) (ATree i)
forall e. e -> Maybe ~> Either e
maybeToRight ("invalid operands", TokenLC i
cur) (ATree i -> ATree i -> Maybe (ATree i)
forall i. (Eq i, Ord i) => ATree i -> ATree i -> Maybe (ATree i)
subKind ATree i
era (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ([TokenLC i], ATree i, ConstructionData i) -> ATree i
forall a b c. (a, b, c) -> b
snd3 ([TokenLC i], ATree i, ConstructionData i)
zz) Either (Text, TokenLC i) (ATree i)
-> (ATree i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \nat :: ATree i
nat -> ((ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a. a -> a
id ((ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ ([TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
first3 [TokenLC i]
-> ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
add' (([TokenLC i], ATree i, ConstructionData i)
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i))
-> ([TokenLC i], ATree i, ConstructionData i)
-> (ATree i
-> ConstructionData i
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i),
ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATree i -> ATree i -> ATree i
forall a b. a -> b -> a
const ATree i
nat) ([TokenLC i], ATree i, ConstructionData i)
zz
add' ert :: [TokenLC i]
ert erat :: ATree i
erat ars :: ConstructionData i
ars = ([TokenLC i], ATree i, ConstructionData i)
-> Either
(Text, TokenLC i) ([TokenLC i], ATree i, ConstructionData i)
forall a b. b -> Either a b
Right ([TokenLC i]
ert, ATree i
erat, ConstructionData i
ars)
term :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
term :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
term = ([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
forall i.
([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> [(Text, ATKind i)]
-> [TokenLC i]
-> ATree i
-> ConstructionData i
-> ASTConstruction i
inners [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
cast [("*", ATKind i
forall a. ATKind a
ATMul), ("/", ATKind i
forall a. ATKind a
ATDiv), ("%", ATKind i
forall a. ATKind a
ATMod)]
cast :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
cast :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
cast (cur :: TokenLC i
cur@(_, HT.TKReserved "("):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = (((StorageClass i, [TokenLC i]) -> ASTConstruction i)
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> ASTConstruction i)
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> ((StorageClass i, [TokenLC i]) -> ASTConstruction i)
-> ASTConstruction i
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ASTError i -> ASTConstruction i)
-> ((StorageClass i, [TokenLC i]) -> ASTConstruction i)
-> Either (ASTError i) (StorageClass i, [TokenLC i])
-> ASTConstruction i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ASTConstruction i -> ASTError i -> ASTConstruction i
forall a b. a -> b -> a
const (ASTConstruction i -> ASTError i -> ASTConstruction i)
-> ASTConstruction i -> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> 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
unary (TokenLC i
curTokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs) ATree i
at ConstructionData i
scp)) ([TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
takeTypeName [TokenLC i]
xs ConstructionData i
scp) (((StorageClass i, [TokenLC i]) -> ASTConstruction i)
-> ASTConstruction i)
-> ((StorageClass i, [TokenLC i]) -> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \case
(t :: StorageClass i
t, (_, HT.TKReserved ")"):xs' :: [TokenLC i]
xs') -> (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (StorageClass i -> ATree i -> ATree i
forall i. StorageClass i -> ATree i -> ATree i
atCast StorageClass i
t) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
cast [TokenLC i]
xs' ATree i
at ConstructionData i
scp
_ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("The token ')' corresponding to '(' is expected", TokenLC i
cur)
cast xs :: [TokenLC i]
xs at :: ATree i
at scp :: ConstructionData i
scp = [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
unary [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
unary :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
unary ((_, HT.TKReserved "+"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = [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
cast [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary ((_, HT.TKReserved "-"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATSub (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt) (i -> ATree i
forall i. i -> ATree i
atNumLit 0)) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
cast [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary ((_, HT.TKReserved "!"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 ((ATree i -> ATree i -> ATree i) -> ATree i -> ATree i -> ATree i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATNot (StorageClass i -> ATree i -> ATree i -> ATree i)
-> StorageClass i -> ATree i -> ATree i -> ATree i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt) ATree i
forall a. ATree a
ATEmpty) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
cast [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary ((_, HT.TKReserved "~"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 ((ATree i -> ATree i -> ATree i) -> ATree i -> ATree i -> ATree i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATBitNot (StorageClass i -> ATree i -> ATree i -> ATree i)
-> StorageClass i -> ATree i -> ATree i -> ATree i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt) ATree i
forall a. ATree a
ATEmpty) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
cast [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary ((_, HT.TKReserved "&"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = ((([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i)
-> ASTConstruction i
-> (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([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
cast [TokenLC i]
xs ATree i
at ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 ((ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ \x :: ATree i
x -> let ty :: StorageClass i
ty = if StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTArray (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
x) then Maybe (StorageClass i) -> StorageClass i
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (StorageClass i) -> StorageClass i)
-> Maybe (StorageClass i) -> StorageClass i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
x) else ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
x in
ATKind i -> StorageClass i -> ATree i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i -> ATree i
atUnary ATKind i
forall a. ATKind a
ATAddr ((TypeKind i -> TypeKind i) -> StorageClass i -> StorageClass i
forall (a :: * -> *) i j.
TypeKindBase a =>
(TypeKind i -> TypeKind j) -> a i -> a j
CT.mapTypeKind TypeKind i -> TypeKind i
forall i. TypeKind i -> TypeKind i
CT.CTPtr StorageClass i
ty) ATree i
x
unary (cur :: TokenLC i
cur@(_, HT.TKReserved "*"):xs :: [TokenLC i]
xs) at :: ATree i
at !ConstructionData i
scp = ASTConstruction i
-> (([TokenLC i], ATree 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
cast [TokenLC i]
xs ATree i
at ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) ->
(Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("invalid pointer dereference", TokenLC i
cur) (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) Either (Text, TokenLC i) (StorageClass i)
-> (StorageClass i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \y :: StorageClass i
y -> case StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
y of
CT.CTVoid -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("void value not ignored as it ought to be", TokenLC i
cur)
_ -> (\ty' :: StorageClass i
ty' -> ([TokenLC i]
ert, ATKind i -> StorageClass i -> ATree i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i -> ATree i
atUnary ATKind i
forall a. ATKind a
ATDeref StorageClass i
ty' ATree i
erat, ConstructionData i
erscp)) (StorageClass i -> ([TokenLC i], ATree i, ConstructionData i))
-> Either (Text, TokenLC i) (StorageClass i) -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("incomplete value dereference", TokenLC i
cur) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
y ConstructionData i
scp)
unary ((_, HT.TKReserved "++"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (\x :: ATree i
x -> ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATPreInc (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
x) ATree i
x ATree i
forall a. ATree a
ATEmpty) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
unary [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary ((_, HT.TKReserved "--"):xs :: [TokenLC i]
xs) at :: ATree i
at scp :: ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (\x :: ATree i
x -> ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATPreDec (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
x) ATree i
x ATree i
forall a. ATree a
ATEmpty) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
unary [TokenLC i]
xs ATree i
at ConstructionData i
scp
unary xs :: [TokenLC i]
xs at :: ATree i
at scp :: ConstructionData i
scp = ((Text, TokenLC i) -> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction 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 (([TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i)
-> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f) (ASTConstruction i -> ASTConstruction i)
-> ASTConstruction i -> ASTConstruction i
forall a b. (a -> b) -> a -> 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
factor [TokenLC i]
xs ATree i
at ConstructionData i
scp
where
f :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f (cur :: TokenLC i
cur@(_, HT.TKReserved "["):xs' :: [TokenLC i]
xs') erat :: ATree i
erat !ConstructionData i
erscp = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
xs' ATree i
erat ConstructionData i
erscp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert' :: [TokenLC i]
ert', erat' :: ATree i
erat', erscp' :: ConstructionData i
erscp') -> case [TokenLC i]
ert' of
(_, HT.TKReserved "]"):xs'' :: [TokenLC i]
xs'' -> (Text, TokenLC i)
-> Maybe (ATree i) -> Either (Text, TokenLC i) (ATree i)
forall e. e -> Maybe ~> Either e
maybeToRight ("invalid operands", TokenLC i
cur) (ATree i -> ATree i -> Maybe (ATree i)
forall i.
(Eq i, Ord i, Show i) =>
ATree i -> ATree i -> Maybe (ATree i)
addKind ATree i
erat ATree i
erat') Either (Text, TokenLC i) (ATree i)
-> (ATree i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \erat'' :: ATree i
erat'' ->
(Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("subscripted value is neither array nor pointer nor vector", [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
xs) (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat'') Either (Text, TokenLC i) (StorageClass i)
-> (StorageClass i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: StorageClass i
t ->
(Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("incomplete value dereference", TokenLC i
cur) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
erscp') Either (Text, TokenLC i) (StorageClass i)
-> (StorageClass i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t' :: StorageClass i
t' -> [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f [TokenLC i]
xs'' (ATKind i -> StorageClass i -> ATree i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i -> ATree i
atUnary ATKind i
forall a. ATKind a
ATDeref StorageClass i
t' ATree i
erat'') ConstructionData i
erscp'
_ -> (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]
ert' then ("expected expression after '[' token", TokenLC i
cur) else ("expected expression 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] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ert')) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' token", [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ert')
f (cur :: TokenLC i
cur@(_, HT.TKReserved "."):xs' :: [TokenLC i]
xs') erat :: ATree i
erat !ConstructionData i
erscp
| StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTStruct (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) Bool -> Bool -> Bool
|| StorageClass i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
CT.isIncompleteStruct (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) = if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
xs' then (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected identifier at end of input", TokenLC i
cur) else case [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs' of
(_, HT.TKIdent ident :: Text
ident) -> (Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("incomplete type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StorageClass i -> Text
forall a. Show a => a -> Text
tshow (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) ConstructionData i
erscp) Either (Text, TokenLC i) (StorageClass i)
-> (StorageClass i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: StorageClass i
t ->
(Text, TokenLC i)
-> Maybe (StructMember i)
-> Either (Text, TokenLC i) (StructMember i)
forall e. e -> Maybe ~> Either e
maybeToRight ("no such member", TokenLC i
cur) (Text -> TypeKind i -> Maybe (StructMember i)
forall i. Text -> TypeKind i -> Maybe (StructMember i)
CT.lookupMember Text
ident (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
t)) Either (Text, TokenLC i) (StructMember i)
-> (StructMember i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \mem :: StructMember i
mem ->
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail [TokenLC i]
xs') (StructMember i -> ATree i -> ATree i
forall i. StructMember i -> ATree i -> ATree i
atMemberAcc StructMember i
mem ATree i
erat) ConstructionData i
erscp
_ -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected identifier after '.' token", TokenLC i
cur)
| Bool
otherwise = (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("request for a member in something not a structure or union", TokenLC i
cur)
f (cur :: TokenLC i
cur@(_, HT.TKReserved "->"):xs' :: [TokenLC i]
xs') erat :: ATree i
erat !ConstructionData i
erscp
| Bool -> (StorageClass i -> Bool) -> Maybe (StorageClass i) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTStruct (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) Bool -> Bool -> Bool
|| Bool -> (StorageClass i -> Bool) -> Maybe (StorageClass i) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False StorageClass i -> Bool
forall (a :: * -> *) i. IncompleteBase a => a i -> Bool
CT.isIncompleteStruct (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) = if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
xs' then (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected identifier at end of input", TokenLC i
cur) else
case [TokenLC i] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
xs' of
(_, HT.TKIdent ident :: Text
ident) -> (Text, TokenLC i)
-> Maybe (StorageClass i)
-> Either (Text, TokenLC i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("incomplete type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StorageClass i -> Text
forall a. Show a => a -> Text
tshow (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete (Maybe (StorageClass i) -> StorageClass i
forall a. HasCallStack => Maybe a -> a
fromJust (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat)) ConstructionData i
erscp) Either (Text, TokenLC i) (StorageClass i)
-> (StorageClass i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: StorageClass i
t ->
(Text, TokenLC i)
-> Maybe (StructMember i)
-> Either (Text, TokenLC i) (StructMember i)
forall e. e -> Maybe ~> Either e
maybeToRight ("no such member", TokenLC i
cur) (Text -> TypeKind i -> Maybe (StructMember i)
forall i. Text -> TypeKind i -> Maybe (StructMember i)
CT.lookupMember Text
ident (StorageClass i -> TypeKind i
forall (a :: * -> *) i. TypeKindBase a => a i -> TypeKind i
CT.toTypeKind StorageClass i
t)) Either (Text, TokenLC i) (StructMember i)
-> (StructMember i -> ASTConstruction i) -> ASTConstruction i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \mem :: StructMember i
mem ->
[TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f ([TokenLC i] -> [TokenLC i]
forall a. [a] -> [a]
tail [TokenLC i]
xs') (StructMember i -> ATree i -> ATree i
forall i. StructMember i -> ATree i -> ATree i
atMemberAcc StructMember i
mem (ATKind i -> StorageClass i -> ATree i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i -> ATree i
atUnary ATKind i
forall a. ATKind a
ATDeref (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ StructMember i -> TypeKind i
forall i. StructMember i -> TypeKind i
CT.smType StructMember i
mem) ATree i
erat)) ConstructionData i
erscp
_ -> (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("expected identifier after '->' token", TokenLC i
cur)
| Bool
otherwise = (Text, TokenLC i) -> ASTConstruction i
forall a b. a -> Either a b
Left ("invalid type argument of '->'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTUndef (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) then "" else " (have '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StorageClass i -> Text
forall a. Show a => a -> Text
tshow (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "')", TokenLC i
cur)
f ((_, HT.TKReserved "++"):xs' :: [TokenLC i]
xs') erat :: ATree i
erat !ConstructionData i
erscp = [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f [TokenLC i]
xs' (ATKind i -> StorageClass i -> ATree i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i -> ATree i
atUnary ATKind i
forall a. ATKind a
ATPostInc (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) ATree i
erat) ConstructionData i
erscp
f ((_, HT.TKReserved "--"):xs' :: [TokenLC i]
xs') erat :: ATree i
erat !ConstructionData i
erscp = [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
f [TokenLC i]
xs' (ATKind i -> StorageClass i -> ATree i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i -> ATree i
atUnary ATKind i
forall a. ATKind a
ATPostDec (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) ATree i
erat) ConstructionData i
erscp
f ert :: [TokenLC i]
ert erat :: ATree i
erat !ConstructionData i
erscp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, ATree i
erat, ConstructionData i
erscp)
factor :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
factor :: [TokenLC i] -> ATree i -> ConstructionData i -> ASTConstruction i
factor [] atn :: ATree i
atn !ConstructionData i
scp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([], ATree i
atn, ConstructionData i
scp)
factor tk :: [TokenLC i]
tk@((_, HT.TKReserved "("):((_, HT.TKReserved "{"):_)) at :: ATree i
at !ConstructionData i
scp = [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
stmtExpr [TokenLC i]
tk ATree i
at ConstructionData i
scp
factor (cur :: TokenLC i
cur@(_, HT.TKReserved "("):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = ASTConstruction i
-> (([TokenLC i], ATree 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
expr [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) -> case [TokenLC i]
ert of
(_, HT.TKReserved ")"):ys :: [TokenLC i]
ys -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ys, ATree i
erat, ConstructionData i
erscp)
ert' :: [TokenLC i]
ert' -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> ASTError i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ Text -> TokenLC i -> [TokenLC i] -> ASTError i
forall i. Show i => Text -> TokenLC i -> [TokenLC i] -> ASTError i
expectedMessage ")" TokenLC i
cur [TokenLC i]
ert'
factor ((_, HT.TKNum n :: i
n):xs :: [TokenLC i]
xs) _ !ConstructionData i
scp = ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, i -> ATree i
forall i. i -> ATree i
atNumLit i
n, ConstructionData i
scp)
factor (cur :: TokenLC i
cur@(_, HT.TKIdent v :: Text
v):(_, HT.TKReserved "("):(_, HT.TKReserved ")"):xs :: [TokenLC i]
xs) _ !ConstructionData i
scp = case Text -> ConstructionData i -> Maybe (Function i)
forall i. Text -> ConstructionData i -> Maybe (Function i)
lookupFunction Text
v ConstructionData i
scp of
Nothing -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, ATKind i -> StorageClass i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i
atNoLeaf (Text -> Maybe [ATree i] -> ATKind i
forall a. Text -> Maybe [ATree a] -> ATKind a
ATCallFunc Text
v Maybe [ATree i]
forall a. Maybe a
Nothing) (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt), Text -> TokenLC i -> ConstructionData i -> ConstructionData i
forall i.
Text -> TokenLC i -> ConstructionData i -> ConstructionData i
pushWarn ("the function '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is not declared.") TokenLC i
cur ConstructionData i
scp)
Just fn :: Function i
fn -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, ATKind i -> StorageClass i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i
atNoLeaf (Text -> Maybe [ATree i] -> ATKind i
forall a. Text -> Maybe [ATree a] -> ATKind a
ATCallFunc Text
v Maybe [ATree i]
forall a. Maybe a
Nothing) (Function i -> StorageClass i
forall a. Function a -> StorageClass a
PSF.fntype Function i
fn), ConstructionData i
scp)
factor (cur1 :: TokenLC i
cur1@(_, HT.TKIdent v :: Text
v):cur2 :: TokenLC i
cur2@(_, HT.TKReserved "("):xs :: [TokenLC i]
xs) _ scp :: ConstructionData i
scp = Either (ASTError 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
(>>=) (ASTError i
-> Maybe (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
-> Either
(ASTError i) (Either (TokenLC i) ([TokenLC i], [TokenLC i]))
forall e. e -> Maybe ~> Either e
maybeToRight (Text
internalCE, TokenLC i
cur1) (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
cur2TokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[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 (ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (ASTError i -> ASTConstruction i)
-> (TokenLC i -> ASTError i) -> TokenLC i -> ASTConstruction i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("invalid function call",)) ((([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
$ \(fsec :: [TokenLC i]
fsec, ds :: [TokenLC i]
ds) -> case Text -> ConstructionData i -> Maybe (Function i)
forall i. Text -> ConstructionData i -> Maybe (Function i)
lookupFunction Text
v ConstructionData i
scp of
Nothing -> [TokenLC i]
-> [TokenLC i]
-> ConstructionData i
-> StorageClass i
-> ASTConstruction i
forall a.
[TokenLC i]
-> a
-> ConstructionData i
-> StorageClass i
-> Either (ASTError i) (a, ATree i, ConstructionData i)
f [TokenLC i]
fsec [TokenLC i]
ds (Text -> TokenLC i -> ConstructionData i -> ConstructionData i
forall i.
Text -> TokenLC i -> ConstructionData i -> ConstructionData i
pushWarn ("The function '" 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
cur1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is not declared.") TokenLC i
cur1 ConstructionData i
scp) (StorageClass i -> ASTConstruction i)
-> StorageClass i -> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto TypeKind i
forall i. TypeKind i
CT.CTInt
Just fn :: Function i
fn -> [TokenLC i]
-> [TokenLC i]
-> ConstructionData i
-> StorageClass i
-> ASTConstruction i
forall a.
[TokenLC i]
-> a
-> ConstructionData i
-> StorageClass i
-> Either (ASTError i) (a, ATree i, ConstructionData i)
f [TokenLC i]
fsec [TokenLC i]
ds ConstructionData i
scp (Function i -> StorageClass i
forall a. Function a -> StorageClass a
PSF.fntype Function i
fn)
where
f :: [TokenLC i]
-> a
-> ConstructionData i
-> StorageClass i
-> Either (ASTError i) (a, ATree i, ConstructionData i)
f fsec :: [TokenLC i]
fsec ds :: a
ds scp' :: ConstructionData i
scp' t :: StorageClass i
t = ASTError i
-> Maybe [[TokenLC i]] -> Either (ASTError i) [[TokenLC i]]
forall e. e -> Maybe ~> Either e
maybeToRight ("invalid function call", TokenLC i
cur1) ([TokenLC i] -> Maybe [[TokenLC i]]
forall i. Eq i => [TokenLC i] -> Maybe [[TokenLC i]]
takeExps [TokenLC i]
fsec) Either (ASTError i) [[TokenLC i]]
-> ([[TokenLC i]]
-> Either (ASTError i) (a, ATree i, ConstructionData i))
-> Either (ASTError i) (a, ATree i, ConstructionData i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \exps :: [[TokenLC i]]
exps -> (forall s.
ST s (Either (ASTError i) (a, ATree i, ConstructionData i)))
-> Either (ASTError i) (a, ATree i, ConstructionData i)
forall a. (forall s. ST s a) -> a
runST ((forall s.
ST s (Either (ASTError i) (a, ATree i, ConstructionData i)))
-> Either (ASTError i) (a, ATree i, ConstructionData i))
-> (forall s.
ST s (Either (ASTError i) (a, ATree i, ConstructionData i)))
-> Either (ASTError i) (a, ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ do
STRef s (ConstructionData i)
mk <- ConstructionData i -> ST s (STRef s (ConstructionData i))
forall a s. a -> ST s (STRef s a)
newSTRef ConstructionData i
scp'
[Either (ASTError i) (ATree i)]
expl <- [[TokenLC i]]
-> ([TokenLC i] -> ST s (Either (ASTError i) (ATree i)))
-> ST s [Either (ASTError i) (ATree i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[TokenLC i]]
exps (([TokenLC i] -> ST s (Either (ASTError i) (ATree i)))
-> ST s [Either (ASTError i) (ATree i)])
-> ([TokenLC i] -> ST s (Either (ASTError i) (ATree i)))
-> ST s [Either (ASTError i) (ATree i)]
forall a b. (a -> b) -> a -> b
$ \etk :: [TokenLC i]
etk -> STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
mk ST s (ConstructionData i)
-> (ConstructionData i -> ST s (Either (ASTError i) (ATree i)))
-> ST s (Either (ASTError i) (ATree i))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ASTError i -> ST s (Either (ASTError i) (ATree i)))
-> (([TokenLC i], ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (ATree i)))
-> ASTConstruction i
-> ST s (Either (ASTError i) (ATree i))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either (ASTError i) (ATree i)
-> ST s (Either (ASTError i) (ATree i))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ASTError i) (ATree i)
-> ST s (Either (ASTError i) (ATree i)))
-> (ASTError i -> Either (ASTError i) (ATree i))
-> ASTError i
-> ST s (Either (ASTError i) (ATree i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTError i -> Either (ASTError i) (ATree i)
forall a b. a -> Either a b
Left) (\(_, erat :: ATree i
erat, ervar :: ConstructionData i
ervar) -> ATree i -> Either (ASTError i) (ATree i)
forall a b. b -> Either a b
Right ATree i
erat Either (ASTError i) (ATree i)
-> ST s () -> ST s (Either (ASTError i) (ATree 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)
mk ConstructionData i
ervar) (ASTConstruction i -> ST s (Either (ASTError i) (ATree i)))
-> (ConstructionData i -> ASTConstruction i)
-> ConstructionData i
-> ST s (Either (ASTError i) (ATree i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
expr [TokenLC i]
etk ATree i
forall a. ATree a
ATEmpty
if (Either (ASTError i) (ATree i) -> Bool)
-> [Either (ASTError i) (ATree i)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Either (ASTError i) (ATree i) -> Bool
forall a b. Either a b -> Bool
isLeft [Either (ASTError i) (ATree i)]
expl then Either (ASTError i) (a, ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (a, ATree i, ConstructionData i))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ASTError i) (a, ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (a, ATree i, ConstructionData i)))
-> Either (ASTError i) (a, ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (a, ATree i, ConstructionData i))
forall a b. (a -> b) -> a -> b
$ ASTError i -> Either (ASTError i) (a, ATree i, ConstructionData i)
forall a b. a -> Either a b
Left (ASTError i
-> Either (ASTError i) (a, ATree i, ConstructionData i))
-> ASTError i
-> Either (ASTError i) (a, ATree i, ConstructionData i)
forall a b. (a -> b) -> a -> b
$ [ASTError i] -> ASTError i
forall a. [a] -> a
head ([ASTError i] -> ASTError i) -> [ASTError i] -> ASTError i
forall a b. (a -> b) -> a -> b
$ [Either (ASTError i) (ATree i)] -> [ASTError i]
forall a b. [Either a b] -> [a]
lefts [Either (ASTError i) (ATree i)]
expl else do
ConstructionData i
scp'' <- STRef s (ConstructionData i) -> ST s (ConstructionData i)
forall s a. STRef s a -> ST s a
readSTRef STRef s (ConstructionData i)
mk
Either (ASTError i) (a, ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (a, ATree i, ConstructionData i))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ASTError i) (a, ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (a, ATree i, ConstructionData i)))
-> Either (ASTError i) (a, ATree i, ConstructionData i)
-> ST s (Either (ASTError i) (a, ATree i, ConstructionData i))
forall a b. (a -> b) -> a -> b
$ (a, ATree i, ConstructionData i)
-> Either (ASTError i) (a, ATree i, ConstructionData i)
forall a b. b -> Either a b
Right (a
ds, ATKind i -> StorageClass i -> ATree i
forall i. ATKind i -> StorageClass i -> ATree i
atNoLeaf (Text -> Maybe [ATree i] -> ATKind i
forall a. Text -> Maybe [ATree a] -> ATKind a
ATCallFunc Text
v ([ATree i] -> Maybe [ATree i]
forall a. a -> Maybe a
Just ([ATree i] -> Maybe [ATree i]) -> [ATree i] -> Maybe [ATree i]
forall a b. (a -> b) -> a -> b
$ [Either (ASTError i) (ATree i)] -> [ATree i]
forall a b. [Either a b] -> [b]
rights [Either (ASTError i) (ATree i)]
expl)) StorageClass i
t, ConstructionData i
scp'')
factor (cur0 :: TokenLC i
cur0@(_, HT.TKSizeof):cur :: TokenLC i
cur@(_, HT.TKReserved "("):xs :: [TokenLC i]
xs) atn :: ATree i
atn scp :: ConstructionData i
scp = case [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
forall i.
(Integral i, Show i, Read i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (StorageClass i, [TokenLC i])
takeTypeName [TokenLC i]
xs ConstructionData i
scp of
Left _ -> (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (i -> ATree i
forall i. i -> ATree i
atNumLit (i -> ATree i) -> (ATree i -> i) -> ATree i -> ATree i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> i) -> (ATree i -> Natural) -> ATree i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.sizeof (StorageClass i -> Natural)
-> (ATree i -> StorageClass i) -> ATree i -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
unary (TokenLC i
curTokenLC i -> [TokenLC i] -> [TokenLC i]
forall a. a -> [a] -> [a]
:[TokenLC i]
xs) ATree i
atn ConstructionData i
scp
Right (t :: StorageClass i
t, (_, HT.TKReserved ")"):ds :: [TokenLC i]
ds) -> ([TokenLC i]
ds, , ConstructionData i
scp) (ATree i -> ([TokenLC i], ATree i, ConstructionData i))
-> (StorageClass i -> ATree i)
-> StorageClass i
-> ([TokenLC i], ATree i, ConstructionData i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> ATree i
forall i. i -> ATree i
atNumLit (i -> ATree i)
-> (StorageClass i -> i) -> StorageClass i -> ATree i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> i)
-> (StorageClass i -> Natural) -> StorageClass i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.sizeof (StorageClass i -> ([TokenLC i], ATree i, ConstructionData i))
-> Either (ASTError i) (StorageClass i) -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ASTError i
-> Maybe (StorageClass i) -> Either (ASTError i) (StorageClass i)
forall e. e -> Maybe ~> Either e
maybeToRight ("invalid application of 'sizeof' to incomplete type '" 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
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'", TokenLC i
cur0) (StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
forall i.
StorageClass i -> ConstructionData i -> Maybe (StorageClass i)
incomplete StorageClass i
t ConstructionData i
scp)
Right _ -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("The token ')' corresponding to '(' is expected", TokenLC i
cur)
factor ((_, HT.TKSizeof):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = (ATree i -> ATree i)
-> ([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
second3 (i -> ATree i
forall i. i -> ATree i
atNumLit (i -> ATree i) -> (ATree i -> i) -> ATree i -> ATree i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> i) -> (ATree i -> Natural) -> ATree i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.sizeof (StorageClass i -> Natural)
-> (ATree i -> StorageClass i) -> ATree i -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype) (([TokenLC i], ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> ASTConstruction i -> ASTConstruction i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
unary [TokenLC i]
xs ATree i
atn ConstructionData i
scp
factor (cur :: TokenLC i
cur@(_, HT.TKAlignof):xs :: [TokenLC i]
xs) atn :: ATree i
atn !ConstructionData i
scp = ASTConstruction i
-> (([TokenLC i], ATree 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
unary [TokenLC i]
xs ATree i
atn ConstructionData i
scp) ((([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i)
-> ASTConstruction i)
-> (([TokenLC i], ATree i, ConstructionData i)
-> ASTConstruction i)
-> ASTConstruction i
forall a b. (a -> b) -> a -> b
$ \(ert :: [TokenLC i]
ert, erat :: ATree i
erat, erscp :: ConstructionData i
erscp) ->
if StorageClass i -> Bool
forall (a :: * -> *) i. TypeKindBase a => a i -> Bool
CT.isCTUndef (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat) then ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("_Alignof must be an expression or type", TokenLC i
cur) else ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
ert, i -> ATree i
forall i. i -> ATree i
atNumLit (i -> ATree i) -> i -> ATree i
forall a b. (a -> b) -> a -> b
$ Natural -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> i) -> Natural -> i
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.alignof (StorageClass i -> Natural) -> StorageClass i -> Natural
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
erat, ConstructionData i
erscp)
factor (cur :: TokenLC i
cur@(_, HT.TKString slit :: ByteString
slit):xs :: [TokenLC i]
xs) _ !ConstructionData i
scp = (ATree i
-> ConstructionData i
-> ([TokenLC i], ATree i, ConstructionData i))
-> (ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([TokenLC i]
xs,,) ((ATree i, ConstructionData i)
-> ([TokenLC i], ATree i, ConstructionData i))
-> Either (ASTError 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 (ASTError i) (ATree i, ConstructionData i)
forall i.
(Integral i, Bits i) =>
StorageClass i
-> TokenLC i
-> ConstructionData i
-> Either (ASTError i) (ATree i, ConstructionData i)
addLiteral (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCAuto (TypeKind i -> StorageClass i) -> TypeKind i -> StorageClass i
forall a b. (a -> b) -> a -> b
$ Natural -> TypeKind i -> TypeKind i
forall i. Natural -> TypeKind i -> TypeKind i
CT.CTArray (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
slit) TypeKind i
forall i. TypeKind i
CT.CTChar) TokenLC i
cur ConstructionData i
scp
factor (cur :: TokenLC i
cur@(_, HT.TKIdent ident :: Text
ident):xs :: [TokenLC i]
xs) _ !ConstructionData i
scp = case Text -> ConstructionData i -> LookupVarResult i
forall i. Text -> ConstructionData i -> LookupVarResult i
lookupVar Text
ident ConstructionData i
scp of
FoundGVar (PV.GVar t :: StorageClass i
t _) -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, StorageClass i -> Text -> ATree i
forall i. StorageClass i -> Text -> ATree i
atGVar StorageClass i
t Text
ident, ConstructionData i
scp)
FoundLVar sct :: LVar i
sct -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, LVar i -> ATree i
forall (a :: * -> *) i. Treealizable a => a i -> ATree i
treealize LVar i
sct, ConstructionData i
scp)
FoundEnum sct :: Enumerator i
sct -> ([TokenLC i], ATree i, ConstructionData i) -> ASTConstruction i
forall a b. b -> Either a b
Right ([TokenLC i]
xs, Enumerator i -> ATree i
forall (a :: * -> *) i. Treealizable a => a i -> ATree i
treealize Enumerator i
sct, ConstructionData i
scp)
NotFound -> ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left ("The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' is not defined variable", TokenLC i
cur)
factor ert :: [TokenLC i]
ert _ _ = ASTError i -> ASTConstruction i
forall a b. a -> Either a b
Left (if [TokenLC i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TokenLC i]
ert then "unexpected token in program" else "unexpected token '" 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] -> TokenLC i
forall a. [a] -> a
head [TokenLC i]
ert)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' in program", [TokenLC i] -> TokenLC i
forall i. Num i => [TokenLC i] -> TokenLC i
HT.altEmptyToken [TokenLC i]
ert)
{-# INLINE parse #-}
parse :: (Show i, Read i, Integral i, Bits i) => [HT.TokenLC i] -> ASTResult i
parse :: [TokenLC i] -> ASTResult i
parse = ((ASTs i, ConstructionData i)
-> (Warnings i, ASTs i, GlobalVars i, Literals i))
-> Either (ASTError i) (ASTs i, ConstructionData i) -> ASTResult i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ast :: ASTs i
ast, sc :: ConstructionData i
sc) -> (ConstructionData i -> Warnings i
forall i. ConstructionData i -> Warnings i
warns ConstructionData i
sc, ASTs i
ast, Vars i -> GlobalVars i
forall a. Vars a -> GlobalVars a
PV.globals (Vars i -> GlobalVars i) -> Vars i -> GlobalVars i
forall a b. (a -> b) -> a -> b
$ Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars (Scoped i -> Vars i) -> Scoped i -> Vars i
forall a b. (a -> b) -> a -> b
$ ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
sc, Vars i -> Literals i
forall a. Vars a -> Literals a
PV.literals (Vars i -> Literals i) -> Vars i -> Literals i
forall a b. (a -> b) -> a -> b
$ Scoped i -> Vars i
forall i. Scoped i -> Vars i
vars (Scoped i -> Vars i) -> Scoped i -> Vars i
forall a b. (a -> b) -> a -> b
$ ConstructionData i -> Scoped i
forall i. ConstructionData i -> Scoped i
scope ConstructionData i
sc)) (Either (ASTError i) (ASTs i, ConstructionData i) -> ASTResult i)
-> ([TokenLC i]
-> Either (ASTError i) (ASTs i, ConstructionData i))
-> [TokenLC i]
-> ASTResult i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (ASTs i, ConstructionData i))
-> ConstructionData i
-> [TokenLC i]
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (ASTs i, ConstructionData i)
forall i.
(Show i, Read i, Integral i, Bits i) =>
[TokenLC i]
-> ConstructionData i
-> Either (ASTError i) (ASTs i, ConstructionData i)
program ConstructionData i
forall i. ConstructionData i
initConstructionData
stackSize :: (Show i, Integral i) => ATree i -> Natural
stackSize :: ATree i -> Natural
stackSize (ATNode (ATDefFunc _ args :: Maybe [ATree i]
args) _ body :: ATree i
body _) = let ms :: Set (StorageClass i, i)
ms = ATree i -> Set (StorageClass i, i) -> Set (StorageClass i, i)
forall a.
Ord a =>
ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree i
body (Set (StorageClass i, i) -> Set (StorageClass i, i))
-> Set (StorageClass i, i) -> Set (StorageClass i, i)
forall a b. (a -> b) -> a -> b
$ Set (StorageClass i, i)
-> ([ATree i] -> Set (StorageClass i, i))
-> Maybe [ATree i]
-> Set (StorageClass i, i)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (StorageClass i, i)
forall a. Set a
S.empty ((ATree i -> Set (StorageClass i, i) -> Set (StorageClass i, i))
-> Set (StorageClass i, i) -> [ATree i] -> Set (StorageClass i, i)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(ATNode (ATLVar t :: StorageClass i
t x :: i
x) _ _ _) acc :: Set (StorageClass i, i)
acc -> (StorageClass i, i)
-> Set (StorageClass i, i) -> Set (StorageClass i, i)
forall a. Ord a => a -> Set a -> Set a
S.insert (StorageClass i
t, i
x) Set (StorageClass i, i)
acc) Set (StorageClass i, i)
forall a. Set a
S.empty) Maybe [ATree i]
args in
if Set (StorageClass i, i) -> Int
forall a. Set a -> Int
S.size Set (StorageClass i, i)
ms Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then Integer -> Natural
forall i. Integral i => i -> Natural
toNatural (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. (Bits a, Num a, Enum a) => a -> a -> a
CT.alignas 8 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.sizeof (StorageClass i -> Natural) -> StorageClass i -> Natural
forall a b. (a -> b) -> a -> b
$ (StorageClass i, i) -> StorageClass i
forall a b. (a, b) -> a
fst ((StorageClass i, i) -> StorageClass i)
-> (StorageClass i, i) -> StorageClass i
forall a b. (a -> b) -> a -> b
$ [(StorageClass i, i)] -> (StorageClass i, i)
forall a. [a] -> a
head (Set (StorageClass i, i) -> [(StorageClass i, i)]
forall a. Set a -> [a]
S.toList Set (StorageClass i, i)
ms) else Integer -> Natural
forall i. Integral i => i -> Natural
toNatural (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. (Bits a, Num a, Enum a) => a -> a -> a
CT.alignas 8 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer) -> (Integer, Integer) -> Integer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$
((StorageClass i, i) -> Integer)
-> ((StorageClass i, i), Integer) -> (Integer, Integer)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Natural -> Integer
toInteger (Natural -> Integer)
-> ((StorageClass i, i) -> Natural)
-> (StorageClass i, i)
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> Natural
forall a. CType a => a -> Natural
CT.sizeof (StorageClass i -> Natural)
-> ((StorageClass i, i) -> StorageClass i)
-> (StorageClass i, i)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageClass i, i) -> StorageClass i
forall a b. (a, b) -> a
fst) (((StorageClass i, i), Integer) -> (Integer, Integer))
-> ((StorageClass i, i), Integer) -> (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ ((StorageClass i, i) -> Integer)
-> ((StorageClass i, i), (StorageClass i, i))
-> ((StorageClass i, i), Integer)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Integer)
-> ((StorageClass i, i) -> i) -> (StorageClass i, i) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageClass i, i) -> i
forall a b. (a, b) -> b
snd) (((StorageClass i, i), (StorageClass i, i))
-> ((StorageClass i, i), Integer))
-> ((StorageClass i, i), (StorageClass i, i))
-> ((StorageClass i, i), Integer)
forall a b. (a -> b) -> a -> b
$ (StorageClass i, i) -> ((StorageClass i, i), (StorageClass i, i))
forall a. a -> (a, a)
dupe ((StorageClass i, i) -> ((StorageClass i, i), (StorageClass i, i)))
-> (StorageClass i, i)
-> ((StorageClass i, i), (StorageClass i, i))
forall a b. (a -> b) -> a -> b
$ ((StorageClass i, i) -> (StorageClass i, i) -> (StorageClass i, i))
-> (StorageClass i, i)
-> [(StorageClass i, i)]
-> (StorageClass i, i)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\acc :: (StorageClass i, i)
acc x :: (StorageClass i, i)
x -> if (StorageClass i, i) -> i
forall a b. (a, b) -> b
snd (StorageClass i, i)
acc i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< (StorageClass i, i) -> i
forall a b. (a, b) -> b
snd (StorageClass i, i)
x then (StorageClass i, i)
x else (StorageClass i, i)
acc) (TypeKind i -> StorageClass i
forall i. TypeKind i -> StorageClass i
CT.SCUndef TypeKind i
forall i. TypeKind i
CT.CTUndef, 0) ([(StorageClass i, i)] -> (StorageClass i, i))
-> [(StorageClass i, i)] -> (StorageClass i, i)
forall a b. (a -> b) -> a -> b
$ Set (StorageClass i, i) -> [(StorageClass i, i)]
forall a. Set a -> [a]
S.toList Set (StorageClass i, i)
ms
where
f :: ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATEmpty !Set (StorageClass a, a)
s = Set (StorageClass a, a)
s
f (ATNode (ATCallFunc _ (Just arg :: [ATree a]
arg)) t :: StorageClass a
t l :: ATree a
l r :: ATree a
r) !Set (StorageClass a, a)
s = ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f (ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ([ATree a] -> ATKind a
forall a. [ATree a] -> ATKind a
ATBlock [ATree a]
arg) StorageClass a
t ATree a
l ATree a
r) Set (StorageClass a, a)
s
f (ATNode (ATLVar t :: StorageClass a
t x :: a
x) _ l :: ATree a
l r :: ATree a
r) !Set (StorageClass a, a)
s = let i :: Set (StorageClass a, a)
i = (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => a -> Set a -> Set a
S.insert (StorageClass a
t, a
x) Set (StorageClass a, a)
s in ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
l Set (StorageClass a, a)
i Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
r Set (StorageClass a, a)
i
f (ATNode (ATBlock xs :: [ATree a]
xs) _ l :: ATree a
l r :: ATree a
r) !Set (StorageClass a, a)
s = let i :: Set (StorageClass a, a)
i = (ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a))
-> Set (StorageClass a, a) -> [ATree a] -> Set (StorageClass a, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a))
-> (ATree a -> Set (StorageClass a, a))
-> ATree a
-> Set (StorageClass a, a)
-> Set (StorageClass a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
`f` Set (StorageClass a, a)
s)) Set (StorageClass a, a)
s [ATree a]
xs in ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
l Set (StorageClass a, a)
i Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
r Set (StorageClass a, a)
i
f (ATNode (ATStmtExpr xs :: [ATree a]
xs) t :: StorageClass a
t l :: ATree a
l r :: ATree a
r) !Set (StorageClass a, a)
s = ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f (ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ([ATree a] -> ATKind a
forall a. [ATree a] -> ATKind a
ATBlock [ATree a]
xs) StorageClass a
t ATree a
l ATree a
r) Set (StorageClass a, a)
s
f (ATNode (ATFor xs :: [ATKindFor a]
xs) _ l :: ATree a
l r :: ATree a
r) !Set (StorageClass a, a)
s = let i :: Set (StorageClass a, a)
i = (ATKindFor a -> Set (StorageClass a, a) -> Set (StorageClass a, a))
-> Set (StorageClass a, a)
-> [ATKindFor a]
-> Set (StorageClass a, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a))
-> (ATKindFor a -> Set (StorageClass a, a))
-> ATKindFor a
-> Set (StorageClass a, a)
-> Set (StorageClass a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a))
-> Set (StorageClass a, a) -> ATree a -> Set (StorageClass a, a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f Set (StorageClass a, a)
s (ATree a -> Set (StorageClass a, a))
-> (ATKindFor a -> ATree a)
-> ATKindFor a
-> Set (StorageClass a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATKindFor a -> ATree a
forall a. ATKindFor a -> ATree a
fromATKindFor) Set (StorageClass a, a)
forall a. Set a
S.empty [ATKindFor a]
xs in ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
l Set (StorageClass a, a)
i Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
r Set (StorageClass a, a)
i
f (ATNode (ATNull x :: ATree a
x) _ _ _) !Set (StorageClass a, a)
s = ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
x Set (StorageClass a, a)
s
f (ATNode _ _ l :: ATree a
l r :: ATree a
r) !Set (StorageClass a, a)
s = ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
l Set (StorageClass a, a)
s Set (StorageClass a, a)
-> Set (StorageClass a, a) -> Set (StorageClass a, a)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ATree a -> Set (StorageClass a, a) -> Set (StorageClass a, a)
f ATree a
r Set (StorageClass a, a)
s
stackSize _ = 0