- bug fixes

- got spreadsheet working again

svn: r507

collects/frtime/demos/spreadsheet/spread.ss

@@ -2,17 +2,20 @@
   
   (require (lib "class.ss")
            (all-except (lib "mred.ss" "mred") send-event)
+           (rename mzscheme mz:define-struct define-struct)
            "preprocessor2.ss"
            (lifted "ss-funcs.ss" inflate-data)
            "quotes.ss"
            (as-is:unchecked (lib "match.ss") match-lambda)
+           (as-is:unchecked (lib "frp-core.ss" "frtime") signal-value
+                            proc->signal)
            (lib "framework.ss" "framework")
            (as-is:unchecked (lib "string.ss") expr->string)
            (as-is:unchecked (lib "etc.ss") build-vector)
            (lifted mzscheme regexp-match)
            (as-is:unchecked mzscheme make-hash-table hash-table-put! hash-table-get
                             hash-table-remove! let*-values vector-set! make-string
-                            exn? eof-object?
+                            exn?
                             open-input-file open-output-file read write hash-table-map
                             file-exists? delete-file open-input-string eof
                             flush-output close-output-port dynamic-require))
@@ -44,7 +47,7 @@
   
   (set-cell! raise-exceptions #t)
   
-  (define-struct ss-loc (row col))
+  (mz:define-struct ss-loc (row col))
   
   (define (ss-format val)
     (if (or (and (signal? val)
@@ -142,7 +145,7 @@
      cols
      (lambda (_) (make-hash-table))))
   
-  (define-struct ss-cell (expr value updater))
+  (mz:define-struct ss-cell (expr value updater))
   
   (define (ss-get-cell-text row col)
     (cond
@@ -212,7 +215,7 @@
                      (eval `(let ([row ,row]
                                   [col ,col])
                               ,processed-expr))))
-        (synchronize)
+        ;(synchronize)
         (send canvas draw-cell row col))
       (send canvas focus)))
   

collects/frtime/lang-ext.ss

@@ -250,9 +250,12 @@
   (define-syntax snapshot/sync
     (syntax-rules ()
       [(_ (id ...) expr ...)
-       (let-values ([(id ...) (sync/read id ...)])
+       (let-values ([(id ...) (value-now/sync id ...)])
          expr ...)]))
   
+  (define (synchronize)
+    (snapshot/sync () (void)))
+  
   (define-syntax snapshot
     (syntax-rules ()
       [(_ (id ...) expr ...)
@@ -702,6 +705,7 @@
            hold
            for-each-e!
            snapshot/sync
+           synchronize
            snapshot
            snapshot-e
            snapshot/apply
@@ -736,7 +740,7 @@
            value-now/sync
            frtime-version
            signal-count
-           
+           signal?
            
            )
   )

collects/frtime/mzscheme-core.ss

@@ -141,7 +141,10 @@
                                   (lambda (_)
                                     (loop (unbox (signal:switching-current v))))
                                   (signal:switching-trigger v))]
-          [(signal? v) (printf "access to ~a in ~a~n" acc (value-now/no-copy v)) (lift #t acc v)]
+          [(signal? v) #;(printf "access to ~a in ~a~n" acc
+                                 (value-now/no-copy v))
+                       (lift #t acc v)]
+	  [(undefined? v) undefined]
           [else (acc v)]))))
     
   (define frp:car
@@ -252,7 +255,7 @@
   
   ; FORBIDS MUTATION
   (define (frp:make-struct-field-mutator acc i sym)
-    (lambda (s)
+    (lambda (s _)
       (error "MUTATION NOT ALLOWED IN FrTime STRUCTURES")))
   
   (define-syntax (frp:define-struct stx)
@@ -280,11 +283,23 @@
       [(_ s (field ...))
        #'(frp:define-struct (s #f) (field ...) (current-inspector))]))
   
+ (define (find pred lst)
+    (cond
+      [(empty? lst) #f]
+      [(pred (first lst)) (first lst)]
+      [else (find pred (rest lst))]))
+ 
   
-  
-  
-  
-  
+ (define (ensure-no-signal-args val name)
+    (if (procedure? val)
+        (lambda args
+          (cond
+            [(find signal? args)
+             =>
+             (lambda (v)
+               (raise-type-error name "non-signal"
+                               (format "#<signal: ~a>" (signal-value v))))]
+            [else (apply val args)]))))
   
   
   ;;;;;;;;;;;;;;;;;;;;;;;

collects/frtime/mzscheme-utils.ss

@@ -306,7 +306,7 @@
                    seconds->date
                    expand syntax-object->datum exn-message continuation-mark-set->list exn-continuation-marks
                    exn:fail?
-                   list->vector make-vector vector-set!)
+                   list->vector make-vector)
             
            (rename eq? mzscheme:eq?)
            make-exn:fail  current-inspector make-inspector