mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix intset-fold-right on transient intsets

Browse source 
* module/language/cps/intset.scm (make-intset-folder): intset-fold-right
on a transient intset would dispatch to left fold after making the
persistent set.  Sadness!
This commit is contained in:
Andy Wingo 2024-08-15 12:18:02 +02:00
parent 7aa4cfa9de
commit d0790d766b
1 changed files with 9 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/language/cps/intset.scm
View file

@ -1,5 +1,5 @@
;;; Functional name maps ;;; Functional name maps
;;; Copyright (C) 2014, 2015, 2017 Free Software Foundation, Inc. ;;; Copyright (C) 2014, 2015, 2017, 2024 Free Software Foundation, Inc.
;;; ;;;
;;; This library is free software: you can redistribute it and/or modify ;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as ;;; it under the terms of the GNU Lesser General Public License as
@ -454,13 +454,14 @@
(lp (if forward? (1+ i) (1- i)) seed ...))) (lp (if forward? (1+ i) (1- i)) seed ...)))
(lp (if forward? (1+ i) (1- i)) seed ...))) (lp (if forward? (1+ i) (1- i)) seed ...)))
(values seed ...))))))) (values seed ...)))))))
(match set (let fold ((set set))
(($ <intset> min shift root) (match set
(cond (($ <intset> min shift root)
((not root) (values seed ...)) (cond
(else (visit-branch root shift min seed ...)))) ((not root) (values seed ...))
(($ <transient-intset>) (else (visit-branch root shift min seed ...))))
(intset-fold f (persistent-intset set) seed ...))))) (($ <transient-intset>)
(fold (persistent-intset set)))))))
(define intset-fold (define intset-fold
(case-lambda (case-lambda