expr is matched against each pattern in
turn, and the corresponding body is evaluated for the first to
succeed. Thus, a list of three elements matches a list of three
elements.
-(let ((ls (list 1 2 3))) (match ls ((1 2 3) #)))=> #t+
(let ((ls (list 1 2 3))) (match ls ((1 2 3) #t)))=> #t
If no patterns match an error is signalled.
Identifiers will match anything, and make the corresponding
binding available in the body.
@@ -65,9 +65,9 @@ parts unquoted.
Often you want to match any number of a repeated pattern. Inside
a list pattern you can append ... after an element to
match zero or more of that pattern (like a regexp Kleene star).
-
(match (list 1 2) ((1 2 3 ...) #))=> #t-
(match (list 1 2 3) ((1 2 3 ...) #))=> #t-
(match (list 1 2 3 3 3) ((1 2 3 ...) #))=> #t+
(match (list 1 2) ((1 2 3 ...) #t))=> #t+
(match (list 1 2 3) ((1 2 3 ...) #t))=> #t+
(match (list 1 2 3 3 3) ((1 2 3 ...) #t))=> #tPattern variables matched inside the repeated pattern are bound to a list of each matching instance in the body.
(match (list 1 2) ((a b c ...) c))=> ()
@@ -96,7 +96,7 @@ bind x to the entire value that matches pat
(c.f. "as-patterns" in ML or Haskell). Another common use is in
conjunction with not patterns to match a general case
with certain exceptions.
-
(match 1 ((and) #))=> #t+
(match 1 ((and) #t))=> #t
(match 1 ((and x) x))=> 1
(match 1 ((and x 1) x))=> 1
The or operator ensures that at least one subpattern
@@ -104,12 +104,12 @@ matches. If the same identifier occurs in different subpatterns,
it is matched independently. All identifiers from all subpatterns
are bound if the or operator matches, but the binding is
only defined for identifiers from the subpattern which matched.
-
(match 1 ((or) #) (else #))=> #f+
(match 1 ((or) #t) (else #f))=> #f
(match 1 ((or x) x))=> 1
(match 1 ((or x 2) x))=> 1
The not operator succeeds if the given pattern doesn't
match. None of the identifiers used are available in the body.
-
(match 1 ((not 2) #))=> #t+
(match 1 ((not 2) #t))=> #t
The more general operator ? can be used to provide a
predicate. The usage is (? predicate pat ...) where
predicate is a Scheme expression evaluating to a predicate
diff --git a/lib/srfi/69/hash.c b/lib/srfi/69/hash.c
index 42d1e864..7f39eb14 100644
--- a/lib/srfi/69/hash.c
+++ b/lib/srfi/69/hash.c
@@ -117,6 +117,8 @@ static sexp sexp_get_bucket (sexp ctx, sexp buckets, sexp hash_fn, sexp obj) {
args = sexp_eval_string(ctx, "(current-error-port)", -1, sexp_context_env(ctx));
sexp_print_exception(ctx, res, args);
res = sexp_make_fixnum(0);
+ } else if (sexp_unbox_fixnum(res) >= len) {
+ res = SEXP_ZERO;
}
sexp_gc_release1(ctx);
}
diff --git a/lib/srfi/69/interface.scm b/lib/srfi/69/interface.scm
index edd752f1..bc7501c0 100644
--- a/lib/srfi/69/interface.scm
+++ b/lib/srfi/69/interface.scm
@@ -112,4 +112,3 @@
(let ((res (make-hash-table (hash-table-equivalence-function table))))
(hash-table-merge! res table)
res))
-
diff --git a/vm.c b/vm.c
index aad431ef..fff0415a 100644
--- a/vm.c
+++ b/vm.c
@@ -616,10 +616,9 @@ static int sexp_check_type(sexp ctx, sexp a, sexp b) {
#include "opt/fcall.c"
#endif
-sexp sexp_vm (sexp ctx, sexp proc) {
- sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc);
- sexp *stack = sexp_stack_data(sexp_context_stack(ctx));
- unsigned char *ip = sexp_bytecode_data(bc);
+sexp sexp_vm (sexp ctx, sexp proc, sexp args) {
+ unsigned char *ip;
+ sexp bc, cp, *stack = sexp_stack_data(sexp_context_stack(ctx));
sexp_sint_t i, j, k, fp, top = sexp_stack_top(sexp_context_stack(ctx));
#if SEXP_USE_GREEN_THREADS
sexp root_thread = ctx;
@@ -631,7 +630,12 @@ sexp sexp_vm (sexp ctx, sexp proc) {
sexp_gc_var3(self, tmp1, tmp2);
sexp_gc_preserve3(ctx, self, tmp1, tmp2);
fp = top - 4;
- self = proc;
+ self = sexp_global(ctx, SEXP_G_FINAL_RESUMER);
+ bc = sexp_procedure_code(self);
+ cp = sexp_procedure_vars(self);
+ ip = sexp_bytecode_data(bc);
+ tmp1 = proc, tmp2 = args;
+ goto apply1;
loop:
#if SEXP_USE_GREEN_THREADS
@@ -727,8 +731,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case SEXP_OP_APPLY1:
tmp1 = _ARG1;
tmp2 = _ARG2;
+ top -= 2;
+ apply1:
i = sexp_unbox_fixnum(sexp_length(ctx, tmp2));
- top += (i-2);
+ top += i;
for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
_ARG1 = sexp_car(tmp2);
top += i+1;
@@ -1593,26 +1599,16 @@ sexp sexp_apply1 (sexp ctx, sexp f, sexp x) {
}
sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
- sexp res, ls, *stack = sexp_stack_data(sexp_context_stack(ctx));
- sexp_sint_t top = sexp_context_top(ctx), len, offset;
+ sexp res;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
- len = sexp_unbox_fixnum(sexp_length(ctx, args));
if (sexp_opcodep(proc))
- proc = tmp = make_opcode_procedure(ctx, proc, len);
+ proc = tmp = make_opcode_procedure(ctx, proc, sexp_unbox_fixnum(sexp_length(ctx, args)));
if (! sexp_procedurep(proc)) {
res = sexp_exceptionp(proc) ? proc :
sexp_type_exception(ctx, NULL, SEXP_PROCEDURE, proc);
} else {
- offset = top + len;
- for (ls=args; sexp_pairp(ls); ls=sexp_cdr(ls), top++)
- stack[--offset] = sexp_car(ls);
- stack[top++] = sexp_make_fixnum(len);
- stack[top++] = SEXP_ZERO;
- stack[top++] = sexp_global(ctx, SEXP_G_FINAL_RESUMER);
- stack[top++] = SEXP_ZERO;
- sexp_context_top(ctx) = top;
- res = sexp_vm(ctx, proc);
+ res = sexp_vm(ctx, proc, args);
if (! res) res = SEXP_VOID; /* shouldn't happen */
}
sexp_gc_release1(ctx);