From 84f81ab1014fd2bdee36611b0971a0d6acd54d49 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 10 Sep 1997 12:56:54 +0000 Subject: [PATCH] *** empty log message *** original commit: 89756069b913e24574b536f36f9ec87803985644 --- collects/mzlib/functior.ss | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/collects/mzlib/functior.ss b/collects/mzlib/functior.ss index 26b8eff..50b29b3 100644 --- a/collects/mzlib/functior.ss +++ b/collects/mzlib/functior.ss @@ -7,16 +7,23 @@ (define compose (polymorphic (case-lambda - [(f) f] + [(f) (if (procedure? f) f (raise-type-error 'compose "procedure" f))] [(f g) - (if (eqv? 1 (arity f)) ; optimize: don't use call-w-values - (if (eqv? 1 (arity g)) ; optimize: single arity everywhere - (lambda (x) (f (g x))) - (lambda args (f (apply g args)))) - (lambda args - (call-with-values - (lambda () (apply g args)) - f)))] + (let ([f (compose f)] + [g (compose g)]) + (if (eqv? 1 (arity f)) ; optimize: don't use call-w-values + (if (eqv? 1 (arity g)) ; optimize: single arity everywhere + (lambda (x) (f (g x))) + (lambda args (f (apply g args)))) + (if (eqv? 1 (arity g)) ; optimize: single input + (lambda (a) + (call-with-values + (lambda () (g a)) + f)) + (lambda args + (call-with-values + (lambda () (apply g args)) + f)))))] [(f . more) (let ([m (apply compose more)]) (compose f m))])))