git.gag.com Git - fw/altos/blob - src/scheme/ao_scheme_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_scheme.h"
  19
  20 static void string_mark(void *addr)
  21 {
  22         (void) addr;
  23 }
  24
  25 static int string_size(void *addr)
  26 {
  27         struct ao_scheme_string *string = addr;
  28         if (!addr)
  29                 return 0;
  30         return strlen(string->val) + 2;
  31 }
  32
  33 static void string_move(void *addr)
  34 {
  35         (void) addr;
  36 }
  37
  38 const struct ao_scheme_type ao_scheme_string_type = {
  39         .mark = string_mark,
  40         .size = string_size,
  41         .move = string_move,
  42         .name = "string",
  43 };
  44
  45 static struct ao_scheme_string *
  46 ao_scheme_string_alloc(int len)
  47 {
  48         struct ao_scheme_string *s;
  49
  50         s = ao_scheme_alloc(len + 2);
  51         if (!s)
  52                 return NULL;
  53         s->type = AO_SCHEME_STRING;
  54         return s;
  55 }
  56
  57 struct ao_scheme_string *
  58 ao_scheme_string_copy(struct ao_scheme_string *a)
  59 {
  60         int                     alen = strlen(a->val);
  61         struct ao_scheme_string *r;
  62
  63         ao_scheme_string_stash(0, a);
  64         r = ao_scheme_string_alloc(alen);
  65         a = ao_scheme_string_fetch(0);
  66         if (!r)
  67                 return NULL;
  68         strcpy(r->val, a->val);
  69         return r;
  70 }
  71
  72 struct ao_scheme_string *
  73 ao_scheme_string_make(char *a)
  74 {
  75         struct ao_scheme_string *r;
  76
  77         r = ao_scheme_string_alloc(strlen(a));
  78         if (!r)
  79                 return NULL;
  80         strcpy(r->val, a);
  81         return r;
  82 }
  83
  84 struct ao_scheme_string *
  85 ao_scheme_atom_to_string(struct ao_scheme_atom *a)
  86 {
  87         int                     alen = strlen(a->name);
  88         struct ao_scheme_string *r;
  89
  90         ao_scheme_poly_stash(0, ao_scheme_atom_poly(a));
  91         r = ao_scheme_string_alloc(alen);
  92         a = ao_scheme_poly_atom(ao_scheme_poly_fetch(0));
  93         if (!r)
  94                 return NULL;
  95         strcpy(r->val, a->name);
  96         return r;
  97 }
  98
  99 struct ao_scheme_string *
 100 ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b)
 101 {
 102         int                             alen = strlen(a->val);
 103         int                             blen = strlen(b->val);
 104         struct ao_scheme_string         *r;
 105
 106         ao_scheme_string_stash(0, a);
 107         ao_scheme_string_stash(1, b);
 108         r = ao_scheme_string_alloc(alen + blen);
 109         a = ao_scheme_string_fetch(0);
 110         b = ao_scheme_string_fetch(1);
 111         if (!r)
 112                 return NULL;
 113         strcpy(r->val, a->val);
 114         strcpy(r->val+alen, b->val);
 115         return r;
 116 }
 117
 118 ao_poly
 119 ao_scheme_string_pack(struct ao_scheme_cons *cons)
 120 {
 121         struct ao_scheme_string *r;
 122         char                    *rval;
 123         int                     len;
 124
 125         len = ao_scheme_cons_length(cons);
 126         ao_scheme_cons_stash(0, cons);
 127         r = ao_scheme_string_alloc(len);
 128         cons = ao_scheme_cons_fetch(0);
 129         if (!r)
 130                 return AO_SCHEME_NIL;
 131         rval = r->val;
 132
 133         while (cons) {
 134                 bool fail = false;
 135                 ao_poly car = cons->car;
 136                 *rval++ = ao_scheme_poly_integer(car, &fail);
 137                 if (fail)
 138                         return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack");
 139                 cons = ao_scheme_cons_cdr(cons);
 140         }
 141         *rval++ = 0;
 142         return ao_scheme_string_poly(r);
 143 }
 144
 145 ao_poly
 146 ao_scheme_string_unpack(struct ao_scheme_string *a)
 147 {
 148         struct ao_scheme_cons   *cons = NULL, *tail = NULL;
 149         int                     c;
 150         int                     i;
 151
 152         for (i = 0; (c = a->val[i]); i++) {
 153                 struct ao_scheme_cons   *n;
 154                 ao_scheme_cons_stash(0, cons);
 155                 ao_scheme_cons_stash(1, tail);
 156                 ao_scheme_string_stash(0, a);
 157                 n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
 158                 a = ao_scheme_string_fetch(0);
 159                 cons = ao_scheme_cons_fetch(0);
 160                 tail = ao_scheme_cons_fetch(1);
 161
 162                 if (!n) {
 163                         cons = NULL;
 164                         break;
 165                 }
 166                 if (tail)
 167                         tail->cdr = ao_scheme_cons_poly(n);
 168                 else
 169                         cons = n;
 170                 tail = n;
 171         }
 172         return ao_scheme_cons_poly(cons);
 173 }
 174
 175 void
 176 ao_scheme_string_write(ao_poly p, bool write)
 177 {
 178         struct ao_scheme_string *s = ao_scheme_poly_string(p);
 179         char                    *sval = s->val;
 180         char                    c;
 181
 182         if (write) {
 183                 putchar('"');
 184                 while ((c = *sval++)) {
 185                         switch (c) {
 186                         case '\n':
 187                                 printf ("\\n");
 188                                 break;
 189                         case '\r':
 190                                 printf ("\\r");
 191                                 break;
 192                         case '\t':
 193                                 printf ("\\t");
 194                                 break;
 195                         default:
 196                                 if (c < ' ')
 197                                         printf("\\%03o", c);
 198                                 else
 199                                         putchar(c);
 200                                 break;
 201                         }
 202                 }
 203                 putchar('"');
 204         } else {
 205                 while ((c = *sval++))
 206                         putchar(c);
 207         }
 208 }