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"); }