diff --git a/BUGS b/BUGS index 29311fa..2270511 100644 --- a/BUGS +++ b/BUGS @@ -1,5 +1,7 @@ BUG: +* symbol calls are not checking for non-procedure. +* set! on global names is not working. Email Will Clinger regarding: diff --git a/bin/Makefile b/bin/Makefile index 4c882d3..e6c0d5a 100644 --- a/bin/Makefile +++ b/bin/Makefile @@ -1,7 +1,7 @@ CFLAGS = -I/opt/local/include -Wall -DNDEBUG -O3 #-fomit-frame-pointer #CFLAGS = -I/opt/local/include -Wall -g -LDFLAGS = -L/opt/local/lib -g -ldl -lgmp -lz #-rdynamic +LDFLAGS = -L/opt/local/lib -g -ldl -lgmp -lz -lm #-rdynamic CC = gcc all: ikarus diff --git a/bin/ikarus b/bin/ikarus index 060bfd5..784e0d8 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-fasl.c b/bin/ikarus-fasl.c index 942ad91..f149b6c 100644 --- a/bin/ikarus-fasl.c +++ b/bin/ikarus-fasl.c @@ -182,6 +182,7 @@ ik_relocate_code(ikp code){ fprintf(stderr, "foreign name is not a bytevector\n"); exit(-1); } + dlerror(); void* sym = dlsym(RTLD_DEFAULT, name); char* err = dlerror(); if(err){ diff --git a/bin/ikarus-main.c b/bin/ikarus-main.c index 3143ddf..c9905b6 100644 --- a/bin/ikarus-main.c +++ b/bin/ikarus-main.c @@ -189,7 +189,7 @@ int main(int argc, char** argv){ struct sigaction * restrict oact); #endif -void handler(int signo, struct __siginfo* info, ucontext_t* uap){ +void handler(int signo, struct __siginfo* info, void* uap){ the_pcb->engine_counter = -1; the_pcb->interrupted = 1; } diff --git a/src/ikarus.boot b/src/ikarus.boot index e46ab0b..757f545 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.vectors.ss b/src/ikarus.vectors.ss index 6aace01..34b42e8 100644 --- a/src/ikarus.vectors.ss +++ b/src/ikarus.vectors.ss @@ -1,11 +1,11 @@ (library (ikarus vectors) (export make-vector vector vector-length vector-ref vector-set! - vector->list list->vector vector-map) + vector->list list->vector vector-map vector-for-each) (import (except (ikarus) make-vector vector vector-length vector-ref vector-set! - vector->list list->vector vector-map) + vector->list list->vector vector-map vector-for-each) (ikarus system $fx) (ikarus system $pairs) (ikarus system $vectors)) @@ -191,4 +191,65 @@ (f i ($cdr v*)))))) ac))])))]))) + + (module (vector-for-each) + (define who 'vector-for-each) + (define vector-for-each + (case-lambda + [(p v) + (unless (procedure? p) + (error who "~s is not a procedure" p)) + (unless (vector? v) + (error who "~s is not a vector" v)) + (let f ([p p] [v v] [i 0] [n (vector-length v)]) + (cond + [($fx= i n) (void)] + [else + (p (vector-ref v i)) + (f p v ($fxadd1 i) n)]))] + [(p v0 v1) + (unless (procedure? p) + (error who "~s is not a procedure" p)) + (unless (vector? v0) + (error who "~s is not a vector" v0)) + (unless (vector? v1) + (error who "~s is not a vector" v1)) + (let ([n (vector-length v0)]) + (unless ($fx= n ($vector-length v1)) + (error who "length mismatch between ~s and ~s" v0 v1)) + (let f ([p p] [v0 v0] [v1 v1] [i 0] [n n]) + (cond + [($fx= i n) (void)] + [else + (p ($vector-ref v0 i) ($vector-ref v1 i)) + (f p v0 v1 ($fxadd1 i) n)])))] + [(p v0 v1 . v*) + (unless (procedure? p) + (error who "~s is not a procedure" p)) + (unless (vector? v0) + (error who "~s is not a vector" v0)) + (unless (vector? v1) + (error who "~s is not a vector" v1)) + (let ([n (vector-length v0)]) + (unless ($fx= n ($vector-length v1)) + (error who "length mismatch between ~s and ~s" v0 v1)) + (let f ([v* v*] [n n]) + (unless (null? v*) + (let ([a ($car v*)]) + (unless (vector? a) + (error who "~s is not a vector" a)) + (unless ($fx= ($vector-length a) n) + (error who "length mismatch"))) + (f ($cdr v*) n))) + (let f ([p p] [v0 v0] [v1 v1] [v* v*] [i 0] [n n]) + (cond + [($fx= i n) (void)] + [else + (apply p ($vector-ref v0 i) ($vector-ref v1 i) + (let f ([i i] [v* v*]) + (if (null? v*) + '() + (cons ($vector-ref ($car v*) i) + (f i ($cdr v*)))))) + (f p v0 v1 v* ($fxadd1 i) n)])))]))) ) diff --git a/src/makefile.ss b/src/makefile.ss index 4dffb7b..862c49e 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -348,6 +348,7 @@ [list->vector i r] [vector->list i r] [vector-map i r] + [vector-for-each i r] [make-bytevector i] [bytevector-length i] [bytevector-s8-ref i] diff --git a/src/todo-r6rs.ss b/src/todo-r6rs.ss index f7b38fc..a2521e8 100755 --- a/src/todo-r6rs.ss +++ b/src/todo-r6rs.ss @@ -223,7 +223,7 @@ [vector C ba] [vector->list C ba] [vector-fill! S ba] - [vector-for-each S ba] + [vector-for-each C ba] [vector-length C ba] [vector-map C ba] [vector-ref C ba]