fml/fmltoken.c

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