From f89d241e6bf06b9e5712ec589ff4fbe7f543aa61 Mon Sep 17 00:00:00 2001
From: Greg Cooper <greg@cs.brown.edu>
Date: Tue, 7 Nov 2006 22:14:40 +0000
Subject: [PATCH] under 3m, letrec doesn't seem to work the way I want for
 signal structures, so I've switched to manual set!

also, cleaned up the push-pull-ball demo

svn: r4803
---
 collects/frtime/demos/push-pull-ball.ss | 12 ++++----
 collects/frtime/lang-ext.ss             | 38 +++++++++++++------------
 2 files changed, 25 insertions(+), 25 deletions(-)

diff --git a/collects/frtime/demos/push-pull-ball.ss b/collects/frtime/demos/push-pull-ball.ss
index aa6e64215d..16a87f5463 100644
--- a/collects/frtime/demos/push-pull-ball.ss
+++ b/collects/frtime/demos/push-pull-ball.ss
@@ -6,28 +6,26 @@
 (define pos1
   (rec pos
     (until (make-posn 200 200)
-           (delay-by
+           (inf-delay
             (let ([brnch (posn+ pos
                                 (posn* (normalize (posn- mouse-pos pos))
                                        (- (posn-diff pos mouse-pos) (sub1 radius))))])
               (if (> (posn-diff pos mouse-pos) radius)
                   brnch
-                  pos))
-            0))))
+                  pos))))))
 
 (define pos2
   (rec pos
     (until (make-posn 100 100)
-           (delay-by
+            (inf-delay
             (let ([brnch (posn+ pos
                                 (posn* (normalize (posn- pos1 pos))
                                        (- (posn-diff pos pos1) (add1 (* 2 radius)))))])
               (if (< (posn-diff pos pos1) (* 2 radius))
                   brnch
-                  pos))
-            0))))
+                  pos))))))
 
 (display-shapes
  (list
   (make-circle pos1 radius "blue")
-  (make-circle pos2 radius "blue")))
+  (make-circle pos2 radius "gray")))
diff --git a/collects/frtime/lang-ext.ss b/collects/frtime/lang-ext.ss
index adee360eac..a746b6019b 100644
--- a/collects/frtime/lang-ext.ss
+++ b/collects/frtime/lang-ext.ss
@@ -82,24 +82,26 @@
   (define switch
     (opt-lambda (e [init undefined])
       (let* ([init (box init)]
-             [e-b (hold e (unbox init))])
-        (rec ret
-          (proc->signal:switching
-           (case-lambda
-             [()
-              (when (not (eq? (unbox init) (signal-value e-b)))
-                (unregister ret (unbox init))
-                (set-box! init (value-now/no-copy e-b))
-                (register ret (unbox init))
-                (set-signal-producers! ret (list e-b (unbox init)))
-                (set-signal-depth! ret (max (signal-depth ret)
-                                            (add1 (safe-signal-depth (unbox init)))))
-                (iq-resort))
-              (value-now/no-copy (unbox init))]
-             [(msg) e])
-           init
-           e-b
-           e-b (unbox init))))))
+             [e-b (hold e (unbox init))]
+             [ret (proc->signal:switching
+                   (case-lambda [() undefined]
+                                [(msg) e])
+                   init e-b e-b (unbox init))])
+        (set-signal-thunk!
+         ret
+         (case-lambda
+           [()
+            (when (not (eq? (unbox init) (signal-value e-b)))
+              (unregister ret (unbox init))
+              (set-box! init (value-now e-b))
+              (register ret (unbox init))
+              (set-signal-producers! ret (list e-b (unbox init)))
+              (set-signal-depth! ret (max (signal-depth ret)
+                                          (add1 (safe-signal-depth (unbox init)))))
+              (iq-resort))
+            (value-now/no-copy (unbox init))]
+           [(msg) e]))
+        ret)))
   
   ; event ... -> event
   (define (merge-e . args)