From 854a9b24597dedb45d938970fe64f0ea88002273 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 10 May 2017 16:04:30 +0200 Subject: [PATCH] Fixes repeated evaluation of arguments (as reported in #1) --- typed-map-lib/typed-map/main.rkt | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/typed-map-lib/typed-map/main.rkt b/typed-map-lib/typed-map/main.rkt index c6a60c8..8f3963e 100644 --- a/typed-map-lib/typed-map/main.rkt +++ b/typed-map-lib/typed-map/main.rkt @@ -7,20 +7,9 @@ (provide map foldr foldl) -(module m racket/base - (provide unoptimizable-false) - (define (unoptimizable-false) #f)) -(require/typed 'm [unoptimizable-false (→ Boolean)]) - -(define #:∀ (A) (generalize [l : (Listof A)]) - (if (unoptimizable-false) - l - ;; the double-reverse is complex enough that Typed/Racket does not - ;; infer that generalize has type (→ A A) instead of - ;; (→ (Listof A) (Listof A)) - ;; The unoptimizable-false above means that this is never executed, - ;; so the performance cost of the double-reverse is not incured. - (reverse (reverse l)))) +(: generalize (∀ (A) (case→ (→ Null Null) + (→ (Listof A) (Listof A))))) +(define (generalize l) l) (define-syntax (map stx) (syntax-case stx (λ) @@ -30,7 +19,12 @@ #'(foldr (λ (argᵢ ... acc) (cons (let () body ...) acc)) null lᵢ ...)] [(_ f lᵢ ...) (with-syntax ([(argᵢ ...) (generate-temporaries #'(lᵢ ...))]) - #'(foldr (λ (argᵢ ... acc) (cons (f argᵢ ...) acc)) null lᵢ ...))])) + #'(let ([f-cache f]) + (foldr (λ (argᵢ ... acc) + (cons (f-cache argᵢ ...) acc)) + null + lᵢ + ...)))])) (define-syntax (foldr stx) (syntax-case stx (λ)