From f7295ae6b6eff3b0131eafe4918564499c5ed990 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 25 Jan 2018 20:32:11 -0800 Subject: [PATCH] Make sure the open-block tag is computed correctly. --- src/runtime/predicate-tagging.scm | 4 +++- src/runtime/scan.scm | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/runtime/predicate-tagging.scm b/src/runtime/predicate-tagging.scm index 61b08635f..6fa109f26 100644 --- a/src/runtime/predicate-tagging.scm +++ b/src/runtime/predicate-tagging.scm @@ -102,7 +102,6 @@ USA. (define-primitive-predicate 'quotation scode-quotation?) (define-primitive-predicate 'ratnum exact-rational?) (define-primitive-predicate 'recnum number?) - (define-primitive-predicate 'sequence scode-sequence?) (define-primitive-predicate 'stack-environment stack-address?) (define-primitive-predicate 'string string?) (define-primitive-predicate 'the-environment scode-the-environment?) @@ -187,5 +186,8 @@ USA. (%record-ref object 0) default-tag)))) + (define-primitive-predicate-method 'sequence + (simple-alternative scode-sequence? open-block?)) + (define-primitive-predicate-method 'tagged-object %tagged-object-tag))) \ No newline at end of file diff --git a/src/runtime/scan.scm b/src/runtime/scan.scm index d43faed8b..3a5d7321b 100644 --- a/src/runtime/scan.scm +++ b/src/runtime/scan.scm @@ -172,6 +172,7 @@ USA. (every %open-block-definition-named? names (cdr actions)))))))) +(register-predicate! open-block? 'open-block '<= scode-sequence?) (define (%open-block-definition-named? name expr) (and (scode-definition? expr) -- 2.25.1