miniscm: add mutable string emulation and char->integer

3 files changed, 54 insertions, 3 deletions

diff --git a/README.rst b/README.rst
index fe60d08..52cd843 100644
--- a/README.rst
+++ b/README.rst
@@ -20,7 +20,7 @@ designed to be used by a severely limited Scheme interpreter, which
   (except ``open-input-port``, ``close-input-port``, ``read-char``,
    ``open-output-port``, ``close-output-port``, ``write-char``)
 * has fixnums only
-* minimizes the use of strings
+* only uses immutable strings
 * does not use "load" recursively
 
-The goal is to have the compiler run under MiniScheme 0.85 in DOS.
+The goal is to have the compiler run under MiniScheme in DOS.
diff --git a/miniscm/init.scm b/miniscm/init.scm
index 6db7145..c3f5612 100644
--- a/miniscm/init.scm
+++ b/miniscm/init.scm
@@ -1,6 +1,8 @@
 ; This is a init file for Mini-Scheme.
 ; Modified for UNSLISP.
 
+(define modulo remainder)
+
 (define (caar x) (car (car x)))
 (define (cadr x) (car (cdr x)))
 (define (cdar x) (cdr (car x)))
@@ -48,6 +50,16 @@
 (define vector-ref list-ref)
 (define vector-set! list-set!)
 
+(define make-vector
+  (lambda (num)
+    (letrec
+        ((loop
+          (lambda (iter cell)
+            (if (= iter 0)
+                cell
+                (loop (- iter 1) (cons #f cell))))))
+      (loop num '()))))
+
 (define (head stream) (car stream))
 
 (define (tail stream) (force (cdr stream)))
@@ -75,3 +87,30 @@
          (equal? (cdr x) (cdr y)))
     (and (not (pair? y))
          (eqv? x y))))
+
+;;; Emulation of mutable strings.
+
+(define string-ref list-ref)
+(define string-set! list-set!)
+(define string list)
+
+(define list<=>
+  (lambda (x y <=>)
+    (cond
+      ((and (null? x) (null? y)) '=)
+      ((null? x) '<)
+      ((null? y) '>)
+      (else
+       (let ((dir (<=> (car x) (car y))))
+         (if (eq? dir '=)
+             (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))
+                           '<
+                           '>))))))
diff --git a/miniscm/miniscm.c b/miniscm/miniscm.c
index ec10d60..e7597c9 100644
--- a/miniscm/miniscm.c
+++ b/miniscm/miniscm.c
@@ -1213,6 +1213,8 @@ register pointer a, b;
 #define OP_CLOSEOUT             109
 #define OP_WRITEOUT             110
 
+#define OP_CHAR2INT             111
+
 static FILE *tmpfp;
 static int tok;
 static int print_flag;
@@ -1771,6 +1773,12 @@ register short op;
 		} else {
 			Error_0("Unable to set-cdr! for non-cons cell");
 		}
+	case OP_CHAR2INT: /* char->integer */
+		if (ischar(car(args))) {
+			s_return(mk_number(ivalue(car(args))));
+		} else {
+			Error_0("char->integer: argument must be char");
+		}
 
 	default:
 		sprintf(strbuff, "%d is illegal operator", operator);
@@ -2447,7 +2455,9 @@ pointer	(*dispatch_table[])() = {
 	opexe_7,        /* OP_READIN */
 	opexe_7,        /* OP_OPENOUT */
 	opexe_7,        /* OP_CLOSEOUT */
-	opexe_7        /* OP_WRITEOUT */
+	opexe_7,        /* OP_WRITEOUT */
+
+	opexe_2         /* OP_CHAR2INT */
 };
 
 
@@ -2604,6 +2614,8 @@ init_procs()
 	mk_proc(OP_OPENOUT, "open-output-file");
 	mk_proc(OP_CLOSEOUT, "close-output-port");
 	mk_proc(OP_WRITEOUT, "write-char");
+
+	mk_proc(OP_CHAR2INT, "char->integer");
 }