#ifndef LFORTRAN_PARSER_SEM4b_H

#define LFORTRAN_PARSER_SEM4b_H

#include <cstring>

#include <lpython/ast.h>

#include <libasr/string_utils.h>

#include <lpython/parser/parser_exception.h>

using namespace LFortran::AST;

using LFortran::Location;

using LFortran::Vec;

using LFortran::FnArg;

using LFortran::CoarrayArg;

using LFortran::VarType;

using LFortran::ArgStarKw;

static inline expr_t* EXPR(const ast_t *f)

{

return down_cast<expr_t>(f);

}

static inline expr_t* EXPR_OPT(const ast_t *f)

{

if (f) {

return EXPR(f);

} else {

return nullptr;

}

}

static inline bind_t* bind_opt(const ast_t *f)

{

if (f) {

return down_cast<bind_t>(f);

} else {

return nullptr;

}

}

static inline trivia_t* trivia_cast(const ast_t *f) {

if (f == nullptr) {

return nullptr;

} else {

return down_cast<trivia_t>(f);

}

}

static inline char* name2char(const ast_t *n)

{

return down_cast2<Name_t>(n)->m_id;

}

template <typename T, astType type>

static inline T** vec_cast(const Vec<ast_t*> &x) {

T **s = (T**)x.p;

for (size_t i=0; i < x.size(); i++) {

LFORTRAN_ASSERT((s[i]->base.type == type))

}

return s;

}

#define VEC_CAST(x, type) vec_cast<type##_t, astType::type>(x)

#define DECLS(x) VEC_CAST(x, unit_decl2)

#define USES(x) VEC_CAST(x, unit_decl1)

#define STMTS(x) VEC_CAST(x, stmt)

#define CONTAINS(x) VEC_CAST(x, program_unit)

#define ATTRS(x) VEC_CAST(x, attribute)

#define EXPRS(x) VEC_CAST(x, expr)

#define CASE_STMTS(x) VEC_CAST(x, case_stmt)

#define RANK_STMTS(x) VEC_CAST(x, rank_stmt)

#define TYPE_STMTS(x) VEC_CAST(x, type_stmt)

#define USE_SYMBOLS(x) VEC_CAST(x, use_symbol)

#define CONCURRENT_CONTROLS(x) VEC_CAST(x, concurrent_control)

#define CONCURRENT_LOCALITIES(x) VEC_CAST(x, concurrent_locality)

#define INTERFACE_ITEMS(x) VEC_CAST(x, interface_item)

Vec<ast_t*> A2LIST(Allocator &al, ast_t *x) {

}

static inline stmt_t** IFSTMTS(Allocator &al, ast_t* x)

{

stmt_t **s = al.allocate<stmt_t*>();

*s = down_cast<stmt_t>(x);

return s;

}

static inline kind_item_t *make_kind_item_t(Allocator &al,

Location &loc, char *id, ast_t *value, kind_item_typeType type)

{

kind_item_t *r = al.allocate<kind_item_t>(1);

r->loc = loc;

r->m_id = id;

if (value) {

r->m_value = down_cast<expr_t>(value);

} else {

r->m_value = nullptr;

}

r->m_type = type;

return r;

}

static inline Vec<kind_item_t> a2kind_list(Allocator &al,

}

#define KIND_ARG1(k, l) make_kind_item_t(p.m_a, l, nullptr, k, \

kind_item_typeType::Value)

#define KIND_ARG1S(l) make_kind_item_t(p.m_a, l, nullptr, nullptr, \

kind_item_typeType::Star)

#define KIND_ARG1C(l) make_kind_item_t(p.m_a, l, nullptr, nullptr, \

kind_item_typeType::Colon)

#define KIND_ARG2(id, k, l) make_kind_item_t(p.m_a, l, name2char(id), k, \

kind_item_typeType::Value)

#define KIND_ARG2S(id, l) make_kind_item_t(p.m_a, l, name2char(id), nullptr, \

kind_item_typeType::Star)

#define KIND_ARG2C(id, l) make_kind_item_t(p.m_a, l, name2char(id), nullptr, \

kind_item_typeType::Colon)

#define SIMPLE_ATTR(x, l) make_SimpleAttribute_t( \

p.m_a, l, simple_attributeType::Attr##x)

#define INTENT(x, l) make_AttrIntent_t( \

p.m_a, l, attr_intentType::x)

#define BIND(x, l) make_AttrBind_t( \

p.m_a, l, bind_opt(x))

#define EXTENDS(x, l) make_AttrExtends_t( \

p.m_a, l, name2char(x))

#define DIMENSION(x, l) make_AttrDimension_t( \

p.m_a, l, \

x.p, x.size())

#define DIMENSION0(l) make_AttrDimension_t( \

p.m_a, l, \

nullptr, 0)

#define CODIMENSION(dim, l) make_AttrCodimension_t( \

p.m_a, l, \

dim.p, dim.size())

ast_t* PASS1(Allocator &al, Location &loc, ast_t* id) {

char* name;

if(id == nullptr) {

name = nullptr;

} else {

name = name2char(id);

}

return make_AttrPass_t(al, loc, name);

}

#define PASS(id, l) PASS1(p.m_a, l, id)

decl_attribute_t** EQUIVALENCE(Allocator &al, Location &loc,

equi_t* args, size_t n_args) {

Vec<decl_attribute_t*> v;

v.reserve(al, 1);

ast_t* a = make_AttrEquivalence_t(al, loc, args, n_args);

v.push_back(al, down_cast<decl_attribute_t>(a));

return v.p;

}

static inline equi_t* EQUIVALENCE1(Allocator &al, Location &loc,

const Vec<ast_t*> set_list)

{

equi_t *r = al.allocate<equi_t>(1);

r->loc = loc;

r->m_set_list = EXPRS(set_list);

r->n_set_list = set_list.size();

return r;

}

#define VAR_DECL_EQUIVALENCE(args, trivia, l) make_Declaration_t(p.m_a, l, \

nullptr, EQUIVALENCE(p.m_a, l, args.p, args.n), 1, \

nullptr, 0, trivia_cast(trivia))

#define EQUIVALENCE_SET(set_list, l) EQUIVALENCE1(p.m_a, l, set_list)

#define ATTR_TYPE(x, l) make_AttrType_t( \

p.m_a, l, \

decl_typeType::Type##x, \

nullptr, 0, \

nullptr, None)

#define ATTR_TYPE_INT(x, n, l) make_AttrType_t( \

p.m_a, l, \

decl_typeType::Type##x, \

a2kind_list(p.m_a, l, INTEGER(n, l)).p, 1, \

nullptr, None)

#define ATTR_TYPE_KIND(x, kind, l) make_AttrType_t( \

p.m_a, l, \

decl_typeType::Type##x, \

kind.p, kind.size(), \

nullptr, None)

#define ATTR_TYPE_NAME(x, name, l) make_AttrType_t( \

p.m_a, l, \

decl_typeType::Type##x, \

nullptr, 0, \

name2char(name), None)

#define ATTR_TYPE_STAR(x, sym, l) make_AttrType_t( \

p.m_a, l, \

decl_typeType::Type##x, \

nullptr, 0, \

nullptr, sym)

#define IMPORT0(x, trivia, l) make_Import_t( \

p.m_a, l, \

nullptr, 0, \

import_modifierType::Import##x, \

trivia_cast(trivia))

#define IMPORT1(args, x, trivia, l) make_Import_t( \

p.m_a, l, \

REDUCE_ARGS(p.m_a, args), args.size(), \

import_modifierType::Import##x, \

trivia_cast(trivia))

#define VAR_DECL1(vartype, xattr, varsym, trivia, l) \

make_Declaration_t(p.m_a, l, \

down_cast<decl_attribute_t>(vartype), \

VEC_CAST(xattr, decl_attribute), xattr.n, \

varsym.p, varsym.n, trivia_cast(trivia))

decl_attribute_t** VAR_DECL2b(Allocator &al,

ast_t *xattr0) {

decl_attribute_t** a = al.allocate<decl_attribute_t*>(1);

*a = down_cast<decl_attribute_t>(xattr0);

return a;

}

decl_attribute_t** VAR_DECL_NAMELISTb(Allocator &al,

Location &loc,

char *name) {

Vec<decl_attribute_t*> v;

v.reserve(al, 1);

ast_t* a = make_AttrNamelist_t(al, loc, name);

v.push_back(al, down_cast<decl_attribute_t>(a));

return v.p;

}

var_sym_t* VAR_DECL_NAMELISTc(Allocator &al,

Vec<ast_t*> id_list) {

var_sym_t* a = al.allocate<var_sym_t>(id_list.size());

for (size_t i=0; i<id_list.size(); i++) {

a[i].m_name = name2char(id_list[i]);

}

return a;

}

decl_attribute_t** VAR_DECL_PARAMETERb(Allocator &al,

Location &loc) {

Vec<decl_attribute_t*> v;

v.reserve(al, 1);

ast_t* a = make_SimpleAttribute_t(al, loc,

simple_attributeType::AttrParameter);

v.push_back(al, down_cast<decl_attribute_t>(a));

return v.p;

}

decl_attribute_t** ATTRCOMMON(Allocator &al,

Location &loc) {

Vec<decl_attribute_t*> v;

v.reserve(al, 1);

ast_t* a = make_SimpleAttribute_t(al, loc,

simple_attributeType::AttrCommon);

v.push_back(al, down_cast<decl_attribute_t>(a));

return v.p;

}

#define VAR_DECL2(xattr0, trivia, l) \

make_Declaration_t(p.m_a, l, \

nullptr, \

VAR_DECL2b(p.m_a, xattr0), 1, \

nullptr, 0, trivia_cast(trivia))

#define VAR_DECL3(xattr0, varsym, trivia, l) \

make_Declaration_t(p.m_a, l, \

nullptr, \

VAR_DECL2b(p.m_a, xattr0), 1, \

varsym.p, varsym.n, trivia_cast(trivia))

#define VAR_DECL_NAMELIST(id, id_list, trivia, l) \

make_Declaration_t(p.m_a, l, \

nullptr, \

VAR_DECL_NAMELISTb(p.m_a, l, name2char(id)), 1, \

VAR_DECL_NAMELISTc(p.m_a, id_list), id_list.n, \

trivia_cast(trivia))

#define VAR_DECL_PARAMETER(varsym, trivia, l) \

make_Declaration_t(p.m_a, l, \

nullptr, \

VAR_DECL_PARAMETERb(p.m_a, l), 1, \

varsym.p, varsym.n, \

trivia_cast(trivia))

#define VAR_DECL_COMMON(varsym, trivia, l) \

make_Declaration_t(p.m_a, l, \

nullptr, \

ATTRCOMMON(p.m_a, l), 1, \

varsym.p, varsym.n, \

trivia_cast(trivia))

#define VAR_DECL_DATA(x, trivia, l) make_Declaration_t(p.m_a, l, \

nullptr, VEC_CAST(x, decl_attribute), x.size(), \

nullptr, 0, trivia_cast(trivia))

#define DATA(objects, values, l) make_AttrData_t(p.m_a, l, \

EXPRS(objects), objects.size(), \

EXPRS(values), values.size())

ast_t* data_implied_do(Allocator &al, Location &loc,

Vec<ast_t*> obj_list,

ast_t* type,

char* id,

expr_t* start, expr_t* end, expr_t* incr) {

decl_attribute_t* t;

if(type == nullptr){

t = nullptr;

} else {

t = down_cast<decl_attribute_t>(type);

}

return make_DataImpliedDo_t(al, loc, EXPRS(obj_list), obj_list.size(),

t, id, start, end, incr);

}

#define DATA_IMPLIED_DO1(obj_list, type, id, start, end, l) \

data_implied_do(p.m_a, l, obj_list, type, \

name2char(id), EXPR(start), EXPR(end), nullptr)

#define DATA_IMPLIED_DO2(obj_list, type, id, start, end, incr, l) \

data_implied_do(p.m_a, l, obj_list, type, \

name2char(id), EXPR(start), EXPR(end), EXPR(incr))

#define ENUM(attr, trivia, decl, l) make_Enum_t(p.m_a, l, \

VEC_CAST(attr, decl_attribute), attr.n, \

trivia_cast(trivia), \

DECLS(decl), decl.size())

#define IMPLICIT_NONE(trivia, l) make_ImplicitNone_t(p.m_a, l, \

nullptr, 0, trivia_cast(trivia))

#define IMPLICIT_NONE2(x, trivia, l) make_ImplicitNone_t(p.m_a, l, \

VEC_CAST(x, implicit_none_spec), x.size(), \

trivia_cast(trivia))

#define IMPLICIT_NONE_EXTERNAL(l) make_ImplicitNoneExternal_t(p.m_a, l, 0)

#define IMPLICIT_NONE_TYPE(l) make_ImplicitNoneType_t(p.m_a, l)

#define IMPLICIT(t, spec, trivia, l) make_Implicit_t(p.m_a, l, \

down_cast<decl_attribute_t>(t), nullptr, 0, \

VEC_CAST(spec, letter_spec), spec.size(), \

trivia_cast(trivia))

#define IMPLICIT1(t, spec, specs, trivia, l) make_Implicit_t(p.m_a, l, \

down_cast<decl_attribute_t>(t), \

VEC_CAST(spec, letter_spec), spec.size(), \

VEC_CAST(specs, letter_spec), specs.size(), \

trivia_cast(trivia))

#define LETTER_SPEC1(a, l) make_LetterSpec_t(p.m_a, l, \

nullptr, name2char(a))

#define LETTER_SPEC2(a, b, l) make_LetterSpec_t(p.m_a, l, \

name2char(a), name2char(b))

static inline var_sym_t* VARSYM(Allocator &al, Location &l,

char* name, dimension_t* dim, size_t n_dim,

codimension_t* codim, size_t n_codim, expr_t* init,

LFortran::AST::symbolType sym, decl_attribute_t* x)

{

var_sym_t *r = al.allocate<var_sym_t>(1);

r->loc = l;

r->m_name = name;

r->m_dim = dim;

r->n_dim = n_dim;

r->m_codim = codim;

r->n_codim = n_codim;

r->m_initializer = init;

r->m_sym = sym;

r->m_spec = x;

return r;

}

#define VAR_SYM_NAME(name, sym, loc) VARSYM(p.m_a, loc, \

name2char(name), nullptr, 0, nullptr, 0, nullptr, sym, nullptr)

#define VAR_SYM_DIM_EXPR(exp, sym, loc) VARSYM(p.m_a, loc, nullptr, \

nullptr, 0, nullptr, 0, down_cast<expr_t>(exp), sym, nullptr)

#define VAR_SYM_DIM_INIT(name, dim, n_dim, init, sym, loc) VARSYM(p.m_a, loc, \

name2char(name), dim, n_dim, nullptr, 0, \

down_cast<expr_t>(init), sym, nullptr)

#define VAR_SYM_DIM(name, dim, n_dim, sym, loc) VARSYM(p.m_a, loc, \

name2char(name), dim, n_dim, nullptr, 0, nullptr, sym, nullptr)

#define VAR_SYM_CODIM(name, codim, n_codim, sym, loc) VARSYM(p.m_a, loc, \

name2char(name), nullptr, 0, codim, n_codim, nullptr, sym, nullptr)

#define VAR_SYM_DIM_CODIM(name, dim, n_dim, codim, n_codim, sym, loc) \

VARSYM(p.m_a, loc, name2char(name), \

dim, n_dim, codim, n_codim, nullptr, sym, nullptr)

#define VAR_SYM_SPEC(x, sym, loc) VARSYM(p.m_a, loc, \

nullptr, nullptr, 0, nullptr, 0, nullptr, sym, \

down_cast<decl_attribute_t>(x))

#define DECL_ASSIGNMENT(l) make_AttrAssignment_t(p.m_a, l)

#define DECL_OP(op, l) make_AttrIntrinsicOperator_t(p.m_a, l, op)

#define DECL_DEFOP(optype, l) make_AttrDefinedOperator_t(p.m_a, l, \

def_op_to_str(p.m_a, optype))

static inline expr_t** DIMS2EXPRS(Allocator &al, const Vec<FnArg> &d)

{

if (d.size() == 0) {

return nullptr;

} else {

expr_t **s = al.allocate<expr_t*>(d.size());

for (size_t i=0; i < d.size(); i++) {

// TODO: we need to change this to allow both array and fn arguments

// Right now we assume everything is a function argument

if (d[i].keyword) {

if (d[i].kw.m_value) {

s[i] = d[i].kw.m_value;

} else {

Location l;

s[i] = EXPR(make_Num_t(al, l, 1, nullptr));

}

} else {

if (d[i].arg.m_end) {

s[i] = d[i].arg.m_end;

} else {

Location l;

s[i] = EXPR(make_Num_t(al, l, 1, nullptr));

}

}

}

return s;

}

}

static inline Vec<kind_item_t> empty()

}

static inline Vec<ast_t*> empty_vecast()

}

static inline Vec<struct_member_t> empty5()

}

static inline Vec<FnArg> empty1()

}

static inline VarType* VARTYPE0_(Allocator &al,

const LFortran::Str &s, const Vec<kind_item_t> kind, Location &l)

{

VarType *r = al.allocate<VarType>(1);

r->loc = l;

r->string = s;

r->identifier = nullptr;

r->kind = kind;

return r;

}

static inline VarType* VARTYPE4_(Allocator &al,

const LFortran::Str &s, const ast_t *id, Location &l)

{

VarType *r = al.allocate<VarType>(1);

r->loc = l;

r->string = s;

char *derived_type_name = name2char(id);

r->identifier = derived_type_name;

Vec<kind_item_t> kind;

kind.reserve(al, 1);

r->kind = kind;

return r;

}

#define VARTYPE0(s, l) VARTYPE0_(p.m_a, s, empty(), l)

#define VARTYPE3(s, k, l) VARTYPE0_(p.m_a, s, k, l)

#define VARTYPE4(s, k, l) VARTYPE4_(p.m_a, s, k, l)

static inline FnArg* DIM1(Allocator &al, Location &l,

expr_t *a, expr_t *b, expr_t *c)

{

FnArg *s = al.allocate<FnArg>();

s->keyword = false;

s->arg.loc = l;

s->arg.m_start = a;

s->arg.m_end = b;

s->arg.m_step = c;

return s;

}

static inline FnArg* DIM1k(Allocator &al, Location &l,

ast_t *id, expr_t */*a*/, expr_t *b)

{

FnArg *s = al.allocate<FnArg>();

s->keyword = true;

s->kw.loc = l;

s->kw.m_arg = name2char(id);

s->kw.m_value = b;

return s;

}

static inline CoarrayArg* CODIM1(Allocator &al, Location &l,

expr_t *a, expr_t *b, expr_t *c)

{

CoarrayArg *s = al.allocate<CoarrayArg>();

s->keyword = false;

s->arg.loc = l;

s->arg.m_start = a;

s->arg.m_end = b;

s->arg.m_step = c;

s->arg.m_star = codimension_typeType::CodimensionExpr;

return s;

}

static inline CoarrayArg* CODIM1star(Allocator &al, Location &l, expr_t *c)

{

CoarrayArg *s = al.allocate<CoarrayArg>();

s->keyword = false;

s->arg.loc = l;

s->arg.m_start = nullptr;

s->arg.m_end = nullptr;

s->arg.m_step = c;

s->arg.m_star = codimension_typeType::CodimensionStar;

return s;

}

static inline CoarrayArg* CODIM1k(Allocator &al, Location &l,

ast_t *id, expr_t */*a*/, expr_t *b)

{

CoarrayArg *s = al.allocate<CoarrayArg>();

s->keyword = true;

s->kw.loc = l;

s->kw.m_arg = name2char(id);

s->kw.m_value = b;

return s;

}

static inline dimension_t* DIM1d(Allocator &al, Location &l, expr_t *a, expr_t *b)

{

dimension_t *s = al.allocate<dimension_t>();

s->loc = l;

s->m_start = a;

s->m_end = b;

s->m_end_star = dimension_typeType::DimensionExpr;

return s;

}

static inline dimension_t* DIM1d_type(Allocator &al, Location &l,

expr_t *a, dimension_typeType type) {

dimension_t *s = al.allocate<dimension_t>();

s->loc = l;

s->m_start = a;

s->m_end = nullptr;

s->m_end_star = type;

return s;

}

static inline codimension_t* CODIM1d(Allocator &al, Location &l, expr_t *a, expr_t *b)

{

codimension_t *s = al.allocate<codimension_t>();

s->loc = l;

s->m_start = a;

s->m_end = b;

s->m_end_star = codimension_typeType::CodimensionExpr;

return s;

}

static inline codimension_t* CODIM1d_star(Allocator &al, Location &l, expr_t *a)

{

codimension_t *s = al.allocate<codimension_t>();

s->loc = l;

s->m_start = a;

s->m_end = nullptr;

s->m_end_star = codimension_typeType::CodimensionStar;

return s;

}

static inline arg_t* ARGS(Allocator &al, Location &l,

const Vec<ast_t*> args)

{

arg_t *a = al.allocate<arg_t>(args.size());

for (size_t i=0; i < args.size(); i++) {

a[i].loc = l;

a[i].m_arg = name2char(args.p[i]);

}

return a;

}

static inline char** REDUCE_ARGS(Allocator &al, const Vec<ast_t*> args)

{

char **a = al.allocate<char*>(args.size());

for (size_t i=0; i < args.size(); i++) {

a[i] = name2char(args.p[i]);

}

return a;

}

static inline reduce_opType convert_id_to_reduce_type(

}

#define TYPE ast_t*

#define LLOC(a, b) a.last = b.last;

#define ADD(x, y, l) make_BinOp_t(p.m_a, l, EXPR(x), operatorType::Add, EXPR(y))

#define SUB(x, y, l) make_BinOp_t(p.m_a, l, EXPR(x), operatorType::Sub, EXPR(y))

#define MUL(x, y, l) make_BinOp_t(p.m_a, l, EXPR(x), operatorType::Mul, EXPR(y))

#define DIV(x, y, l) make_BinOp_t(p.m_a, l, EXPR(x), operatorType::Div, EXPR(y))

#define POW(x, y, l) make_BinOp_t(p.m_a, l, EXPR(x), operatorType::Pow, EXPR(y))

#define UNARY_MINUS(x, l) make_UnaryOp_t(p.m_a, l, unaryopType::USub, EXPR(x))

#define UNARY_PLUS(x, l) make_UnaryOp_t(p.m_a, l, unaryopType::UAdd, EXPR(x))

#define TRUE(l) make_Logical_t(p.m_a, l, true)

#define FALSE(l) make_Logical_t(p.m_a, l, false)

ast_t* parenthesis(Allocator &al, Location &loc, expr_t *op) {

switch (op->type) {

case LFortran::AST::exprType::Name: { return make_Parenthesis_t(al, loc, op); }

default : { return (ast_t*)op; }

}

}

#define PAREN(x, l) parenthesis(p.m_a, l, EXPR(x))

#define STRCONCAT(x, y, l) make_StrOp_t(p.m_a, l, EXPR(x), stroperatorType::Concat, EXPR(y))

#define EQ(x, y, l) make_Compare_t(p.m_a, l, EXPR(x), cmpopType::Eq, EXPR(y))

#define NE(x, y, l) make_Compare_t(p.m_a, l, EXPR(x), cmpopType::NotEq, EXPR(y))

#define LT(x, y, l) make_Compare_t(p.m_a, l, EXPR(x), cmpopType::Lt, EXPR(y))

#define LE(x, y, l) make_Compare_t(p.m_a, l, EXPR(x), cmpopType::LtE, EXPR(y))

#define GT(x, y, l) make_Compare_t(p.m_a, l, EXPR(x), cmpopType::Gt, EXPR(y))

#define GE(x, y, l) make_Compare_t(p.m_a, l, EXPR(x), cmpopType::GtE, EXPR(y))

#define NOT(x, l) make_UnaryOp_t(p.m_a, l, unaryopType::Not, EXPR(x))

#define AND(x, y, l) make_BoolOp_t(p.m_a, l, EXPR(x), boolopType::And, EXPR(y))

#define OR(x, y, l) make_BoolOp_t(p.m_a, l, EXPR(x), boolopType::Or, EXPR(y))

#define XOR(x, y, l) make_BoolOp_t(p.m_a, l, EXPR(x), boolopType::Xor, EXPR(y))

#define EQV(x, y, l) make_BoolOp_t(p.m_a, l, EXPR(x), boolopType::Eqv, EXPR(y))

#define NEQV(x, y, l) make_BoolOp_t(p.m_a, l, EXPR(x), boolopType::NEqv, EXPR(y))

#define DEFOP(x, op, y, l) make_DefBinOp_t(p.m_a, l, EXPR(x), \

def_op_to_str(p.m_a, op), EXPR(y))

#define UNARY_DEFOP(op, y, l) make_DefUnaryOp_t(p.m_a, l, \

def_op_to_str(p.m_a, op), EXPR(y))

#define ARRAY_IN1(a, l) make_ArrayInitializer_t(p.m_a, l, \

nullptr, nullptr, EXPRS(a), a.size())

#define ARRAY_IN2(vartype, a, l) make_ArrayInitializer_t(p.m_a, l, \

down_cast<decl_attribute_t>(vartype), nullptr, EXPRS(a), a.size())

#define ARRAY_IN3(classtype, a, l) make_ArrayInitializer_t(p.m_a, l, \

nullptr, name2char(classtype), EXPRS(a), a.size())

ast_t* implied_do_loop(Allocator &al, Location &loc,

Vec<ast_t*> &ex_list,

ast_t* i,

ast_t* low,

ast_t* high,

ast_t* incr) {

return make_ImpliedDoLoop_t(al, loc,

EXPRS(ex_list), ex_list.size(),

name2char(i),

EXPR(low),

EXPR(high),

EXPR_OPT(incr));

}

ast_t* implied_do1(Allocator &al, Location &loc,

ast_t* ex,

ast_t* i,

ast_t* low,

ast_t* high,

ast_t* incr) {

Vec<ast_t*> v;

v.reserve(al, 1);

v.push_back(al, ex);

return implied_do_loop(al, loc, v, i, low, high, incr);

}

ast_t* implied_do2(Allocator &al, Location &loc,

ast_t* ex1,

ast_t* ex2,

ast_t* i,

ast_t* low,

ast_t* high,

ast_t* incr) {

Vec<ast_t*> v;

v.reserve(al, 2);

v.push_back(al, ex1);

v.push_back(al, ex2);

return implied_do_loop(al, loc, v, i, low, high, incr);

}

ast_t* implied_do3(Allocator &al, Location &loc,

ast_t* ex1,

ast_t* ex2,

Vec<ast_t*> ex_list,

ast_t* i,

ast_t* low,

ast_t* high,

ast_t* incr) {

Vec<ast_t*> v;

v.reserve(al, 2+ex_list.size());

v.push_back(al, ex1);

v.push_back(al, ex2);

for (size_t i=0; i<ex_list.size(); i++) {

v.push_back(al, ex_list[i]);

}

return implied_do_loop(al, loc, v, i, low, high, incr);

}

#define IMPLIED_DO_LOOP1(ex, i, low, high, l) \

implied_do1(p.m_a, l, ex, i, low, high, nullptr)

#define IMPLIED_DO_LOOP2(ex1, ex2, i, low, high, l) \

implied_do2(p.m_a, l, ex1, ex2, i, low, high, nullptr)

#define IMPLIED_DO_LOOP3(ex1, ex2, ex_list, i, low, high, l) \

implied_do3(p.m_a, l, ex1, ex2, ex_list, i, low, high, nullptr)

#define IMPLIED_DO_LOOP4(ex, i, low, high, incr, l) \

implied_do1(p.m_a, l, ex, i, low, high, incr)

#define IMPLIED_DO_LOOP5(ex1, ex2, i, low, high, incr, l) \

implied_do2(p.m_a, l, ex1, ex2, i, low, high, incr)

#define IMPLIED_DO_LOOP6(ex1, ex2, ex_list, i, low, high, incr, l) \

implied_do3(p.m_a, l, ex1, ex2, ex_list, i, low, high, incr)

char *str2str_null(Allocator &al, const LFortran::Str &s) {

if (s.p == nullptr) {

LFORTRAN_ASSERT(s.n == 0)

return nullptr;

} else {

LFORTRAN_ASSERT(s.n > 0)

return s.c_str(al);

}

}

#define SYMBOL(x, l) make_Name_t(p.m_a, l, x.c_str(p.m_a), nullptr, 0)

#define INTEGER(x, l) make_Num_t(p.m_a, l, x.int_n.n, str2str_null(p.m_a, x.int_kind))

#define INT1(l) make_Num_t(p.m_a, l, 1, nullptr)

#define INTEGER3(x) (x.int_n.as_smallint())

#define REAL(x, l) make_Real_t(p.m_a, l, x.c_str(p.m_a))

#define COMPLEX(x, y, l) make_Complex_t(p.m_a, l, EXPR(x), EXPR(y))

#define STRING(x, l) make_String_t(p.m_a, l, x.c_str(p.m_a))

#define BOZ(x, l) make_BOZ_t(p.m_a, l, x.c_str(p.m_a))

#define ASSIGN(label, variable, l) make_Assign_t(p.m_a, l, 0, label, name2char(variable), nullptr)

#define ASSIGNMENT(x, y, l) make_Assignment_t(p.m_a, l, 0, EXPR(x), EXPR(y), nullptr)

#define ASSOCIATE(x, y, l) make_Associate_t(p.m_a, l, 0, EXPR(x), EXPR(y), nullptr)

#define GOTO(x, l) make_GoTo_t(p.m_a, l, 0, nullptr, \

EXPR(INTEGER(x, l)), nullptr, 0, nullptr)

#define GOTO1(labels, e, l) make_GoTo_t(p.m_a, l, 0, nullptr, \

EXPR(e), EXPRS(labels), labels.size(), nullptr)

#define GOTO2(id, l) make_GoTo_t(p.m_a, l, 0, name2char(id), \

nullptr, nullptr, 0, nullptr)

#define GOTO3(id, labels, l) make_GoTo_t(p.m_a, l, 0, name2char(id), \

nullptr, EXPRS(labels), labels.size(), nullptr)

ast_t* SUBROUTINE_CALL0(Allocator &al, struct_member_t* mem, size_t n,

const ast_t *id, const Vec<FnArg> &args, Location &l) {

Vec<fnarg_t> v;

v.reserve(al, args.size());

Vec<keyword_t> v2;

v2.reserve(al, args.size());

for (auto &item : args) {

if (item.keyword) {

v2.push_back(al, item.kw);

} else {

v.push_back(al, item.arg);

}

}

return make_SubroutineCall_t(al, l, 0,

/*char* a_func*/ name2char(id),

/*struct_member_t* a_member*/ mem, /*size_t n_member*/ n,

/*expr_t** a_args*/ v.p, /*size_t n_args*/ v.size(),

/*keyword_t* a_keywords*/ v2.p, /*size_t n_keywords*/ v2.size(), nullptr);

}

#define SUBROUTINE_CALL(name, args, l) SUBROUTINE_CALL0(p.m_a, \

nullptr, 0, name, args, l)

#define SUBROUTINE_CALL1(mem, name, args, l) SUBROUTINE_CALL0(p.m_a, \

mem.p, mem.n, name, args, l)

#define SUBROUTINE_CALL2(name, l) make_SubroutineCall_t(p.m_a, l, 0, \

name2char(name), nullptr, 0, nullptr, 0, nullptr, 0, nullptr)

#define SUBROUTINE_CALL3(mem, name, l) make_SubroutineCall_t(p.m_a, l, 0, \

name2char(name), mem.p, mem.n, nullptr, 0, nullptr, 0, nullptr)

ast_t* DEALLOCATE_STMT1(Allocator &al,

const Vec<FnArg> &args, Location &l) {

Vec<fnarg_t> v;

v.reserve(al, args.size());

Vec<keyword_t> v2;

v2.reserve(al, args.size());

for (auto &item : args) {

if (item.keyword) {

v2.push_back(al, item.kw);

} else {

v.push_back(al, item.arg);

}

}

return make_Deallocate_t(al, l, 0,

/*expr_t** a_args*/ v.p, /*size_t n_args*/ v.size(),

/*keyword_t* a_keywords*/ v2.p, /*size_t n_keywords*/ v2.size(), nullptr);

}

ast_t* ALLOCATE_STMT0(Allocator &al,

const Vec<FnArg> &args, Location &l) {

Vec<fnarg_t> v;

v.reserve(al, args.size());

Vec<keyword_t> v2;

v2.reserve(al, args.size());

for (auto &item : args) {

if (item.keyword) {

v2.push_back(al, item.kw);

} else {

v.push_back(al, item.arg);

}

}

return make_Allocate_t(al, l, 0,

/*expr_t** a_args*/ v.p, /*size_t n_args*/ v.size(),

/*keyword_t* a_keywords*/ v2.p, /*size_t n_keywords*/ v2.size(), nullptr);

}

#define ALLOCATE_STMT(args, l) ALLOCATE_STMT0(p.m_a, args, l)

#define DEALLOCATE_STMT(args, l) DEALLOCATE_STMT1(p.m_a, args, l)

char* def_op_to_str(Allocator &al, const LFortran::Str &s) {

LFORTRAN_ASSERT(s.p[0] == '.');

LFORTRAN_ASSERT(s.p[s.size()-1] == '.');

std::string s0 = s.str();

s0 = s0.substr(1, s.size()-2);

LFortran::Str s2;

s2.from_str_view(s0);

return s2.c_str(al);

}

ast_t* PRINT1(Allocator &al, Location &l,

ast_t* fmt,

expr_t** m_args, size_t n_args) {

expr_t* x;

if(fmt == nullptr) {

x = nullptr;

} else {

x = down_cast<expr_t>(fmt);

}

return make_Print_t(al, l, 0, x, m_args, n_args, nullptr);

}

#define PRINT0(fmt, l) PRINT1(p.m_a, l, fmt, nullptr, 0)

#define PRINT(fmt, args, l) PRINT1(p.m_a, l, fmt, \

EXPRS(args), args.size())

ast_t* WRITE1(Allocator &al,

const Vec<ArgStarKw> &args0,

const Vec<ast_t*> &args,

Location &l) {

Vec<argstar_t> v;

v.reserve(al, args0.size());

Vec<kw_argstar_t> v2;

v2.reserve(al, args0.size());

for (auto &item : args0) {

if (item.keyword) {

v2.push_back(al, item.kw);

} else {

v.push_back(al, item.arg);

}

}

return make_Write_t(al, l, 0,

v.p, v.size(),

v2.p, v2.size(),

EXPRS(args), args.size(), nullptr);

}

ast_t* READ1(Allocator &al,

const Vec<ArgStarKw> &args0,

const Vec<ast_t*> &args,

Location &l) {

Vec<argstar_t> v;

v.reserve(al, args0.size());

Vec<kw_argstar_t> v2;

v2.reserve(al, args0.size());

for (auto &item : args0) {

if (item.keyword) {

v2.push_back(al, item.kw);

} else {

v.push_back(al, item.arg);

}

}

return make_Read_t(al, l, 0, nullptr,

v.p, v.size(),

v2.p, v2.size(),

EXPRS(args), args.size(), nullptr);

}

void extract_args1(Allocator &al,

}

template <typename ASTConstructor>

ast_t* builtin1(Allocator &al,

const Vec<ArgStarKw> &args0,

Location &l, ASTConstructor cons) {

Vec<expr_t*> v;

Vec<keyword_t> v2;

extract_args1(al, v, v2, args0);

return cons(al, l, 0,

v.p, v.size(),

v2.p, v2.size(), nullptr);

}

template <typename ASTConstructor>

ast_t* builtin2(Allocator &al,

const Vec<ArgStarKw> &args0,

const Vec<ast_t*> &ex_list,

Location &l, ASTConstructor cons) {

Vec<expr_t*> v;

Vec<keyword_t> v2;

extract_args1(al, v, v2, args0);

return cons(al, l, 0,

v.p, v.size(),

v2.p, v2.size(), EXPRS(ex_list), ex_list.size(), nullptr);

}

template <typename ASTConstructor>

ast_t* builtin3(Allocator &al,

const Vec<ArgStarKw> &args0,

Location &l, ASTConstructor cons) {

Vec<expr_t*> v;

Vec<keyword_t> v2;

extract_args1(al, v, v2, args0);

return cons(al, l,

v.p, v.size(),

v2.p, v2.size());

}

#define WRITE_ARG1(out, arg0) \

out = p.m_a.make_new<ArgStarKw>(); \

out->keyword = false; \

if (arg0 == nullptr) { \

out->arg.m_value = nullptr; \

} else { \

out->arg.m_value = down_cast< \

expr_t>(arg0); \

}

#define WRITE_ARG2(out, id0, arg0) \

out = p.m_a.make_new<ArgStarKw>(); \

out->keyword = true; \

out->kw.m_arg = name2char(id0); \

if (arg0 == nullptr) { \