static OBJECT load(FULL_CHAR *xstr, unsigned xpre,
BOOLEAN xleft, BOOLEAN xright, BOOLEAN xindef, unsigned char xprec)
{ OBJECT s;
  s = InsertSym(xstr, LOCAL, no_fpos, xprec, xindef, FALSE, xpre,
	StartSym, nilobj);
  if( xleft )  InsertSym( AsciiToFull("pa"), LPAR, no_fpos, DEFAULT_PREC,
    FALSE, FALSE, 0, s, nilobj);
  if( xright )  InsertSym( AsciiToFull("pb"), RPAR, no_fpos, DEFAULT_PREC,
    FALSE, FALSE, 0, s, nilobj);
  if( xleft && xright && xpre != PLUS && xpre != MINUS )
    right_assoc(s) = TRUE;
  return s;
} /* end load */
Пример #2
0
static OBJECT ReadMacro(OBJECT *token, OBJECT curr_encl, OBJECT encl)
{ OBJECT t, res;

  /* find macro name and insert into symbol table */
  SuppressScope();
  Dispose(*token);  t = LexGetToken();
  if( !is_word(type(t)) )
  { Error(5, 24, "%s ignored (name is missing)", WARN, &fpos(t), KW_MACRO);
    debug1(ANY, D, "offending type is %s", Image(type(t)));
    UnSuppressScope();
    *token = t;
    return nilobj;
  }
  res = InsertSym(string(t), MACRO, &fpos(t), 0, FALSE,TRUE,0,curr_encl,nilobj);
  if( curr_encl != encl )  visible(res) = TRUE;
  UnSuppressScope();

  /* find alternative names for this symbol */
  Dispose(t);  t = LexGetToken();
  while( is_word(type(t)) )
  {
    InsertAlternativeName(string(t), res, &fpos(t));
    Dispose(t);  t = LexGetToken();
  }

  /* find opening left brace */
  if( type(t) != LBR )
  { Error(5, 25, "%s ignored (opening %s is missing)",
      WARN, &fpos(t), KW_MACRO, KW_LBR);
    *token = t;
    return nilobj;
  }
  
  /* read macro body */
  ReadTokenList(t, res);
  Dispose(t);

  /* clean up (kill final RBR, dispose macro name) and exit */
  t = pred(sym_body(res), PARENT);
  sym_body(res) = Delete(t, PARENT);
  Dispose(t);
  recursive(res) = FALSE;
  *token = nilobj;
  return res;
} /* end ReadMacro */
Пример #3
0
void ReadDefinitions(OBJECT *token, OBJECT encl, unsigned char res_type)
{ OBJECT t, res, res_target, export_list, import_list, link, y, z;
  OBJECT curr_encl;  BOOLEAN compulsory_par, has_import_encl;
  t = *token;

  while( res_type==LOCAL || is_string(t, KW_NAMED) || is_string(t, KW_IMPORT) )
  {
    curr_encl = encl;

    if( is_string(t, KW_LANGDEF) )
    { ReadLangDef(encl);
      t = LexGetToken();
      continue;  /* next definition */
    }
    else if( type(t) == PREPEND || type(t) == SYS_PREPEND )
    { ReadPrependDef(type(t), encl);
      Dispose(t);
      t = LexGetToken();
      continue;  /* next definition */
    }
    else if( type(t) == INCG_REPEATED || type(t) == SINCG_REPEATED )
    { ReadIncGRepeatedDef(type(t), encl);
      Dispose(t);
      t = LexGetToken();
      continue;  /* next definition */
    }
    else if( type(t) == DATABASE || type(t) == SYS_DATABASE )
    { ReadDatabaseDef(type(t), encl);
      Dispose(t);
      t = LexGetToken();
      continue;  /* next definition */
    }

    if( !is_string(t, KW_DEF)    && !is_string(t, KW_MACRO)  &&
	!is_string(t, KW_NAMED)  && !is_string(t, KW_IMPORT) &&
        !is_string(t, KW_EXTEND) && !is_string(t, KW_EXPORT) )
      break;

    /* get import or extend list and change scope appropriately */
    BodyParNotAllowed();
    New(import_list, ACAT);
    has_import_encl = FALSE;
    if( is_string(t, KW_IMPORT) )
    { Dispose(t);
      t = LexGetToken();
      while( type(t) == CLOSURE ||
	       (type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF)
	       && !is_string(t, KW_MACRO) && !is_string(t, KW_NAMED)) )
      {	if( type(t) == CLOSURE )
	{ if( type(actual(t)) == LOCAL )
	  {
	    /* *** letting this through now
	    if( res_type == NPAR && has_par(actual(t)) )
	    {
	      Error(5, 46, "named parameter import %s has parameters",
		WARN, &fpos(t), SymName(actual(t)));
	    }
	    else
	    {
	    *** */
	      PushScope(actual(t), FALSE, TRUE);
	      if( actual(t) == encl )  has_import_encl = TRUE;
	      Link(import_list, t);
	    /* ***
	    }
	    *** */
	  }
	  else
	  { Error(5, 26, "import name expected here", WARN, &fpos(t));
	    Dispose(t);
	  }
	}
	else
	{ Error(5, 27, "import %s not in scope", WARN, &fpos(t), string(t));
	  Dispose(t);
	}
	t = LexGetToken();
      }
    }
    else if( is_string(t, KW_EXTEND) )
    { Dispose(t);
      t = LexGetToken();
      while( type(t) == CLOSURE ||
	       (type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF)
	       && !is_string(t, KW_MACRO)) )
      {	if( type(t) == CLOSURE )
	{ if( imports(actual(t)) != nilobj )
	  { Error(5, 48, "%s has %s clause, so cannot be extended",
	      WARN, &fpos(t), SymName(actual(t)), KW_IMPORT);
	  }
	  else if( type(actual(t)) == LOCAL )
	  { PushScope(actual(t), FALSE, FALSE);
	    curr_encl = actual(t);
            debug1(DRD, D, "  curr_encl = %s", SymName(curr_encl));
	    Link(import_list, t);
	  }
	  else
	  { Error(5, 28, "%s symbol name expected here",
	      WARN, &fpos(t), KW_EXTEND);
	    Dispose(t);
	  }
	}
	else
	{ Error(5, 29, "extend symbol %s not in scope", WARN,&fpos(t),string(t));
	  Dispose(t);
	}
	t = LexGetToken();
      }
    }

    /* get export list and store for setting visible flags below */
    New(export_list, ACAT);
    if( is_string(t, KW_EXPORT) )
    { Dispose(t);
      SuppressScope();
      t = LexGetToken();
      while( is_word(type(t)) && !is_string(t, KW_DEF) && !is_string(t, KW_IMPORT)
	&& !is_string(t, KW_MACRO) && !is_string(t, KW_EXTEND) )
      { Link(export_list, t);
	t = LexGetToken();
      }
      UnSuppressScope();
    }


    if( res_type == LOCAL && !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) )
    { Error(5, 30, "keyword %s or %s expected here", WARN, &fpos(t),
	KW_DEF, KW_MACRO);
      break;
    }
    if( res_type == NPAR && !is_string(t, KW_NAMED) )
    { Error(5, 31, "keyword %s expected here", WARN, &fpos(t), KW_NAMED);
      break;
    }

    if( is_string(t, KW_MACRO) )
    { if( Down(export_list) != export_list )
	Error(5, 32, "ignoring export list of macro", WARN, &fpos(t));
      res = ReadMacro(&t, curr_encl, encl);
    }
    else
    {
      SuppressScope();  Dispose(t);  t = LexGetToken();

      /* check for compulsory keyword */
      if( res_type == NPAR && is_string(t, KW_COMPULSORY) )
      { compulsory_par = TRUE;
	Dispose(t);  t = LexGetToken();
      }
      else compulsory_par = FALSE;

      /* find name of symbol and insert it */
      if( !is_word(type(t)) )
      { Error(5, 33, "symbol name expected here", WARN, &fpos(t));
	debug1(ANY, D, "offending type is %s", Image(type(t)));
	UnSuppressScope();
	*token = t;
	return;
      }
      res = InsertSym(string(t), res_type, &fpos(t), DEFAULT_PREC,
		FALSE, FALSE, 0, curr_encl, nilobj);
      if( curr_encl != encl )  visible(res) = TRUE;
      if( has_import_encl )
      {
	imports_encl(res) = TRUE;
	debug1(DCE, D, "  setting import_encl(%s) to TRUE", SymName(res));
      }
      if( compulsory_par )
      { has_compulsory(encl)++;
	is_compulsory(res) = TRUE;
      }
      Dispose(t);  t = LexGetToken();

      /* find alternative names for this symbol */
      while( is_word(type(t)) && !is_string(t, KW_NAMED) &&
	!is_string(t, KW_IMPORT) &&
	!is_string(t, KW_FORCE) && !is_string(t, KW_INTO) &&
	!is_string(t, KW_HORIZ) && !is_string(t, KW_PRECEDENCE) &&
	!is_string(t, KW_ASSOC) && !is_string(t, KW_LEFT) &&
	!is_string(t, KW_RIGHT) && !is_string(t, KW_BODY) &&
	!is_string(t, KW_LBR) && !is_string(t, KW_BEGIN) )
      {
	InsertAlternativeName(string(t), res, &fpos(t));
	Dispose(t);  t = LexGetToken();
      }

      /* find force, if any */
      if( is_string(t, KW_FORCE) )
      {	force_target(res) = TRUE;
	Dispose(t);  t = LexGetToken();
	if( !is_string(t, KW_INTO) && !is_string(t, KW_HORIZ) )
	   Error(5, 34, "%s expected here", WARN, &fpos(t), KW_INTO);
      }
	
      /* find horizontally, if any */
      if( is_string(t, KW_HORIZ) )
      { horiz_galley(res) = COLM;
	Dispose(t);  t = LexGetToken();
	/* *** want to allow KW_HORIZ with @Target form now
	if( !is_string(t, KW_INTO) )
	  Error(5, 35, "%s expected here", WARN, &fpos(t), KW_INTO);
	*** */
      }

      /* find into clause, if any */
      res_target = nilobj;
      if( is_string(t, KW_INTO) )
      { UnSuppressScope();
	Dispose(t);  t = LexGetToken();
	if( type(t) != LBR )
	{ Error(5, 36, "%s expected here", WARN, &fpos(t), KW_LBR);
	  debug1(ANY, D, "offending type is %s", Image(type(t)));
	  UnSuppressScope();
	  *token = t;
	  return;
	}
	res_target = Parse(&t, curr_encl, FALSE, FALSE);
	SuppressScope();
	if( t == nilobj )  t = LexGetToken();
      }

      /* find precedence clause, if any */
      if( is_string(t, KW_PRECEDENCE) )
      {	int prec = 0;
	UnSuppressScope();
	Dispose(t);
	t = LexGetToken();
	while( type(t) == WORD && decimaldigit(string(t)[0]) )
	{
	  prec = prec * 10 + digitchartonum(string(t)[0]);
	  Dispose(t);  t = LexGetToken();
	}
	SuppressScope();

	if( prec < MIN_PREC )
	{ Error(5, 37, "precedence is too low (%d substituted)",
	    WARN, &fpos(t), MIN_PREC);
	  prec = MIN_PREC;
	}
	else if( prec > MAX_PREC )
	{ Error(5, 38, "precedence is too high (%d substituted)",
	    WARN, &fpos(t), MAX_PREC);
	  prec = MAX_PREC;
	}
	precedence(res) = prec;
      }

      /* find associativity clause, if any */
      if( is_string(t, KW_ASSOC) )
      {
	UnSuppressScope();
	Dispose(t);  t = LexGetToken();
	if( is_string(t, KW_LEFT) )  right_assoc(res) = FALSE;
	else if( !is_string(t, KW_RIGHT) )
	  Error(5, 39, "associativity altered to %s", WARN, &fpos(t), KW_RIGHT);
	SuppressScope();
	Dispose(t);  t = LexGetToken();
      }

      /* find left parameter, if any */
      if( is_string(t, KW_LEFT) )
      {	Dispose(t);  t = LexGetToken();
	if( type(t) != WORD )
	{ Error(5, 40, "cannot find %s parameter name", WARN, &fpos(t), KW_LEFT);
	  debug1(ANY, D, "offending type is %s", Image(type(t)));
	  UnSuppressScope();
	  *token = t;
	  return;
	}
	InsertSym(string(t), LPAR, &fpos(t), DEFAULT_PREC, 
	  FALSE, FALSE, 0, res, nilobj);
	Dispose(t);  t = LexGetToken();
      }

      /* find named parameters, if any */
      UnSuppressScope();
      ReadDefinitions(&t, res, NPAR);

      /* find right or body parameter, if any */
      if( is_string(t, KW_RIGHT) || is_string(t, KW_BODY) )
      {	has_body(res) = is_string(t, KW_BODY);
	SuppressScope();
	Dispose(t);  t = LexGetToken();
	if( type(t) != WORD )
	{ Error(5, 41, "cannot find %s parameter name", WARN,&fpos(t),KW_RIGHT);
	  debug1(ANY, D, "offending type is %s", Image(type(t)));
	  UnSuppressScope();
	  *token = t;
	  return;
	}
	InsertSym(string(t), RPAR, &fpos(t), DEFAULT_PREC,
	  FALSE, FALSE, 0, res, nilobj);
	UnSuppressScope();
	Dispose(t);  t = LexGetToken();
      }

      /* read local definitions and body */
      if( res_target != nilobj )
	InsertSym(KW_TARGET, LOCAL, &fpos(res_target), DEFAULT_PREC,
			FALSE, FALSE, 0, res, res_target);
      if( type(t) == WORD && StringEqual(string(t), KW_LBR) )
      {	z = NewToken(LBR, &fpos(t), 0, 0, LBR_PREC, StartSym);
	Dispose(t);
	t = z;
      }
      else if( type(t) == WORD && StringEqual(string(t), KW_BEGIN) )
      {	z = NewToken(BEGIN, &fpos(t), 0, 0, BEGIN_PREC, StartSym);
	Dispose(t);
	t = z;
      }
      else if( type(t) != LBR && type(t) != BEGIN )
	Error(5, 42, "opening left brace or @Begin of %s expected",
	  FATAL, &fpos(t), SymName(res));
      if( type(t) == BEGIN )  actual(t) = res;
      PushScope(res, FALSE, FALSE);
      BodyParAllowed();
      sym_body(res) = Parse(&t, res, TRUE, FALSE);

      /* set visible flag of the exported symbols */
      for( link=Down(export_list);  link != export_list;  link=NextDown(link) )
      {	Child(y, link);
	z = SearchSym(string(y), StringLength(string(y)));
	if( z == nilobj || enclosing(z) != res )
	  Error(5, 43, "exported symbol %s is not defined in %s",
	    WARN, &fpos(y), string(y), SymName(res));
	else if( has_body(res) && type(z) == RPAR )
	  Error(5, 44, "body parameter %s may not be exported",
	    WARN, &fpos(y), string(y));
	else if( visible(z) )
	  Error(5, 45, "symbol %s exported twice", WARN, &fpos(y), string(y));
	else visible(z) = TRUE;
      }
      DisposeObject(export_list);

      /* pop scope of res */
      PopScope();
    }

    /* pop import scopes and store imports in sym tab */
    for( link=Down(import_list);  link != import_list;  link=NextDown(link) )
    {
      PopScope();
    }
    if( Down(import_list) == import_list || curr_encl != encl )
    { DisposeObject(import_list);
      import_list = nilobj;
    }
    else
    {
      imports(res) = import_list;
    }

    BodyParAllowed();
    if( t == nilobj ) t = LexGetToken();

  } /* end while */

  *token = t;
  return;
} /* end ReadDefinitions */