From 8481f543a90c2a7d90bb1b52f07cb0f3dc48aaf2 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 23 Nov 2009 01:54:22 +0900 Subject: [PATCH] cleanup, making infinities optional, fixing build for plan9 --- config.scm | 3 ++- eval.c | 2 ++ include/chibi/config.h | 12 ++++++++++ lib/srfi/1.module | 6 ++--- lib/srfi/1/fold.scm | 2 +- lib/srfi/1/misc.scm | 15 ++++--------- lib/srfi/1/predicates.scm | 8 +++++++ opcodes.c | 2 +- opt/plan9.c | 47 ++++++++++++++++++++++++--------------- sexp.c | 12 +++++++--- 10 files changed, 71 insertions(+), 38 deletions(-) diff --git a/config.scm b/config.scm index 1208c201..0a8f0f5c 100644 --- a/config.scm +++ b/config.scm @@ -108,7 +108,8 @@ car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr - null? list? list length append reverse list-tail list-ref memq memv + null? list? list length append reverse reverse! + list-tail list-ref memq memv member assq assv assoc symbol? symbol->string string->symbol char? char=? char? char<=? char>=? char-ci=? char-ci? char-ci<=? char-ci>=? char-alphabetic? char-numeric? char-whitespace? diff --git a/eval.c b/eval.c index 118127a0..fec23de4 100644 --- a/eval.c +++ b/eval.c @@ -1976,12 +1976,14 @@ static sexp sexp_close_port (sexp ctx, sexp port) { return SEXP_VOID; } +#ifndef PLAN9 static sexp sexp_file_exists_p (sexp ctx, sexp path) { struct stat buf; if (! sexp_stringp(path)) return sexp_type_exception(ctx, "not a string", path); return (stat(sexp_string_data(path), &buf) ? SEXP_FALSE : SEXP_TRUE); } +#endif void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out) { sexp x; diff --git a/include/chibi/config.h b/include/chibi/config.h index f033e622..4b9957b7 100644 --- a/include/chibi/config.h +++ b/include/chibi/config.h @@ -53,6 +53,10 @@ /* and write flonums directly through the sexp API. */ /* #define USE_FLONUMS 0 */ +/* uncomment this to disable reading/writing IEEE infinities */ +/* By default you can read/write +inf.0, -inf.0 and +nan.0 */ +/* #define USE_INFINITIES 0 */ + /* uncomment this if you want immediate flonums */ /* This is experimental, enablde at your own risk. */ /* #define USE_IMMEDIATE_FLONUMS 1 */ @@ -177,6 +181,14 @@ #define USE_FLONUMS 1 #endif +#ifndef USE_INFINITIES +#if defined(PLAN9) || ! USE_FLONUMS +#define USE_INFINITIES 0 +#else +#define USE_INFINITIES 1 +#endif +#endif + #ifndef USE_IMMEDIATE_FLONUMS #define USE_IMMEDIATE_FLONUMS 0 #endif diff --git a/lib/srfi/1.module b/lib/srfi/1.module index 1d76a116..93477756 100644 --- a/lib/srfi/1.module +++ b/lib/srfi/1.module @@ -19,11 +19,11 @@ lset-intersection! lset-difference lset-difference! lset-xor lset-xor! lset-diff+intersection lset-diff+intersection!) (import (scheme)) - (include "srfi/1/constructors.scm" - "srfi/1/predicates.scm" + (include "srfi/1/predicates.scm" "srfi/1/selectors.scm" - "srfi/1/misc.scm" "srfi/1/search.scm" + "srfi/1/misc.scm" + "srfi/1/constructors.scm" "srfi/1/fold.scm" "srfi/1/deletion.scm" "srfi/1/alists.scm" diff --git a/lib/srfi/1/fold.scm b/lib/srfi/1/fold.scm index 8bb25b4a..4c0c2afa 100644 --- a/lib/srfi/1/fold.scm +++ b/lib/srfi/1/fold.scm @@ -59,7 +59,7 @@ (let lp ((ls (cdr rev-ls)) (res (car rev-ls))) (if (null? ls) res (lp (cdr ls) (append (f (car ls) res)))) ))) - (if (and (pair? ls) (every pair lists)) + (if (and (pair? ls) (every pair? lists)) (let lp ((lists (cons ls lists))) (let ((vals (apply f (map car lists))) (cdrs (map cdr lists))) diff --git a/lib/srfi/1/misc.scm b/lib/srfi/1/misc.scm index 20011c44..c40afa1d 100644 --- a/lib/srfi/1/misc.scm +++ b/lib/srfi/1/misc.scm @@ -3,18 +3,11 @@ (let lp ((ls ls) (res init)) (if (null? ls) res (lp (cdr ls) (cons (proc (car ls)) res))))) -(define (length+ x) - (if (not (pair? x)) - 0 - (let lp ((hare (cdr x)) (tortoise x) (res 0)) - (and (not (eq? hare tortoise)) - (if (pair? hare) - (lp (cddr hare) (cdr tortoise) (+ res 1)) - res))))) - (define (append! . lists) (concatenate! lists)) -(define (concatenate lists) (reduce-right append '() lists)) +(define (concatenate lists) + (let lp ((ls (reverse lists)) (res '())) + (if (null? ls) res (lp (cdr ls) (append (car ls) res))))) (define (concatenate! lists) (if (null? lists) @@ -45,7 +38,7 @@ (values (map car ls) (map cadr ls) (map caddr ls) (map cadddr ls))) (define (unzip5 ls) (values (map car ls) (map cadr ls) (map caddr ls) - (map cadddr ls) (map fifth ls))) + (map cadddr ls) (map (lambda (x) (car (cddddr x))) ls))) (define (count pred ls . lists) (if (null? lists) diff --git a/lib/srfi/1/predicates.scm b/lib/srfi/1/predicates.scm index fe1dc77b..70144660 100644 --- a/lib/srfi/1/predicates.scm +++ b/lib/srfi/1/predicates.scm @@ -29,3 +29,11 @@ (and (eq (car ls1) (car ls2)) (lp2 (cdr ls1) (cdr ls2)))))))) +(define (length+ x) + (if (not (pair? x)) + 0 + (let lp ((hare (cdr x)) (tortoise x) (res 0)) + (and (not (eq? hare tortoise)) + (if (pair? hare) + (lp (cddr hare) (cdr tortoise) (+ res 1)) + res))))) diff --git a/opcodes.c b/opcodes.c index 04f7b4e6..28f2aa2e 100644 --- a/opcodes.c +++ b/opcodes.c @@ -86,7 +86,6 @@ _FN1(SEXP_STRING, "open-input-file", 0, sexp_open_input_file), _FN1(SEXP_STRING, "open-output-file", 0, sexp_open_output_file), _FN1(SEXP_IPORT, "close-input-port", 0, sexp_close_port), _FN1(SEXP_OPORT, "close-output-port", 0, sexp_close_port), -_FN1(SEXP_STRING, "file-exists?", 0, sexp_file_exists_p), _FN0("make-environment", 0, sexp_make_env), _FN1(SEXP_FIXNUM, "null-environment", 0, sexp_make_null_env), _FN1(SEXP_FIXNUM, "scheme-report-environment", 0, sexp_make_standard_env), @@ -142,5 +141,6 @@ _FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sex #if PLAN9 #include "opt/plan9-opcodes.c" #endif +_FN1(SEXP_STRING, "file-exists?", 0, sexp_file_exists_p), }; diff --git a/opt/plan9.c b/opt/plan9.c index 024e37d0..68346ab8 100644 --- a/opt/plan9.c +++ b/opt/plan9.c @@ -3,21 +3,30 @@ /* BSD-style license: http://synthcode.com/license.txt */ sexp sexp_rand (sexp ctx) { - return sexp_make_integer(rand()); + return sexp_make_fixnum(rand()); } sexp sexp_srand (sexp ctx, sexp seed) { - srand(sexp_unbox_integer(seed)); + srand(sexp_unbox_fixnum(seed)); return SEXP_VOID; } +sexp sexp_file_exists_p (sexp ctx, sexp path) { + int res; + uchar statbuf[STATMAX]; + if (! sexp_stringp(path)) + return sexp_type_exception(ctx, "file-exists?: not a string", path); + res = stat(sexp_string_data(path), statbuf, sizeof(statbuf)); + return (res < 0) ? SEXP_FALSE : SEXP_TRUE; +} + sexp sexp_fdopen (sexp ctx, sexp fd, sexp mode) { FILE *f; if (! sexp_integerp(fd)) return sexp_type_exception(ctx, "fdopen: not an integer", fd); if (! sexp_stringp(mode)) return sexp_type_exception(ctx, "fdopen: not a mode string", mode); - f = fdopen(sexp_unbox_integer(fd), sexp_string_data(mode)); + f = fdopen(sexp_unbox_fixnum(fd), sexp_string_data(mode)); if (! f) return sexp_user_exception(ctx, SEXP_FALSE, "fdopen failed", fd); /* maybe use fd2path to get the name of the fd */ @@ -30,15 +39,15 @@ sexp sexp_fdopen (sexp ctx, sexp fd, sexp mode) { sexp sexp_fileno (sexp ctx, sexp port) { if (! sexp_portp(port)) return sexp_type_exception(ctx, "fileno: not a port", port); - return sexp_make_integer(fileno(sexp_port_stream(port))); + return sexp_make_fixnum(fileno(sexp_port_stream(port))); } sexp sexp_fork (sexp ctx) { - return sexp_make_integer(fork()); + return sexp_make_fixnum(fork()); } sexp sexp_exec (sexp ctx, sexp name, sexp args) { - int i, len = sexp_unbox_integer(sexp_length(ctx, args)); + int i, len = sexp_unbox_fixnum(sexp_length(ctx, args)); char **argv = malloc((len+1)*sizeof(char*)); for (i=0; imsg, -1); - res = sexp_list2(ctx, sexp_make_integer(wmsg->pid), msg); + res = sexp_list2(ctx, sexp_make_fixnum(wmsg->pid), msg); sexp_gc_release(ctx, msg, s_msg); return res; } @@ -116,7 +125,7 @@ sexp sexp_postnote (sexp ctx, sexp pid, sexp note) { return sexp_type_exception(ctx, "postnote: not an integer", pid); if (! sexp_stringp(note)) return sexp_type_exception(ctx, "postnote: not a string", note); - postnote(PNPROC, sexp_unbox_integer(pid), sexp_string_data(note)); + postnote(PNPROC, sexp_unbox_fixnum(pid), sexp_string_data(note)); return SEXP_VOID; } @@ -303,28 +312,30 @@ sexp sexp_postmountsrv (sexp ctx, sexp ls, sexp name, sexp mtpt, sexp flags) { s.destroyreq = &sexp_9p_destroyreq; s.end = &sexp_9p_end; postmountsrv(&s, sexp_string_data(name), sexp_string_data(mtpt), - sexp_unbox_integer(flags)); + sexp_unbox_fixnum(flags)); return SEXP_UNDEF; } sexp sexp_9p_req_offset (sexp ctx, sexp req) { - return sexp_make_integer(ctx, (Req*)sexp_cpointer_value(req)->ifcall.offset); + return sexp_make_integer(ctx, ((Req*)sexp_cpointer_value(req))->ifcall.offset); } sexp sexp_9p_req_count (sexp ctx, sexp req) { - return sexp_make_integer(ctx, (Req*)sexp_cpointer_value(req)->ifcall.count); + return sexp_make_integer(ctx, ((Req*)sexp_cpointer_value(req))->ifcall.count); } +#if 0 sexp sexp_9p_req_path (sexp ctx, sexp req) { - return sexp_c_string(ctx, (Req*)sexp_cpointer_value(req)->fid.qid.path, -1); + return sexp_c_string(ctx, ((Req*)sexp_cpointer_value(req))->fid->qid.path, -1); } +#endif sexp sexp_9p_req_fid (sexp ctx, sexp req) { - return sexp_make_cpointer(ctx, (Req*)sexp_cpointer_value(req)->fid); + return sexp_make_cpointer(ctx, ((Req*)sexp_cpointer_value(req))->fid); } sexp sexp_9p_req_newfid (sexp ctx, sexp req) { - return sexp_make_cpointer(ctx, (Req*)sexp_cpointer_value(req)->newfid); + return sexp_make_cpointer(ctx, ((Req*)sexp_cpointer_value(req))->newfid); } sexp sexp_9p_respond (sexp ctx, sexp req, sexp err) { diff --git a/sexp.c b/sexp.c index d0b9a8c9..64650fc1 100644 --- a/sexp.c +++ b/sexp.c @@ -976,10 +976,13 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) { #if ! USE_IMMEDIATE_FLONUMS case SEXP_FLONUM: f = sexp_flonum_value(obj); +#if USE_INFINITIES if (isinf(f) || isnan(f)) { numbuf[0] = (isinf(f) && f < 0 ? '-' : '+'); strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0"); - } else { + } else +#endif + { i = sprintf(numbuf, "%.15g", f); if (f == trunc(f) && ! strchr(numbuf, '.')) { numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0'; @@ -1039,10 +1042,13 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) { #if USE_IMMEDIATE_FLONUMS } else if (sexp_flonump(obj)) { f = sexp_flonum_value(obj); +#if USE_INFINITIES if (isinf(f) || isnan(f)) { numbuf[0] = (isinf(f) && f < 0 ? '-' : '+'); strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0"); - } else { + } else +#endif + { i = sprintf(numbuf, "%.15g", f); if (f == trunc(f) && ! strchr(numbuf, '.')) { numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0'; @@ -1485,7 +1491,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) { } else { sexp_push_char(ctx, c2, in); res = sexp_read_symbol(ctx, in, c1, 1); -#if USE_FLONUMS +#if USE_INFINITIES if (res == sexp_intern(ctx, "+inf.0")) res = sexp_make_flonum(ctx, 1.0/0.0); else if (res == sexp_intern(ctx, "-inf.0"))