mes_string.c 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154
  1. /* -*-comment-start: "//";comment-end:""-*-
  2. * GNU Mes --- Maxwell Equations of Software
  3. * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  4. * Copyright © 2019 Jeremiah Orians
  5. *
  6. * This file is part of GNU Mes.
  7. *
  8. * GNU Mes is free software; you can redistribute it and/or modify it
  9. * under the terms of the GNU General Public License as published by
  10. * the Free Software Foundation; either version 3 of the License, or (at
  11. * your option) any later version.
  12. *
  13. * GNU Mes is distributed in the hope that it will be useful, but
  14. * WITHOUT ANY WARRANTY; without even the implied warranty of
  15. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. * GNU General Public License for more details.
  17. *
  18. * You should have received a copy of the GNU General Public License
  19. * along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
  20. */
  21. #include "mes.h"
  22. /* Imported functions */
  23. char* ntoab(SCM x, int base, int signed_p);
  24. int string_size(char* a);
  25. struct cell* make_int(int a);
  26. struct cell* make_string(char* a);
  27. struct cell* make_sym(char* name);
  28. struct cell* string_length(struct cell* a)
  29. {
  30. require(a->type == STRING, "Wrong type recieved\n");
  31. return make_int(string_size(a->string));
  32. }
  33. struct cell* string_eq(struct cell* a, struct cell* b)
  34. {
  35. require(a->type == STRING, "Wrong type recieved\n");
  36. require(b->type == STRING, "Wrong type recieved\n");
  37. if(match(a->string, b->string)) return cell_t;
  38. return cell_f;
  39. }
  40. /****************************************************************
  41. * Functions for reducing wasted memory *
  42. ****************************************************************/
  43. void reset_block(char* a)
  44. {
  45. int c;
  46. do
  47. {
  48. c = a[0];
  49. a[0] = 0;
  50. a = a + 1;
  51. } while(0 != c);
  52. }
  53. char* copy_string(char* target, char* source)
  54. {
  55. while(0 != source[0])
  56. {
  57. target[0] = source[0];
  58. target = target + 1;
  59. source = source + 1;
  60. }
  61. return target;
  62. }
  63. char* string_append(char* a, char* b)
  64. {
  65. if(NULL == a) return b;
  66. if(NULL == b) return a;
  67. int a_size = string_size(a);
  68. int buffer_size = a_size + string_size(b) + 1;
  69. char* buffer = calloc(buffer_size, sizeof(char));
  70. copy_string(buffer, a);
  71. copy_string(buffer + a_size, b);
  72. return buffer;
  73. }
  74. /* Exposed primitives */
  75. struct cell* builtin_stringp(struct cell* args)
  76. {
  77. require(nil != args, "string? requires arguments\n");
  78. require(nil == args->cdr, "string? recieved too many arguments\n");
  79. if(STRING == args->car->type) return cell_t;
  80. return cell_f;
  81. }
  82. struct cell* builtin_stringeq(struct cell* args)
  83. {
  84. require(nil != args, "string=? requires arguments\n");
  85. require(STRING == args->car->type, "string=? received non-string\n");
  86. struct cell* temp = args->car;
  87. for(args = args->cdr; nil != args; args = args->cdr)
  88. {
  89. require(STRING == args->car->type, "string=? received non-string\n");
  90. if(cell_t != string_eq(temp, args->car))
  91. {
  92. return cell_f;
  93. }
  94. }
  95. return cell_t;
  96. }
  97. struct cell* builtin_string_size(struct cell* args)
  98. {
  99. require(nil != args, "string-length requires an argument\n");
  100. require(nil == args->cdr, "string-length only allows a single argument\n");
  101. return string_length(args->car);
  102. }
  103. struct cell* builtin_string_to_number(struct cell* args)
  104. {
  105. require(nil != args, "string->number requires an argument\n");
  106. require(nil == args->cdr, "string->number only supports a single argument (currently)\n");
  107. require(STRING == args->car->type, "string->number requires a string\n");
  108. int i = numerate_string(args->car->string);
  109. if(0 != i) return make_int(i);
  110. if('0' == args->car->string[0]) return make_int(i);
  111. return cell_f;
  112. }
  113. struct cell* builtin_string_to_symbol(struct cell* args)
  114. {
  115. require(nil != args, "string->symbol requires an argument\n");
  116. require(nil == args->cdr, "string->symbol only supports a single argument\n");
  117. require(STRING == args->car->type, "string->symbol requires a string\n");
  118. return make_sym(args->car->string);
  119. }
  120. struct cell* builtin_symbol_to_string(struct cell* args)
  121. {
  122. require(nil != args, "symbol->string requires an argument\n");
  123. require(nil == args->cdr, "symbol->string only supports a single argument\n");
  124. require(SYM == args->car->type, "symbol->string requires a symbol\n");
  125. return make_string(args->car->string);
  126. }
  127. struct cell* builtin_number_to_string(struct cell* args)
  128. {
  129. require(nil != args, "number->string requires an argument\n");
  130. require(INT == args->car->type, "number->string requires an integer\n");
  131. if(nil == args->cdr) return make_string(ntoab(args->car->value, 10, TRUE));
  132. require(INT == args->cdr->car->type, "number->string only accepts integer ranges\n");
  133. require(2 <= args->cdr->car->value, "number->string Value out of range 2 to 36\n");
  134. require(36 >= args->cdr->car->value, "number->string Value out of range 2 to 36\n");
  135. require(nil == args->cdr->cdr, "number->string does not support more than 2 arguments\n");
  136. return make_string(ntoab(args->car->value, args->cdr->car->value, TRUE));
  137. }