# define C 257
# define CDEF 258
# define DEFINE 259
# define FLOAT 260
# define IDENT 261
# define INT 262
# define NUMBER 263
# define RARROW 264
# define STRING 265

# line 4 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
#include <stdio.h>
int line_no = 1;
void print_decs(), print_ids(), print_addrs(), print_defs(),
    print_args(), print_sets();
extern FILE *scm, *c, *yyout;
typedef struct ident_info NODE;

struct ident_info {
    int tid;
    char *pid;
    NODE *next;
};
NODE *create_node(), *add_node();

extern scheme;  /* 1 if scheme ; 0 if common lisp */
#define yyclearin yychar = -1
#define yyerrok yyerrflag = 0
extern int yychar;
extern short yyerrflag;
#ifndef YYMAXDEPTH
#define YYMAXDEPTH 150
#endif
#ifndef YYSTYPE
#define YYSTYPE int
#endif
YYSTYPE yylval, yyval;
# define YYERRCODE 256

# line 212 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"

void yyerror(s)
char *s;
{
    printf("line %d: %s\n", line_no, s);
}

int *yyerrlval()
{
    static int i = 0;
    return(&i);
}

NODE *create_node(t, s)
int t;
char *s;
{
    NODE *n;
    n = (NODE *)malloc(sizeof(NODE));
    n->tid = t;
    n->pid = s;
    n->next = (NODE *)0;
    return (n);
}

NODE *add_node(n1, n2)
NODE *n1, *n2;
{
    NODE *n = n1;

    while (n->next) {
	n = n->next;
    }
    n->next = n2;
    return(n1);
}

void print_decs(n,argument)
NODE *n;
int argument;
{
    while (n) {
	switch (n->tid) {
	  case INT:
	    fprintf(c, "int %s;\n", n->pid);
	    break;
	  case FLOAT:
	    fprintf(c, "float %s;\n", n->pid);
	    break;
	  case STRING:
	    if (argument)
	      fprintf(c, "char * %s;\n", n->pid);
	    else
	      fprintf(c, "static char %s[1024];\n", n->pid);
	    break;
	}
	n = n->next;
    }
}

void print_actuals (f, n, sep)
FILE *f;
NODE *n;
char *sep;
{
    while (n) {
        if (n->tid == STRING)
	  fprintf(f,"(unsigned long)&%s[0]",n->pid);
	else
	  fprintf(f, "%s", n->pid);
	if (n->next) fprintf(f, "%s", sep);
	n = n->next;
    }
}

void print_ids(f, n, sep)
FILE *f;
NODE *n;
char *sep;
{
    while (n) {
        if (n->tid == STRING)
	  fprintf(f, "%s", n->pid);
	else
	  fprintf(f, "%s", n->pid);
	if (n->next) fprintf(f, "%s", sep);
	n = n->next;
    }
}

void print_addrs(n)
NODE *n;
{
    while (n) {
        if (n->tid == STRING)
	  fprintf(c, "&%s[0]", n->pid);
	else
	  fprintf(c, "&%s", n->pid);
	if (n->next) fprintf(c, ", ");
	n = n->next;
    }
}

void print_defs(proc, n)
char *proc;
NODE *n;
{
    while (n) {
        if (scheme)
	  fprintf(scm, "(define %s_%s)\n", proc, n->pid);
	else
	  fprintf(scm, "(defvar %s_%s nil)\n", proc, n->pid);	  
	n = n->next;
    }
}

void print_args(n)
NODE *n;
{
    while (n) {
	switch (n->tid) {
	  case INT:
	    fprintf(scm, "lisp:fixnum ");
	    break;
	  case FLOAT:
	    if (scheme)
	      fprintf(scm, "lisp:flonum ");
	    else
	      fprintf(scm, "lisp:single-float ");
	    break;
	  case STRING:
	    fprintf(scm, "lisp:string ");
	    break;
	}
	n = n->next;
    }
}

void print_sets(proc, n)
char *proc;
NODE *n;
{
    while (n) {
        if (n->tid == STRING)
	  if (scheme)
	    fprintf(scm, "  (set! %s_%s (string-get %s))\n",
		    proc, n->pid, n->pid);
	  else
	    fprintf(scm, " (setq %s_%s (string-get %s))\n",
		    proc, n->pid, n->pid);
	else
	  if (scheme)
	    fprintf(scm, "  (set! %s_%s %s)\n", proc, n->pid, n->pid);
	  else
	    fprintf(scm, "  (setq %s_%s %s)\n", proc, n->pid, n->pid);
	n = n->next;
    }
}
short yyexca[] ={
-1, 1,
	0, -1,
	-2, 0,
	};
# define YYNPROD 43
# define YYLAST 243
short yyact[]={

  35,  48,  61,  45,  33,  44,  35,  58,  53,  41,
  33,  40,  35,  39,  19,  12,  33,  11,  34,   6,
  25,  23,  24,  16,  34,  26,   9,  10,  27,  60,
  34,  38,  59,  37,  55,  17,  22,  13,  18,  57,
  21,  56,  54,  42,  51,  20,  14,  43,  36,  15,
   5,   4,   3,   2,   1,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,  49,   0,   0,   0,  47,  46,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  30,  28,  29,  31,  50,  32,  30,  28,  29,  31,
  52,  32,  30,  28,  29,  31,   0,  32,   0,   0,
   0,   7,   8 };
short yypact[]={

-1000, -16,-1000,-1000,-1000,-1000,-233, -31,-244,-246,
   2,-1000,-1000,-236,  -5,-1000,-247,-240, -28,-1000,
  -8, -13,-1000,-1000,-248,-250,-252,-1000,-1000,-1000,
-1000,-1000,-1000,-1000,-1000,-1000,-258,-1000,-240,-1000,
-1000,-1000, -40,-1000,-1000,-1000, -34,-1000,-1000,-1000,
-1000,-1000,-253,-1000,  -6,-254,  -9, -15,-1000,-1000,
-259,-1000 };
short yypgo[]={

   0,  54,  53,  52,  51,  50,  49,  38,  48,  47,
  46,  45,  44,  28,  43,  42,  41,  40,  36,  39 };
short yyr1[]={

   0,   1,   1,   2,   2,   2,   6,   3,   8,   4,
   9,   9,   9,  10,   5,   7,   7,  13,  13,  13,
  13,  13,  13,  13,  13,  14,  14,  14,  12,  15,
  12,  11,  11,  17,  17,  18,  18,  18,  18,  16,
  16,  19,  19 };
short yyr2[]={

   0,   0,   2,   1,   1,   1,   0,   5,   0,   7,
   0,   1,   1,   0,   8,   0,   2,   1,   1,   1,
   1,   1,   1,   1,   3,   0,   2,   2,   0,   0,
   6,   0,   1,   1,   3,   1,   2,   2,   2,   0,
   1,   1,   3 };
short yychk[]={

-1000,  -1,  -2,  -3,  -4,  -5,  35, 257, 258, 259,
  58, 261, 261,  35, -10,  -6, 259,  40,  -7, 261,
 -11, -17, -18, 261, 262, 260, 265, -13, 261, 262,
 260, 263, 265,  44,  58,  40,  -8,  41,  44, 261,
 261, 261, -14,  -9, 263, 261,  -7, -18,  41, -13,
 264, -12, 264, 261, -15,  40, -16, -19, 261,  41,
  44, 261 };
short yydef[]={

   1,  -2,   2,   3,   4,   5,   0,   0,   0,   0,
   0,  13,   6,   0,   0,  15,   0,  31,   7,   8,
   0,  32,  33,  35,   0,   0,   0,  16,  17,  18,
  19,  20,  21,  22,  23,  25,  10,  15,   0,  36,
  37,  38,   0,   9,  11,  12,  28,  34,  24,  26,
  27,  14,   0,  29,   0,  39,   0,  40,  41,  30,
   0,  42 };
#ifndef lint
static	char yaccpar_sccsid[] = "@(#)yaccpar 1.6 88/02/08 SMI"; /* from UCB 4.1 83/02/11 */
#endif

#
# define YYFLAG -1000
# define YYERROR goto yyerrlab
# define YYACCEPT return(0)
# define YYABORT return(1)

/*	parser for yacc output	*/

#ifdef YYDEBUG
int yydebug = 0; /* 1 for debugging */
#endif
YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */
int yychar = -1; /* current input token number */
int yynerrs = 0;  /* number of errors */
short yyerrflag = 0;  /* error recovery flag */

yyparse() {

	short yys[YYMAXDEPTH];
	short yyj, yym;
	register YYSTYPE *yypvt;
	register short yystate, *yyps, yyn;
	register YYSTYPE *yypv;
	register short *yyxi;

	yystate = 0;
	yychar = -1;
	yynerrs = 0;
	yyerrflag = 0;
	yyps= &yys[-1];
	yypv= &yyv[-1];

 yystack:    /* put a state and value onto the stack */

#ifdef YYDEBUG
	if( yydebug  ) printf( "state %d, char 0%o\n", yystate, yychar );
#endif
		if( ++yyps>= &yys[YYMAXDEPTH] ) { yyerror( "yacc stack overflow" ); return(1); }
		*yyps = yystate;
		++yypv;
		*yypv = yyval;

 yynewstate:

	yyn = yypact[yystate];

	if( yyn<= YYFLAG ) goto yydefault; /* simple state */

	if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0;
	if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault;

	if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */
		yychar = -1;
		yyval = yylval;
		yystate = yyn;
		if( yyerrflag > 0 ) --yyerrflag;
		goto yystack;
		}

 yydefault:
	/* default state action */

	if( (yyn=yydef[yystate]) == -2 ) {
		if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0;
		/* look through exception table */

		for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */

		while( *(yyxi+=2) >= 0 ){
			if( *yyxi == yychar ) break;
			}
		if( (yyn = yyxi[1]) < 0 ) return(0);   /* accept */
		}

	if( yyn == 0 ){ /* error */
		/* error ... attempt to resume parsing */

		switch( yyerrflag ){

		case 0:   /* brand new error */

			yyerror( "syntax error" );
		yyerrlab:
			++yynerrs;

		case 1:
		case 2: /* incompletely recovered error ... try again */

			yyerrflag = 3;

			/* find a state where "error" is a legal shift action */

			while ( yyps >= yys ) {
			   yyn = yypact[*yyps] + YYERRCODE;
			   if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){
			      yystate = yyact[yyn];  /* simulate a shift of "error" */
			      goto yystack;
			      }
			   yyn = yypact[*yyps];

			   /* the current yyps has no shift onn "error", pop stack */

#ifdef YYDEBUG
			   if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] );
#endif
			   --yyps;
			   --yypv;
			   }

			/* there is no state on the stack with an error shift ... abort */

	yyabort:
			return(1);


		case 3:  /* no shift yet; clobber input char */

#ifdef YYDEBUG
			if( yydebug ) printf( "error recovery discards char %d\n", yychar );
#endif

			if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */
			yychar = -1;
			goto yynewstate;   /* try again in the same state */

			}

		}

	/* reduction by production yyn */

#ifdef YYDEBUG
		if( yydebug ) printf("reduce %d\n",yyn);
#endif
		yyps -= yyr2[yyn];
		yypvt = yypv;
		yypv -= yyr2[yyn];
		yyval = yypv[1];
		yym=yyn;
			/* consult goto table to find next state */
		yyn = yyr1[yyn];
		yyj = yypgo[yyn] + *yyps + 1;
		if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]];
		switch(yym){
			
case 6:
# line 29 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
            fprintf(yyout, "%s", (char *)yypvt[-0]);
        } break;
case 8:
# line 37 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{ 
            fprintf(yyout, "%s", (char *)yypvt[-0]);
	    if (scheme)
	      fprintf(scm, "(define %s ", (char *)yypvt[-0]);
	    else
	      fprintf(scm, "(defvar %s ", (char *) yypvt[-0]);
        } break;
case 9:
# line 45 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(scm, "%s)\n", (char *)yypvt[-0]);
	} break;
case 11:
# line 52 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    yyval = (YYSTYPE)yypvt[-0];
	} break;
case 12:
# line 56 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
            fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)yypvt[-0];
        } break;
case 13:
# line 64 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "h_");
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
        } break;
case 14:
# line 71 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    if (yypvt[-0]) {		/* $8 = result */
		fprintf(c, "int c_%s(index)\nint index;\n{", (char *)yypvt[-6]);
		print_decs((NODE *)yypvt[-3], 0);
		fprintf(c, "int result;\n");
		fprintf(c, "result = h_%s(", (char *)yypvt[-6]);
		print_addrs((NODE *)yypvt[-3]);
		fprintf(c, ");\nlisp_call(index");
		if ((NODE *)yypvt[-3]) {
		    fprintf(c, ",");
		    print_actuals(c, (NODE *)yypvt[-3], ", ");
		}
		fprintf(c, ");\nreturn result;\n}\n");
		print_defs((char *)yypvt[-6], (NODE *)yypvt[-3]);
		fprintf(scm, "(ff:defforeign 'c_%s\n", (char *)yypvt[-6]);
		fprintf(scm, "  :arguments \'(lisp:fixnum)\n");
		fprintf(scm, "  :return-type :fixnum)\n");
		fprintf(scm, "(ff:defun-c-callable %s_scm (", (char *)yypvt[-6]);
		print_ids(scm, (NODE *)yypvt[-3], " ");
		fprintf(scm, ")\n");
		print_sets((char *)yypvt[-6], (NODE *)yypvt[-3]);
		fprintf(scm, ")\n");
		if (scheme)
		  fprintf(scm, "(define %s_scm_index\n", (char *)yypvt[-6]);
		else
		  fprintf(scm, "(defvar %s_scm_index\n", (char *)yypvt[-6]);
		fprintf(scm, "  (cadr (lisp:multiple-value-list\n    (ff:");
		fprintf(scm, "register-function \'%s_scm))))\n", (char *)yypvt[-6]);
		if (scheme)
		  fprintf(scm, "(define (%s)\n", (char *)yypvt[-6]);
		else
		  fprintf(scm, "(defun %s ()\n", (char *)yypvt[-6]);
		fprintf(scm, "  (not (= (c_%s %s_scm_index) 0)))\n",
			(char *)yypvt[-6], (char *)yypvt[-6]);
	      } else {
		  fprintf(c, "void %s(", (char *)yypvt[-6]);
		  print_ids(c, (NODE *)yypvt[-3], ", ");
		  fprintf(c, ")\n");
		  print_decs((NODE *)yypvt[-3], 1);
		  fprintf(c, "{ h_%s(", (char *)yypvt[-6]);
		  print_ids(c, (NODE *)yypvt[-3], ", ");
		  fprintf(c, "); }\n");
		  fprintf(scm, "(ff:defforeign \'");
		  fprintf(scm, "%s", (char *)yypvt[-6]);
		  fprintf(scm, "\n  :arguments \'(");
		  print_args((NODE *)yypvt[-3]);
		  fprintf(scm, ")\n  :return-type :void)\n");
	      }
	} break;
case 17:
# line 128 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
            fprintf(yyout, "%s", (char *)yypvt[-0]);
        } break;
case 28:
# line 141 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    yyval = (YYSTYPE)0;
	} break;
case 29:
# line 145 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	} break;
case 30:
# line 149 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    yyval = (YYSTYPE)1;
	} break;
case 31:
# line 155 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    yyval = (YYSTYPE)((NODE *)0);
	} break;
case 34:
# line 164 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    yyval = (YYSTYPE)add_node((NODE *)yypvt[-2], (NODE *)yypvt[-0]);
	} break;
case 35:
# line 171 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)create_node(INT, (char *)yypvt[-0]);
	} break;
case 36:
# line 176 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)create_node(INT, (char *)yypvt[-0]);
	} break;
case 37:
# line 181 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)create_node(FLOAT, (char *)yypvt[-0]);
	} break;
case 38:
# line 186 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)create_node(STRING, (char *)yypvt[-0]);
	} break;
case 39:
# line 193 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    yyval = (YYSTYPE)(NODE *)0;
	} break;
case 41:
# line 201 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)create_node(0, (char *)yypvt[-0]);
	} break;
case 42:
# line 206 "/hcil/u/graphics/news-tape/utilities/lps/gram.y"
{
	    fprintf(yyout, "%s", (char *)yypvt[-0]);
	    yyval = (YYSTYPE)add_node((NODE *)yypvt[-2],
				   create_node(0, (char *)yypvt[-0]));
	} break;
		}
		goto yystack;  /* stack new state and value */

	}