view release on metacpan or  search on metacpan

Compiler/parser.y  view on Meta::CPAN

#define Z3		Z2, NULL
#define Z4		Z3, NULL
#define Z5		Z4, NULL
#define Z6		Z5, NULL

#define N_A0(t)					yyparse_node(t,               Z6)
#define N_A1(t,a0)				yyparse_node(t,a0,            Z5)
#define N_A2(t,a0,a1)			yyparse_node(t,a0,a1,         Z4)
#define N_A3(t,a0,a1,a2)		yyparse_node(t,a0,a1,a2,      Z3)
#define N_A4(t,a0,a1,a2,a3)		yyparse_node(t,a0,a1,a2,a3,   Z2)
#define N_A5(t,a0,a1,a2,a3,a4)	yyparse_node(t,a0,a1,a2,a3,a4,Z1)

#define N_A0R(t,r)					yyparse_node(t,            Z5,r)
#define N_A1R(t,a0,r)				yyparse_node(t,a0,         Z4,r)
#define N_A2R(t,a0,a1,r)			yyparse_node(t,a0,a1,      Z3,r)
#define N_A3R(t,a0,a1,a2,r)			yyparse_node(t,a0,a1,a2,   Z2,r)
#define N_A4R(t,a0,a1,a2,a3,r)		yyparse_node(t,a0,a1,a2,a3,Z1,r)
#define N_A5R(t,a0,a1,a2,a3,a4,r)	yyparse_node(t,a0,a1,a2,a3,a4,r)

static SV *
yyparse_node(char *type,
				SV *arg0, SV *arg1, SV *arg2, SV *arg3, SV *arg4,
				AV *rest)
{
	dSP;
	int		 count;
	SV		*node;
	char	 buf[512];
	SV		*class;
	SV		**svp;
	int		 len;
	int		 i;

	strcpy(buf, _AMD "::Compiler::Node::");
	strcat(buf, type);
	class = sv_2mortal(newSVpv(buf, 0));

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(class);
	/* This unconventional formatting pushes the first few of argN
	 * which are not NULL. */
	if (arg0) { XPUSHs(arg0);
	if (arg1) { XPUSHs(arg1);
	if (arg2) { XPUSHs(arg2);
	if (arg3) { XPUSHs(arg3);
	if (arg4) { XPUSHs(arg4);
								} } } } }

	if (rest) {
		len = av_len(rest);
		for (i = 0; i <= len; i++) {
			svp = av_fetch(rest, i, FALSE);
			if (svp)
				XPUSHs(*svp);
		}
	}

	PUTBACK;
	count = call_method("new", G_SCALAR);
	SPAGAIN;
	if (count != 1)
		croak("Didn't get a return value from constructing %s\n", type);
	node = POPs;
	PUTBACK;

	SvREFCNT_inc(node);

	FREETMPS;
	LEAVE;

	// sv_2mortal(node);	/* This segfaults it at the moment. */

	return node;
}

/* We have to make sure that 'type' coming into here is PV not RV */
static SV *
yyparse_type(const char *type, SV *stars)
{
	static SV	*class = NULL;
	SV			*sv;
	dSP;
	int			 count;
	SV			*node;

	if (!class) {
		class = newSVpv(_AMD "::Compiler::Type", 0);
	}

	// fprintf(stderr, "Type is %s, stars is %s\n", type, SvPV_nolen(stars));

	/* XXX It's quite likely that we own the only ref to 'stars' here.
	 */
	sv = newSVsv(stars);
	sv_catpv(sv, type);

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(class);
	XPUSHs(sv);		/* Does this get freed? */

	PUTBACK;
	count = call_method("new", G_SCALAR);
	SPAGAIN;
	if (count != 1)
		croak("Didn't get a return value from constructing Type\n");
	node = POPs;
	PUTBACK;

	SvREFCNT_inc(node);

	FREETMPS;
	LEAVE;

	/* In the outer scope. Let's hope this doesn't get dested. */
	sv_2mortal(node);

	return node;

#if 0
	return sv_bless(newRV_noinc(stars),
			gv_stashpv(_AMD "::Compiler::Type", TRUE));
#endif
}

/* Can I pass mods as a primitive integer, and not bother if they
 * are zero? This applies to functions as well. */
static SV *
yyparse_variable(SV *name, const char *type, SV *stars, SV *mods)
{
	static SV	*class = NULL;
	static SV	*k_type = NULL;
	static SV	*k_name = NULL;
	static SV	*k_flags = NULL;
	SV			*newtype;
	dSP;
	int			 count;
	SV			*node;

	if (!class) {
		class = newSVpv(_AMD "::Program::Variable", 0);
		k_type = newSVpv("Type", 0);
		k_name = newSVpv("Name", 0);
		k_flags = newSVpv("Flags", 0);
	}

	newtype = yyparse_type(type, stars);

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(class);
	XPUSHs(k_type);
	XPUSHs(newtype);
	XPUSHs(k_name);
	XPUSHs(name);
	XPUSHs(k_flags);
	XPUSHs(mods);

	PUTBACK;
	count = call_method("new", G_SCALAR);
	SPAGAIN;
	if (count != 1)
		croak("Didn't get a return value from constructing Variable\n");
	node = POPs;
	PUTBACK;

	SvREFCNT_inc(node);

	FREETMPS;
	LEAVE;

	return node;
}

static SV *
yyparse_method(SV *name, const char *type, SV *stars,
				SV *args, SV *mods)
{
	static SV	*class = NULL;
	static SV	*k_type = NULL;
	static SV	*k_name = NULL;
	static SV	*k_args = NULL;
	static SV	*k_flags = NULL;
	SV			*newtype;
	dSP;
	int			 count;
	SV			*node;

	if (!class) {
		class = newSVpv(_AMD "::Program::Method", 0);
		k_type = newSVpv("Type", 0);
		k_name = newSVpv("Name", 0);
		k_args = newSVpv("Args", 0);
		k_flags = newSVpv("Flags", 0);
	}

	newtype = yyparse_type(type, stars);

	// printf("Start of yyparse_method\n");

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(class);
	XPUSHs(k_type);
	XPUSHs(newtype);
	XPUSHs(k_name);
	XPUSHs(name);
	XPUSHs(k_args);
	XPUSHs(args);
	XPUSHs(k_flags);
	XPUSHs(mods);

	PUTBACK;
	count = call_method("new", G_SCALAR);
	SPAGAIN;
	if (count != 1)
		croak("Didn't get a return value from constructing Method\n");
	node = POPs;
	PUTBACK;

	SvREFCNT_inc(node);

	FREETMPS;
	LEAVE;

	// printf("End of yyparse_method\n");

	return node;
}

static void
yyparse_method_add_code(SV *method, SV *code)
{
	dSP;
	int			 count;

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(method);
	XPUSHs(code);

	PUTBACK;
	count = call_method("code", G_DISCARD);
	SPAGAIN;
	if (count != 0)
		croak("Got a return value from method->code()\n");
	PUTBACK;
	FREETMPS;
	LEAVE;
}

static SV *
yyparse_program_apply(amd_parse_param_t *param,
				const char *func, SV *arg0, SV *arg1)
{
	dSP;
	int		 count;
	SV		*node;

	// printf("Apply %s\n", func);

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(param->program);
	if (arg0) XPUSHs(arg0);
	if (arg1) XPUSHs(arg1);

	PUTBACK;
	count = call_method(func, G_SCALAR);
	SPAGAIN;
	if (count != 1)
		croak("No returned value from apply %s\n", func);
	node = POPs;

	SvREFCNT_inc(node);

	PUTBACK;
	FREETMPS;
	LEAVE;

	return node;
}

%}

%token L_BREAK L_CASE L_CATCH L_CLASS L_CONTINUE L_DEFAULT L_DO
%token L_EFUN L_ELSE L_FOR L_FOREACH L_IF L_IN L_INHERIT L_NEW
%token L_NIL L_RETURN L_RLIMITS L_SWITCH L_SSCANF L_TRY L_WHILE

%token L_MAP_START L_MAP_END
%token L_ARRAY_START L_ARRAY_END
%token L_FUNCTION_START L_FUNCTION_END
%token L_PARAMETER L_IDENTIFIER L_NIL L_STRING L_CHARACTER
%token L_INTEGER L_HEXINTEGER
%token L_BASIC_TYPE L_TYPE_MODIFIER L_STATIC

%token L_INHERIT L_COLONCOLON
%token L_IF L_DO L_WHILE L_FOR L_FOREACH L_IN L_RLIMITS
%token L_TRY L_CATCH
%token L_SWITCH L_CASE L_BREAK
%token L_CONTINUE L_RETURN L_ELSE

%token L_VOID L_ELLIPSIS
%token L_ARROW L_RANGE

%nonassoc LOWER_THAN_ELSE
%nonassoc L_ELSE

/* Strictly these can be %token */
%nonassoc L_PLUS_EQ L_MINUS_EQ L_DIV_EQ L_TIMES_EQ
%nonassoc L_MOD_EQ L_AND_EQ L_OR_EQ L_XOR_EQ L_DOT_EQ
	/* Is this the right place? */
%nonassoc L_LOR_EQ L_LAND_EQ

/* %left CONST */
%right '?'
%left L_LOR
%left L_LAND
%left '|'
%left '^'
%left '&'
%left L_EQ L_NE
%left L_GE L_LE '<' '>'
%left L_LSH L_RSH
%left '.'
%left '+' '-'
%left '*' '%' '/'
%right '!' '~'
%nonassoc L_INC L_DEC

/* These aren't strictly necessary, but they help debugging. */

%token '{' '}' ',' ';' ':' '(' ')' '[' ']' '=' '$'

	/* I should have a new type 'node' in here for blessed objects
	 * which are specifically parse nodes. */
	/* It is very very tempting to expand this to say 12 bytes