diff --git a/miniscm/init.scm b/miniscm/init.scm index 725c7d0..2427772 100644 --- a/miniscm/init.scm +++ b/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) diff --git a/miniscm/miniscm.c b/miniscm/miniscm.c index 7500ad2..d2ec49f 100644 --- a/miniscm/miniscm.c +++ b/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"); }