mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

psyntax simplification

Browse source 
* module/ice-9/psyntax.scm (strip): Inline the and-map* definition to
  its one call site.

* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2011-05-05 16:28:28 +02:00
parent 3b7f4ba37b
commit e2ccab571e
2 changed files with 15076 additions and 15300 deletions
Download patch file Download diff file Expand all files Collapse all files

16759
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

27
module/ice-9/psyntax.scm
View file

@ -156,25 +156,6 @@
(set-current-module (resolve-module '(guile)))) (set-current-module (resolve-module '(guile))))
(let () (let ()
;; Private version of and-map that handles multiple lists.
(define and-map*
(lambda (f first . rest)
(or (null? first)
(if (null? rest)
(let andmap ((first first))
(let ((x (car first)) (first (cdr first)))
(if (null? first)
(f x)
(and (f x) (andmap first)))))
(let andmap ((first first) (rest rest))
(let ((x (car first))
(xr (map car rest))
(first (cdr first))
(rest (map cdr rest)))
(if (null? first)
(apply f x xr)
(and (apply f x xr) (andmap first rest)))))))))
(define-syntax define-expansion-constructors (define-syntax define-expansion-constructors
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
@ -1747,7 +1728,13 @@
((vector? x) ((vector? x)
(let ((old (vector->list x))) (let ((old (vector->list x)))
(let ((new (map f old))) (let ((new (map f old)))
(if (and-map* eq? old new) x (list->vector new))))) ;; inlined and-map with two args
(let lp ((l1 old) (l2 new))
(if (null? l1)
x
(if (eq? (car l1) (car l2))
(lp (cdr l1) (cdr l2))
(list->vector new)))))))
(else x)))))) (else x))))))
;; lexical variables ;; lexical variables