string.c

   1 /* -*-comment-start: "//";comment-end:""-*-
   2  * Mes --- Maxwell Equations of Software
   3  * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   4  *
   5  * This file is part of Mes.
   6  *
   7  * Mes is free software; you can redistribute it and/or modify it
   8  * under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3 of the License, or (at
  10  * your option) any later version.
  11  *
  12  * Mes is distributed in the hope that it will be useful, but
  13  * 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
  19  */
  20
  21 scm *
  22 string (scm *x) ///((args . n))
  23 {
  24   char buf[STRING_MAX] = "";
  25   char *p = buf;
  26   while (x != &scm_nil)
  27     {
  28       scm *s = car (x);
  29       assert (s->type == CHAR);
  30       *p++ = s->value;
  31       x = cdr (x);
  32     }
  33   return make_string (buf);
  34 }
  35
  36 scm *
  37 string_append (scm *x) ///((args . n))
  38 {
  39   char buf[STRING_MAX] = "";
  40
  41   while (x != &scm_nil)
  42     {
  43       scm *s = car (x);
  44       assert (s->type == STRING);
  45       strcat (buf, s->name);
  46       x = cdr (x);
  47     }
  48   return make_string (buf);
  49 }
  50
  51 scm *
  52 list_to_string (scm *x)
  53 {
  54   char buf[STRING_MAX] = "";
  55   char *p = buf;
  56   while (x != &scm_nil)
  57     {
  58       scm *s = car (x);
  59       assert (s->type == CHAR);
  60       *p++ = s->value;
  61       x = cdr (x);
  62     }
  63   *p = 0;
  64   return make_string (buf);
  65 }
  66
  67 scm *
  68 string_length (scm *x)
  69 {
  70   assert (x->type == STRING);
  71   return make_number (strlen (x->name));
  72 }
  73
  74 scm *
  75 string_ref (scm *x, scm *k)
  76 {
  77   assert (x->type == STRING);
  78   assert (k->type == NUMBER);
  79   return make_char (x->name[k->value]);
  80 }
  81
  82 scm *
  83 substring (scm *x) ///((args . n))
  84 {
  85   assert (x->type == PAIR);
  86   assert (x->car->type == STRING);
  87   char const *s = x->car->name;
  88   assert (x->cdr->car->type == NUMBER);
  89   int start = x->cdr->car->value;
  90   int end = strlen (s);
  91   if (x->cdr->cdr->type == PAIR) {
  92     assert (x->cdr->cdr->car->type == NUMBER);
  93     assert (x->cdr->cdr->car->value <= end);
  94     end = x->cdr->cdr->car->value;
  95   }
  96   char buf[STRING_MAX];
  97   strncpy (buf, s+start, end - start);
  98   buf[end-start] = 0;
  99   return make_string (buf);
 100 }
 101
 102 scm *
 103 number_to_string (scm *x)
 104 {
 105   assert (x->type == NUMBER);
 106   char buf[STRING_MAX];
 107   sprintf (buf,"%d", x->value);
 108   return make_string (buf);
 109 }
 110
 111 scm *
 112 string_to_symbol (scm *x)
 113 {
 114   assert (x->type == STRING);
 115   return make_symbol (x->name);
 116 }
 117
 118 scm *
 119 symbol_to_string (scm *x)
 120 {
 121   assert (x->type == SYMBOL);
 122   return make_string (x->name);
 123 }