From: Andy Wingo Date: Thu, 26 Mar 2015 12:32:46 +0000 (+0100) Subject: Default "meet" operator is meet-error for intmap X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/33ab2838de874fe2b9dfae2008c93e550c7ab4af?hp=50fcdfece306a437ebad326679245e206cfbe6b2 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. --- 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))