From 5daed4abaafa67e3887fb22916a09c453d91ce46 Mon Sep 17 00:00:00 2001 From: Greg Cooper Date: Mon, 4 Aug 2008 19:20:31 +0000 Subject: [PATCH] by default, raise an error when HOLD (or a derived construct like ACCUM-B or COLLECT-B) is used to create a higher-order behavior svn: r11071 --- collects/frtime/lang-ext.ss | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/collects/frtime/lang-ext.ss b/collects/frtime/lang-ext.ss index 9d41a072fb..45f4554aa6 100644 --- a/collects/frtime/lang-ext.ss +++ b/collects/frtime/lang-ext.ss @@ -123,7 +123,7 @@ (define switch (opt-lambda (e [init undefined]) (let* ([init (box init)] - [e-b (hold e (unbox init))] + [e-b (hold e (unbox init) #t)] [ret (proc->signal:switching (case-lambda [() (value-now (unbox init))] [(msg) e]) @@ -281,12 +281,20 @@ ; hold : a event[a] -> behavior[a] (define hold - (opt-lambda (e [init undefined]) - (let ([val init]) + (opt-lambda (e [init undefined] [allow-behaviors? #f]) + (let ([val init] + [warn-about-behaviors? #t]) (lift #t (lambda (es) (let ([events (event-set-events es)]) (when (and (= (current-logical-time) (event-set-time es)) (cons? events)) (set! val (first (last-pair (event-set-events es))))) + (when (and (behavior? val) (not allow-behaviors?)) + (set! val (value-now val)) + (when warn-about-behaviors? + (thread + (lambda () + (error "hold: input event had a behavior; snapshotting to prevent nested behavior"))) + (set! warn-about-behaviors? #f))) val)) e))))