Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +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 (define-syntax syntax-rules
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
(let ((ellipse-specified? (identifier? (cadr expr))) (let ((ellipsis-specified? (identifier? (cadr expr)))
(count 0) (count 0)
(_er-macro-transformer (rename 'er-macro-transformer)) (_er-macro-transformer (rename 'er-macro-transformer))
(_lambda (rename 'lambda)) (_let (rename 'let)) (_lambda (rename 'lambda)) (_let (rename 'let))
@ -625,9 +625,9 @@
(_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i)) (_ls (rename 'ls)) (_res (rename 'res)) (_i (rename 'i))
(_reverse (rename 'reverse)) (_vector->list (rename 'vector->list)) (_reverse (rename 'reverse)) (_vector->list (rename 'vector->list))
(_list->vector (rename 'list->vector))) (_list->vector (rename 'list->vector)))
(define ellipse (rename (if ellipse-specified? (cadr expr) '...))) (define ellipsis (rename (if ellipsis-specified? (cadr expr) '...)))
(define lits (if ellipse-specified? (caddr expr) (cadr expr))) (define lits (if ellipsis-specified? (caddr expr) (cadr expr)))
(define forms (if ellipse-specified? (cdddr expr) (cddr expr))) (define forms (if ellipsis-specified? (cdddr expr) (cddr expr)))
(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)))))
@ -647,11 +647,11 @@
(if (any (lambda (l) (compare p l)) lits) (if (any (lambda (l) (compare p l)) lits)
(list _and (list _compare v (list _quote p)) (k vars)) (list _and (list _compare v (list _quote p)) (k vars))
(list _let (list (list p v)) (k (cons (cons p dim) vars))))) (list _let (list (list p v)) (k (cons (cons p dim) vars)))))
((ellipse? p) ((ellipsis? p)
(cond (cond
((not (null? (cddr p))) ((not (null? (cddr p)))
(cond (cond
((any (lambda (x) (and (identifier? x) (compare x ellipse))) ((any (lambda (x) (and (identifier? x) (compare x ellipsis)))
(cddr p)) (cddr p))
(error "multiple ellipses" p)) (error "multiple ellipses" p))
(else (else
@ -722,16 +722,16 @@
(lp (vector->list p) (list _vector->list v) dim vars k))) (lp (vector->list p) (list _vector->list v) dim vars k)))
((null? p) (list _and (list _null? v) (k vars))) ((null? p) (list _and (list _null? v) (k vars)))
(else (list _and (list _equal? v p) (k vars)))))))) (else (list _and (list _equal? v p) (k vars))))))))
(define (ellipse-escape? x) (and (pair? x) (compare ellipse (car x)))) (define (ellipsis-escape? x) (and (pair? x) (compare ellipsis (car x))))
(define (ellipse? x) (define (ellipsis? x)
(and (pair? x) (pair? (cdr x)) (compare ellipse (cadr x)))) (and (pair? x) (pair? (cdr x)) (compare ellipsis (cadr x))))
(define (ellipse-depth x) (define (ellipsis-depth x)
(if (ellipse? x) (if (ellipsis? x)
(+ 1 (ellipse-depth (cdr x))) (+ 1 (ellipsis-depth (cdr x)))
0)) 0))
(define (ellipse-tail x) (define (ellipsis-tail x)
(if (ellipse? x) (if (ellipsis? x)
(ellipse-tail (cdr x)) (ellipsis-tail (cdr x))
(cdr x))) (cdr x)))
(define (all-vars x dim) (define (all-vars x dim)
(let lp ((x x) (dim dim) (vars '())) (let lp ((x x) (dim dim) (vars '()))
@ -739,7 +739,7 @@
(if (any (lambda (lit) (compare x lit)) lits) (if (any (lambda (lit) (compare x lit)) lits)
vars vars
(cons (cons x dim) 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))) ((pair? x) (lp (car x) dim (lp (cdr x) dim vars)))
((vector? x) (lp (vector->list x) dim vars)) ((vector? x) (lp (vector->list x) dim vars))
(else vars)))) (else vars))))
@ -769,13 +769,13 @@
(list _rename (list _quote t))))) (list _rename (list _quote t)))))
((pair? t) ((pair? t)
(cond (cond
((ellipse-escape? t) ((ellipsis-escape? t)
(list _quote (list _quote
(if (pair? (cdr t)) (if (pair? (cdr t))
(if (pair? (cddr t)) (cddr t) (cadr t)) (if (pair? (cddr t)) (cddr t) (cadr t))
(cdr t)))) (cdr t))))
((ellipse? t) ((ellipsis? t)
(let* ((depth (ellipse-depth t)) (let* ((depth (ellipsis-depth t))
(ell-dim (+ dim depth)) (ell-dim (+ dim depth))
(ell-vars (free-vars (car t) vars ell-dim))) (ell-vars (free-vars (car t) vars ell-dim)))
(if (null? ell-vars) (if (null? ell-vars)
@ -792,9 +792,9 @@
(many nest (many nest
(list _apply _append many))) (list _apply _append many)))
((= d 1) many)))) ((= d 1) many))))
(if (null? (ellipse-tail t)) (if (null? (ellipsis-tail t))
many ;; shortcut 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))))) (else (list _cons (lp (car t) dim) (lp (cdr t) dim)))))
((vector? t) (list _list->vector (lp (vector->list t) dim))) ((vector? t) (list _list->vector (lp (vector->list t) dim)))
((null? t) (list _quote '())) ((null? t) (list _quote '()))