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         s->val[len] = '\0';
  55         return s;
  56 }
  57
  58 struct ao_scheme_string *
  59 ao_scheme_string_copy(struct ao_scheme_string *a)
  60 {
  61         int                     alen = strlen(a->val);
  62         struct ao_scheme_string *r;
  63
  64         ao_scheme_string_stash(a);
  65         r = ao_scheme_string_alloc(alen);
  66         a = ao_scheme_string_fetch();
  67         if (!r)
  68                 return NULL;
  69         strcpy(r->val, a->val);
  70         return r;
  71 }
  72
  73 struct ao_scheme_string *
  74 ao_scheme_make_string(int32_t len, char fill)
  75 {
  76         struct ao_scheme_string *r;
  77
  78         r = ao_scheme_string_alloc(len);
  79         if (!r)
  80                 return NULL;
  81         memset(r->val, fill, len);
  82         return r;
  83 }
  84
  85 struct ao_scheme_string *
  86 ao_scheme_string_new(char *a)
  87 {
  88         struct ao_scheme_string *r;
  89
  90         r = ao_scheme_string_alloc(strlen(a));
  91         if (!r)
  92                 return NULL;
  93         strcpy(r->val, a);
  94         return r;
  95 }
  96
  97 struct ao_scheme_string *
  98 ao_scheme_atom_to_string(struct ao_scheme_atom *a)
  99 {
 100         int                     alen = strlen(a->name);
 101         struct ao_scheme_string *r;
 102
 103         ao_scheme_atom_stash(a);
 104         r = ao_scheme_string_alloc(alen);
 105         a = ao_scheme_atom_fetch();
 106         if (!r)
 107                 return NULL;
 108         strcpy(r->val, a->name);
 109         return r;
 110 }
 111
 112 struct ao_scheme_string *
 113 ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b)
 114 {
 115         int                             alen = strlen(a->val);
 116         int                             blen = strlen(b->val);
 117         struct ao_scheme_string         *r;
 118
 119         ao_scheme_string_stash(a);
 120         ao_scheme_string_stash(b);
 121         r = ao_scheme_string_alloc(alen + blen);
 122         b = ao_scheme_string_fetch();
 123         a = ao_scheme_string_fetch();
 124         if (!r)
 125                 return NULL;
 126         strcpy(r->val, a->val);
 127         strcpy(r->val+alen, b->val);
 128         return r;
 129 }
 130
 131 ao_poly
 132 ao_scheme_string_pack(struct ao_scheme_cons *cons)
 133 {
 134         struct ao_scheme_string *r;
 135         char                    *rval;
 136         int                     len;
 137
 138         len = ao_scheme_cons_length(cons);
 139         ao_scheme_cons_stash(cons);
 140         r = ao_scheme_string_alloc(len);
 141         cons = ao_scheme_cons_fetch();
 142         if (!r)
 143                 return AO_SCHEME_NIL;
 144         rval = r->val;
 145
 146         while (cons) {
 147                 bool fail = false;
 148                 ao_poly car = cons->car;
 149                 *rval++ = ao_scheme_poly_integer(car, &fail);
 150                 if (fail)
 151                         return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack");
 152                 cons = ao_scheme_cons_cdr(cons);
 153         }
 154         return ao_scheme_string_poly(r);
 155 }
 156
 157 ao_poly
 158 ao_scheme_string_unpack(struct ao_scheme_string *a)
 159 {
 160         struct ao_scheme_cons   *cons = NULL, *tail = NULL;
 161         int                     c;
 162         int                     i;
 163
 164         for (i = 0; (c = a->val[i]); i++) {
 165                 struct ao_scheme_cons   *n;
 166                 ao_scheme_cons_stash(cons);
 167                 ao_scheme_cons_stash(tail);
 168                 ao_scheme_string_stash(a);
 169                 n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
 170                 a = ao_scheme_string_fetch();
 171                 tail = ao_scheme_cons_fetch();
 172                 cons = ao_scheme_cons_fetch();
 173
 174                 if (!n) {
 175                         cons = NULL;
 176                         break;
 177                 }
 178                 if (tail)
 179                         tail->cdr = ao_scheme_cons_poly(n);
 180                 else
 181                         cons = n;
 182                 tail = n;
 183         }
 184         return ao_scheme_cons_poly(cons);
 185 }
 186
 187 void
 188 ao_scheme_string_write(ao_poly p, bool write)
 189 {
 190         struct ao_scheme_string *s = ao_scheme_poly_string(p);
 191         char                    *sval = s->val;
 192         char                    c;
 193
 194         if (write) {
 195                 putchar('"');
 196                 while ((c = *sval++)) {
 197                         switch (c) {
 198                         case '\a':
 199                                 printf("\\a");
 200                                 break;
 201                         case '\b':
 202                                 printf("\\b");
 203                                 break;
 204                         case '\t':
 205                                 printf ("\\t");
 206                                 break;
 207                         case '\n':
 208                                 printf ("\\n");
 209                                 break;
 210                         case '\r':
 211                                 printf ("\\r");
 212                                 break;
 213                         case '\f':
 214                                 printf("\\f");
 215                                 break;
 216                         case '\v':
 217                                 printf("\\v");
 218                                 break;
 219                         case '\"':
 220                                 printf("\\\"");
 221                                 break;
 222                         case '\\':
 223                                 printf("\\\\");
 224                                 break;
 225                         default:
 226                                 if (c < ' ')
 227                                         printf("\\%03o", c);
 228                                 else
 229                                         putchar(c);
 230                                 break;
 231                         }
 232                 }
 233                 putchar('"');
 234         } else {
 235                 while ((c = *sval++))
 236                         putchar(c);
 237         }
 238 }