fml/fmltoken.c

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