fml/fmltoken.c

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