From 33ab2838de874fe2b9dfae2008c93e550c7ab4af Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 26 Mar 2015 13:32:46 +0100 Subject: [PATCH] Default "meet" operator is meet-error for intmap * module/language/cps/intmap.scm (meet-error): New helper. (intmap-add, intmap-union, intmap-intersect): The "meet" argument is optional and defaults to meet-error. --- module/language/cps/intmap.scm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/module/language/cps/intmap.scm b/module/language/cps/intmap.scm index d6c017a4f..e3ed5dacf 100644 --- a/module/language/cps/intmap.scm +++ b/module/language/cps/intmap.scm @@ -1,5 +1,5 @@ ;;; Functional name maps -;;; Copyright (C) 2014 Free Software Foundation, Inc. +;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc. ;;; ;;; This library is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU Lesser General Public License as @@ -102,7 +102,10 @@ ;; Shouldn't be reached... (else empty-intmap))))) -(define (intmap-add bs i val meet) +(define (meet-error old new) + (error "Multiple differing values and no meet procedure defined" old new)) + +(define* (intmap-add bs i val #:optional (meet meet-error)) (define (adjoin i shift root) (cond ((zero? shift) @@ -209,7 +212,7 @@ (let ((i (visit-node root shift i))) (and i (+ min i)))))))) -(define (intmap-union a b meet) +(define* (intmap-union a b #:optional (meet meet-error)) ;; Union A and B from index I; the result will be fresh. (define (union-branches/fresh shift a b i fresh) (let lp ((i 0)) @@ -288,7 +291,7 @@ ((eq? root b-root) b) (else (make-intmap a-min a-shift root))))))))) -(define (intmap-intersect a b meet) +(define* (intmap-intersect a b #:optional (meet meet-error)) ;; Intersect A and B from index I; the result will be fresh. (define (intersect-branches/fresh shift a b i fresh) (let lp ((i 0)) -- 2.20.1