;;; 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)))))