src/zsend-0.0.1/lread.c

   1 /*
   2   lread.c: simple sexp-like data structures in C.
   3            useful for communication between emacs and C client programs
   4
   5    Copyright (C) 1992 Nick Thompson (nix@cs.cmu.edu)
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 2 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program; if not, write to the Free Software
  19    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21    TODO
  22
  23    add tag checking on CAR, CDR, etc?
  24  */
  25
  26 #include <setjmp.h>
  27
  28 #include "lread.h"
  29 #include <stdio.h>
  30 #include <string.h>     /* for strlen() */
  31
  32 Value *
  33 vmake_cons(Value *car, Value *cdr)
  34 {
  35    Value *v = ALLOC_VALUE();
  36    v->tag = cons;
  37    VCAR(v) = car;
  38    VCDR(v) = cdr;
  39    return v;
  40 }
  41
  42 Value *
  43 vmake_symbol(int length, char *data)
  44 {
  45    Value *v = ALLOC_VALUE();
  46    v->tag = symbol;
  47    VSLENGTH(v) = length;
  48    VSDATA(v) = data;
  49    return v;
  50 }
  51
  52 Value *
  53 vmake_symbol_c(char *s)
  54 {
  55    Value *v = ALLOC_VALUE();
  56    v->tag = symbol;
  57    VSLENGTH(v) = strlen(s);
  58    VSDATA(v) = s;
  59    return v;
  60 }
  61
  62 Value *
  63 vmake_string(int length, char *data)
  64 {
  65    Value *v = ALLOC_VALUE();
  66    v->tag = string;
  67    VSLENGTH(v) = length;
  68    VSDATA(v) = data;
  69    return v;
  70 }
  71
  72 Value *
  73 vmake_string_c(char *s)
  74 {
  75    Value *v = ALLOC_VALUE();
  76    v->tag = string;
  77    VSLENGTH(v) = strlen(s);
  78    VSDATA(v) = s;
  79    return v;
  80 }
  81
  82 char *
  83 vextract_string_c(Value *v)
  84 {
  85    char *s = (char *) malloc(VSLENGTH(v) + 1);
  86    memcpy(s, VSDATA(v), VSLENGTH(v));
  87    s[VSLENGTH(v)] = '\0';
  88    return s;
  89 }
  90
  91 Value *
  92 vmake_integer(int n)
  93 {
  94    Value *v = ALLOC_VALUE();
  95    v->tag = integer;
  96    VINTEGER(v) = n;
  97    return v;
  98 }
  99
 100 Value *
 101 vmake_var(enum Vtag tag, void **value)
 102 {
 103    Value *v = ALLOC_VALUE();
 104    v->tag = var;
 105    VVTAG(v) = tag;
 106    VVDATA(v) = value;
 107    return v;
 108 }
 109
 110 int
 111 vlength(Value *l)
 112 {
 113     int i;
 114     for (i=0; VTAG(l) == cons; i++, l = VCDR(l))
 115         ;
 116     return i;
 117 }
 118
 119 typedef struct {
 120    jmp_buf abort;               /* nonlocal exit for abort */
 121
 122    char *input_string;          /* input string */
 123    int buflen;                  /* amount left in input string */
 124    char *buf;                   /* pointer into input */
 125
 126    int strbuflen;               /* length of scratch buffer */
 127    char *strbuf;                /* scratch buffer for building strings */
 128 } Globals;
 129
 130 Value *read_value(Globals *g);
 131 Value *read_list(Globals *g);
 132
 133 #define PEEK_CHAR(g)    (*(g)->buf)
 134 #define NEXT_CHAR(g)    ((g)->buflen > 0 ? \
 135                          (void) ((g)->buf++,((g)->buflen--)) : \
 136                          (void) (ABORT(g, 23)))
 137 #define ABORT(g, code)  longjmp((g)->abort, (code))
 138
 139 /* A pox on languages without coroutines. */
 140 /* I don't feel like putting the entire state of the parser in data
 141  * structures that I can save and restore myself, so if EOF is
 142  * encountered while parsing the parser will have to start from
 143  * scratch when it gets more data */
 144
 145 void
 146 expand_strbuf(Globals *g)
 147 {
 148    if (g->strbuflen == 0) {
 149       g->strbuflen = 128;
 150       g->strbuf = (char *) malloc(g->strbuflen);
 151    }
 152    else {
 153       int newbuflen = 3 * g->strbuflen / 2;
 154       char *newbuf = (char *) malloc(newbuflen);
 155       memcpy(newbuf, g->strbuf, g->strbuflen);
 156       free(g->strbuf);
 157       g->strbuf = newbuf;
 158       g->strbuflen = newbuflen;
 159    }
 160 }
 161
 162 int parse(int slen, char *s, Value **v)
 163 {
 164    Globals g;
 165    int jmpret;
 166
 167    if (0 == (jmpret = setjmp(g.abort))) {       /* successful parse */
 168       g.input_string = s;
 169       g.buflen = slen;
 170       g.buf = g.input_string;
 171       g.strbuflen = 0;
 172       g.strbuf = NULL;
 173       expand_strbuf(&g);
 174       *v = read_value(&g);
 175       return g.buf - g.input_string;
 176    }
 177    else {                       /* return from nonlocal abort */
 178       free(g.strbuf);
 179       *v = NULL;
 180       return 0;
 181    }
 182 }
 183
 184 int
 185 read_escape(Globals *g, char *c)
 186 {
 187    int valid = 1;
 188    int nc = PEEK_CHAR(g);
 189
 190    switch (nc) {
 191     case '\n':
 192       valid = 0;
 193       NEXT_CHAR(g);
 194       break;
 195     case 'n':
 196       *c = '\n';
 197       NEXT_CHAR(g);
 198       break;
 199     case 't':
 200       *c = '\t';
 201       NEXT_CHAR(g);
 202       break;
 203     default:
 204       if (nc >= '0' && nc <= '7') {
 205         int digits;
 206         /* handle octal \nnn notation */
 207         *c = 0;
 208         for (digits = 0; digits < 3; digits++) {
 209           if (nc < '0' || nc > '7')
 210             break;
 211           *c = (*c * 8) + (nc - '0');
 212           NEXT_CHAR(g);
 213           nc = PEEK_CHAR(g);
 214         }
 215       } else {
 216         /* backslash followed by some random char, like \q.
 217          * (some of these are actually valid, but I don't think prin1 will
 218          * produce them, so it's not too critical). */
 219         *c = nc;
 220         NEXT_CHAR(g);
 221       }
 222       break;
 223    }
 224    return valid;
 225 }
 226
 227 Value *
 228 read_string(Globals *g)
 229 {
 230    int strpos = 0;
 231    Value *v;
 232    char c;
 233
 234 #define ADD_CHAR(c)     \
 235    if (strpos >= g->strbuflen) \
 236       expand_strbuf(g);         \
 237    g->strbuf[strpos++] = (c)
 238
 239    while (1) {
 240       switch (PEEK_CHAR(g)) {
 241        case '\"':
 242          NEXT_CHAR(g);
 243          v = ALLOC_VALUE();
 244          v->tag = string;
 245          v->value.s.length = strpos;
 246          v->value.s.string = (char *) malloc(v->value.s.length);
 247          memcpy(v->value.s.string, g->strbuf, v->value.s.length);
 248          return v;
 249          break;
 250        case '\\':
 251          NEXT_CHAR(g);
 252          if (read_escape(g, &c))
 253             ADD_CHAR(c);
 254          break;
 255        default:
 256          ADD_CHAR(PEEK_CHAR(g));
 257          NEXT_CHAR(g);
 258          break;
 259       }
 260    }
 261 }
 262
 263 /* characters
 264 (
 265 )
 266 "
 267 \
 268 <white>
 269 <character>
 270 <number>
 271  */
 272
 273 Value *
 274 read_num_or_symbol(Globals *g)
 275 {
 276    Value *v;
 277    int strpos = 0;
 278    int i;
 279    int is_integer;
 280
 281 #define ADD_CHAR(c)     \
 282    if (strpos >= g->strbuflen) \
 283       expand_strbuf(g);         \
 284    g->strbuf[strpos++] = (c)
 285
 286    while (g->buflen > 0) {
 287       switch (PEEK_CHAR(g)) {
 288        case ' ':
 289        case '\t':
 290        case '\n':
 291        case '\0':
 292        case '\"':
 293        case '(':
 294        case ')':
 295        case '.':
 296          goto done;
 297          break;
 298        case '\\':
 299          NEXT_CHAR(g);
 300          ADD_CHAR(PEEK_CHAR(g));
 301          NEXT_CHAR(g);
 302          break;
 303        default:
 304          ADD_CHAR(PEEK_CHAR(g));
 305          NEXT_CHAR(g);
 306          break;
 307       }
 308    }
 309    ABORT(g, 23);
 310
 311  done:
 312    /* is this a number or a symbol? */
 313    /* assume integer to start */
 314    is_integer = 1;
 315
 316    /* assume no empty strings? */
 317
 318    /* if the first character is '+' or '-' and that's not the only */
 319    /* character it can still be an integer */
 320    i = 0;
 321    if (strpos > 0) {
 322       if (g->strbuf[0] == '-' || g->strbuf[0] == '+') {
 323          if (strpos > 1) {
 324             i = 1;
 325          } else {
 326             is_integer = 0;
 327          }
 328       }
 329    }
 330
 331    while (is_integer && i < strpos) {
 332       if (g->strbuf[i] < '0' || g->strbuf[i] > '9')
 333          is_integer = 0;
 334       i++;
 335    }
 336
 337    if (is_integer) {
 338       /* it's an integer */
 339       v = ALLOC_VALUE();
 340       v->tag = integer;
 341       ADD_CHAR('\0');
 342       v->value.integer.i = atoi(g->strbuf);
 343    }
 344    else {
 345       /* it's a symbol */
 346       if (3 == strpos &&
 347           !memcmp(g->strbuf, "nil", 3)) {
 348          v = NULL;
 349       } else {
 350          v = ALLOC_VALUE();
 351          v->tag = symbol;
 352          v->value.s.length = strpos;
 353          v->value.s.string = (char *) malloc(v->value.s.length);
 354          memcpy(v->value.s.string, g->strbuf, v->value.s.length);
 355       }
 356    }
 357    return v;
 358 }
 359
 360 Value *
 361 read_value(Globals *g)
 362 {
 363    while (g->buflen > 0) {
 364       switch (PEEK_CHAR(g)) {
 365        case ' ':
 366        case '\t':
 367        case '\n':
 368        case '\0':
 369          NEXT_CHAR(g);
 370          break;
 371        case '\"':                       /* begin string */
 372          NEXT_CHAR(g);
 373          return read_string(g);
 374          break;
 375        case '(':
 376          NEXT_CHAR(g);
 377          return read_list(g);
 378          break;
 379        case ')':
 380        case '.':
 381          return NULL;
 382          break;
 383        default:
 384          return read_num_or_symbol(g);
 385          break;
 386       }
 387    }
 388    ABORT(g, 23);
 389 }
 390
 391 Value *
 392 read_list(Globals *g)
 393 {
 394    Value *list;
 395    Value **tail;
 396    Value *v;
 397
 398    tail = &list;
 399    while (g->buflen > 0) {
 400       if (NULL == (v = read_value(g))) {
 401          switch (PEEK_CHAR(g)) {
 402
 403           case ')':
 404             if (tail != NULL) {         /* if no last cdr yet, use nil */
 405                *tail = NULL;
 406             }
 407             NEXT_CHAR(g);
 408             return list;
 409             break;
 410
 411           case '.':                     /* set last cdr explicitly */
 412             NEXT_CHAR(g);
 413             *tail = read_value(g);
 414             if (*tail == NULL) {
 415                /* badly formed input ??? */
 416                ABORT(g, 13);
 417             }
 418             tail = NULL;
 419             break;
 420
 421           default:
 422             /* badly formed input ??? */
 423             ABORT(g, 13);
 424             break;
 425          }
 426       }
 427       else {                    /* read a value, add it to the list */
 428          if (NULL == tail) {
 429             /* two values after a . in a list.  very bad! ??? */
 430             ABORT(g, 13);
 431          }
 432          *tail = ALLOC_VALUE();
 433          (*tail)->tag = cons;
 434          (*tail)->value.cons.car = v;
 435          tail = &(*tail)->value.cons.cdr;
 436       }
 437    }
 438    ABORT(g, 23);        /* added this  -dkindred */
 439 }
 440
 441 void free_value(Value *v)
 442 {
 443    switch(VTAG(v)) {
 444     case cons:
 445       free_value(v->value.cons.car);
 446       free_value(v->value.cons.cdr);
 447       break;
 448     case string:
 449     case symbol:
 450       free(v->value.s.string);
 451       break;
 452     default:
 453       break;
 454    }
 455    free(v);
 456 }
 457
 458 void prin(FILE *f, Value *v);
 459
 460 void
 461 prinlis(FILE *f, Value *v, int first)
 462 {
 463    switch(VTAG(v)) {
 464     case cons:                          /* continue printing list */
 465       if (! first)
 466          putc(' ', f);
 467       prin(f, v->value.cons.car);
 468       prinlis(f, v->value.cons.cdr, 0);
 469       break;
 470     case nil:                           /* last elt in list */
 471       putc(')', f);
 472       break;
 473     default:                            /* dotted pair */
 474       putc(' ', f);
 475       putc('.', f);
 476       putc(' ', f);
 477       prin(f, v);
 478       putc(')', f);
 479       break;
 480    }
 481 }
 482
 483 void
 484 prin(FILE *f, Value *v)
 485 {
 486    switch (VTAG(v)) {
 487     case nil:
 488       fputs("\'()", f);
 489       break;
 490     case cons:
 491       putc('(', f);
 492       prinlis(f, v, 1);
 493       break;
 494     case string:
 495       /* ??? do quoting of '"' ??? */
 496       putc('\"', f);
 497       fwrite(v->value.s.string, 1, v->value.s.length, f);
 498       putc('\"', f);
 499       break;
 500     case symbol:
 501       /* ??? do quoting of all whitespace and special chars ??? */
 502       fwrite(v->value.s.string, 1, v->value.s.length, f);
 503       break;
 504     case integer:
 505       fprintf(f, "%ld", v->value.integer.i);
 506       break;
 507     default:
 508       fputs("#<huh?>", f);
 509       break;
 510    }
 511 }
 512
 513 #define CHECK_TAG(v, t) if (VTAG(v) != (t)) return 0
 514
 515 int
 516 eqv(Value *v1, Value *v2)
 517 {
 518
 519    switch (v1->tag) {
 520 /*
 521     case any:
 522       return 1;
 523       break;
 524  */
 525     case nil:
 526       CHECK_TAG(v2, nil);
 527       return 1;
 528       break;
 529     case cons:
 530       CHECK_TAG(v2, cons);
 531       return (eqv(VCAR(v1), VCAR(v2)) &&
 532               eqv(VCDR(v1), VCDR(v2)));
 533       break;
 534     case string:
 535       CHECK_TAG(v2, string);
 536       return (VSLENGTH(v1) == VSLENGTH(v2) &&
 537               0 == memcmp(VSDATA(v1), VSDATA(v2), VSLENGTH(v1)));
 538       break;
 539     case symbol:
 540       CHECK_TAG(v2, symbol);
 541       return (VSLENGTH(v1) == VSLENGTH(v2) &&
 542               0 == memcmp(VSDATA(v1), VSDATA(v2), VSLENGTH(v1)));
 543       break;
 544     case integer:
 545       CHECK_TAG(v2, integer);
 546       return (VINTEGER(v1) == VINTEGER(v2));
 547       break;
 548     case var:
 549       if (VVTAG(v1) != any)
 550          CHECK_TAG(v2, VVTAG(v1));
 551       return 1;
 552       break;
 553     default:
 554       fprintf(stderr,"eqv(): bad tag: %d\n",(int)(v1->tag));
 555       /* die? */
 556       return 0;
 557       break;
 558    }
 559 }
 560
 561 Value *
 562 assqv(Value *key, Value *assoc)
 563 {
 564    Value *pair;
 565
 566    /* cdr on through */
 567    while (VTAG(assoc) == cons) {
 568       pair = VCAR(assoc);
 569       if (VTAG(pair) == cons && eqv(VCAR(pair), key)) {
 570          return pair;
 571       }
 572       assoc = VCDR(assoc);
 573    }
 574    return NULL;
 575 }
 576
 577 int
 578 destructure(Value *pattern, Value *match)
 579 {
 580    switch (VTAG(pattern)) {
 581     case any:
 582       return 1;
 583       break;
 584     case nil:
 585       CHECK_TAG(match, nil);
 586       return 1;
 587       break;
 588     case cons:
 589       CHECK_TAG(match, cons);
 590       return (destructure(VCAR(pattern), VCAR(match)) &&
 591               destructure(VCDR(pattern), VCDR(match)));
 592       break;
 593     case string:
 594       CHECK_TAG(match, string);
 595       return (VSLENGTH(pattern) == VSLENGTH(match) &&
 596               0 == memcmp(VSDATA(pattern), VSDATA(match), VSLENGTH(pattern)));
 597       break;
 598     case symbol:
 599       CHECK_TAG(match, symbol);
 600       return (VSLENGTH(pattern) == VSLENGTH(match) &&
 601               0 == memcmp(VSDATA(pattern), VSDATA(match), VSLENGTH(pattern)));
 602       break;
 603     case integer:
 604       CHECK_TAG(match, integer);
 605       return (VINTEGER(pattern) == VINTEGER(match));
 606       break;
 607     case var:
 608       if (VVTAG(pattern) != any)
 609          CHECK_TAG(match, VVTAG(pattern));
 610       if (VVDATA(pattern) != NULL)
 611          *VVDATA(pattern) = (void *) match;
 612       return 1;
 613       break;
 614     default:
 615       fprintf(stderr,"destructure(): bad tag: %d\n",(int)VTAG(pattern));
 616       /* die? */
 617       return 0;
 618       break;
 619    }
 620 }
 621
 622 #ifdef TEST
 623
 624 read_and_parse()
 625 {
 626 #define BUFLEN 512
 627    char buf[BUFLEN];    /* this will have to be dynamically expanded */
 628    int bufpos = 0;
 629    int ret;
 630    Value *v = NULL;
 631    Value *match_data;
 632    Value *pattern = vmake_cons(vmake_symbol_c("integer"),
 633                                vmake_var(integer, (void **) &match_data));
 634
 635    while (1) {
 636       ret = read(0, buf + bufpos, BUFLEN - bufpos);
 637       if (ret < 0) {
 638          perror("read");
 639          exit(1);
 640       }
 641       else {
 642          bufpos += ret;
 643
 644          do {
 645             if (v != NULL) {
 646                free_value(v);
 647                v = NULL;
 648             }
 649             ret = parse(bufpos, buf, &v);
 650             if (ret > 0) {
 651                memmove(buf, buf + ret, bufpos - ret);
 652                bufpos -= ret;
 653                printf("parsed: ");
 654                prin(stdout, v);
 655                fputc('\n', stdout);
 656
 657                if (destructure(pattern, v)) {
 658                   printf("match_data = ");
 659                   prin(stdout, match_data);
 660                   fputc('\n', stdout);
 661                }
 662                else {
 663                   printf("destructure failed\n");
 664                }
 665
 666                free_value(v);
 667             }
 668             else
 669                printf("EOF\n");
 670          } while (ret > 0);
 671       }
 672    }
 673 }
 674
 675 main(int argc, char *argv[])
 676 {
 677    read_and_parse();
 678 #if 0
 679       Value *v;
 680       v = ALLOC_VALUE();
 681
 682       v->tag = cons;
 683       v->value.cons.car = ALLOC_VALUE();
 684       v->value.cons.car->tag = symbol;
 685       v->value.cons.car->value.s.length = 6;
 686       v->value.cons.car->value.s.string = "symbol";
 687
 688       v->value.cons.cdr = ALLOC_VALUE();
 689       v->value.cons.cdr->tag = cons;
 690
 691       v->value.cons.cdr->value.cons.car = ALLOC_VALUE();
 692       v->value.cons.cdr->value.cons.car->tag = string;
 693       v->value.cons.cdr->value.cons.car->value.s.length = 6;
 694       v->value.cons.cdr->value.cons.car->value.s.string = "string";
 695
 696       v->value.cons.cdr->value.cons.cdr = ALLOC_VALUE();
 697       v->value.cons.cdr->value.cons.cdr->tag = integer;
 698       v->value.cons.cdr->value.cons.cdr->value.integer.i = 23;
 699       prin(stdout, v);
 700       fputc('\n', stdout);
 701 #endif
 702 }
 703 #endif