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

Fix definition of full-match?

Browse source 
Fixes #816
This commit is contained in:
Daphne Preston-Kendal 2022-03-16 09:12:35 +01:00
parent 9fe1e69c23
commit c28bbbaa98
1 changed files with 1 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lib/init-7.scm
View file

@ -869,14 +869,11 @@
(define ellipsis (if ellipsis-specified? (cadr expr) (rename '...))) (define ellipsis (if ellipsis-specified? (cadr expr) (rename '...)))
(define lits (if ellipsis-specified? (car (cddr expr)) (cadr expr))) (define lits (if ellipsis-specified? (car (cddr expr)) (cadr expr)))
(define forms (if ellipsis-specified? (cdr (cddr expr)) (cddr expr))) (define forms (if ellipsis-specified? (cdr (cddr expr)) (cddr expr)))
(define full-match? (any (lambda (x) (not (pair? (car x)))) forms))
(define (next-symbol s) (define (next-symbol s)
(set! count (+ count 1)) (set! count (+ count 1))
(rename (string->symbol (string-append s (%number->string count))))) (rename (string->symbol (string-append s (%number->string count)))))
(define (expand-pattern pat tmpl) (define (expand-pattern pat tmpl)
(define full-match?
(or (not (pair? pat))
(and (compare (car pat) (rename 'set!))
(any (lambda (x) (compare x (rename 'set!))) lits))))
(let lp ((p (if full-match? pat (cdr pat))) (let lp ((p (if full-match? pat (cdr pat)))
(x (if full-match? _expr (list _cdr _expr))) (x (if full-match? _expr (list _cdr _expr)))
(dim 0) (dim 0)