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

s/ellipse/ellipsis/g

Browse source
This commit is contained in:
Alex Shinn 2011-03-08 21:29:27 +09:00
parent 9b8126cfc3
commit 1831d33b26
1 changed files with 21 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
lib/init.scm
View file

@ -606,7 +606,7 @@
(define-syntax syntax-rules
(er-macro-transformer
(lambda (expr rename compare)
(let ((ellipse-specified? (identifier? (cadr expr)))
(let ((ellipsis-specified? (identifier? (cadr expr)))
(count 0)
(_er-macro-transformer (rename 'er-macro-transformer))
(_lambda (rename 'lambda)) (_let (rename 'let))
@ -625,9 +625,9 @@
(_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i))
(_reverse (rename 'reverse)) (_vector->list (rename 'vector->list))
(_list->vector (rename 'list->vector)))
(define ellipse (rename (if ellipse-specified? (cadr expr) '...)))
(define lits (if ellipse-specified? (caddr expr) (cadr expr)))
(define forms (if ellipse-specified? (cdddr expr) (cddr expr)))
(define ellipsis (rename (if ellipsis-specified? (cadr expr) '...)))
(define lits (if ellipsis-specified? (caddr expr) (cadr expr)))
(define forms (if ellipsis-specified? (cdddr expr) (cddr expr)))
(define (next-symbol s)
(set! count (+ count 1))
(rename (string->symbol (string-append s (number->string count)))))
@ -647,11 +647,11 @@
(if (any (lambda (l) (compare p l)) lits)
(list _and (list _compare v (list _quote p)) (k vars))
(list _let (list (list p v)) (k (cons (cons p dim) vars)))))
((ellipse? p)
((ellipsis? p)
(cond
((not (null? (cddr p)))
(cond
((any (lambda (x) (and (identifier? x) (compare x ellipse)))
((any (lambda (x) (and (identifier? x) (compare x ellipsis)))
(cddr p))
(error "multiple ellipses" p))
(else
@ -722,16 +722,16 @@
(lp (vector->list p) (list _vector->list v) dim vars k)))
((null? p) (list _and (list _null? v) (k vars)))
(else (list _and (list _equal? v p) (k vars))))))))
(define (ellipse-escape? x) (and (pair? x) (compare ellipse (car x))))
(define (ellipse? x)
(and (pair? x) (pair? (cdr x)) (compare ellipse (cadr x))))
(define (ellipse-depth x)
(if (ellipse? x)
(+ 1 (ellipse-depth (cdr x)))
(define (ellipsis-escape? x) (and (pair? x) (compare ellipsis (car x))))
(define (ellipsis? x)
(and (pair? x) (pair? (cdr x)) (compare ellipsis (cadr x))))
(define (ellipsis-depth x)
(if (ellipsis? x)
(+ 1 (ellipsis-depth (cdr x)))
0))
(define (ellipse-tail x)
(if (ellipse? x)
(ellipse-tail (cdr x))
(define (ellipsis-tail x)
(if (ellipsis? x)
(ellipsis-tail (cdr x))
(cdr x)))
(define (all-vars x dim)
(let lp ((x x) (dim dim) (vars '()))
@ -739,7 +739,7 @@
(if (any (lambda (lit) (compare x lit)) lits)
vars
(cons (cons x dim) vars)))
((ellipse? x) (lp (car x) (+ dim 1) vars))
((ellipsis? x) (lp (car x) (+ dim 1) vars))
((pair? x) (lp (car x) dim (lp (cdr x) dim vars)))
((vector? x) (lp (vector->list x) dim vars))
(else vars))))
@ -769,13 +769,13 @@
(list _rename (list _quote t)))))
((pair? t)
(cond
((ellipse-escape? t)
((ellipsis-escape? t)
(list _quote
(if (pair? (cdr t))
(if (pair? (cddr t)) (cddr t) (cadr t))
(cdr t))))
((ellipse? t)
(let* ((depth (ellipse-depth t))
((ellipsis? t)
(let* ((depth (ellipsis-depth t))
(ell-dim (+ dim depth))
(ell-vars (free-vars (car t) vars ell-dim)))
(if (null? ell-vars)
@ -792,9 +792,9 @@
(many nest
(list _apply _append many)))
((= d 1) many))))
(if (null? (ellipse-tail t))
(if (null? (ellipsis-tail t))
many ;; shortcut
(list _append many (lp (ellipse-tail t) dim)))))))
(list _append many (lp (ellipsis-tail t) dim)))))))
(else (list _cons (lp (car t) dim) (lp (cdr t) dim)))))
((vector? t) (list _list->vector (lp (vector->list t) dim)))
((null? t) (list _quote '()))