1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00

Fix error when boot-9.go after "skip invalid .go files" commit

* module/ice-9/boot-9.scm (map, for-each): Move definition up before
  loading r4rs.go.  Before, when r4rs.go was being loaded, there was a
  window in which "catch" defined in Scheme used with-fluids before
  "map" was defined, but if "with-fluids" in eval.scm uses "map".  That
  would lead to the inability to catch errors (stack overflow) if
  `catch' was used in that window -- which it now is, due to the "skip
  invalid .go files" patch.
This commit is contained in:
Andy Wingo 2016-07-14 16:20:59 +02:00
parent da757c6814
commit 4e02ce55a6

View file

@ -186,6 +186,51 @@ If there is no handler at all, Guile prints an error and then exits."
"Wrong type argument in position ~a: ~a" (list 1 key) (list key))
(apply (fluid-ref %exception-handler) key args)))))
;;; Boot versions of `map' and `for-each', enough to get the expander
;;; running, and get the "map" used in eval.scm for with-fluids to work.
;;;
(define map
(case-lambda
((f l)
(let map1 ((l l))
(if (null? l)
'()
(cons (f (car l)) (map1 (cdr l))))))
((f l1 l2)
(let map2 ((l1 l1) (l2 l2))
(if (null? l1)
'()
(cons (f (car l1) (car l2))
(map2 (cdr l1) (cdr l2))))))
((f l1 . rest)
(let lp ((l1 l1) (rest rest))
(if (null? l1)
'()
(cons (apply f (car l1) (map car rest))
(lp (cdr l1) (map cdr rest))))))))
(define for-each
(case-lambda
((f l)
(let for-each1 ((l l))
(if (pair? l)
(begin
(f (car l))
(for-each1 (cdr l))))))
((f l1 l2)
(let for-each2 ((l1 l1) (l2 l2))
(if (pair? l1)
(begin
(f (car l1) (car l2))
(for-each2 (cdr l1) (cdr l2))))))
((f l1 . rest)
(let lp ((l1 l1) (rest rest))
(if (pair? l1)
(begin
(apply f (car l1) (map car rest))
(lp (cdr l1) (map cdr rest))))))))
@ -252,50 +297,6 @@ If there is no handler at all, Guile prints an error and then exits."
;;; Boot versions of `map' and `for-each', enough to get the expander
;;; running.
;;;
(define map
(case-lambda
((f l)
(let map1 ((l l))
(if (null? l)
'()
(cons (f (car l)) (map1 (cdr l))))))
((f l1 l2)
(let map2 ((l1 l1) (l2 l2))
(if (null? l1)
'()
(cons (f (car l1) (car l2))
(map2 (cdr l1) (cdr l2))))))
((f l1 . rest)
(let lp ((l1 l1) (rest rest))
(if (null? l1)
'()
(cons (apply f (car l1) (map car rest))
(lp (cdr l1) (map cdr rest))))))))
(define for-each
(case-lambda
((f l)
(let for-each1 ((l l))
(if (pair? l)
(begin
(f (car l))
(for-each1 (cdr l))))))
((f l1 l2)
(let for-each2 ((l1 l1) (l2 l2))
(if (pair? l1)
(begin
(f (car l1) (car l2))
(for-each2 (cdr l1) (cdr l2))))))
((f l1 . rest)
(let lp ((l1 l1) (rest rest))
(if (pair? l1)
(begin
(apply f (car l1) (map car rest))
(lp (cdr l1) (map cdr rest))))))))
;; Temporary definition used in the include-from-path expansion;
;; replaced later.