fml/fmltoken.c

   1 /*
   2  * FML interpreter. Europagate, 1995
   3  *
   4  * $Log: fmltoken.c,v $
   5  * Revision 1.3  1995/02/10 15:50:57  adam
   6  * MARC interface implemented. Minor bugs fixed. fmltest can
   7  * be used to format single MARC records. New function '\list'
   8  * implemented.
   9  *
  10  * Revision 1.2  1995/02/07  16:09:24  adam
  11  * The \ character is no longer INCLUDED when terminating a token.
  12  * Major changes in tokenization routines. Bug fixes in expressions
  13  * with lists (fml_sub0).
  14  *
  15  * Revision 1.1.1.1  1995/02/06  13:48:10  adam
  16  * First version of the FML interpreter. It's slow and memory isn't
  17  * freed properly. In particular, the FML nodes aren't released yet.
  18  *
  19  */
  20 #include <string.h>
  21 #include <assert.h>
  22 #include <stdio.h>
  23
  24 #include "fmlp.h"
  25
  26 static int look_char;
  27 static int look_type;
  28 static char lex_buf[FML_MAX_TOKEN];
  29
  30 static void lexer (Fml fml);
  31
  32 struct fml_node *fml_group (Fml fml);
  33
  34 struct fml_node *fml_tokenize (Fml fml)
  35 {
  36     struct fml_node *p;
  37
  38     look_char = (*fml->read_func)();
  39     p = fml_group (fml);
  40     if (fml->debug)
  41     {
  42         fml_pr_list (p);
  43         printf ("\n");
  44     }
  45     return p;
  46 }
  47
  48 void fml_pr_list (struct fml_node *p)
  49 {
  50     printf ("{");
  51
  52     while (p)
  53     {
  54         if (p->is_atom)
  55         {
  56             char buf[100];
  57             fml_atom_str (p->p[0], buf);
  58             printf (" %s", buf);
  59         }
  60         else
  61         {
  62             printf (" ");
  63             fml_pr_list (p->p[0]);
  64         }
  65         p = p->p[1];
  66     }
  67     printf (" }");
  68 }
  69
  70 struct fml_node *fml_group (Fml fml)
  71 {
  72     struct fml_node *ptr0 = NULL, *ptr1, *ptr2;
  73
  74     lexer (fml);
  75     if (look_type == 0)
  76         return NULL;
  77     while (1)
  78     {
  79         if (look_type == 'a')
  80         {
  81             ptr2 = fml_node_alloc (fml);
  82             if (!ptr0)
  83                 ptr0 = ptr2;
  84             else
  85                 ptr1->p[1] = ptr2;
  86             ptr2->p[0] = fml_atom_alloc (fml, lex_buf);
  87             ptr2->is_atom = 1;
  88         }
  89         else if (look_type == '{')
  90         {
  91             struct fml_node *sptr = fml_group (fml);
  92             if (sptr)
  93             {
  94                 ptr2 = fml_node_alloc (fml);
  95                 if (!ptr0)
  96                     ptr0 = ptr2;
  97                 else
  98                         ptr1->p[1] = ptr2;
  99                 ptr2->p[0] = sptr;
 100                 ptr2->is_atom = 0;
 101             }
 102             else
 103             {
 104                 ptr2 = fml_node_alloc (fml);
 105                 if (!ptr0)
 106                     ptr0 = ptr2;
 107                 else
 108                     ptr1->p[1] = ptr2;
 109                 ptr2->is_atom = 0;
 110             }
 111         }
 112         else
 113             break;
 114         lexer (fml);
 115         ptr1 = ptr2;
 116     }
 117     return ptr0;
 118 }
 119
 120 static void lexer (Fml fml)
 121 {
 122     int off;
 123     while (1)
 124     {
 125         if (look_char == fml->eof_mark)
 126         {
 127             look_type = 0;
 128             return;
 129         }
 130         else if (look_char == fml->comment_char)
 131         {
 132             do
 133                 look_char = (*fml->read_func)();
 134             while (look_char != '\n' && look_char != fml->eof_mark);
 135         }
 136         else
 137         {
 138             if (!strchr (fml->white_chars, look_char))
 139                 break;
 140             look_char = (*fml->read_func)();
 141         }
 142     }
 143     if (look_char == '{')
 144     {
 145         look_type = '{';
 146         look_char = (*fml->read_func)();
 147     }
 148     else if (look_char == '}')
 149     {
 150         look_type = '}';
 151         look_char = (*fml->read_func)();
 152     }
 153     else if (look_char == '\'')
 154     {
 155         off = 0;
 156         look_char = (*fml->read_func)();
 157         while (look_char != fml->eof_mark && look_char != '\'')
 158         {
 159             lex_buf[off++] = look_char;
 160             look_char = (*fml->read_func)();
 161         }
 162         lex_buf[off] = '\0';
 163         look_type = 'a';
 164         if (look_char == '\'')
 165             look_char = (*fml->read_func)();
 166     }
 167     else
 168     {
 169         off = 0;
 170         do
 171         {
 172             lex_buf[off++] = look_char;
 173             look_char = (*fml->read_func)();
 174         } while (look_char != fml->eof_mark
 175                  && !strchr (fml->white_chars, look_char)
 176                  && look_char != '{' && look_char != '}');
 177         lex_buf[off] = '\0';
 178         look_type = 'a';
 179     }
 180 #if 0
 181     if (fml->debug)
 182     {
 183         if (look_type == 'a')
 184             printf ("[%s]", lex_buf);
 185         else
 186             printf ("[%c]", look_type);
 187     }
 188 #endif
 189 }