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) ///((arity . n))
  23 {
  24   return make_string (x);
  25 }
  26
  27 SCM
  28 string_append (SCM x) ///((arity . n))
  29 {
  30   SCM p = cell_nil;
  31   while (x != cell_nil)
  32     {
  33       SCM s = car (x);
  34       assert (TYPE (s) == STRING);
  35       p = append2 (p, STRING (s));
  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 (TYPE (x) == STRING);
  51   return make_number (VALUE (length (STRING (x))));
  52 }
  53
  54 SCM
  55 string_ref (SCM x, SCM k)
  56 {
  57   assert (TYPE (x) == STRING);
  58   assert (TYPE (k) == NUMBER);
  59   VALUE (tmp_num) = VALUE (k);
  60   return make_char (VALUE (list_ref (STRING (x), tmp_num)));
  61 }
  62
  63 SCM
  64 substring (SCM x) ///((arity . n))
  65 {
  66   assert (TYPE (x) == PAIR);
  67   assert (TYPE (car (x)) == STRING);
  68   SCM s = STRING (car (x));
  69   assert (TYPE (cadr (x)) == NUMBER);
  70   int start = VALUE (cadr (x));
  71   int end = VALUE (length (s));
  72   if (TYPE (cddr (x)) == PAIR) {
  73     assert (TYPE (caddr (x)) == NUMBER);
  74     assert (VALUE (caddr (x)) <= end);
  75     end = VALUE (caddr (x));
  76   }
  77   int n = end - start;
  78   while (start--) s = cdr (s);
  79   SCM p = cell_nil;
  80   while (n-- && s != cell_nil) {
  81     p = append2 (p, cons (make_char (VALUE (car (s))), cell_nil));
  82     s = cdr (s);
  83   }
  84   return make_string (p);
  85 }
  86
  87 SCM
  88 number_to_string (SCM x)
  89 {
  90   assert (TYPE (x) == NUMBER);
  91   int n = VALUE (x);
  92   SCM p = n < 0 ? cons (make_char ('-'), cell_nil) : cell_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 (TYPE (x) == STRING);
 104   return make_symbol (STRING (x));
 105 }
 106
 107 SCM
 108 symbol_to_string (SCM x)
 109 {
 110   assert (TYPE (x) == SYMBOL);
 111   return make_string (STRING (x));
 112 }
 113
 114 SCM
 115 keyword_to_symbol (SCM x)
 116 {
 117   assert (TYPE (x) == KEYWORD);
 118   return make_symbol (STRING (x));
 119 }
 120
 121 SCM
 122 symbol_to_keyword (SCM x)
 123 {
 124   assert (TYPE (x) == SYMBOL);
 125   return make_keyword (STRING (x));
 126 }