39 lines
1.6 KiB
Scheme
39 lines
1.6 KiB
Scheme
|
;;; Copyright 2024 Peter McGoron
|
||
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
||
|
|
;;; you may not use this file except in compliance with the License.
|
||
|
|
;;; You may obtain a copy of the License at
|
||
|
|
;;;
|
||
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
||
|
|
;;;
|
||
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
||
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
||
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
|
||
|
|
;;; implied. See the License for the specific language governing
|
||
|
|
;;; permissions and limitations under the License.
|
||
|
|
|
||
|
|
;;; Helper function.
|
||
|
|
(define (null-cdr? lst) (null? (cdr lst)))
|
||
|
|
|
||
|
|
;;; MAP-VALUES returns (VALUES L1 L2 ...), where L1 is the first
|
||
|
|
;;; value returned from (F (CAR LST)), (F (CADR LST)), ... and so on.
|
||
|
|
(define (map-values f . lists)
|
||
|
|
(define (null-cdr? lst) (null? (cdr lst)))
|
||
|
|
(let-values ((new-values (apply f (map car lists))))
|
||
|
|
(if (any null-cdr? lists)
|
||
|
|
(apply values (map list new-values))
|
||
|
|
(let-values ((returned (apply map-values f (map cdr lists))))
|
||
|
|
(apply values (map cons new-values returned))))))
|
||
|
|
|
||
|
|
;;; (ANY-VALUES F (A1 A2 ...) (B1 B2 ...) ...) runs
|
||
|
|
;;; (F A1 B1 ...) and checks if there any returned values. If there are
|
||
|
|
;;; none, runs (F A2 B2 ...), and so on.
|
||
|
|
;;;
|
||
|
|
;;; If any of the lists end, then ANY-VALUES returns no values.
|
||
|
|
(define (any-values f . lists)
|
||
|
|
(after ((when (not (null? lists)))
|
||
|
|
(when (all pair? lists)))
|
||
|
|
(let-values ((returned (apply f (map car lists))))
|
||
|
|
(if (null? returned)
|
||
|
|
(apply any-values f (map cdr lists))
|
||
|
|
(apply values returned)))))
|