Anarres-Mud-Driver

 view release on metacpan or  search on metacpan

Compiler/lexer.c  view on Meta::CPAN

#include "compiler.h"
#include "parser.h"

#define YY_DECL int amd_yylex(AMD_YYSTYPE *amd_yylval, amd_parse_param_t *param)

static int amd_yyinteger(AMD_YYSTYPE *lvalp);
static int amd_yyidentifier(AMD_YYSTYPE *lvalp, amd_parse_param_t *param);
#define YY_NO_INPUT 1
#define YY_NO_UNPUT 1
#define YY_NO_TOP_STATE 1
/* %option debug */
#define CODE 1

#define BLANK 2

#define STRING 3

#define PPLINE 4

#define CCOMMENT 5

Compiler/lexer.yy  view on Meta::CPAN

static int yyinteger(YYSTYPE *lvalp);
static int yyidentifier(YYSTYPE *lvalp, amd_parse_param_t *param);
%}

%option noyywrap
%option noinput
%option nounput
%option noreject
%option noyy_top_state

	/* %option debug */

%s CODE
%x BLANK
%x STRING
%x PPLINE
%x CCOMMENT
%x CPPCOMMENT

WHITE			[ \f\t\v]+
NONWHITE		[^ \f\t\v\r\n]

Compiler/parser.c  view on Meta::CPAN


#ifdef YYLSP_NEEDED
YYLTYPE amd_yylloc;			/*  location data for the lookahead	*/
				/*  symbol				*/
#endif

int amd_yynerrs;			/*  number of parse errors so far       */
#endif  /* not YYPURE */

#if YYDEBUG != 0
int amd_yydebug;			/*  nonzero means print parse trace	*/
/* Since this is uninitialized, it does not stop multiple parsers
   from coexisting.  */
#endif

/*  YYINITDEPTH indicates the initial size of the parser's stacks	*/

#ifndef	YYINITDEPTH
#define YYINITDEPTH 200
#endif

Compiler/parser.c  view on Meta::CPAN

#endif
#endif

  AMD_YYSTYPE amd_yyval;		/*  the variable used to return		*/
				/*  semantic values from the action	*/
				/*  routines				*/

  int amd_yylen;

#if YYDEBUG != 0
  if (amd_yydebug)
    fprintf(stderr, "Starting parse\n");
#endif

  amd_yystate = 0;
  amd_yyerrstatus = 0;
  amd_yynerrs = 0;
  amd_yychar = YYEMPTY;		/* Cause a token to be read.  */

  /* Initialize stack pointers.
     Waste one element of value and location stack

Compiler/parser.c  view on Meta::CPAN

#endif
#endif /* no amd_yyoverflow */

      amd_yyssp = amd_yyss + size - 1;
      amd_yyvsp = amd_yyvs + size - 1;
#ifdef YYLSP_NEEDED
      amd_yylsp = amd_yyls + size - 1;
#endif

#if YYDEBUG != 0
      if (amd_yydebug)
	fprintf(stderr, "Stack size increased to %d\n", amd_yystacksize);
#endif

      if (amd_yyssp >= amd_yyss + amd_yystacksize - 1)
	YYABORT;
    }

#if YYDEBUG != 0
  if (amd_yydebug)
    fprintf(stderr, "Entering state %d\n", amd_yystate);
#endif

  goto amd_yybackup;
 amd_yybackup:

/* Do appropriate processing given the current state.  */
/* Read a lookahead token if we need one and don't already have one.  */
/* amd_yyresume: */

Compiler/parser.c  view on Meta::CPAN

    goto amd_yydefault;

  /* Not known => get a lookahead token if don't already have one.  */

  /* amd_yychar is either YYEMPTY or YYEOF
     or a valid token in external form.  */

  if (amd_yychar == YYEMPTY)
    {
#if YYDEBUG != 0
      if (amd_yydebug)
	fprintf(stderr, "Reading a token: ");
#endif
      amd_yychar = YYLEX;
    }

  /* Convert token to internal form (in amd_yychar1) for indexing tables with */

  if (amd_yychar <= 0)		/* This means end of input. */
    {
      amd_yychar1 = 0;
      amd_yychar = YYEOF;		/* Don't call YYLEX any more */

#if YYDEBUG != 0
      if (amd_yydebug)
	fprintf(stderr, "Now at end of input.\n");
#endif
    }
  else
    {
      amd_yychar1 = YYTRANSLATE(amd_yychar);

#if YYDEBUG != 0
      if (amd_yydebug)
	{
	  fprintf (stderr, "Next token is %d (%s", amd_yychar, amd_yytname[amd_yychar1]);
	  /* Give the individual parser a way to print the precise meaning
	     of a token, for further debugging info.  */
#ifdef YYPRINT
	  YYPRINT (stderr, amd_yychar, amd_yylval);
#endif
	  fprintf (stderr, ")\n");
	}
#endif
    }

  amd_yyn += amd_yychar1;
  if (amd_yyn < 0 || amd_yyn > YYLAST || amd_yycheck[amd_yyn] != amd_yychar1)

Compiler/parser.c  view on Meta::CPAN

    }
  else if (amd_yyn == 0)
    goto amd_yyerrlab;

  if (amd_yyn == YYFINAL)
    YYACCEPT;

  /* Shift the lookahead token.  */

#if YYDEBUG != 0
  if (amd_yydebug)
    fprintf(stderr, "Shifting token %d (%s), ", amd_yychar, amd_yytname[amd_yychar1]);
#endif

  /* Discard the token being shifted unless it is eof.  */
  if (amd_yychar != YYEOF)
    amd_yychar = YYEMPTY;

  *++amd_yyvsp = amd_yylval;
#ifdef YYLSP_NEEDED
  *++amd_yylsp = amd_yylloc;

Compiler/parser.c  view on Meta::CPAN

  if (amd_yyn == 0)
    goto amd_yyerrlab;

/* Do a reduction.  amd_yyn is the number of a rule to reduce with.  */
amd_yyreduce:
  amd_yylen = amd_yyr2[amd_yyn];
  if (amd_yylen > 0)
    amd_yyval = amd_yyvsp[1-amd_yylen]; /* implement default value of the action */

#if YYDEBUG != 0
  if (amd_yydebug)
    {
      int i;

      fprintf (stderr, "Reducing via rule %d (line %d), ",
	       amd_yyn, amd_yyrline[amd_yyn]);

      /* Print the symbols being reduced, and their result.  */
      for (i = amd_yyprhs[amd_yyn]; amd_yyrhs[i] > 0; i++)
	fprintf (stderr, "%s ", amd_yytname[amd_yyrhs[i]]);
      fprintf (stderr, " -> %s\n", amd_yytname[amd_yyr1[amd_yyn]]);

Compiler/parser.c  view on Meta::CPAN

   /* the action file gets copied in in place of this dollarsign */
#line 554 "/usr/share/bison.simple"

  amd_yyvsp -= amd_yylen;
  amd_yyssp -= amd_yylen;
#ifdef YYLSP_NEEDED
  amd_yylsp -= amd_yylen;
#endif

#if YYDEBUG != 0
  if (amd_yydebug)
    {
      short *ssp1 = amd_yyss - 1;
      fprintf (stderr, "state stack now");
      while (ssp1 != amd_yyssp)
	fprintf (stderr, " %d", *++ssp1);
      fprintf (stderr, "\n");
    }
#endif

  *++amd_yyvsp = amd_yyval;

Compiler/parser.c  view on Meta::CPAN


  if (amd_yyerrstatus == 3)
    {
      /* if just tried and failed to reuse lookahead token after an error, discard it.  */

      /* return failure if at end of input */
      if (amd_yychar == YYEOF)
	YYABORT;

#if YYDEBUG != 0
      if (amd_yydebug)
	fprintf(stderr, "Discarding token %d (%s).\n", amd_yychar, amd_yytname[amd_yychar1]);
#endif

      amd_yychar = YYEMPTY;
    }

  /* Else will try to reuse lookahead token
     after shifting the error token.  */

  amd_yyerrstatus = 3;		/* Each real token shifted decrements this */

Compiler/parser.c  view on Meta::CPAN

amd_yyerrpop:   /* pop the current state because it cannot handle the error token */

  if (amd_yyssp == amd_yyss) YYABORT;
  amd_yyvsp--;
  amd_yystate = *--amd_yyssp;
#ifdef YYLSP_NEEDED
  amd_yylsp--;
#endif

#if YYDEBUG != 0
  if (amd_yydebug)
    {
      short *ssp1 = amd_yyss - 1;
      fprintf (stderr, "Error: state stack now");
      while (ssp1 != amd_yyssp)
	fprintf (stderr, " %d", *++ssp1);
      fprintf (stderr, "\n");
    }
#endif

amd_yyerrhandle:

Compiler/parser.c  view on Meta::CPAN

      amd_yyn = -amd_yyn;
      goto amd_yyreduce;
    }
  else if (amd_yyn == 0)
    goto amd_yyerrpop;

  if (amd_yyn == YYFINAL)
    YYACCEPT;

#if YYDEBUG != 0
  if (amd_yydebug)
    fprintf(stderr, "Shifting error token, ");
#endif

  *++amd_yyvsp = amd_yylval;
#ifdef YYLSP_NEEDED
  *++amd_yylsp = amd_yylloc;
#endif

  amd_yystate = amd_yyn;
  goto amd_yynewstate;

Compiler/parser.c  view on Meta::CPAN


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

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

	amd_yylex_init(str);
#if YYDEBUG != 0
	amd_yydebug = 1;
#endif

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

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

	return ret;
}

Compiler/parser.y  view on Meta::CPAN

%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
	 * to save on the use of AVs for type declarators. */
%union {
	int			 number;
	const char	*str;

Compiler/parser.y  view on Meta::CPAN


	// 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;
}

Efun/Core/Core.pm  view on Meta::CPAN

		# File stuff

		file_size		=> [ 0,		T_INTEGER, T_STRING, ],
		read_file		=> [ 0,		T_STRING, T_STRING, ],
		write_file		=> [ 0,		T_INTEGER, T_STRING, T_STRING, ],

		# System stuff

		time			=> [ 0,		T_INTEGER, ],

		debug_message	=> [ 0,		T_STRING, T_STRING, ],
		error			=> [ 0,		T_INTEGER, T_STRING, ],
		catch			=> [ 0,		T_STRING, T_UNKNOWN, ],
		shutdown		=> [ 0,		T_INTEGER, ],

		trace			=> [ 0,		T_INTEGER, T_INTEGER, ],
			);

	# We call this as an exported function since ISA isn't yet set up.
	foreach (keys %efuns) {
		register(__PACKAGE__ . "::" . $_, @{ $efuns{$_} });
	}
}

{
	package Anarres::Mud::Driver::Efun::Core::time;
	sub generate_call { "time()" }
}

{
	package Anarres::Mud::Driver::Efun::Core::debug_message;
	sub generate_call { "print STDERR $_[1], '\\n'" }
}

{
	package Anarres::Mud::Driver::Efun::Core::previous_object;
	sub invoke { undef }
}

{
	package Anarres::Mud::Driver::Efun::Core::file_name;

lib/Driver/Compiler/Check.pm  view on Meta::CPAN

sub DBG_TC_PROMOTE	() { 2 }
sub DBG_TC_CONVERT	() { 4 }

$DEBUG = 0;;
$DEBUG |= DBG_TC_NAME		if 0;
$DEBUG |= DBG_TC_PROMOTE	if 0;
$DEBUG |= DBG_TC_CONVERT	if 0;

@STACK = ();

sub debug_tc {
	my ($self, $class, @args) = @_;
	return undef unless $DEBUG & $class;
	my $msg = join(": ", @args);
	print STDERR "DebugTC: $msg\n";
}

# Called at the beginning of any typecheck call
sub tc_start {
	my ($self, @args) = @_;
	push(@STACK, $self);
	$self->debug_tc(DBG_TC_NAME, "Checking " . $self->opcode, @args);
}

# Called at the end of any typecheck call, possibly by tc_fail().
sub tc_end {
	my ($self, $type, @args) = @_;
	$self->settype($type) if $type;
	$self->debug_tc(DBG_TC_NAME, "Finished " . $self->opcode, @args);
	pop(@STACK);
	return 1;	# Make it return a success.
}

	# This is a utility method. Calling it is mandatory
	# in the case of failure.
sub tc_fail {
	my ($self, $type, @args) = @_;
	$type = T_FAILED unless $type;
	$self->tc_end($type, @args);

lib/Driver/Compiler/Check.pm  view on Meta::CPAN

}

# There is a special case of this in Integer.
sub promote {
	my ($self, $newtype) = @_;
	my $type = $self->type;
	# XXX Checking for T_UNKNOWN is wrong here. I need to check
	# whether the old type is 'weaker' than the new type.
	confess "XXX No type in " . $self->dump unless $type;
	return $self if $type->equals($newtype);
	$self->debug_tc(DBG_TC_PROMOTE, "Promoting ([" . $type->dump . "] ".
					$self->opcode . ") into " . $newtype->dump);

	# Anything can become 'unknown' - this allows weakening
	return $self if $type->compatible($newtype);

	# This should really be done by 'compatible'?
	return $self if $newtype->equals(T_BOOL);

	# The Assert nodes are broken for some reason?
	# return $self->assert($newtype) if $type->equals(T_UNKNOWN);

lib/Driver/Compiler/Check.pm  view on Meta::CPAN

	return undef;
}

# This might return an undef in the error list in the case that an
# error occurred which has already been reported.
sub convert {
	my ($self, $program, @rest) = @_;

	my $opcode = $self->opcode;

	$self->debug_tc(DBG_TC_CONVERT, "Convert " . $self->opcode .
					" to " . $opcode);

	unless (ref $OPTYPES{$opcode}) {
		confess "XXX OPTYPES for $opcode is $OPTYPES{$opcode}"
				if $OPTYPES{$opcode};
		confess "XXX No OPTYPES for $opcode!";
	}

	my @values = $self->values;
	my @template = @{ $OPTYPES{$opcode} };
	my $rettype = pop(@template);

	unless (@values == @template) {
		# XXX This is for self-debugging.
		print STDERR "I have " . scalar(@values) . " values\n";
		print STDERR "I have " . scalar(@template) . " template\n";
		die "Child count mismatch in $opcode";
	}

	# We push undef into @errors to indicate that an error occurred
	# but should have been reported already at a lower level.

	my $i = 0;
	my @tvals = ();

lib/Driver/Compiler/Generate.pm  view on Meta::CPAN

# "Refactor", I hear you say?
# This needs a magic token for line number...
sub generate ($) {
	my $self = shift;

	my $name = $self->opcode;
	# print "Finding code for $name\n";
	my $code = $OPCODETABLE{$name};
	return "GEN($name)" unless defined $code;

	# This is mostly for debugging. It can be safely removed.
	if ($code eq 'NOGEN') {
		print "XXX Attempt to generate NOGEN opcode $name\n";
		return "GEN($name)";
	}

	my $subref = $self->gensub($name, $code);

	{
		# Backpatch our original package.
		no strict qw(refs);



( run in 1.301 second using v1.01-cache-2.11-cpan-49f99fa48dc )