Skip to content

Commit 783e001

Browse files
NJdevProNJdevPro
committed
Add strings and string functions
Add file load.
1 parent 10480ae commit 783e001

4 files changed

Lines changed: 163 additions & 28 deletions

File tree

‎README.md‎

Lines changed: 28 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -260,9 +260,9 @@ exhaustion error.
260260

261261
`progn` executes several expressions consecutively.
262262

263-
(progn (println 'I 'own)
263+
(progn (print 'I 'own)
264264
(defun add(x y)(+ x y)
265-
(println (add 3 7) 'cents) ; -> I own
265+
(println (add 3 7) 'cents))) ; -> I own
266266
10 cents
267267

268268
### Equivalence test operators
@@ -271,12 +271,35 @@ exhaustion error.
271271
really does is a pointer comparison, so two objects happened to have the same
272272
contents but actually different are considered to not be the same by `eq`.
273273

274+
### String functions
275+
276+
`string=` compares two strings.
277+
278+
(string= "Hello" "Hello") ; -> t
279+
(string= "Hello" "World") ; -> ()
280+
281+
`string-concat` concatenates strings.
282+
283+
(string-concat) ; -> ""
284+
(string-concat "A" "B" "C" "D") ; -> "ABCD"
285+
286+
`symbol->string` turns a symbol into a string.
287+
288+
(define sym 'hello) ; -> hello
289+
(symbol->string sym) ; -> "hello"
290+
291+
`string->symbol` turns a string into a symbol of the same name.
292+
293+
(string->symbol "hello") ; -> hello
294+
274295
### Output operators
275296

276-
`println` prints a given object to the standard output.
297+
`print` prints a given object to the standard output.
298+
299+
(print 3) ; prints "3"
300+
(print '(hello world)) ; prints "(hello world)"
277301

278-
(println 3) ; prints "3"
279-
(println '(hello world)) ; prints "(hello world)"
302+
`println` does the same, adding a return at the end.
280303

281304
### Definitions
282305

‎examples/hanoi.lisp‎

Lines changed: 4 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,4 @@
1-
;(defun list (x . y) (cons x y))
2-
3-
;(defun list2 (a b) (cons a (cons b ())))
4-
;(defun list3 (a b c) (cons a (cons b (cons c ()))))
5-
6-
(defmacro cond (rest)
7-
(if (= () rest)
8-
()
9-
(if (= (car (car rest)) t)
10-
(car (cdr (car rest)))
11-
(list 'if
12-
(car (car rest))
13-
(car (cdr (car rest)))
14-
(cond (cdr rest))))))
1+
(defun list (x . y) (cons x y))
152

163
(defun mapc1 (fn xs)
174
(if (= () xs)
@@ -21,13 +8,9 @@
218
(mapc1 fn (cdr xs)))))
229

2310
(defun hanoi-print (disk from to)
24-
(println (cons 'Move
25-
(cons 'disk
26-
(cons disk
27-
(cons 'from
28-
(cons from
29-
(cons 'to
30-
(cons to ())))))))))
11+
(println (string-concat "Move disk " disk
12+
" from " (symbol->string from)
13+
" to " (symbol->string to) )))
3114

3215
(defun hanoi-move (n from to via)
3316
(if (= n 1)

‎src/minilisp.c‎

Lines changed: 130 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -197,6 +197,38 @@ static Obj *read_symbol(void *root, char c) {
197197
return intern(root, buf);
198198
}
199199

200+
static Obj *make_string(void *root, const char *str) {
201+
size_t len = strlen(str);
202+
Obj *r = alloc(root, TSTRING, len + 1);
203+
strcpy(r->name, str); // We can reuse the name field for string data
204+
return r;
205+
}
206+
207+
static Obj *read_string(void *root) {
208+
char buf[1024];
209+
int i = 0;
210+
211+
while (1) {
212+
int c = getchar();
213+
if (c == EOF)
214+
error("Unclosed string literal");
215+
if (c == '"')
216+
break;
217+
if (c == '\\') {
218+
c = getchar();
219+
if (c == 'n') c = '\n';
220+
else if (c == 't') c = '\t';
221+
else if (c == 'r') c = '\r';
222+
// Add more escape sequences as needed
223+
}
224+
if (i >= sizeof(buf) - 1)
225+
error("String too long");
226+
buf[i++] = c;
227+
}
228+
buf[i] = '\0';
229+
return make_string(root, buf);
230+
}
231+
200232
static Obj *read_expr(void *root) {
201233
for (;;) {
202234
char c = getchar();
@@ -216,6 +248,8 @@ static Obj *read_expr(void *root) {
216248
return Dot;
217249
if (c == '\'')
218250
return read_quote(root);
251+
if (c == '"')
252+
return read_string(root);
219253
if (isdigit(c))
220254
return make_int(root, read_number(c - '0'));
221255
if (c == '-' && isdigit(peek()))
@@ -262,6 +296,17 @@ static void print(Obj *obj) {
262296
break;
263297
case TNIL : fputs("()", stdout);
264298
break;
299+
case TSTRING:
300+
fputc('"', stdout);
301+
for (char *p = obj->name; *p; p++) {
302+
if (*p == '"') printf("\\\"");
303+
else if (*p == '\n') fputc('\n', stdout);
304+
else if (*p == '\t') fputc('\t', stdout);
305+
else if (*p == '\r') fputc('\r', stdout);
306+
else fputc(*p, stdout);
307+
}
308+
fputc('"', stdout);
309+
break;
265310
default:
266311
error("Bug: print: Unknown tag type: %d", obj->type);
267312
}
@@ -382,6 +427,7 @@ static Obj *macroexpand(void *root, Obj **env, Obj **obj) {
382427
static Obj *eval(void *root, Obj **env, Obj **obj) {
383428
switch ((*obj)->type) {
384429
case TINT:
430+
case TSTRING:
385431
case TPRIMITIVE:
386432
case TFUNCTION:
387433
case TTRUE:
@@ -668,11 +714,12 @@ extern void process_file(char *fname, Obj **env, Obj **expr);
668714
static Obj *prim_load(void *root, Obj **env, Obj **list) {
669715
DEFINE1(expr);
670716
Obj *args = eval_list(root, env, list);
671-
if (args->car->type != TSYMBOL){
672-
error("load: filename must be a symbol");
717+
if (args->car->type != TSTRING){
718+
error("load: filename must be a string");
673719
}
674720
char *name = args->car->name;
675721
process_file(name, env, expr );
722+
return Nil;
676723
}
677724

678725
static Obj *prim_exit(void *root, Obj **env, Obj **list) {
@@ -802,6 +849,83 @@ static Obj *prim_eq(void *root, Obj **env, Obj **list) {
802849
return values->car == values->cdr->car ? True : Nil;
803850
}
804851

852+
// String primitives
853+
static Obj *prim_string_concat(void *root, Obj **env, Obj **list) {
854+
Obj *args = eval_list(root, env, list);
855+
856+
// First pass: calculate total length needed
857+
size_t total_len = 1; // Start with 1 for null terminator
858+
for (Obj *p = args; p != Nil; p = p->cdr) {
859+
if (p->car->type != TSTRING && p->car->type != TINT)
860+
error("string-concat arguments must be strings or numbers");
861+
if (p->car->type == TINT) {
862+
long long val = p->car->value;
863+
char var[22];
864+
snprintf(var, sizeof(var), "%lld", val);
865+
total_len += strlen(var);
866+
}
867+
else {
868+
total_len += strlen(p->car->name);
869+
}
870+
}
871+
872+
char *buf = malloc(total_len);
873+
if (!buf)
874+
error("Out of memory in string-concat");
875+
buf[0] = '\0';
876+
877+
// Second pass: concatenate all strings
878+
for (Obj *p = args; p != Nil; p = p->cdr) {
879+
if (p->car->type == TINT) {
880+
long long val = p->car->value;
881+
char var[22];
882+
snprintf(var, sizeof(var), "%lld", val);
883+
strcat(buf, var);
884+
}
885+
else {
886+
strcat(buf, p->car->name);
887+
}
888+
}
889+
890+
Obj *result = make_string(root, buf);
891+
free(buf);
892+
return result;
893+
}
894+
895+
static Obj *prim_symbol_to_string(void *root, Obj **env, Obj **list) {
896+
Obj *args = eval_list(root, env, list);
897+
if (length(args) != 1)
898+
error("symbol->string requires 1 argument");
899+
900+
if (args->car->type != TSYMBOL)
901+
error("symbol->string argument must be a symbol");
902+
903+
return make_string(root, args->car->name);
904+
}
905+
906+
static Obj *prim_string_to_symbol(void *root, Obj **env, Obj **list) {
907+
Obj *args = eval_list(root, env, list);
908+
if (length(args) != 1)
909+
error("string->symbol requires 1 argument");
910+
911+
if (args->car->type != TSTRING)
912+
error("string->symbol argument must be a string");
913+
914+
return intern(root, args->car->name);
915+
}
916+
917+
// String comparison
918+
static Obj *prim_string_eq(void *root, Obj **env, Obj **list) {
919+
Obj *args = eval_list(root, env, list);
920+
if (length(args) != 2)
921+
error("string= requires 2 arguments");
922+
923+
if (args->car->type != TSTRING || args->cdr->car->type != TSTRING)
924+
error("string= arguments must be strings");
925+
926+
return strcmp(args->car->name, args->cdr->car->name) == 0 ? True : Nil;
927+
}
928+
805929
static void add_primitive(void *root, Obj **env, char *name, Primitive *fn) {
806930
DEFINE2(sym, prim);
807931
*sym = intern(root, name);
@@ -849,6 +973,10 @@ static void define_primitives(void *root, Obj **env) {
849973
add_primitive(root, env, "progn", prim_progn);
850974
add_primitive(root, env, "print", prim_print);
851975
add_primitive(root, env, "println", prim_println);
976+
add_primitive(root, env, "string-concat", prim_string_concat);
977+
add_primitive(root, env, "symbol->string", prim_symbol_to_string);
978+
add_primitive(root, env, "string->symbol", prim_string_to_symbol);
979+
add_primitive(root, env, "string=", prim_string_eq);
852980
add_primitive(root, env, "load", prim_load);
853981
add_primitive(root, env, "exit", prim_exit);
854982
}

‎src/minilisp.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ enum {
2424
// can be found at the forwarding pointer. Only the functions to do garbage collection set and
2525
// handle the object of this type. Other functions will never see the object of this type.
2626
TMOVED,
27+
TSTRING,
2728
// Const objects. They are statically allocated and will never be managed by GC.
2829
TTRUE,
2930
TNIL,

0 commit comments

Comments
 (0)