mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 13:00:26 +02:00
* boot-9.scm (struct-printer): Fix off-by-one error in range
check. Correctly check for struct printer tag. * boot-9.scm (with-regexp-parts): Comment this out. It has no users in the core, and relies on mildly hairy details of the old regexp interface. * boot-9.scm (ipow-by-squaring, butlast): Fix uses of outdated function names. * boot-9.scm (with-excursion-getter-and-setter, q-rear): Doc fixes.
This commit is contained in:
parent
ec8469e7cb
commit
52c5a23aed
1 changed files with 19 additions and 15 deletions
|
@ -104,7 +104,7 @@
|
|||
(define (ipow-by-squaring x k acc proc)
|
||||
(cond ((zero? k) acc)
|
||||
((= 1 k) (proc acc x))
|
||||
(else (logical:ipow-by-squaring (proc x x)
|
||||
(else (ipow-by-squaring (proc x x)
|
||||
(quotient k 2)
|
||||
(if (even? k) acc (proc acc x))
|
||||
proc))))
|
||||
|
@ -333,10 +333,11 @@
|
|||
|
||||
(define (struct-printer s)
|
||||
(let ((vtable (struct-vtable s)))
|
||||
(and (>= (string-length (struct-layout vtable))
|
||||
(and (> (string-length (struct-layout vtable))
|
||||
(* 2 struct-vtable-offset))
|
||||
(let ((p (struct-ref vtable struct-vtable-offset)))
|
||||
(and (eq? (car p) %struct-printer-tag)
|
||||
(and (pair? p)
|
||||
(eq? (car p) %struct-printer-tag)
|
||||
(cdr p))))))
|
||||
|
||||
(define (make-struct-printer printer)
|
||||
|
@ -2719,7 +2720,7 @@
|
|||
`(,proc ,@ (delegating-getter-and-setter-syntax vars get-delegate set-delegate)))
|
||||
|
||||
|
||||
;;; with-delegating-getter-and-setter <vars> get-delegate set-delegate proc
|
||||
;;; with-excursion-getter-and-setter <vars> proc
|
||||
;;; <vars> is an unevaluated list of names that are bound in the caller.
|
||||
;;; proc is called:
|
||||
;;;
|
||||
|
@ -3046,7 +3047,7 @@
|
|||
(cons (car lst) (bl (cdr lst) (+ -1 n))))
|
||||
(else '())))))
|
||||
(bl lst (if (negative? n)
|
||||
(slib:error "negative argument to butlast" n)
|
||||
(error "negative argument to butlast" n)
|
||||
l))))
|
||||
|
||||
(define-public (and? . args)
|
||||
|
@ -3263,7 +3264,7 @@
|
|||
;;; Return the first element of Q.
|
||||
(define-public (q-front q) (q-empty-check q) (caar q))
|
||||
|
||||
;;; q-front q
|
||||
;;; q-rear q
|
||||
;;; Return the last element of Q.
|
||||
(define-public (q-rear q) (q-empty-check q) (cadr q))
|
||||
|
||||
|
@ -3799,11 +3800,14 @@
|
|||
|
||||
;;; {String Fun: with-regexp-parts}
|
||||
|
||||
(define-public (with-regexp-parts regexp fields str return fail)
|
||||
(let ((parts (regexec regexp str fields)))
|
||||
(if (number? parts)
|
||||
(fail parts)
|
||||
(apply return parts))))
|
||||
;;; This relies on the older, hairier regexp interface, which we don't
|
||||
;;; particularly want to implement, and it's not used anywhere, so
|
||||
;;; we're just going to drop it for now.
|
||||
;;; (define-public (with-regexp-parts regexp fields str return fail)
|
||||
;;; (let ((parts (regexec regexp str fields)))
|
||||
;;; (if (number? parts)
|
||||
;;; (fail parts)
|
||||
;;; (apply return parts))))
|
||||
|
||||
|
||||
;;; {Load debug extension code if debug extensions present.}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue