From 6d6d85a8fb0775750a64a9b19fa6230b4cc9d6db Mon Sep 17 00:00:00 2001
From: Greg Cooper <greg@cs.brown.edu>
Date: Fri, 28 Nov 2008 02:33:40 +0000
Subject: [PATCH] - cleaned up public version of deep-value-now - removed ft-qq
 (obsolete implementation of quasiquote) - removed a bunch of commented-out
 code

svn: r12627
---
 collects/frtime/frtime-lang-only.ss |   4 +-
 collects/frtime/frtime-opt-lang.ss  |   2 +-
 collects/frtime/frtime.ss           |   8 +-
 collects/frtime/ft-qq.ss            | 178 ----------------------------
 collects/frtime/lang-ext.ss         |  52 +++++++-
 collects/frtime/lang.ss             |   4 +-
 collects/frtime/mzscheme-core.ss    | 149 +++--------------------
 collects/frtime/mzscheme-utils.ss   |  85 ++-----------
 collects/frtime/reactive.ss         |   4 +-
 9 files changed, 81 insertions(+), 405 deletions(-)
 delete mode 100644 collects/frtime/ft-qq.ss

diff --git a/collects/frtime/frtime-lang-only.ss b/collects/frtime/frtime-lang-only.ss
index f2e4515898..fea1cf5415 100644
--- a/collects/frtime/frtime-lang-only.ss
+++ b/collects/frtime/frtime-lang-only.ss
@@ -1,6 +1,5 @@
 (module frtime-lang-only "mzscheme-utils.ss"
   (require frtime/lang-ext)
-  (require frtime/ft-qq)
   (require (as-is:unchecked frtime/frp-core
 	    event-set? signal-value))
   
@@ -18,5 +17,4 @@
   
   (provide value-nowable? behaviorof
 	   (all-from "mzscheme-utils.ss")
-           (all-from-except frtime/lang-ext lift)
-           (all-from frtime/ft-qq)))
+           (all-from-except frtime/lang-ext lift)))
diff --git a/collects/frtime/frtime-opt-lang.ss b/collects/frtime/frtime-opt-lang.ss
index e5534f5330..2a543d6f1a 100644
--- a/collects/frtime/frtime-opt-lang.ss
+++ b/collects/frtime/frtime-opt-lang.ss
@@ -166,7 +166,7 @@
    raise raise-exceptions raise-type-error error exit let/ec
 
    ;; no equiv because I haven't completely thought through these
-   lambda quote quasiquote unquote unquote-splicing make-parameter parameterize
+   lambda quote unquote unquote-splicing make-parameter parameterize
    procedure-arity-includes? dynamic-require)
 
   (provide #%app #%top #%datum require require-for-syntax provide define)
diff --git a/collects/frtime/frtime.ss b/collects/frtime/frtime.ss
index c76a6bc360..4db2c946bb 100644
--- a/collects/frtime/frtime.ss
+++ b/collects/frtime/frtime.ss
@@ -1,7 +1,6 @@
 (module frtime "mzscheme-utils.ss"
-  (require "lang-ext.ss")
+  (require (all-except "lang-ext.ss" lift deep-value-now))
   (require "frp-snip.ss")
-  (require "ft-qq.ss")
   (require (as-is:unchecked "frp-core.ss"
                             event-set? signal-value))
 
@@ -18,7 +17,6 @@
   ;(provide-for-syntax (rename frtime/mzscheme-utils syntax->list syntax->list))
   
   (provide value-nowable? behaviorof
+           (all-from "lang-ext.ss")
 	   (all-from "mzscheme-utils.ss")
-           (all-from-except "lang-ext.ss" lift)
-           (all-from "frp-snip.ss")
-           (all-from "ft-qq.ss")))
+           (all-from "frp-snip.ss")))
diff --git a/collects/frtime/ft-qq.ss b/collects/frtime/ft-qq.ss
deleted file mode 100644
index aabe428d15..0000000000
--- a/collects/frtime/ft-qq.ss
+++ /dev/null
@@ -1,178 +0,0 @@
-(module ft-qq "mzscheme-core.ss"
-  (require (as-is:unchecked mzscheme define-values define-syntaxes require-for-syntax
-  raise-type-error quote unquote unquote-splicing))
-  ;(require-for-syntax frtime/frp)
-  (require-for-syntax syntax/stx)
-  
-  
-  (define-values (frp:qq-append)
-    (lambda (a b)
-      (if (list? a)
-	  (append a b)
-	  (raise-type-error 'unquote-splicing "proper list" a))))
-
-  (define-syntaxes (frp:quasiquote)
-    (let ([here (quote-syntax here)] ; id with module bindings, but not lexical
-	  [unquote-stx (quote-syntax unquote)]
-	  [unquote-splicing-stx (quote-syntax unquote-splicing)])
-      (lambda (in-form)
-	(if (identifier? in-form)
-	    (raise-syntax-error #f "bad syntax" in-form))
-	(let-values
-	    (((form) (if (stx-pair? (stx-cdr in-form))
-			 (if (stx-null? (stx-cdr (stx-cdr in-form)))
-			     (stx-car (stx-cdr in-form))
-			     (raise-syntax-error #f "bad syntax" in-form))
-			 (raise-syntax-error #f "bad syntax" in-form)))
-	     ((normal)
-	      (lambda (x old)
-		(if (eq? x old)
-		    (if (stx-null? x)
-			(quote-syntax ())
-			(list (quote-syntax quote) x))
-		    x)))
-	     ((apply-cons)
-	      (lambda (a d)
-		(if (stx-null? d)
-		    (list (quote-syntax list) a)
-		    (if (if (pair? d)
-			    (module-identifier=? (quote-syntax list) (car d))
-			    #f)
-			(list* (quote-syntax list) a (cdr d))
-			(list (quote-syntax cons) a d))))))
-	  (datum->syntax-object
-	   here
-	   (normal
-	    (letrec-values
-		(((qq)
-		  (lambda (x level)
-		    (let-values
-			(((qq-list)
-			  (lambda (x level)
-			    (let-values
-				(((old-first) (stx-car x)))
-			      (let-values
-				  (((old-second) (stx-cdr x)))
-				(let-values
-				    (((first) (qq old-first level)))
-				  (let-values
-				      (((second) (qq old-second level)))
-				    (let-values
-					()
-				      (if (if (eq? first old-first)
-					      (eq? second old-second)
-					      #f)
-					  x
-					  (apply-cons
-					   (normal first old-first)
-					   (normal second old-second)))))))))))
-		      (if (stx-pair? x)
-			  (let-values
-			      (((first) (stx-car x)))
-			    (if (if (if (identifier? first)
-					(module-identifier=? first unquote-stx)
-					#f)
-				    (stx-list? x)
-				    #f)
-				(let-values
-				    (((rest) (stx-cdr x)))
-				  (if (let-values
-					  (((g35) (not (stx-pair? rest))))
-					(if g35 g35 (not (stx-null? (stx-cdr rest)))))
-				      (raise-syntax-error
-				       'unquote
-				       "expects exactly one expression"
-				       in-form
-				       x))
-				  (if (zero? level)
-				      (stx-car rest)
-				      (qq-list x (sub1 level))))
-				(if (if (if (identifier? first)
-					    (module-identifier=? first (quote-syntax frp:quasiquote))
-					    #f)
-					(stx-list? x)
-					#f)
-				    (qq-list x (add1 level))
-				    (if (if (if (identifier? first)
-						(module-identifier=? first unquote-splicing-stx)
-						#f)
-					    (stx-list? x)
-					    #f)
-					(raise-syntax-error
-					 'unquote-splicing
-					 "invalid context within quasiquote"
-					 in-form
-					 x)
-					(if (if (stx-pair? first)
-						(if (identifier? (stx-car first))
-						    (if (module-identifier=? (stx-car first)
-									     unquote-splicing-stx)
-							(stx-list? first)
-							#F)
-						    #f)
-						#f)
-					    (let-values
-						(((rest) (stx-cdr first)))
-					      (if (let-values
-						      (((g34) (not (stx-pair? rest))))
-						    (if g34
-							g34
-							(not (stx-null? (stx-cdr rest)))))
-						  (raise-syntax-error
-						   'unquote
-						   "expects exactly one expression"
-						   in-form
-						   x))
-					      (let-values
-						  (((uqsd) (stx-car rest))
-						   ((old-l) (stx-cdr x))
-						   ((l) (qq (stx-cdr x) level)))
-						(if (zero? level)
-						    (let-values
-							(((l) (normal l old-l)))
-						      (let-values
-							  ()
-							(list (quote-syntax frp:qq-append) uqsd l)))
-						    (let-values
-							(((restx) (qq-list rest (sub1 level))))
-						      (let-values
-							  ()
-							(if (if (eq? l old-l)
-								(eq? restx rest)
-								#f)
-							    x
-							    (apply-cons
-							     (apply-cons
-							      (quote-syntax (quote unquote-splicing))
-							      (normal restx rest))
-							     (normal l old-l))))))))
-					    (qq-list x level))))))
-			  (if (if (syntax? x) 
-				  (vector? (syntax-e x))
-				  #f)
-			      (let-values
-				  (((l) (vector->list (syntax-e x))))
-				(let-values
-				    (((l2) (qq l level)))
-				  (let-values
-				      ()
-				    (if (eq? l l2)
-					x
-					(list (quote-syntax list->vector) l2)))))
-			      (if (if (syntax? x) (box? (syntax-e x)) #f)
-				  (let-values
-				      (((v) (unbox (syntax-e x))))
-				    (let-values
-					(((qv) (qq v level)))
-				      (let-values
-					  ()
-					(if (eq? v qv)
-					    x
-					    (list (quote-syntax box) qv)))))
-				  x)))))))
-	      (qq form 0))
-	    form)
-	   in-form)))))
-  
-  (provide ;(rename frp:qq-append qq-append)
-           (rename frp:quasiquote quasiquote)))
diff --git a/collects/frtime/lang-ext.ss b/collects/frtime/lang-ext.ss
index 45f4554aa6..6708e8a664 100644
--- a/collects/frtime/lang-ext.ss
+++ b/collects/frtime/lang-ext.ss
@@ -15,9 +15,52 @@
        (define name
          (let ([val (parameterize ([snap? #f])
                       expr)])
-           (lambda () (deep-value-now val))))]))
+           (lambda () (deep-value-now val empty))))]))
   
-  (define deep-value-now
+  (define (deep-value-now obj table)
+    (cond
+      [(assq obj table) => second]
+      [(behavior? obj)
+       (deep-value-now (signal-value obj) (cons (list obj (signal-value obj)) table))]
+      [(cons? obj)
+       (let* ([result (cons #f #f)]
+              [new-table (cons (list obj result) table)]
+              [car-val (deep-value-now (car obj) new-table)]
+              [cdr-val (deep-value-now (cdr obj) new-table)])
+         (if (and (eq? car-val (car obj))
+                  (eq? cdr-val (cdr obj)))
+             obj
+             (cons car-val cdr-val)))]
+      ; won't work in the presence of super structs or immutable fields
+      [(struct? obj)
+       (let*-values ([(info skipped) (struct-info obj)]
+                     [(name init-k auto-k acc mut! immut sup skipped?) (struct-type-info info)]
+                     [(ctor) (struct-type-make-constructor info)]
+                     [(indices) (build-list init-k identity)]
+                     [(result) (apply ctor (build-list init-k (lambda (i) #f)))]
+                     [(new-table) (cons (list obj result) table)]
+                     [(elts) (build-list init-k (lambda (i)
+                                                  (deep-value-now (acc obj i) new-table)))])
+         (if (andmap (lambda (i e) (eq? (acc obj i) e)) indices elts)
+             obj
+             (begin
+               (for-each (lambda (i e) (mut! result i e)) indices elts)
+               result)))]
+      [(vector? obj)
+       (let* ([len (vector-length obj)]
+              [indices (build-list len identity)]
+              [result (build-vector len (lambda (_) #f))]
+              [new-table (cons (list obj result) table)]
+              [elts (build-list len (lambda (i)
+                                      (deep-value-now (vector-ref obj i) new-table)))])
+         (if (andmap (lambda (i e) (eq? (vector-ref obj i) e)) indices elts)
+             obj
+             (begin
+               (for-each (lambda (i e) (vector-set! result i e)) indices elts)
+               result)))]
+      [else obj]))
+
+  #;(define deep-value-now
     (case-lambda
       [(obj) (deep-value-now obj empty)]
       [(obj table)
@@ -166,7 +209,7 @@
                    (make-events-now
                     (if first-time
                         empty
-                        (list (deep-value-now bh))))
+                        (list (deep-value-now bh empty))))
                    (set! first-time #f))))
           b))
   
@@ -389,7 +432,7 @@
              [consumer (proc->signal
                         (lambda ()
                           (let* ([now (current-inexact-milliseconds)]
-                                 [new (deep-value-now beh)]
+                                 [new (deep-value-now beh empty)]
                                  [ms (value-now ms-b)])
                             (when (not (equal? new (car (mcar last))))
                               (set-mcdr! last (mcons (cons new now)
@@ -786,6 +829,7 @@
 
   
   (provide raise-exceptions
+           deep-value-now
            nothing
            nothing?
            ;general-event-processor
diff --git a/collects/frtime/lang.ss b/collects/frtime/lang.ss
index c26a239a38..583049834e 100644
--- a/collects/frtime/lang.ss
+++ b/collects/frtime/lang.ss
@@ -1,6 +1,5 @@
 (module lang frtime/mzscheme-utils
   (require frtime/lang-ext)
-  (require frtime/ft-qq)
   (require (as-is:unchecked frtime/frp-core
 	    event-set? signal-value))
   
@@ -18,5 +17,4 @@
   
   (provide value-nowable? behaviorof
 	   (all-from frtime/mzscheme-utils)
-           (all-from-except frtime/lang-ext lift)
-           (all-from frtime/ft-qq)))
+           (all-from-except frtime/lang-ext lift)))
diff --git a/collects/frtime/mzscheme-core.ss b/collects/frtime/mzscheme-core.ss
index 0f88d07c23..b535b7a33e 100644
--- a/collects/frtime/mzscheme-core.ss
+++ b/collects/frtime/mzscheme-core.ss
@@ -1,11 +1,9 @@
 (module mzscheme-core mzscheme
-  ;(require (all-except mzscheme provide module if require letrec null?)
-           ;mzlib/list)
   (require-for-syntax frtime/struct mzlib/list)
   (require mzlib/list
            frtime/frp-core
            (only srfi/43/vector-lib vector-any)
-           (only frtime/lang-ext lift new-cell switch ==> changes)
+           (only frtime/lang-ext lift new-cell switch ==> changes deep-value-now)
            (only mzlib/etc build-vector rec build-list opt-lambda identity))
   
   ;;;;;;;;;;;;;;;;;;;;;;;;
@@ -23,10 +21,6 @@
          ...
          expr ...)]))
   
-  ;(define-syntax frp:match
-  ;  (syntax-rules ()
-  ;    [(_ expr clause ...) (lift #t (match-lambda clause ...) expr)]))
-  
   (define (->boolean x)
     (if x #t #f))
   
@@ -42,7 +36,6 @@
       [(_ test-exp then-exp else-exp undef-exp)
        (super-lift
         (lambda (b)
-          ;(printf "~n\t******\tIF CONDITION IS ~a~n" b)
           (cond
             [(undefined? b) undef-exp]
             [b then-exp]
@@ -93,21 +86,6 @@
                       (map translate-clause (syntax->list #'(clause ...)))])
          #'(case-lambda
              new-clause ...))]))
-  #|
-  (define (split-list acc lst)
-    (if (null? (cdr lst))
-        (values acc lst)
-        (split-list (append acc (list (car lst))) (cdr lst))))
-  
-  (define (frp:apply fn . args)
-    (let-values ([(first-args rest-args) (split-list () args)])
-      (if (behavior? rest-args)
-          (super-lift
-           (lambda (rest-args)
-             (apply apply fn (append first-args rest-args)))
-           args)
-          (apply apply fn (append first-args rest-args)))))
-  |#
   
   (define any-nested-reactivity?
     (opt-lambda (obj [mem empty])
@@ -141,7 +119,8 @@
          [(absent) (hash-table-put! deps obj 'new)]
          [(old)    (hash-table-put! deps obj 'alive)]
          [(new)    (void)])
-       (deep-value-now/update-deps (signal-value obj) deps table)]
+       (deep-value-now/update-deps (signal-value obj) deps
+                                   (cons (list obj (signal-value obj)) table))]
       [(cons? obj)
        (let* ([result (cons #f #f)]
               [new-table (cons (list obj result) table)]
@@ -178,48 +157,9 @@
                result)))]
       [else obj]))
   
-  (define (deep-value-now obj table)
-    (cond
-      [(assq obj table) => second]
-      [(behavior? obj)
-       (deep-value-now (signal-value obj) table)]
-      [(cons? obj)
-       (let* ([result (cons #f #f)]
-              [new-table (cons (list obj result) table)]
-              [car-val (deep-value-now (car obj) new-table)]
-              [cdr-val (deep-value-now (cdr obj) new-table)])
-         (if (and (eq? car-val (car obj))
-                  (eq? cdr-val (cdr obj)))
-             obj
-             (cons car-val cdr-val)))]
-      ; won't work in the presence of super structs or immutable fields
-      [(struct? obj)
-       (let*-values ([(info skipped) (struct-info obj)]
-                     [(name init-k auto-k acc mut! immut sup skipped?) (struct-type-info info)]
-                     [(ctor) (struct-type-make-constructor info)]
-                     [(indices) (build-list init-k identity)]
-                     [(result) (apply ctor (build-list init-k (lambda (i) #f)))]
-                     [(new-table) (cons (list obj result) table)]
-                     [(elts) (build-list init-k (lambda (i)
-                                                  (deep-value-now (acc obj i) new-table)))])
-         (if (andmap (lambda (i e) (eq? (acc obj i) e)) indices elts)
-             obj
-             (begin
-               (for-each (lambda (i e) (mut! result i e)) indices elts)
-               result)))]
-      [(vector? obj)
-       (let* ([len (vector-length obj)]
-              [indices (build-list len identity)]
-              [result (build-vector len (lambda (_) #f))]
-              [new-table (cons (list obj result) table)]
-              [elts (build-list len (lambda (i)
-                                      (deep-value-now (vector-ref obj i) new-table)))])
-         (if (andmap (lambda (i e) (eq? (vector-ref obj i) e)) indices elts)
-             obj
-             (begin
-               (for-each (lambda (i e) (vector-set! result i e)) indices elts)
-               result)))]
-      [else obj]))
+  (define (public-dvn obj)
+    (do-in-manager-after
+     (deep-value-now obj empty)))
 
   (define any-spinal-reactivity?
     (opt-lambda (lst [mem empty])
@@ -261,8 +201,7 @@
                                 (iq-enqueue rtn))]
                       [(alive) (hash-table-put! deps k 'old)]
                       [(old)   (hash-table-remove! deps k)
-                               (unregister rtn k)])))
-                 #;(printf "count = ~a~n" (hash-table-count deps))))))
+                               (unregister rtn k)])))))))
           (do-in-manager
            (iq-enqueue rtn))
           rtn)
@@ -284,8 +223,7 @@
                            (register rtn k)]
                   [(alive) (hash-table-put! deps k 'old)]
                   [(old)   (hash-table-remove! deps k)
-                           (unregister rtn k)])))
-             #;(printf "count = ~a~n" (hash-table-count deps))))))
+                           (unregister rtn k)])))))))
       (do-in-manager
        (iq-enqueue rtn))
       rtn))
@@ -299,7 +237,6 @@
            (begin0
              (let/ec esc
                (begin0
-                 ;;(with-handlers ([exn:fail? (lambda (exn) #f)])
                  (proc (lambda (obj)
                          (if (behavior? obj)
                              (begin
@@ -320,8 +257,7 @@
                     (case v
                       [(new alive) (hash-table-put! deps k 'old)]
                       [(old)   (hash-table-remove! deps k)
-                               (unregister rtn k)])))
-                 #;(printf "count = ~a~n" (hash-table-count deps))))))))
+                               (unregister rtn k)])))))))))
       (iq-enqueue rtn)
       rtn))
   
@@ -334,29 +270,14 @@
   ;; CONS
   
   
-  (define (frp:cons f r)
-    (cons f r)
-    #;(lift #f cons f r)
-    #;(if (or (behavior? f) (behavior? r))
-        (procs->signal:compound
-         cons
-         (lambda (p i)
-           (if (zero? i)
-               (lambda (v) (set-car! p v))
-               (lambda (v) (set-cdr! p v))))
-         f r)
-        (cons f r)))
+  (define frp:cons cons)
   
   (define (make-accessor acc)
     (lambda (v)
       (let loop ([v v])
         (cond
           [(signal:compound? v) (acc (signal:compound-content v))]
-          [(signal? v) #;(printf "access to ~a in ~a~n" acc
-                                 (value-now/no-copy v))
-                       #;(lift #t acc v)
-                       #;(switch ((changes v) . ==> . acc) (acc (value-now v)))
-                       (super-lift acc v)]
+          [(signal? v) (super-lift acc v)]
           [(signal:switching? v) (super-lift
                                   (lambda (_)
                                     (loop (unbox (signal:switching-current v))))
@@ -390,10 +311,7 @@
          [(empty? lst) (ef)]
          [else (error "list-match: expected a list, got ~a" lst)]))
      lst))
-  
-  #;(define (frp:append . args)
-    (apply lift #t append args))
-  
+    
   (define frp:append
     (case-lambda
       [() ()]
@@ -401,18 +319,9 @@
       [(lst1 lst2 . lsts)
        (list-match lst1
                    (lambda (f r) (cons f (apply frp:append r lst2 lsts)))
-                   (lambda () (apply frp:append lst2 lsts)))                          
-       #;(frp:if (frp:empty? lst1)
-               (apply frp:append lst2 lsts)
-               (frp:cons (frp:car lst1)
-                         (apply frp:append (frp:cdr lst1) lst2 lsts)))]))
+                   (lambda () (apply frp:append lst2 lsts)))]))
   
-  (define frp:list list
-    #;(lambda elts
-     (frp:if (frp:empty? elts)
-              '()
-              (frp:cons (frp:car elts)
-                        (apply frp:list (frp:cdr elts))))))
+  (define frp:list list)
   
   (define frp:list*
     (lambda elts
@@ -426,7 +335,6 @@
   (define (frp:list? itm)
     (if (signal:compound? itm)
         (let ([ctnt (signal:compound-content itm)])
-          ;        (let ([ctnt (value-now itm)])
           (if (cons? ctnt)
               (frp:list? (cdr ctnt))
               #f))
@@ -442,23 +350,10 @@
   
   
   (define frp:vector vector)
-  #;(define (frp:vector . args)
-    (if (ormap behavior? args)
-        (apply procs->signal:compound
-               vector
-               (lambda (vec idx)
-                 (lambda (x)
-                   (vector-set! vec idx x)))
-               args)        
-        (apply vector args)))
   
   (define (frp:vector-ref v i)
     (cond
-      [(behavior? v) (super-lift (lambda (v) (frp:vector-ref v i)) v)
-       #;(switch ((changes v) . ==> . (lambda (vv) (vector-ref vv i)))
-                           (vector-ref (value-now v) i)) ;; rewrite as super-lift
-                           #;(lift #t vector-ref v i)]
-      #;[(signal:compound? v) (vector-ref (signal:compound-content v) i)]
+      [(behavior? v) (super-lift (lambda (v) (frp:vector-ref v i)) v)]
       [else (lift #t vector-ref v i)]))
   
   
@@ -472,16 +367,7 @@
                          args)])
       (values
        desc
-       #;(lambda fields
-         (if (ormap behavior? fields)
-             (apply procs->signal:compound
-                    ctor
-                    (lambda (strct idx)
-                      (lambda (val)
-                        (mut strct idx val)))
-                    fields)
-             (apply ctor fields)))
-         ctor
+       ctor
        (lambda (v) (if (signal:compound? v)
                        (pred (value-now/no-copy v))
                        (lift #t pred v)))
@@ -646,14 +532,13 @@
            #%top-interaction
            raise-reactivity
            raise-list-for-apply
-           deep-value-now
+           (rename public-dvn deep-value-now)
            any-nested-reactivity?
            compound-lift
            list-match
            (rename frp:if if)
            (rename frp:lambda lambda)
            (rename frp:case-lambda case-lambda)
-           ;(rename frp:apply apply)
            (rename frp:letrec letrec)
            (rename frp:cons cons)
            (rename frp:car car)
diff --git a/collects/frtime/mzscheme-utils.ss b/collects/frtime/mzscheme-utils.ss
index 2a68c0a0c9..02ebe00f1c 100644
--- a/collects/frtime/mzscheme-utils.ss
+++ b/collects/frtime/mzscheme-utils.ss
@@ -10,7 +10,6 @@
                        if
                        lambda
                        case-lambda
-                       ;apply
                        reverse
                        list-ref
                        require
@@ -24,8 +23,6 @@
                        make-struct-field-mutator
                        vector
                        vector-ref
-		       quasiquote
-                       ;qq-append
                        define-struct
                        list
 		       list*
@@ -33,8 +30,7 @@
 		       append
                        and
                        or
-                       cond when unless ;case
-                       ; else =>
+                       cond when unless
                        map ormap andmap assoc member)
            (rename mzscheme mzscheme:if if)
            (rename "lang-ext.ss" lift lift)
@@ -59,11 +55,7 @@
     (if (lift #t positive? idx)
         (list-ref (cdr lst) (lift #t sub1 idx))
         (car lst)))
-  
-  ;(define (frp:eq? itm1 itm2)
-  ;  (lift #t eq? itm1 itm2))
-
-  
+    
   (define-syntax cond
     (syntax-rules (else =>)
       [(_ [else result1 result2 ...])
@@ -189,14 +181,7 @@
   
   (define (cddddr v)
     (cdr (cdddr v)))
- 
-  #|
-  (define-syntax frp:case
-    (syntax-rules ()
-      [(_ expr clause ...)
-       (super-lift (lambda (v) (case v clause ...)) expr)]))
-  |#
-  
+   
   (define (split-list acc lst)
     (if (null? (cdr lst))
         (values acc (car lst))
@@ -215,45 +200,7 @@
          (lambda (last-args)
            (apply apply fn (append first-args (cons last-args empty))))
          last-args))))
-  
-  #|
-  ;; taken from startup.ss
-  (define-syntax frp:case
-    (lambda (x)
-      (syntax-case x (else)
-	((_ v)
-	 (syntax (begin v (cond))))
-	((_ v (else e1 e2 ...))
-	 (syntax/loc x (begin v e1 e2 ...)))
-	((_ v ((k ...) e1 e2 ...))
-	 (syntax/loc x (if (memv v '(k ...)) (begin e1 e2 ...))))
-	((_ v ((k ...) e1 e2 ...) c1 c2 ...)
-	 (syntax/loc x (let ((x v))
-			 (if (memv x '(k ...))
-			     (begin e1 e2 ...)
-			     (frp:case x c1 c2 ...)))))
-	((_ v (bad e1 e2 ...) . rest)
-	 (raise-syntax-error 
-	  #f
-	  "bad syntax (not a datum sequence)"
-	  x
-	  (syntax bad)))
-	((_ v clause . rest)
-	 (raise-syntax-error 
-	  #f
-	  "bad syntax (missing expression after datum sequence)"
-	  x
-	  (syntax clause)))
-	((_ . v)
-	 (not (null? (syntax-e (syntax v))))
-	 (raise-syntax-error 
-	  #f
-	  "bad syntax (illegal use of `.')"
-	  x)))))
-  
-  
-|#
-  
+    
   (define-syntax frp:case
     (syntax-rules ()
       [(_ exp clause ...)
@@ -274,10 +221,7 @@
   
   (define map
     (case-lambda
-      [(f l) #;(if (pair? l)
-                 (cons (f (car l)) (map f (cdr l)))
-                 null)
-             (list-match
+      [(f l) (list-match
               l
               (lambda (a d) (cons (f a) (map f d)))
               (lambda () null))]
@@ -292,10 +236,7 @@
                     (list-match
                      l2
                      (lambda (a2 d2) (error "map expected lists of same length but got" l1 l2))
-                     (lambda () null))))
-      #;(if (and (pair? l1) (pair? l2))
-          (cons (f (car l1) (car l2)) (map f (cdr l1) (cdr l2)))
-          null)]
+                     (lambda () null))))]
       [(f l . ls) (if (and (pair? l) (andmap pair? ls))
                       (cons (apply f (car l) (map car ls)) (apply map f (cdr l) (map cdr ls)))
                       null)]))
@@ -323,7 +264,6 @@
   (define (dont-optimize x) x)
 
   (provide cond 
-           ; else =>
            and 
            or 
            or-undef 
@@ -342,7 +282,6 @@
            cdddr
            cadddr
            cddddr
-           ;case
            build-path
            collection-path
            
@@ -357,7 +296,7 @@
                    eq? 
                    equal? eqv? < > <= >= 
                    add1 cos sin tan symbol->string symbol?
-                   number->string string->symbol eof-object? exp expt even? odd? string-append eval ; list-ref
+                   number->string string->symbol eof-object? exp expt even? odd? string-append eval
                    sub1 sqrt not number? string string? zero? min max modulo
                    string->number void? rational? char? char-upcase char-ci>=? char-ci<=?
                    string>=? char-upper-case? char-alphabetic?
@@ -374,8 +313,7 @@
                    date-minute date-second make-date char-downcase char>=? char<=? char->integer integer->char boolean?
                    integer? quotient remainder positive? negative? inexact->exact exact->inexact
                    make-polar denominator truncate bitwise-not bitwise-xor bitwise-and bitwise-ior inexact?
-                   char-whitespace? assq assv memq memv list-tail ;reverse
-                   ;length
+                   char-whitespace? assq assv memq memv list-tail
                    seconds->date
                    expand syntax-object->datum exn-message continuation-mark-set->list exn-continuation-marks
                    exn:fail? regexp-match
@@ -393,12 +331,8 @@
            procedure-arity-includes? raise-type-error raise thread
            current-continuation-marks
            raise-mismatch-error require-for-syntax define-syntax define-syntaxes syntax-rules syntax-case
-          ; set-eventspace
-	   ;install-errortrace-key
            (lifted:nonstrict format)
            print-struct
-           ;lambda
-           ;case-lambda
            define
            let
            let*
@@ -409,6 +343,7 @@
            begin
            begin0
            quote
+           quasiquote
            unquote
            unquote-splicing
 
@@ -442,8 +377,6 @@
          
            dont-optimize
            
-          ; null
-        ;   make-struct-field-mutator
            )
   
   ; from core
diff --git a/collects/frtime/reactive.ss b/collects/frtime/reactive.ss
index c066356363..69affd2357 100644
--- a/collects/frtime/reactive.ss
+++ b/collects/frtime/reactive.ss
@@ -1,7 +1,6 @@
 (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"
@@ -25,5 +24,4 @@
            (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")))
+           (all-from "frp-snip.ss")))