Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

simplifying apply and fixing variadic applications

Browse source
This commit is contained in:
Alex Shinn 2011-05-22 03:21:44 -07:00
parent 1e02e95590
commit 1fea7687e2
4 changed files with 24 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
doc/lib/chibi/match.html
View file

@ -43,7 +43,7 @@ where the result of <code>expr</code> is matched against each pattern in
turn, and the corresponding body is evaluated for the first to turn, and the corresponding body is evaluated for the first to
succeed. Thus, a list of three elements matches a list of three succeed. Thus, a list of three elements matches a list of three
elements. elements.
</p><div><pre><code>(<span class="keyword">let</span> ((ls (list <span>1</span> <span>2</span> <span>3</span>))) (<span class="keyword">match</span> <span>ls</span> ((1 <span>2</span> <span>3</span>) #)))</code></pre><code><div class="result">=> #t</div></code></div><p> </p><div><pre><code>(<span class="keyword">let</span> ((ls (list <span>1</span> <span>2</span> <span>3</span>))) (<span class="keyword">match</span> <span>ls</span> ((1 <span>2</span> <span>3</span>) #t)))</code></pre><code><div class="result">=> #t</div></code></div><p>
If no patterns match an error is signalled. If no patterns match an error is signalled.
Identifiers will match anything, and make the corresponding Identifiers will match anything, and make the corresponding
binding available in the body. binding available in the body.
@ -65,9 +65,9 @@ parts unquoted.
Often you want to match any number of a repeated pattern. Inside Often you want to match any number of a repeated pattern. Inside
a list pattern you can append <code><span>...</span></code> after an element to a list pattern you can append <code><span>...</span></code> after an element to
match zero or more of that pattern (like a regexp Kleene star). match zero or more of that pattern (like a regexp Kleene star).
</p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span>) ((1 <span>2</span> <span>3</span> <span>...</span>) #))</code></pre><code><div class="result">=> #t</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span>) ((1 <span>2</span> <span>3</span> <span>...</span>) #t))</code></pre><code><div class="result">=> #t</div></code></div><p>
</p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span> <span>3</span>) ((1 <span>2</span> <span>3</span> <span>...</span>) #))</code></pre><code><div class="result">=> #t</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span> <span>3</span>) ((1 <span>2</span> <span>3</span> <span>...</span>) #t))</code></pre><code><div class="result">=> #t</div></code></div><p>
</p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span> <span>3</span> <span>3</span> <span>3</span>) ((1 <span>2</span> <span>3</span> <span>...</span>) #))</code></pre><code><div class="result">=> #t</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span> <span>3</span> <span>3</span> <span>3</span>) ((1 <span>2</span> <span>3</span> <span>...</span>) #t))</code></pre><code><div class="result">=> #t</div></code></div><p>
Pattern variables matched inside the repeated pattern are bound to Pattern variables matched inside the repeated pattern are bound to
a list of each matching instance in the body. a list of each matching instance in the body.
</p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span>) ((a <span>b</span> <span>c</span> <span>...</span>) <span>c</span>))</code></pre><code><div class="result">=> ()</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> (list <span>1</span> <span>2</span>) ((a <span>b</span> <span>c</span> <span>...</span>) <span>c</span>))</code></pre><code><div class="result">=> ()</div></code></div><p>
@ -96,7 +96,7 @@ bind <code>x</code> to the entire value that matches <code>pat</code>
(c.f. "as-patterns" in ML or Haskell). Another common use is in (c.f. "as-patterns" in ML or Haskell). Another common use is in
conjunction with <code><span>not</span></code> patterns to match a general case conjunction with <code><span>not</span></code> patterns to match a general case
with certain exceptions. with certain exceptions.
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((and) #))</code></pre><code><div class="result">=> #t</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((and) #t))</code></pre><code><div class="result">=> #t</div></code></div><p>
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((and <span>x</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((and <span>x</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p>
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((and <span>x</span> <span>1</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((and <span>x</span> <span>1</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p>
The <code><span>or</span></code> operator ensures that at least one subpattern The <code><span>or</span></code> 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 it is matched independently. All identifiers from all subpatterns
are bound if the <code><span>or</span></code> operator matches, but the binding is are bound if the <code><span>or</span></code> operator matches, but the binding is
only defined for identifiers from the subpattern which matched. only defined for identifiers from the subpattern which matched.
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((or) #) (<span class="keyword">else</span> #))</code></pre><code><div class="result">=> #f</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((or) #t) (<span class="keyword">else</span> #f))</code></pre><code><div class="result">=> #f</div></code></div><p>
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((or <span>x</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((or <span>x</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p>
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((or <span>x</span> <span>2</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((or <span>x</span> <span>2</span>) <span>x</span>))</code></pre><code><div class="result">=> 1</div></code></div><p>
The <code><span>not</span></code> operator succeeds if the given pattern doesn't The <code><span>not</span></code> operator succeeds if the given pattern doesn't
match. None of the identifiers used are available in the body. match. None of the identifiers used are available in the body.
</p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((not <span>2</span>) #))</code></pre><code><div class="result">=> #t</div></code></div><p> </p><div><pre><code>(<span class="keyword">match</span> <span>1</span> ((not <span>2</span>) #t))</code></pre><code><div class="result">=> #t</div></code></div><p>
The more general operator <code><span>?</span></code> can be used to provide a The more general operator <code><span>?</span></code> can be used to provide a
predicate. The usage is <code>(? <span>predicate</span> <span>pat</span> <span>...</span>)</code> where predicate. The usage is <code>(? <span>predicate</span> <span>pat</span> <span>...</span>)</code> where
<code>predicate</code> is a Scheme expression evaluating to a predicate <code>predicate</code> is a Scheme expression evaluating to a predicate

2
lib/srfi/69/hash.c
View file

@ -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)); args = sexp_eval_string(ctx, "(current-error-port)", -1, sexp_context_env(ctx));
sexp_print_exception(ctx, res, args); sexp_print_exception(ctx, res, args);
res = sexp_make_fixnum(0); res = sexp_make_fixnum(0);
} else if (sexp_unbox_fixnum(res) >= len) {
res = SEXP_ZERO;
} }
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
} }

1
lib/srfi/69/interface.scm
View file

@ -112,4 +112,3 @@
(let ((res (make-hash-table (hash-table-equivalence-function table)))) (let ((res (make-hash-table (hash-table-equivalence-function table))))
(hash-table-merge! res table) (hash-table-merge! res table)
res)) res))

34
vm.c
View file

@ -616,10 +616,9 @@ static int sexp_check_type(sexp ctx, sexp a, sexp b) {
#include "opt/fcall.c" #include "opt/fcall.c"
#endif #endif
sexp sexp_vm (sexp ctx, sexp proc) { sexp sexp_vm (sexp ctx, sexp proc, sexp args) {
sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc); unsigned char *ip;
sexp *stack = sexp_stack_data(sexp_context_stack(ctx)); sexp bc, cp, *stack = sexp_stack_data(sexp_context_stack(ctx));
unsigned char *ip = sexp_bytecode_data(bc);
sexp_sint_t i, j, k, fp, top = sexp_stack_top(sexp_context_stack(ctx)); sexp_sint_t i, j, k, fp, top = sexp_stack_top(sexp_context_stack(ctx));
#if SEXP_USE_GREEN_THREADS #if SEXP_USE_GREEN_THREADS
sexp root_thread = ctx; sexp root_thread = ctx;
@ -631,7 +630,12 @@ sexp sexp_vm (sexp ctx, sexp proc) {
sexp_gc_var3(self, tmp1, tmp2); sexp_gc_var3(self, tmp1, tmp2);
sexp_gc_preserve3(ctx, self, tmp1, tmp2); sexp_gc_preserve3(ctx, self, tmp1, tmp2);
fp = top - 4; 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: loop:
#if SEXP_USE_GREEN_THREADS #if SEXP_USE_GREEN_THREADS
@ -727,8 +731,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
case SEXP_OP_APPLY1: case SEXP_OP_APPLY1:
tmp1 = _ARG1; tmp1 = _ARG1;
tmp2 = _ARG2; tmp2 = _ARG2;
top -= 2;
apply1:
i = sexp_unbox_fixnum(sexp_length(ctx, tmp2)); i = sexp_unbox_fixnum(sexp_length(ctx, tmp2));
top += (i-2); top += i;
for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--) for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
_ARG1 = sexp_car(tmp2); _ARG1 = sexp_car(tmp2);
top += i+1; 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 sexp_apply (sexp ctx, sexp proc, sexp args) {
sexp res, ls, *stack = sexp_stack_data(sexp_context_stack(ctx)); sexp res;
sexp_sint_t top = sexp_context_top(ctx), len, offset;
sexp_gc_var1(tmp); sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp); sexp_gc_preserve1(ctx, tmp);
len = sexp_unbox_fixnum(sexp_length(ctx, args));
if (sexp_opcodep(proc)) 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)) { if (! sexp_procedurep(proc)) {
res = sexp_exceptionp(proc) ? proc : res = sexp_exceptionp(proc) ? proc :
sexp_type_exception(ctx, NULL, SEXP_PROCEDURE, proc); sexp_type_exception(ctx, NULL, SEXP_PROCEDURE, proc);
} else { } else {
offset = top + len; res = sexp_vm(ctx, proc, args);
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);
if (! res) res = SEXP_VOID; /* shouldn't happen */ if (! res) res = SEXP_VOID; /* shouldn't happen */
} }
sexp_gc_release1(ctx); sexp_gc_release1(ctx);