/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* File: tabutil.c */
/* Author: Andy Lowry */
/* SCCS Info: @(#)tabutil.c	1.3 3/13/90 */

/* The following routines act on a parsed checking table entries by */
/* generating Hermes source code to produce corresponding entries in a */
/* checing_table object */


#include "gentab.h"
#include <stdio.h>

/* Initial code required before any operations are installed */
void
init_checking_table()
{
  printf("gentab:\n");
  printf("  using (main, common, checking_table, type_inference, ");
  printf("typestate_inference)\n");
  printf("process (Q: main_Q)\n");
  printf("declare\n");
  printf("  args: main_intf;\n");
  printf("  chTab: checking_table;\n");
  printf("  chRec: checking_record;\n");
  printf("  infRec: type_inference_entry;\n");
  printf("  asgnRec: type_assignment_rule;\n");
  printf("  classRec: type_class_entry;\n");
  printf("  preRule: precondition_Rule;\n");
  printf("  postRule: postcondition;\n");
  printf("  regularPost: regularPostconditionInfo;\n");
  printf("  postRuleElem: postconditionRuleElement;\n");
  printf("  empty: empty;\n");
  printf("  poly: polymorph;\n");
  printf("begin\n");
  printf("  receive args from Q;\n");
  printf("  new chTab;\n");
}

void
add_operation(opname, operands, selectpos, qualname, typerules,
	      tsrules, exceptions)
char *opname, *qualname;
stringlist *operands;
int selectpos;
typerule *typerules;
typestaterules *tsrules;
stringlist *exceptions;
{
  void gen_typerules(), gen_tsrules(), gen_exceptions();
  int stringlist_size();
  int noperand;

  if (getenv("DEBUGGENTAB") != nil)
    fprintf(stderr,"Adding statement: %s\n", opname);
  printf("  new chRec;\n");
  printf("  new chRec.type_assignment_rules;\n");
  printf("  new chRec.type_inference_rules;\n");
  printf("  new chRec.type_class_rules;\n");
  printf("  new chRec.precondition_rules;\n");
  printf("  chRec.operator <- predefined!operator#'%s';\n", opname);
  if (operands == &variable_operands)
    noperand = 0;
  else
    noperand = stringlist_size(operands);
  if (noperand == 0)
    printf("  unite chRec.operand_count.empty from empty;\n");
  else
    printf("  unite chRec.operand_count.value from integer#%d;\n", noperand);
  printf("  chRec.qualifier <- qualifier_types#'%s';\n", qualname);
  if (selectpos == -1)
    printf("  unite chRec.qualifier_info.normal from empty;\n");
  else
    printf("  unite chRec.qualifier_info.selector from integer#%d;\n",
	   selectpos);
  gen_typerules(typerules);
  gen_tsrules(tsrules);
  /* currently, checking_table.d doesn't allow exceptions in special */
  /* rules... this should be changed, and typestate checker should be */
  /* reworked to use the exceptions list for special rules. */
  /* We put them in checking_table now so they can go into the manual */
  /* appendix. */
  if (tsrules->type == NORMAL)
    gen_exceptions(exceptions);
  printf("  insert chRec into chTab;\n");
}

void
done_checking_table()
{
  printf("  wrap chTab as poly;\n");
  printf("  call args.std.writeObj");
  printf("(charstring#\"checking_table.ho\", poly);\n");
  printf("  return args;\n");
  printf("end process\n");
}

static void
gen_typerules(rules)
typerule *rules;
{
  void gen_inf_rule(), gen_asgn_rule(), gen_fam_rule();

  while (rules != nil) {
    switch (rules->type) {
    case INFERENCE:
      gen_inf_rule(&rules->rule.inf);
      break;
    case ASSIGNMENT:
      gen_asgn_rule(&rules->rule.asgn);
      break;
    case FAMILY:
      gen_fam_rule(&rules->rule.fam);
      break;
    }
    rules = rules->next;
  }  
}

static void
gen_inf_rule(rule)
inferencerule *rule;
{
  printf("  new infRec;\n");
  printf("  infRec.result <- integer#%d;\n", rule->target);
  printf("  infRec.function <- type_inference_function#'%s';\n", rule->func);
  printf("  infRec.argument <- integer#%d;\n", rule->source);
  printf("  insert infRec into chRec.type_inference_rules;\n");
}

static void
gen_asgn_rule(rule)
assignmentrule *rule;
{
  printf("  new asgnRec;\n");
  printf("  asgnRec.result <- integer#%d;\n", rule->target);
  printf("  asgnRec.function <- type_assignment_function#'%s';\n", rule->func);
  printf("  insert asgnRec into chRec.type_assignment_rules;\n");
}

static void
gen_fam_rule(rule)
familyrule *rule;
{
  printf("  new classRec;\n");
  printf("  classRec.argument <- integer#%d;\n", rule->target);
  printf("  classRec.function <- type_class_function#'%s';\n", rule->family);
  printf("  insert classRec into chRec.type_class_rules;\n");
}


static void
gen_tsrules(rules)
typestaterules *rules;
{
  void gen_preconditions(), gen_post_normal(), gen_post_special();

  gen_preconditions(rules->preconditions);
  switch(rules->type) {
  case NORMAL:
    gen_post_normal(rules->post.postconditions);
    break;
  case SPECIAL:
    gen_post_special(rules->post.special);
    break;
  }
}


static void
gen_preconditions(rules)
tsrule *rules;
{
  intlist *operands;

  while (rules != nil) {
    printf("  new preRule;\n");
    printf("  preRule.precondition_function <- ");
    printf("precondition_function_name#'%s';\n", rules->func);
    printf("  new preRule.affected_operands;\n");
    for (operands = rules->operands; operands != nil; 
	 operands = operands->next)
      printf("  insert integer#%d into preRule.affected_operands;\n",
	     operands->value);
    printf("  insert preRule into chRec.precondition_rules;\n");

    rules = rules->next;
  }
}

static void
gen_post_normal(postconditions)
tsrule *postconditions;
{
  void gen_postconditions();

  printf("  new regularPost;\n");
  printf("  new regularPost.rule;\n");
  printf("  new regularPost.exceptions;\n");
  gen_postconditions(postconditions);
  printf("  unite chRec.postcondition_rules.regularRule from regularPost;\n");
}


static void
gen_postconditions(rules)
tsrule *rules;
{
  intlist *operands;

  while (rules != nil) {
    printf("  new postRuleElem;\n");
    printf("  postRuleElem.postconditionFunction <- ");
    printf("postconditionFunctionName#'%s';\n", rules->func);
    printf("  new postRuleElem.affectedOperands;\n");
    for (operands = rules->operands; operands != nil; 
	 operands = operands->next)
      printf("  insert integer#%d into postRuleElem.affectedOperands;\n",
	     operands->value);
    printf("  insert postRuleElem into regularPost.rule;\n");

    rules = rules->next;
  }
}


static void
gen_exceptions(names)
stringlist *names;
{
  while (names != nil) {
    printf("  insert builtin_exception#'%s' into ",
	   names->value);
    printf("chRec.postcondition_rules.regularRule.exceptions;\n");
    names = names->next;
  }
}

static void
gen_post_special(name)
char *name;
{
  if (strcmp(name, "call") == 0)
    printf("  unite chRec.postcondition_rules.Call from empty;\n");
  else if (strcmp(name,"exit") == 0)
    printf("  unite chRec.postcondition_rules.exit from empty;\n");
  else if (strcmp(name, "compound") == 0)
    printf("  unite chRec.postcondition_rules.compound from empty;\n");
  else {
    fprintf(stderr, "Unknown 'special' postcondition: %s", name);
    exit(1);
  }
}


static int
stringlist_size(strings)
stringlist *strings;
{
  int count;

  count = 0;
  while (strings != nil) {
    count++;
    strings = strings->next;
  }
  return(count);
}
