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   return make_string (x);
  25 }
  26
  27 scm *
  28 string_append (scm *x) ///((args . n))
  29 {
  30   scm *p = &scm_nil;
  31   while (x != &scm_nil)
  32     {
  33       scm *s = car (x);
  34       assert (s->type == STRING);
  35       p = append2 (p, s->string);
  36       x = cdr (x);
  37     }
  38   return make_string (p);
  39 }
  40
  41 scm *
  42 list_to_string (scm *x)
  43 {
  44   return make_string (x);
  45 }
  46
  47 scm *
  48 string_length (scm *x)
  49 {
  50   assert (x->type == STRING);
  51   return make_number (length (x->string)->value);
  52 }
  53
  54 scm *
  55 string_ref (scm *x, scm *k)
  56 {
  57   assert (x->type == STRING);
  58   assert (k->type == NUMBER);
  59   scm n = {NUMBER, .value=k->value};
  60   return make_char (list_ref (x->string, &n)->value);
  61 }
  62
  63 scm *
  64 substring (scm *x) ///((args . n))
  65 {
  66   assert (x->type == PAIR);
  67   assert (x->car->type == STRING);
  68   scm *s = x->car->string;
  69   assert (x->cdr->car->type == NUMBER);
  70   int start = x->cdr->car->value;
  71   int end = length (s)->value;
  72   if (x->cdr->cdr->type == PAIR) {
  73     assert (x->cdr->cdr->car->type == NUMBER);
  74     assert (x->cdr->cdr->car->value <= end);
  75     end = x->cdr->cdr->car->value;
  76   }
  77   int n = end - start;
  78   while (start--) s = s->cdr;
  79   scm *p = &scm_nil;
  80   while (n-- && s != &scm_nil) {
  81     p = append2 (p, cons (make_char (s->car->value), &scm_nil));
  82     s = s->cdr;
  83   }
  84   return make_string (p);
  85 }
  86
  87 scm *
  88 number_to_string (scm *x)
  89 {
  90   assert (x->type == NUMBER);
  91   int n = x->value;
  92   scm *p = n < 0 ? cons (make_char ('-'), &scm_nil) : &scm_nil;
  93   do {
  94     p = cons (make_char (n % 10 + '0'), p);
  95     n = n / 10;
  96   } while (n);
  97   return make_string (p);
  98 }
  99
 100 scm *
 101 string_to_symbol (scm *x)
 102 {
 103   assert (x->type == STRING);
 104   return make_symbol (x->string);
 105 }
 106
 107 scm *
 108 symbol_to_string (scm *x)
 109 {
 110   assert (x->type == SYMBOL);
 111   return make_string (x->string);
 112 }