Logo Search packages:      
Sourcecode: ecl version File versions  Download package

dpp.c

/*
    dpp.c -- Defun preprocessor.
*/
/*
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
    Copyright (c) 1990, Giuseppe Attardi.
    Copyright (c) 2001, Juan Jose Garcia Ripoll.

    ECL is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    See file '../Copyright' for full details.
*/


/*
      Usage:
            dpp [in-file [out-file]]

      The file named in-file is preprocessed and the output will be
      written to the file whose name is out-file. If in-file is "-"
      program is read from standard input, while if out-file is "-"
      C-program is written to standard output.


      The function definition:

      @(defun name ({var}*
                  [&optional {var | (var [initform [svar]])}*]
                  [&rest var]
                  [&key {var |
                       ({var | (keyword var)} [initform [svar]])}*
                      [&allow_other_keys]]
                  [&aux {var | (var [initform])}*])

            C-declaration

      @

            C-body

      @)

      name can be either an identifier or a full C procedure header
      enclosed in quotes (').

      &optional may be abbreviated as &o.
      &rest may be abbreviated as &r.
      &key may be abbreviated as &k.
      &allow_other_keys may be abbreviated as &aok.
      &aux may be abbreviated as &a.

      Each variable becomes a C variable.

      Each supplied-p parameter becomes a boolean C variable.

      Initforms are C expressions.
      It an expression contain non-alphanumeric characters,
      it should be surrounded by backquotes (`).


      Function return:

            @(return {form}*)

*/

#include <stdlib.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>

#define DPP
#include <ecl/config.h>
#include "symbols_list2.h"

/* #define POOLSIZE        2048 */
#define POOLSIZE        4096
#define MAXREQ          16
#define MAXOPT          16
#define MAXKEY          16
#define MAXAUX          16
#define MAXRES          16

#define TRUE            1
#define FALSE           0

typedef int bool;

FILE *in, *out;

char filename[BUFSIZ];
int lineno;
int tab;
int tab_save;

char pool[POOLSIZE];
char *poolp;

char *function;
char *function_symbol;
char *function_c_name;

char *required[MAXREQ];
int nreq;

struct optional {
      char *o_var;
      char *o_init;
      char *o_svar;
} optional[MAXOPT];
int nopt;

bool rest_flag;
char *rest_var;

bool key_flag;
struct keyword {
      char *k_key;
      char *k_var;
      char *k_init;
      char *k_svar;
} keyword[MAXKEY];
int nkey;
bool allow_other_keys_flag;

struct aux {
      char *a_var;
      char *a_init;
} aux[MAXAUX];
int naux;

char *result[MAXRES];
int nres;

put_lineno(void)
{
      static int flag = 0;
#if 1
      if (flag)
            fprintf(out, "#line %d\n", lineno);
      else {
            flag++;
            fprintf(out, "#line %d \"%s\"\n", lineno, filename);
      }
#endif
}

error(char *s)
{
      printf("Error in line %d: %s.\n", lineno, s);
      exit(1);
}

error_symbol(char *s)
{
      printf("Error in line %d: illegal symbol %s.\n", lineno, s);
      exit(1);
}

readc(void)
{
      int c;

      c = getc(in);
      if (feof(in)) {
            if (function != NULL)
                  error("unexpected end of file");
            exit(0);
      }
      if (c == '\n') {
            lineno++;
            tab = 0;
      } else if (c == '\t')
            tab++;
      return(c);
}

nextc(void)
{
      int c;

      while (isspace(c = readc()))
            ;
      return(c);
}

unreadc(int c)
{
      if (c == '\n')
            --lineno;
      else if (c == '\t')
            --tab;
      ungetc(c, in);
}

put_tabs(int n)
{
      put_lineno();
      while (n--)
            putc('\t', out);
}

pushc(int c)
{
      if (poolp >= &pool[POOLSIZE])
            error("buffer pool overflow");
      *poolp++ = c;
}

pushstr(const char *s)
{
      while (*s)
            pushc(*(s++));
}

int
search_keyword(const char *name)
{
      int i;
      char c[256];

      for (i=0; name[i] && i<255; i++)
            if (name[i] == '_')
                  c[i] = '-';
            else
                  c[i] = name[i];
      if (i == 255)
            error("Too long keyword");
      c[i] = 0;
      for (i = 0; cl_symbols[i].name != NULL; i++) {
            if (cl_symbols[i].name[0] == ':')
                  if (!strcasecmp(c, cl_symbols[i].name+1))
                        return i;
      }
      printf("Keyword not found: %s.\n", c);
      return 0;
}

char *
search_symbol(char *name)
{
      int i;
      for (i = 0; cl_symbols[i].name != NULL; i++) {
            if (!strcasecmp(name, cl_symbols[i].name)) {
                  name = poolp;
                  pushstr("ECL_SYM(\"");
                  pushstr(cl_symbols[i].name);
                  pushstr("\",");
                  if (i >= 1000)
                        pushc((i / 1000) % 10 + '0');
                  if (i >= 100)
                        pushc((i / 100) % 10 + '0');
                  if (i >= 10)
                        pushc((i / 10) % 10 + '0');
                  pushc(i % 10 + '0');
                  pushstr(")");
                  pushc(0);
                  return name;
            }
      }
      return NULL;
}

char *
read_symbol()
{
      char c, *name = poolp;
      int i;

      c = readc();
      while (c != '\'') {
            if (c == '_') c = '-';
            pushc(c); 
            c = readc();
      }
      pushc(0);

      name = search_symbol(poolp = name);
      if (name == NULL) {
            name = poolp;
            printf("\nUnknown symbol: %s\n", name);
            pushstr("unknown");
      }
      return name;
}

char *
search_function(char *name)
{
      int i;
      for (i = 0; cl_symbols[i].name != NULL; i++) {
            if (cl_symbols[i].translation != NULL &&
                !strcasecmp(name, cl_symbols[i].name)) {
                  name = poolp;
                  pushstr(cl_symbols[i].translation);
                  pushc(0);
                  return name;
            }
      }
      return name;
}

char *
read_function()
{
      char c, *name = poolp;
      int i;

      c = readc();
      if (c == '"') {
            c = readc();
            while (c != '"') {
                  pushc(c);
                  c = readc();
            }
            pushc(0);
            return name;
      }
      while (c != '(' && !isspace(c) && c != ')' && c != ',') {
            if (c == '_') c = '-';
            pushc(c); 
            c = readc();
      }
      unreadc(c);
      pushc(0);
      return name;
}

char *
translate_function(char *name)
{
      char *output = search_function(name);
      if (output == NULL) {
            printf("\nUnknown function: %s\n", name);
            pushstr("unknown");
            output = poolp;
      }
      return output;
}

char *
read_token(void)
{
      int c;
      int left_paren = 0;
      char *p;

      p = poolp;
      c = readc();
      while (isspace(c))
            c = readc();
      do {
            if (c == '(') {
                  left_paren++;
                  pushc(c);
            } else if (c == ')') {
                  if (left_paren == 0) {
                        break;
                  } else {
                        left_paren--;
                        pushc(c);
                  }
            } else if (isspace(c) && left_paren == 0) {
                  do
                        c = readc();
                  while (isspace(c));
                  break;
            } else if (c == '@') {
                  c = readc();
                  if (c == '\'') {
                        (void)read_symbol();
                        poolp--;
                  } else if (c == '@') {
                        pushc(c);
                  } else {
                        char *name;
                        unreadc(c);
                        poolp = name = read_function();
                        (void)translate_function(poolp);
                  }
            } else {
                  pushc(c);
            }
            c = readc();
      } while (1);
      unreadc(c);
      pushc('\0');
      return(p);
}

reset(void)
{
      int i;

      poolp = pool;
      function = NULL;
      function_symbol = "";
      function_c_name = "";
      nreq = 0;
      for (i = 0;  i < MAXREQ;  i++)
            required[i] = NULL;
      nopt = 0;
      for (i = 0;  i < MAXOPT;  i++)
            optional[i].o_var
            = optional[i].o_init
            = optional[i].o_svar
            = NULL;
      rest_flag = FALSE;
      rest_var = "ARGS";
      key_flag = FALSE;
      nkey = 0;
      for (i = 0;  i < MAXKEY;  i++)
            keyword[i].k_key
            = keyword[i].k_var
            = keyword[i].k_init
            = keyword[i].k_svar
            = NULL;
      allow_other_keys_flag = FALSE;
      naux = 0;
      for (i = 0;  i < MAXAUX;  i++)
            aux[i].a_var
            = aux[i].a_init
            = NULL;
}

get_function(void)
{
      function = read_function();
      function_symbol = search_symbol(function);
      if (function_symbol == NULL) {
            function_symbol = poolp;
            pushstr("Cnil");
            pushc('\0');
      }
      function_c_name = translate_function(function);
}

get_lambda_list(void)
{
      int c;
      char *p;

      if ((c = nextc()) != '(')
            error("( expected");
      for (;;) {
            if ((c = nextc()) == ')')
                  return;
            if (c == '&') {
                  p = read_token();
                  goto OPTIONAL;
            }
            unreadc(c);
            p = read_token();
            if (nreq >= MAXREQ)
                  error("too many required variables");
            required[nreq++] = p;
      }

OPTIONAL:
      if (strcmp(p, "optional") != 0 && strcmp(p, "o") != 0)
            goto REST;
      for (;;  nopt++) {
            if ((c = nextc()) == ')')
                  return;
            if (c == '&') {
                  p = read_token();
                  goto REST;
            }
            if (nopt >= MAXOPT)
                  error("too many optional argument");
            if (c == '(') {
                  optional[nopt].o_var = read_token();
                  if ((c = nextc()) == ')')
                        continue;
                  unreadc(c);
                  optional[nopt].o_init = read_token();
                  if ((c = nextc()) == ')')
                        continue;
                  unreadc(c);
                  optional[nopt].o_svar = read_token();
                  if (nextc() != ')')
                        error(") expected");
            } else {
                  unreadc(c);
                  optional[nopt].o_var = read_token();
            }
      }

REST:
      if (strcmp(p, "rest") != 0 && strcmp(p, "r") != 0)
            goto KEY;
      rest_flag = TRUE;
      if ((c = nextc()) == ')' || c == '&')
            error("&rest var missing");
      unreadc(c);
      rest_var = read_token();
      if ((c = nextc()) == ')')
            return;
      if (c != '&')
            error("& expected");
      p = read_token();
      goto KEY;

KEY:
      if (strcmp(p, "key") != 0 && strcmp(p, "k") != 0)
            goto AUX;
      key_flag = TRUE;
      for (;;  nkey++) {
            if ((c = nextc()) == ')')
                  return;
            if (c == '&') {
                  p = read_token();
                  if (strcmp(p, "allow_other_keys") == 0 ||
                      strcmp(p, "aok") == 0) {
                        allow_other_keys_flag = TRUE;
                        if ((c = nextc()) == ')')
                              return;
                        if (c != '&')
                              error("& expected");
                        p = read_token();
                  }
                  goto AUX;
            }
            if (nkey >= MAXKEY)
                  error("too many optional argument");
            if (c == '(') {
                  if ((c = nextc()) == '(') {
                        p = read_token();
                        if (p[0] != ':' || p[1] == '\0')
                              error("keyword expected");
                        keyword[nkey].k_key = p + 1;
                        keyword[nkey].k_var = read_token();
                        if (nextc() != ')')
                              error(") expected");
                  } else {
                        unreadc(c);
                        keyword[nkey].k_key
                        = keyword[nkey].k_var
                        = read_token();
                  }
                  if ((c = nextc()) == ')')
                        continue;
                  unreadc(c);
                  keyword[nkey].k_init = read_token();
                  if ((c = nextc()) == ')')
                        continue;
                  unreadc(c);
                  keyword[nkey].k_svar = read_token();
                  if (nextc() != ')')
                        error(") expected");
            } else {
                  unreadc(c);
                  keyword[nkey].k_key
                  = keyword[nkey].k_var
                  = read_token();
            }
      }

AUX:
      if (strcmp(p, "aux") != 0 && strcmp(p, "a") != 0)
            error("illegal lambda-list keyword");
      for (;;) {
            if ((c = nextc()) == ')')
                  return;
            if (c == '&')
                  error("illegal lambda-list keyword");
            if (naux >= MAXAUX)
                  error("too many auxiliary variable");
            if (c == '(') {
                  aux[naux].a_var = read_token();
                  if ((c = nextc()) == ')')
                        continue;
                  unreadc(c);
                  aux[naux].a_init = read_token();
                  if (nextc() != ')')
                        error(") expected");
            } else {
                  unreadc(c);
                  aux[naux].a_var = read_token();
            }
            naux++;
      }
}

get_return(void)
{
      int c;

      nres = 0;
      for (;;) {
            if ((c = nextc()) == ')')
                  return;
            unreadc(c);
            result[nres++] = read_token();
      }
}

put_fhead(void)
{
      int i;

      put_lineno();
      fprintf(out, "cl_object %s(cl_narg narg", function_c_name);
      for (i = 0; i < nreq; i++)
            fprintf(out, ", cl_object %s", required[i]);
      if (nopt > 0 || rest_flag || key_flag)
            fprintf(out, ", ...");
      fprintf(out, ")\n{\n");
}

put_declaration(void)
{
  int i;
  int simple_varargs;

  for (i = 0;  i < nopt;  i++) {
    put_lineno();
    fprintf(out, "\tcl_object %s;\n", optional[i].o_var);
  }
  for (i = 0;  i < nopt;  i++)
    if (optional[i].o_svar != NULL) {
      put_lineno();
      fprintf(out, "\tbool %s;\n", optional[i].o_svar);
    }
  if (key_flag) {
    put_lineno();
    if (nkey) {
      fprintf(out, "\tstatic cl_object KEYS[%d] = {", nkey);
      for (i = 0; i < nkey; i++) {
      if (i > 0)
        fprintf(out, ", ");
      fprintf(out, "(cl_object)(cl_symbols+%d)", search_keyword(keyword[i].k_key));
      }
      fprintf(out, "};\n");
    } else {
      fprintf(out, "\tconst cl_object *KEYS = NULL;\n");
    }
  }
  for (i = 0;  i < nkey;  i++) {
    fprintf(out, "\tcl_object %s;\n", keyword[i].k_var);
    if (keyword[i].k_svar != NULL)
      fprintf(out, "\tbool %s;\n", keyword[i].k_svar);
  }
  for (i = 0;  i < naux;  i++) {
    put_lineno();
    fprintf(out, "\tcl_object %s;\n", aux[i].a_var);
  }
  if (nopt == 0 && !rest_flag && !key_flag) {
    put_lineno();
    fprintf(out, "\tif (narg!=%d) FEwrong_num_arguments(%s);\n", nreq, function_symbol);
  } else {
    simple_varargs = !rest_flag && !key_flag && ((nreq + nopt) < 32);
    if (key_flag) {
      put_lineno();
      /* We do this because Microsoft VC++ does not support arrays of zero size */
      if (nkey) {
      fprintf(out, "\tcl_object KEY_VARS[%d];\n", 2*nkey);
      } else {
      fprintf(out, "\tconst cl_object *KEY_VARS = NULL;\n");
      }
    }
    put_lineno();
    if (simple_varargs)
      fprintf(out,"\tva_list %s;\n\tva_start(%s, %s);\n",
            rest_var, rest_var, ((nreq > 0) ? required[nreq-1] : "narg"));
    else
      fprintf(out,"\tcl_va_list %s;\n\tcl_va_start(%s, %s, narg, %d);\n",
            rest_var, rest_var, ((nreq > 0) ? required[nreq-1] : "narg"),
            nreq);
    put_lineno();
    fprintf(out, "\tif (narg < %d", nreq);
    if (nopt > 0 && !rest_flag && !key_flag) {
      fprintf(out, "|| narg > %d", nreq + nopt);
    }
    fprintf(out, ") FEwrong_num_arguments(%s);\n", function_symbol);
    for (i = 0;  i < nopt;  i++) {
      put_lineno();
      fprintf(out, "\tif (narg > %d) {\n", nreq+i, optional[i].o_var);
      put_lineno();
      fprintf(out, simple_varargs?
            "\t\t%s = va_arg(%s,cl_object);\n":
            "\t\t%s = cl_va_arg(%s);\n",
            optional[i].o_var, rest_var);
      if (optional[i].o_svar) {
      put_lineno();
      fprintf(out, "\t\t%s = TRUE;\n", optional[i].o_svar);
      }
      put_lineno();
      fprintf(out, "\t} else {\n");
      put_lineno();
      fprintf(out, "\t\t%s = %s;\n",
            optional[i].o_var,
            optional[i].o_init == NULL ? "Cnil" : optional[i].o_init);
      if (optional[i].o_svar) {
      put_lineno();
      fprintf(out, "\t\t%s = FALSE;\n", optional[i].o_svar);
      }
      put_lineno();
      fprintf(out, "\t}\n");
    }
    if (key_flag) {
      put_lineno();
      fprintf(out, "\tcl_parse_key(ARGS, %d, KEYS, KEY_VARS, NULL, %d);\n",
            nkey, allow_other_keys_flag);
      for (i = 0;  i < nkey;  i++) {
      put_lineno();
      fprintf(out, "\tif (KEY_VARS[%d]==Cnil) {\n", nkey+i);
      if (keyword[i].k_init != NULL) {
        put_lineno();
        fprintf(out, "\t  %s = %s;\n", keyword[i].k_var, keyword[i].k_init);
      } else {
        put_lineno();
        fprintf(out, "\t  %s = Cnil;\n", keyword[i].k_var);
      }
      if (keyword[i].k_svar != NULL) {
        put_lineno();
        fprintf(out, "\t  %s = FALSE;\n", keyword[i].k_svar);
      }
      fprintf(out, "\t} else {\n");
      if (keyword[i].k_svar != NULL) {
        put_lineno();
        fprintf(out, "\t  %s = TRUE;\n", keyword[i].k_svar);
      }
      put_lineno();
      fprintf(out, "\t  %s = KEY_VARS[%d];\n\t}\n", keyword[i].k_var, i);
      }
    }
  }
  for (i = 0;  i < naux;  i++) {
    put_lineno();
    fprintf(out, "\t%s = %s;\n", aux[i].a_var,
          aux[i].a_init == NULL ? "Cnil" : aux[i].a_init);
  }
}

put_return(void)
{
      int i, t;

      t = tab_save+1;
      if (nres == 0) {
        fprintf(out, "return0();");
      } else if (nres == 1) {
        fprintf(out, "return1(%s);", result[0]);
      } else {
        fprintf(out, "{\n");
        put_tabs(t);
        for (i = 0;  i < nres;  i++) {
            put_tabs(t);
            fprintf(out, "cl_object value%d = %s;\n", i, result[i]);
        }
        put_tabs(t);
        fprintf(out, "NVALUES = %d;\n", nres);
        for (i = nres-1;  i > 0;  i--) {
            put_tabs(t);
            fprintf(out, "VALUES(%d) = value%d;\n", i, i);
        }
        put_tabs(t);
        fprintf(out, "return value0;\n");
        put_tabs(tab_save);
        fprintf(out, "}\n");
      }
}

char
jump_to_at(void)
{
      char c;
 GO_ON:
      while ((c = readc()) != '@')
            putc(c, out);
      if ((c = readc()) == '@') {
            putc(c, out);
            goto GO_ON;
      }
      return c;
}

main_loop(void)
{
      int c;
      int in_defun=0;
      char *p;

      lineno = 1;

      reset();
      put_lineno();
LOOP:
      c = jump_to_at();
      if (c == ')') {
            if (!in_defun)
                  error("unmatched @) found");
            in_defun = 0;
            putc('}',out);
            reset();
            goto LOOP;
      } else if (c == '\'') {
            char *p;
            poolp = pool;
            p = read_symbol();
            pushc('\0');
            fprintf(out,"%s",p);
            goto LOOP;
      } else if (c != '(') {
            char *p;
            unreadc(c);
            poolp = pool;
            poolp = p = read_function();
            fprintf(out,"%s",translate_function(poolp));
            goto LOOP;
      }
      p = read_token();
      if (strcmp(p, "defun") == 0) {
            if (in_defun)
                  error("@) expected before new function definition");
            in_defun = 1;
            get_function();
            get_lambda_list();
            put_fhead();
            put_lineno();
            c = jump_to_at();
            put_declaration();
            put_lineno();
      } else if (strcmp(p, "return") == 0) {
            tab_save = tab;
            get_return();
            put_return();
      } else
            error_symbol(p);
      goto LOOP;
}

main(int argc, char **argv)
{
      char *p, *q;
      char outfile[BUFSIZ];

      if (argc < 2 || !strcmp(argv[1],"-")) {
        in = stdin;
        strcpy(filename, "-");
      } else {
        in = fopen(argv[1],"r");
        strncpy(filename, argv[1], BUFSIZ);
      }
#ifdef _MSC_VER
      /* Convert all backslashes in filename into slashes,
       * to avoid warnings when compiling with MSVC
       */
      for ( p=filename; *p; p++ )
            if ( *p == '\\' )
                  *p = '/';
#endif
      if (argc < 3 || !strcmp(argv[2],"-")) {
        out = stdout;
        strncpy(outfile, "-", BUFSIZ);
      } else {
        out = fopen(argv[2],"w");
        strncpy(outfile, argv[2], BUFSIZ);
      }
      if (in == NULL)
            error("can't open input file");
      if (out == NULL)
            error("can't open output file");
      printf("dpp: %s -> %s\n", filename, outfile);
      main_loop();
}

Generated by  Doxygen 1.6.0   Back to index