add frtime/reactive language and define-reactive construct

svn: r10620

collects/frtime/lang-ext.ss

@@ -9,6 +9,14 @@
   
   (define (nothing? v) (eq? v nothing))
   
+  (define-syntax define-reactive
+    (syntax-rules ()
+      [(_ name expr)
+       (define name
+         (let ([val (parameterize ([snap? #f])
+                      expr)])
+           (lambda () (deep-value-now val))))]))
+  
   (define deep-value-now
     (case-lambda
       [(obj) (deep-value-now obj empty)]
@@ -40,7 +48,7 @@
       
   (define (lift strict? fn . args)
     (if (snap?) ;; maybe fix later to handle undefined-strictness
-        (apply fn (map value-now/no-copy args))
+        (apply fn (map value-now args))
         (with-continuation-mark
             'frtime 'lift-active
           (cond
@@ -817,6 +825,7 @@
            until
            event-loop
            split
+           define-reactive
            
            ;; from frp-core
            event-receiver

collects/frtime/reactive.ss

@@ -0,0 +1,29 @@
+(module reactive "mzscheme-utils.ss"
+  (require "lang-ext.ss")
+  (require "frp-snip.ss")
+  (require "ft-qq.ss")
+  (require frtime/list)
+  (require frtime/etc)
+  (require (as-is:unchecked "frp-core.ss"
+                            event-set? snap? signal-value))
+
+  (snap? #t)
+  
+  (define (value-nowable? x)
+    (or (not (signal? x))
+	(not (event-set? (signal-value x)))))
+
+  (define ((behaviorof pred) x)
+    (let ([v (value-now x)])
+      (or (undefined? v)
+          (pred v))))
+
+  ;(provide-for-syntax (rename frtime/mzscheme-utils syntax->list syntax->list))
+  
+  (provide value-nowable? behaviorof
+           (all-from frtime/list)
+           (all-from frtime/etc)
+	   (all-from "mzscheme-utils.ss")
+           (all-from-except "lang-ext.ss" lift)
+           (all-from "frp-snip.ss")
+           (all-from "ft-qq.ss")))

collects/frtime/reactive/lang/reader.ss

@@ -0,0 +1,2 @@
+(module reader syntax/module-reader
+  frtime/reactive)