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