miniscm: list->string

miniscm/init.scm

@@ -107,15 +107,6 @@
              (list<=> (cdr x) (cdr y) <=>)
              dir))))))
 
-(define string<=>
-  (lambda (x y)
-    (list<=> x y (lambda (x y)
-                   (if (eqv? x y)
-                       '=
-                       (if (< (char->integer x) (char->integer y))
-                           '<
-                           '>))))))
-
 (define max
   (lambda (curmax . rest)
     (if (null? rest)
@@ -151,6 +142,10 @@
                                   lst))))))
         (loop 0)))))
 
+(define string
+  (lambda args
+    (list->string args)))
+
 (macro
  cond-expand
  (lambda (body)

miniscm/miniscm.c

@@ -1217,6 +1217,7 @@ register pointer a, b;
 #define OP_CHAR2INT             111
 #define OP_STRINGREF            112
 #define OP_STRINGLEN            113
+#define OP_LIST2STRING          114
 
 static FILE *tmpfp;
 static int tok;
@@ -2362,6 +2363,43 @@ register short op;
 	return T;
 }
 
+pointer opexe_list2string(op)
+register short op;
+{
+	register pointer head, ch;
+	char buf[128];
+	register int i = 0;
+
+	switch (op) {
+	case OP_LIST2STRING:
+		head = car(args);
+		while (ispair(head)) {
+			if (i >= sizeof(buf) - 1) {
+				Error_0("list->string -- too long");
+			}
+
+			ch = car(head);
+			if (!ischar(ch)) {
+				Error_0("list->string -- non char found");
+			}
+			buf[i++] = ivalue(ch);
+
+			head = cdr(head);
+		}
+
+		if (head != NIL) {
+			Error_0("list->string -- not a list");
+		}
+
+		buf[i] = 0;
+		s_return(mk_string(buf));
+	default:
+		sprintf(strbuff, "%d is illegal operator", operator);
+		Error_0(strbuff);
+	}
+
+	return T;
+}
 
 pointer	(*dispatch_table[])() = {
 	opexe_0,	/* OP_LOAD = 0, */
@@ -2490,7 +2528,8 @@ pointer	(*dispatch_table[])() = {
 
 	opexe_2,        /* OP_CHAR2INT */
 	opexe_4,        /* OP_STRINGREF */
-	opexe_4         /* OP_STRINGLEN */
+	opexe_4,        /* OP_STRINGLEN */
+	opexe_list2string         /* OP_LIST2STRING */
 };
 
 
@@ -2652,6 +2691,7 @@ init_procs()
 
 	mk_proc(OP_STRINGREF, "string-ref");
 	mk_proc(OP_STRINGLEN, "string-length");
+	mk_proc(OP_LIST2STRING, "list->string");
 }