include <ctype.h>
include "syncalc.h"
include "libsynphot.h"

define	YYMAXDEPTH	64
define	YYOPLEN		1
define	yyparse		synparse

define	MAX_TOKEN	SZ_FNAME
define	BLANK		' '
define	VARCHAR		'$'

# Tokens generated by xyacc have been moved to syncalc.h

define	yyclearin	yychar = -1
define	yyerrok		yyerrflag = 0
define	YYMOVE		call amovi (Memi[$1], Memi[$2], YYOPLEN)
define	YYERRCODE	256

# line 112 "syncompile.y"


# SYNCOMPILE -- Compile an synphot expression into psedocode instructions

procedure syncompile (expr, pcode, maxcode)

char	expr[ARB]	# i: Expression to be parsed
int	pcode[ARB]	# o: Array of pseudocode instructions
int	maxcode		# i: Maximum length of pseudocode array
#--
include "syncompile.com"

bool	debug
int	len
pointer	sp, code, line, ch

data	debug	/ false /

int	strlen(), synparse()

extern	synlexer

begin
	# Allocate memory for temporary arrays

	len = strlen (expr)

	call smark (sp)
	call salloc (code, maxcode, TY_INT)
	call salloc (line, len, TY_CHAR)

	# Initialize parsing common block

	strict = true
	icode = code
	ncode = maxcode

	# Parse expression to produce pseudocode

	ch = line
	call strcpy (expr, Memc[line], len)

	if (synparse (ch, debug, synlexer) == ERR) {
	    call eprintf ("%s\n%*t^\n")
	    call pargstr (Memc[line])
	    call pargi (ch-line)

	    call error (SYN_ERR, "Syntax error in expression")
	}

	# Clean up and return pseudocode array

	call amovi (Memi[code], pcode, maxcode)
	call sfree (sp)

end

# SYNLEXER -- Lexical analysis of synphot expression

int procedure synlexer (ch, value)

pointer	ch		# u: Pointer to current char in expression
pointer	value		# i: Pointer to current token value
#--
include	"syncompile.com"

bool	digit
char	token[MAX_TOKEN]
int	functype[MAX_FUNC]
int	ic, nc, type, ftype
pointer	sp, tabname, colname
real	rval

string	loosestr  "(),"
string	strictstr "(),*+-"
string	loosefunc "band,cat,icat,spec,thru"
string	funcstr   FUNCNAMES

data	functype  / FN_BAND, FN_BB, FN_BOX, FN_CAT, FN_EBMV, 
		    FN_EBMVX, FN_EM, FN_GAUSS, FN_GRID, FN_HI, 
	            FN_ICAT, FN_LGAUSS, FN_PL, FN_POLY, FN_RN, 
		    FN_SPEC, FN_THRU, FN_TILT, FN_UNIT, FN_Z /

int	ctor(), stridx(), tbtacc(), word_match()

begin
	# Allocate memory for temporary strings

	call smark (sp)
	call salloc (tabname, SZ_FNAME, TY_CHAR)
	call salloc (colname, SZ_FNAME, TY_CHAR)

	# Skip over leading white space 

	while (Memc[ch] <= BLANK) {
	    if (Memc[ch] == EOS)
		break

	    ch = ch + 1
	}

	# Gather characters in token. Numbers are handled separately
	# because of their complicated syntax.

	digit = strict && (Memc[ch] == '.' || IS_DIGIT(Memc[ch]))

	if (digit) {
	    ic = 1
	    nc = ctor (Memc[ch], ic, rval)
	    nc = min (nc, MAX_TOKEN)

	    ic = nc
	    call strcpy (Memc[ch], token, nc)

	} else {
	    ic = 0

	    while (Memc[ch+ic] > BLANK) {
		if (strict) {
		    if (stridx (Memc[ch+ic], strictstr) > 0)
			break
		} else {
		    if (stridx (Memc[ch+ic], loosestr) > 0)
			break
		}

		if (ic == MAX_TOKEN)
		    break

		token[ic+1] = Memc[ch+ic]
		ic = ic + 1
	    }
	}

	# Token is a char in the stop set

	if (ic == 0) {
	    token[1] = Memc[ch]
	    ic = 1
	}
	token[ic+1] = EOS

	# One letter tokens are symbols (probably)

	type = 0
	Memi[value] = NULL

	if (ic == 1) {
	    switch (token[1]) {
	    case EOS:
		type = Y_DONE
	    case '(':
		type = Y_LPAR
	    case ')':
		type = Y_RPAR
	    case ',':
		type = Y_COMMA
	    case '+':
		type = Y_ADD
	    case '-':
		type = Y_SUB
	    case '*':
		type = Y_MUL
	    case '/':
		type = Y_DIV
	    }
	}

	# Multicharacter tokens are function names, filenames, 
	# strings, variables or numeric constants

	if (type == 0) {
	    if (digit) {
		type = Y_NUM

	    } else if (! strict) {
		type = Y_STR

	    } else {
		ftype = word_match (token, funcstr)
		call breakcomp (token, Memc[tabname], Memc[colname], SZ_FNAME)

		if (ftype > 0) {
		    Memi[value] = functype[ftype] 
		    strict = word_match (token, loosefunc) == 0
		    type = Y_FUNC

		} else if (tbtacc (Memc[tabname]) == YES) {
		    type = Y_FILE

		} else if (IS_ALPHA(token[1])){
		    type = Y_STR

		} else if (token[1] == VARCHAR) {
		    ic = 2
		    if (! IS_DIGIT(token[ic])) {
			Memi[value] = NULL
			type = Y_WRONG
		    } else {
			Memi[value] = TO_INTEG(token[ic])
			token[ic+1] = EOS
			type = Y_VAR
		    }

		} else {
		    type = Y_WRONG
		}
	    }
	
	    if (type != Y_FUNC && type != Y_VAR) {
		call malloc (Memi[value], ic, TY_CHAR)
		call strcpy (token, Memc[Memi[value]], ic)
	    }
	}

	ch = ch + ic
	call sfree (sp)

	return (type)
end

# SYNENCODE -- Add an instruction to the code array

procedure synencode (token)

int	token		# i: Instruction token
#--
include	"syncompile.com"

begin

	if (ncode == 0)
	    call error (SYN_ERR, "Expression too complex")
	else {
	    Memi[icode] = token
	    icode = icode + 1
	    ncode = ncode - 1
	}

end

# SYNCONST -- Add a constant to the code array

procedure synconst (const)

pointer	const		# i: Pointer to constant value
#--
include	"syncompile.com"

pointer	chr

begin
	chr = const - 1

	repeat {
	    chr = chr + 1

	    if (ncode == 0)
		call error (SYN_ERR, "Expression too complex")

	    Memi[icode] = Memc[chr]
	    icode = icode + 1
	    ncode = ncode - 1

	} until (Memc[chr] == EOS)

	call mfree (const, TY_CHAR)
end

define	YYNPROD		17
define	YYLAST		69
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.

# Parser for yacc output, translated to the IRAF SPP language.  The contents
# of this file form the bulk of the source of the parser produced by Yacc.
# Yacc recognizes several macros in the yaccpar input source and replaces
# them as follows:
#	A	user suppled "global" definitions and declarations
# 	B	parser tables
# 	C	user supplied actions (reductions)
# The remainder of the yaccpar code is not changed.

define	yystack_	10		# statement labels for gotos
define	yynewstate_	20
define	yydefault_	30
define	yyerrlab_	40
define	yyabort_	50

define	YYFLAG		(-1000)		# defs used in user actions
define	YYERROR		goto yyerrlab_
define	YYACCEPT	return (OK)
define	YYABORT		return (ERR)


# YYPARSE -- Parse the input stream, returning OK if the source is
# syntactically acceptable (i.e., if compilation is successful),
# otherwise ERR.  The parameters YYMAXDEPTH and YYOPLEN must be
# supplied by the caller in the %{ ... %} section of the Yacc source.
# The token value stack is a dynamically allocated array of operand
# structures, with the length and makeup of the operand structure being
# application dependent.

int procedure yyparse (fd, yydebug, yylex)

int	fd			# stream to be parsed
bool	yydebug			# print debugging information?
int	yylex()			# user-supplied lexical input function
extern	yylex()

short	yys[YYMAXDEPTH]		# parser stack -- stacks tokens
pointer	yyv			# pointer to token value stack
pointer	yyval			# value returned by action
pointer	yylval			# value of token
int	yyps			# token stack pointer
pointer	yypv			# value stack pointer
int	yychar			# current input token number
int	yyerrflag		# error recovery flag
int	yynerrs			# number of errors

short	yyj, yym		# internal variables
pointer	yysp, yypvt
short	yystate, yyn
int	yyxi, i
errchk	salloc, yylex


include "syncompile.com"

short	yyexca[6]
data	(yyexca(i),i=  1,  6)	/  -1,   1,   0,  -1,  -2,   0/
short	yyact[69]
data	(yyact(i),i=  1,  8)	/   3,  10,  13,  14,  11,  17,   4,   5/
data	(yyact(i),i=  9, 16)	/   6,   7,   8,  10,   9,  24,  11,  26/
data	(yyact(i),i= 17, 24)	/   4,   5,   6,   7,   8,   1,   9,  12/
data	(yyact(i),i= 25, 32)	/  15,  16,  13,  14,   0,  15,  16,  13/
data	(yyact(i),i= 33, 40)	/  14,  15,  16,  13,  14,  27,  28,   2/
data	(yyact(i),i= 41, 48)	/   0,   0,   0,   0,   0,   0,   0,   0/
data	(yyact(i),i= 49, 56)	/   0,  18,  19,   0,   0,  20,  21,  22/
data	(yyact(i),i= 57, 64)	/  23,  25,   0,   0,   0,   0,   0,   0/
data	(yyact(i),i= 65, 69)	/   0,   0,   0,   0,  29/
short	yypact[30]
data	(yypact(i),i=  1,  8)	/-256,-1000,-238,-1000,-1000,-1000,-1000,-1000/
data	(yypact(i),i=  9, 16)	/-252,-246,-246,-1000,-1000,-246,-246,-246/
data	(yypact(i),i= 17, 24)	/-246,-246,-1000,-243,-1000,-1000,-267,-267/
data	(yypact(i),i= 25, 30)	/-221,-234,-1000,-1000,-246,-234/
short	yypgo[4]
data	(yypgo(i),i=  1,  4)	/   0,  21,  39,  13/
short	yyr1[17]
data	(yyr1(i),i=  1,  8)	/   0,   1,   1,   2,   2,   2,   2,   2/
data	(yyr1(i),i=  9, 16)	/   2,   2,   2,   2,   2,   2,   2,   3/
data	(yyr1(i),i= 17, 17)	/   3/
short	yyr2[17]
data	(yyr2(i),i=  1,  8)	/   0,   2,   1,   1,   1,   1,   1,   4/
data	(yyr2(i),i=  9, 16)	/   2,   3,   3,   3,   3,   3,   1,   1/
data	(yyr2(i),i= 17, 17)	/   3/
short	yychk[30]
data	(yychk(i),i=  1,  8)	/-1000,  -1,  -2, 256, 262, 263, 264, 265/
data	(yychk(i),i=  9, 16)	/ 266, 268, 257, 260, 261, 269, 270, 267/
data	(yychk(i),i= 17, 24)	/ 268, 257,  -2,  -2,  -2,  -2,  -2,  -2/
data	(yychk(i),i= 25, 30)	/  -3,  -2, 258, 258, 259,  -2/
short	yydef[30]
data	(yydef(i),i=  1,  8)	/   0,  -2,   0,   2,   3,   4,   5,   6/
data	(yydef(i),i=  9, 16)	/   0,   0,   0,  14,   1,   0,   0,   0/
data	(yydef(i),i= 17, 24)	/   0,   0,   8,   0,   9,  10,  11,  12/
data	(yydef(i),i= 25, 30)	/   0,  15,  13,   7,   0,  16/

begin
	call smark (yysp)
	call salloc (yyv, (YYMAXDEPTH+2) * YYOPLEN, TY_STRUCT)

	# Initialization.  The first element of the dynamically allocated
	# token value stack (yyv) is used for yyval, the second for yylval,
	# and the actual stack starts with the third element.

	yystate = 0
	yychar = -1
	yynerrs = 0
	yyerrflag = 0
	yyps = 0
	yyval = yyv
	yylval = yyv + YYOPLEN
	yypv = yylval

yystack_
	# SHIFT -- Put a state and value onto the stack.  The token and
	# value stacks are logically the same stack, implemented as two
	# separate arrays.

	if (yydebug) {
	    call printf ("state %d, char 0%o\n")
		call pargs (yystate)
		call pargi (yychar)
	}
	yyps = yyps + 1
	yypv = yypv + YYOPLEN
	if (yyps > YYMAXDEPTH) {
	    call sfree (yysp)
	    call eprintf ("yacc stack overflow\n")
	    return (ERR)
	}
	yys[yyps] = yystate
	YYMOVE (yyval, yypv)

yynewstate_
	# Process the new state.
	yyn = yypact[yystate+1]

	if (yyn <= YYFLAG)
	    goto yydefault_			# simple state

	# The variable "yychar" is the lookahead token.
	if (yychar < 0) {
	    yychar = yylex (fd, yylval)
	    if (yychar < 0)
		yychar = 0
	}
	yyn = yyn + yychar
	if (yyn < 0 || yyn >= YYLAST)
	    goto yydefault_

	yyn = yyact[yyn+1]
	if (yychk[yyn+1] == yychar) {		# valid shift
	    yychar = -1
	    YYMOVE (yylval, yyval)
	    yystate = yyn
	    if (yyerrflag > 0)
		yyerrflag = yyerrflag - 1
	    goto yystack_
	}

yydefault_
	# Default state action.

	yyn = yydef[yystate+1]
	if (yyn == -2) {
	    if (yychar < 0) {
		yychar = yylex (fd, yylval)
		if (yychar < 0)
		    yychar = 0
	    }

	    # Look through exception table.
	    yyxi = 1
	    while ((yyexca[yyxi] != (-1)) || (yyexca[yyxi+1] != yystate))
		yyxi = yyxi + 2
	    for (yyxi=yyxi+2;  yyexca[yyxi] >= 0;  yyxi=yyxi+2) {
		if (yyexca[yyxi] == yychar)
		    break
	    }

	    yyn = yyexca[yyxi+1]
	    if (yyn < 0) {
		call sfree (yysp)
		return (OK)			# ACCEPT -- all done
	    }
	}


	# SYNTAX ERROR -- resume parsing if possible.

	if (yyn == 0) {
	    switch (yyerrflag) {
	    case 0, 1, 2:
		if (yyerrflag == 0) {		# brand new error
		    call eprintf ("syntax error\n")
yyerrlab_
		    yynerrs = yynerrs + 1
		    # fall through...
		}

	    # case 1:
	    # case 2: incompletely recovered error ... try again
		yyerrflag = 3

		# Find a state where "error" is a legal shift action.
		while (yyps >= 1) {
		    yyn = yypact[yys[yyps]+1] + YYERRCODE
		    if ((yyn >= 0) && (yyn < YYLAST) &&
			(yychk[yyact[yyn+1]+1] == YYERRCODE)) {
			    # Simulate a shift of "error".
			    yystate = yyact[yyn+1]
			    goto yystack_
		    }
		    yyn = yypact[yys[yyps]+1]

		    # The current yyps has no shift on "error", pop stack.
		    if (yydebug) {
			call printf ("error recovery pops state %d, ")
			    call pargs (yys[yyps])
			call printf ("uncovers %d\n")
			    call pargs (yys[yyps-1])
		    }
		    yyps = yyps - 1
		    yypv = yypv - YYOPLEN
		}

		# ABORT -- There is no state on the stack with an error shift.
yyabort_
		call sfree (yysp)
		return (ERR)


	    case 3: # No shift yet; clobber input char.

		if (yydebug) {
		    call printf ("error recovery discards char %d\n")
			call pargi (yychar)
		}

		if (yychar == 0)
		    goto yyabort_		# don't discard EOF, quit
		yychar = -1
		goto yynewstate_		# try again in the same state
	    }
	}


	# REDUCE -- Reduction by production yyn.

	if (yydebug) {
	    call printf ("reduce %d\n")
		call pargs (yyn)
	}
	yyps  = yyps - yyr2[yyn+1]
	yypvt = yypv
	yypv  = yypv - yyr2[yyn+1] * YYOPLEN
	YYMOVE (yypv + YYOPLEN, yyval)
	yym   = yyn

	# Consult goto table to find next state.
	yyn = yyr1[yyn+1]
	yyj = yypgo[yyn+1] + yys[yyps] + 1
	if (yyj >= YYLAST)
	    yystate = yyact[yypgo[yyn+1]+1]
	else {
	    yystate = yyact[yyj+1]
	    if (yychk[yystate+1] != -yyn)
		yystate = yyact[yypgo[yyn+1]+1]
	}

	# Perform action associated with the grammar rule, if any.
	switch (yym) {
	    
case 1:
# line 32 "syncompile.y"
{
			# Normal exit. Code a stop instruction
			call synencode (Y_DONE)
			return (OK)
		}
case 2:
# line 37 "syncompile.y"
{
			# Parser error
			return (ERR)
		}
case 3:
# line 43 "syncompile.y"
{
			# Code a push string instruction
			call synencode (Y_STR)
			call synconst (Memi[yypvt])
		}
case 4:
# line 48 "syncompile.y"
{
			# Code a push file instruction
			call synencode (Y_FILE)
			call synconst (Memi[yypvt])
		}
case 5:
# line 53 "syncompile.y"
{
			# Code a push number instruction
			call synencode (Y_NUM)
			call synconst (Memi[yypvt])
		}
case 6:
# line 58 "syncompile.y"
{
			# Code a push variable instruction
			call synencode (Y_VAR)
			call synencode (Memi[yypvt])
		}
case 7:
# line 63 "syncompile.y"
{
	    		# Code a function call instruction
			call synencode (Y_FUNC)
			call synencode (Memi[yypvt-3*YYOPLEN])
			call synencode (Memi[yypvt-YYOPLEN])
			strict = true
		}
case 8:
# line 70 "syncompile.y"
{
			# Code a negation instruction
			call synencode (Y_NEG)
		}
case 9:
# line 74 "syncompile.y"
{
			# Code a multiplication instruction
			call synencode (Y_MUL)
		}
case 10:
# line 78 "syncompile.y"
{
			# Code a division instruction
			call synencode (Y_DIV)
		}
case 11:
# line 82 "syncompile.y"
{
			# Code an add instruction
			call synencode (Y_ADD)
		}
case 12:
# line 86 "syncompile.y"
{
			# Code a subtraction instruction
			call synencode (Y_SUB)
		}
case 13:
# line 90 "syncompile.y"
{
			# No action for parenthesized expressions
		}
case 14:
# line 93 "syncompile.y"
{
			# Lexical error
	    		call eprintf ("Unrecognized token (%s)\n")
			call pargstr (Memc[Memi[yypvt]])
			call mfree (Memi[yypvt], TY_CHAR)
			return (ERR)
		}
case 15:
# line 102 "syncompile.y"
{
			# Initialize count of number of arguments
			Memi[yyval] = 1
		}
case 16:
# line 106 "syncompile.y"
{
			# Increment count of number of arguments
			Memi[yyval] = Memi[yypvt-2*YYOPLEN] + 1
		}	}

	goto yystack_				# stack new state and value
end