%{
#include "wisebase.h"
#include "wisec.h"
#include "exprtree.h"
#include "y.tab.h"
#include "method.h"

#include "input.h"
#include "dpimpl.h"

#define ScopeLISTLENGTH 16

typedef unsigned int ParseError;

enum ParseErrorType {
  PERR_SYNTAX = 1,
  PERR_COMPLEXMETHOD = 2,
  PERR_ARG_NUM_MIS = 4,
  PERR_ARG_UNTYPED = 8,
  PERR_ARG_MISTYPE = 16,
  PERR_OUT_OF_SCOPE = 32,
  PERR_METHOD_SCOPE = 64
};

enum SCOPE_TYPE {
	SCOPE_RESOURCE = 82,
	SCOPE_QUERY,
	SCOPE_TARGET,
	SCOPE_EXTERN };

/*** declare yyparse ****/

void yyparse(void);

%}



struct ScopeUnit
char * name
char * app
char * type
boolean isglobbed !def="FALSE"
int scope_type !def="SCOPE_EXTERN"
char * no_accept // for guys which don't like other arguments

struct Scope
ScopeUnit ** su; !list


%{
#include "type.h"

 char * calc_lex_string;
 int stringpos =0;
 ExprTree * root = NULL;




%func
copies MethodTypeSet by hard-linking list
members

%%
MethodTypeSet * copy_MethodTypeSet(MethodTypeSet * mts)
{
  int i;
  MethodTypeSet * out;

  out = MethodTypeSet_alloc_std();

  for(i=0;i<mts->me_len;i++) 
    add_me_MethodTypeSet(out,hard_link_Method(mts->me[i]));

  for(i=0;i<mts->ty_len;i++) 
    add_ty_MethodTypeSet(out,hard_link_Type(mts->ty[i]));
  
  return out;
}
			 

%func
sets up "standard" dynamite scope.

%%
Scope * std_Dynamite_Scope(void)
{
  Scope * sc;

  sc = Scope_alloc_std();

  /*** std set up code has moved to dyna2.dy ***/
  return sc;
}


%func
Main function used to access the parser.

This parses the calc_line (without damaging it). Errors will
be placed normally: You should stack errors or catch them if
you want to do something funky. 

At the end of the day, if there was parser syntax error then you
will get NULL, and pe & PERR_SYNTAX will be set. Otherwise you
will get a char * (stringalloc'd). Potentially any number of
PERRs could be set, including unscoped variables or methods etc.
%arg
calc_line r line to be parsed
sc  r scope system to use for this area
mts r method and type information (method scope) for this area
pe w returned parser errors
return stringalloc'd expanded string
%%
char * allocd_calc_line(char * calc_line,Scope * sc,MethodTypeSet * mts,DycWarning * dycw,ParseError * pe,ExprTree ** expr)
{
  char buffer[MAXLINE]; /** ouch - watch overflows **/

  /*** set globals that we share with lex/yacc ***/

  if( calc_line == NULL ) {
    warn("Got a NULL calc line - can hardly parse it!");
    return NULL;
  }

  calc_lex_string = calc_line;
  stringpos= 0;
  root = NULL;

  /*** parse it ***/

  yyparse();

  /*** check root, if NULL... otta here ***/

  if( root == NULL ) {
    /* silent fail. already been warned */
    (*pe) |= PERR_SYNTAX;
    return NULL;
  }


  /*** make top-level name which could be ***/

  find_toplevel_name(root);

  /*** make string, checking semantics this time ***/

  buffer[0]='\0';

  (*pe) |= strcat_ExprTree_Scoped(root,buffer,sc,mts,dycw,NULL,NULL);

  if( expr != NULL ) {
    *expr = root;
  } else {
    /* should free... don't at the moment */
  }

  return stringalloc(buffer);
}

void complain_ParseError_to_file(ParseError pe,FILE * ofp)
{
  if( pe & PERR_SYNTAX ) 
    fprintf(ofp,"Parser Syntax error on calc line\n");
  if( pe & PERR_COMPLEXMETHOD)
    fprintf(ofp,"Complex methods (ie, pointer-functions) which cannot be typed\n");
  if( pe & PERR_ARG_NUM_MIS ) 
    fprintf(ofp,"Argument number mismatches\n");
  if( pe & PERR_ARG_UNTYPED )
    fprintf(ofp,"Un-typable arguments, due to array or structure deferences\n");
  if( pe & PERR_ARG_MISTYPE ) 
    fprintf(ofp,"Mistyped arguments\n");
  if( pe & PERR_OUT_OF_SCOPE) 
    fprintf(ofp,"Variable out of scope\n");
  if( pe & PERR_METHOD_SCOPE)
    fprintf(ofp,"Method out of scope\n");
}


char * type_from_ExprTree(ExprTree * et,Scope * sc,MethodTypeSet * mts)
{
  ScopeUnit * su;
  Method * me;

  switch( et->type ) {
  case ETR_EXPRESSION :
    /*** for the moment, return NULL... could return "int" quite ok.. ***/
    return NULL;
  case ETR_NAME :
    su = ScopeUnit_from_Scope(sc,et->word);
    if( su == NULL ) {
      return NULL;
    } else {
      return su->type;
    }
    break;
  case ETR_TAG :
    if( et->nochild == 1 && et->child[0]->type == ETR_NAME) {
      return type_from_ExprTree(et->child[0],sc,mts);
    }
    return NULL;
    break;
  case ETR_METHOD :
    if( et->child[0]->nochild != 1 || et->child[0]->child[0]->type != ETR_NAME ) {
      return NULL;
    }

    me = Method_from_name(mts,et->child[0]->child[0]->word);
    if( me == NULL) {
      return NULL;
    } else {
      return me->retstr;
    }
    break;
  case ETR_STRUCTREF :
  case ETR_REFERENCE :
    return NULL;
  default :
    warn("Unable to type a Expr Node [%d]. Returing a 'blank' type",et->type);
    return NULL;
  }

}

%func
Main internal recursive functions that
descends the Expr tree. Should at the
start be given the root node: buffer
is written in the final expression, mapped
etc. 
%type internal
%%
ParseError strcat_ExprTree_Scoped(ExprTree * ExprTree,char * buffer,Scope * sc,MethodTypeSet * mts,DycWarning * dycw,boolean (*finish_parsing)(struct ExprTree *,char *,void *),void * data)
{
  ParseError pe = 0; 
  ScopeUnit * su;
  Method * me;
  char tempbuf[512];
  int i;


  if( finish_parsing != NULL ) {
    if( (*finish_parsing)(ExprTree,buffer,data) == TRUE ) {
      return pe;
    }
  }

  switch(ExprTree->type) {
  case ETR_NUMBER : strcat(buffer,ExprTree->word); 
        break;

  case ETR_OPERATOR : strcat(buffer,ExprTree->word); 
    break;

  case ETR_EXPRESSION : strcat(buffer,"(");
    for(i=0;i< ExprTree->nochild;i++)
      pe |= strcat_ExprTree_Scoped(ExprTree->child[i],buffer,sc,mts,dycw,finish_parsing,data);
    strcat(buffer,")");
    break;
  case ETR_STATEMENT :
    for(i=0;i< ExprTree->nochild;i++)
      pe |= strcat_ExprTree_Scoped(ExprTree->child[i],buffer,sc,mts,dycw,finish_parsing,data);
    break;
  case ETR_NAME : 
    if( (ExprTree->attrib & IS_TOPLEVEL) == IS_TOPLEVEL) {
      /* fprintf(stderr,"Got a top level name %s\n",ExprTree->word);*/
      su = ScopeUnit_from_Scope(sc,ExprTree->word);
      if( su == NULL ) {
	pe |= PERR_OUT_OF_SCOPE;
	if( dycw == NULL || dycw->warn_extern == TRUE )
	  warn("Name [%s] is out of scope: assuming extern",ExprTree->word);
      } else {
	/*	fprintf(stderr,"Ok.[%d] for name %s, going to add %s\n",ExprTree->attrib,ExprTree->word,su->app);*/
	strcat(buffer,su->app);
      }
    }
    strcat(buffer,ExprTree->word);
    break;
  case ETR_ARRAY : 
    pe |= strcat_ExprTree_Scoped(ExprTree->child[0],buffer,sc,mts,dycw,finish_parsing,data);
    strcat(buffer,"[");
    pe |= strcat_ExprTree_Scoped(ExprTree->child[1],buffer,sc,mts,dycw,finish_parsing,data);
    strcat(buffer,"]");
    break;
  case ETR_TAG : 
    for(i=0;i< ExprTree->nochild;i++)
      pe |= strcat_ExprTree_Scoped(ExprTree->child[i],buffer,sc,mts,dycw,finish_parsing,data);
    break;
  case ETR_STRUCTREF :
    pe |= strcat_ExprTree_Scoped(ExprTree->child[0],buffer,sc,mts,dycw,finish_parsing,data);
    strcat(buffer,ExprTree->child[1]->word);
    pe |= strcat_ExprTree_Scoped(ExprTree->child[2],buffer,sc,mts,dycw,finish_parsing,data);
    break;
  case ETR_REFERENCE :
    strcat(buffer,ExprTree->child[0]->word);
    pe |= strcat_ExprTree_Scoped(ExprTree->child[1],buffer,sc,mts,dycw,finish_parsing,data);
    break;
  case ETR_METHOD :
    
    if( ExprTree->child[0]->nochild != 1 || ExprTree->child[0]->child[0]->type != ETR_NAME ) {
      pe |= PERR_COMPLEXMETHOD;
      
      /*** generate error ***/
      tempbuf[0]='\0';
      strcat_ExprTree(ExprTree->child[0],tempbuf);
      warn("Method [%s] is not a pure name [%d]: this tolerated in the parser but can't be checked",tempbuf,ExprTree->child[0]->type);
      pe |= strcat_ExprTree_Scoped(ExprTree->child[0],buffer,sc,mts,dycw,finish_parsing,data);

      
    } else {
      me = Method_from_name(mts,ExprTree->child[0]->child[0]->word);
      if( me == NULL ) {
	pe |= PERR_METHOD_SCOPE;
	if( dycw == NULL || dycw->warn_extern_method == TRUE )
	  warn("Implied method [%s] has not been typed, and hence can't be type-checked or logical-mapped",ExprTree->child[0]->child[0]->word);
	pe |= strcat_ExprTree_Scoped(ExprTree->child[0],buffer,sc,mts,dycw,finish_parsing,data);
      } else { 
	pe |= typecheck_method(ExprTree->child[1],me,sc,mts);
	strcat(buffer,me->real);
	/* do nothing at the moment */
      }
    }

    strcat(buffer,"(");
    pe |= strcat_ExprTree_Scoped(ExprTree->child[1],buffer,sc,mts,dycw,finish_parsing,data);
    strcat(buffer,")");

    break;
  case ETR_COMMALIST :
    for(i=0;i<ExprTree->nochild;i++) {
      pe |= strcat_ExprTree_Scoped(ExprTree->child[i],buffer,sc,mts,dycw,finish_parsing,data);
      if( i != ExprTree->nochild-1)
	strcat(buffer,",");
    }
    break;

  default :
    pe |= PERR_SYNTAX;
      warn("In trying to make Expr string, got unobtainable type!");
  }

  return pe;
}

ParseError typecheck_method(ExprTree * et,Method * me,Scope * sc,MethodTypeSet * mts)
{
  int i;
  char * t;
  int ret = 0;
  int j;
  ScopeUnit * sunit = NULL;

  if( et->type != ETR_COMMALIST ) {
    warn("Trying to typecheck with a non-comma list system %d --- internal parser error and v.bad",et->type);
  }

  if( me->len != et->nochild ) {
    ret |= PERR_ARG_NUM_MIS;
    warn("In method [%s], expect %d arguments, given %d arguments",me->logical,me->len,et->nochild);
    return ret;
  }

  for(i=0;i<me->len;i++) {
    t = type_from_ExprTree(et->child[i],sc,mts);
    if( t == NULL ) {
      ret |= PERR_ARG_UNTYPED; 
      /* warn("For argument %d, of %s, no type information",i,me->logical); */
    } else {
      if ( compare_type(t,me->ma[i]->type) == FALSE ) {
	warn("Mis-type in argument %d of %s: wanted [%s] got [%s]",i+1,me->logical,me->ma[i]->type,t);
	ret |= PERR_ARG_MISTYPE;
      }
    }
  }

  /** do forbidden pairs if appropiate **/

  for(i=0;i<me->len;i++) {
    auto char * test_argument;
    if( et->child[i]->type == ETR_NAME ) {
      test_argument = et->child[i]->word;
      if( (sunit = ScopeUnit_from_Scope(sc,et->child[i]->word)) == NULL ) 
	continue; /** ugh - unscoped **/
    } else if ( et->child[i]->type == ETR_TAG && et->child[i]->nochild == 1 && et->child[i]->child[0]->type == ETR_NAME ) {
      test_argument = et->child[i]->child[0]->word;
      if( (sunit = ScopeUnit_from_Scope(sc,et->child[i]->child[0]->word)) == NULL ) 
	continue; /** ugh - unscoped **/
    }
    if( sunit == NULL ) {
      continue;
    }

    /** we have scope. Continue if it has no forbiddens **/
    if( sunit->no_accept == NULL )
      continue;

    for(j=i+1;j<me->len;j++) {
      auto char * word;
      word = NULL;
      if( et->child[j]->type == ETR_NAME ) {
	word = et->child[j]->word;

      } else if ( et->child[i]->type == ETR_TAG && et->child[i]->nochild == 1 && et->child[i]->child[0]->type == ETR_NAME ) {
	word = et->child[j]->child[0]->word;
      }
      
      if( word != NULL && strcmp(word,sunit->no_accept) == 0 && 0) 
	warn("For function %s, you have arguments %s and %s, which do not expect to paired directly in a function. This is just a warning that you can ignore",me->logical,word,test_argument);
    }
  }

  /*** end of forbidden pairs code ***/
      


  return ret;
}


%func
gets a ScopeUnit from the name
%type internal
%%
ScopeUnit * ScopeUnit_from_Scope(Scope * sc,char * word)
{
  int i;

  for(i=0;i<sc->len;i++) {
    if( sc->su[i]->isglobbed == TRUE) {
      /*** hacky ***/
      if( strstartcmp(word,sc->su[i]->name) == 0 ) {
	return sc->su[i];
      }
    } else {
      if( strcmp(sc->su[i]->name,word) == 0 )
	return sc->su[i];
    }
  }

  return NULL;
}

ScopeUnit * ScopeUnit_from_nat(MethodTypeSet * mts,char * name,char * app,char * type)
{
  ScopeUnit * su;

  su = ScopeUnit_alloc();

  if( name[strlen(name)-1] == '*') {
    name[strlen(name)-1] = '\0';
    su->isglobbed = TRUE;
  }

  su->name = stringalloc(name);
  su->app = stringalloc(app);
  su->type = stringalloc(type);

  return su;
}


%}