view release on metacpan or  search on metacpan

Compiler/parser.y  view on Meta::CPAN

	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);

Compiler/parser.y  view on Meta::CPAN

			char	 buf[64];
			snprintf(buf, 64, "%d", $1);
			$$ = newSVpv(buf, 0);
		}
	;

string
		: L_STRING
			/* default */
		| string L_STRING
		{
			sv_catpv($1, SvPVX($2));
			SvREFCNT_dec($2);
			$$ = $1;
		}
	;

integer
		: L_INTEGER
		| L_CHARACTER
	;

array
		: L_ARRAY_START opt_arg_list_comma L_ARRAY_END
		{
			$$ = $2;
		}
	;

mapping
		: L_MAP_START opt_assoc_arg_list_comma L_MAP_END
		{
			/* This doesn't expand the pairs into a single list.
			 * There is a hack elsewhere. */
			$$ = $2;
		}
	;

		/* Also things like (: foo :) ? */
closure
		: L_FUNCTION_START list_exp L_FUNCTION_END
		{
			$$ = $2;
		}
	;

%%

const char *
yytokname(int i)
{
	return yytname[YYTRANSLATE(i)];
}

int
yyparser_parse(SV *program, const char *str)
{
	amd_parse_param_t	 param;
	int					 ret;

	// fprintf(stderr, "Start of yyparser_parse\n");
	// fflush(stderr);

	memset(&param, 0, sizeof(param));
	param.program = program;
	param.symtab = newHV();

	yylex_init(str);
#if YYDEBUG != 0
	yydebug = 1;
#endif

	ret = yyparse((void *)(&param));

	/* Delete the HV but not the contents. */
	hv_undef(param.symtab);

	return ret;
}