git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_string.c

   1 /*
   2  * Copyright © 2016 Keith Packard <keithp@keithp.com>
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; version 2 of the License.
   7  *
   8  * This program is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License along
  14  * with this program; if not, write to the Free Software Foundation, Inc.,
  15  * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
  16  */
  17
  18 #include "ao_lisp.h"
  19
  20 static void string_mark(void *addr)
  21 {
  22         (void) addr;
  23 }
  24
  25 static int string_size(void *addr)
  26 {
  27         if (!addr)
  28                 return 0;
  29         return strlen(addr) + 1;
  30 }
  31
  32 static void string_move(void *addr)
  33 {
  34         (void) addr;
  35 }
  36
  37 const struct ao_lisp_type ao_lisp_string_type = {
  38         .mark = string_mark,
  39         .size = string_size,
  40         .move = string_move,
  41         .name = "string",
  42 };
  43
  44 char *
  45 ao_lisp_string_copy(char *a)
  46 {
  47         int     alen = strlen(a);
  48
  49         ao_lisp_string_stash(0, a);
  50         char    *r = ao_lisp_alloc(alen + 1);
  51         a = ao_lisp_string_fetch(0);
  52         if (!r)
  53                 return NULL;
  54         strcpy(r, a);
  55         return r;
  56 }
  57
  58 char *
  59 ao_lisp_string_cat(char *a, char *b)
  60 {
  61         int     alen = strlen(a);
  62         int     blen = strlen(b);
  63
  64         ao_lisp_string_stash(0, a);
  65         ao_lisp_string_stash(1, b);
  66         char    *r = ao_lisp_alloc(alen + blen + 1);
  67         a = ao_lisp_string_fetch(0);
  68         b = ao_lisp_string_fetch(1);
  69         if (!r)
  70                 return NULL;
  71         strcpy(r, a);
  72         strcpy(r+alen, b);
  73         return r;
  74 }
  75
  76 ao_poly
  77 ao_lisp_string_pack(struct ao_lisp_cons *cons)
  78 {
  79         int     len = ao_lisp_cons_length(cons);
  80         ao_lisp_cons_stash(0, cons);
  81         char    *r = ao_lisp_alloc(len + 1);
  82         cons = ao_lisp_cons_fetch(0);
  83         char    *s = r;
  84
  85         while (cons) {
  86                 if (!ao_lisp_integer_typep(ao_lisp_poly_type(cons->car)))
  87                         return ao_lisp_error(AO_LISP_INVALID, "non-int passed to pack");
  88                 *s++ = ao_lisp_poly_integer(cons->car);
  89                 cons = ao_lisp_poly_cons(cons->cdr);
  90         }
  91         *s++ = 0;
  92         return ao_lisp_string_poly(r);
  93 }
  94
  95 ao_poly
  96 ao_lisp_string_unpack(char *a)
  97 {
  98         struct ao_lisp_cons     *cons = NULL, *tail = NULL;
  99         int                     c;
 100         int                     i;
 101
 102         for (i = 0; (c = a[i]); i++) {
 103                 ao_lisp_cons_stash(0, cons);
 104                 ao_lisp_cons_stash(1, tail);
 105                 ao_lisp_string_stash(0, a);
 106                 struct ao_lisp_cons     *n = ao_lisp_cons_cons(ao_lisp_int_poly(c), AO_LISP_NIL);
 107                 a = ao_lisp_string_fetch(0);
 108                 cons = ao_lisp_cons_fetch(0);
 109                 tail = ao_lisp_cons_fetch(1);
 110
 111                 if (!n) {
 112                         cons = NULL;
 113                         break;
 114                 }
 115                 if (tail)
 116                         tail->cdr = ao_lisp_cons_poly(n);
 117                 else
 118                         cons = n;
 119                 tail = n;
 120         }
 121         return ao_lisp_cons_poly(cons);
 122 }
 123
 124 void
 125 ao_lisp_string_write(ao_poly p)
 126 {
 127         char    *s = ao_lisp_poly_string(p);
 128         char    c;
 129
 130         putchar('"');
 131         while ((c = *s++)) {
 132                 switch (c) {
 133                 case '\n':
 134                         printf ("\\n");
 135                         break;
 136                 case '\r':
 137                         printf ("\\r");
 138                         break;
 139                 case '\t':
 140                         printf ("\\t");
 141                         break;
 142                 default:
 143                         if (c < ' ')
 144                                 printf("\\%03o", c);
 145                         else
 146                                 putchar(c);
 147                         break;
 148                 }
 149         }
 150         putchar('"');
 151 }
 152
 153 void
 154 ao_lisp_string_display(ao_poly p)
 155 {
 156         char    *s = ao_lisp_poly_string(p);
 157         char    c;
 158
 159         while ((c = *s++))
 160                 putchar(c);
 161 }