moved forcers into their own module for easier access

svn: r4526

collects/lazy/doc.txt

@@ -50,4 +50,31 @@ forced.  There are also bindings for `begin' (delays a computation
 that forces all sub-expressions), `when', `unless', etc.  These are,
 however, less reliable and might change (or be dropped) in the future.
 
+
+Multiple values
+---------------
+
+Also, to avoid dealing with multiple values, they are treated as a
+single tuple in the lazy language.  This is implemented as a
+`multiple-values' struct, with a `values' slot.
+
+> split-values
+  is used to split such a tuple to actual multiple values.  (This may
+  change in the future.)
+
+> (!values expr)
+  forces `expr', and uses `split-values' on the result.
+
+> (!!values expr)
+  similar to `!values', but forces each of the values (not
+  recursively).
+
+
+Making strict code interact with lazy code
+------------------------------------------
+
+To make it easy for strict code to interact with lazy code, use the
+_force.ss_ module: it provides the above bindings (as functions) that
+can be used to force promises in various ways.
+
 [More documentation will be added.]

collects/lazy/force.ss

@@ -0,0 +1,78 @@
+(module force mzscheme
+  (provide (all-defined-except do-!!))
+
+  (define-syntax (~ stx)
+    (syntax-case stx ()
+      [(~ E) (syntax/loc stx (delay E))]))
+
+  (define (! x) (if (promise? x) (! (force x)) x))
+
+  (define (!! x) (do-!! x #f))
+  ;; Similar to the above, but wrap procedure values too
+  (define (!!! x) (do-!! x #t))
+  ;; Force just a top-level list structure, similar to the above.
+  ;; (todo: this and the next assumes no cycles.)
+  (define (!list x)
+    (let loop ([x x])
+      (let ([x (! x)]) (when (pair? x) (set-cdr! x (loop (cdr x)))) x)))
+  ;; Force a top-level list structure and the first level of values, again,
+  ;; similar to the above.
+  (define (!!list x)
+    (let loop ([x x])
+      (let ([x (! x)])
+        (when (pair? x)
+          (set-car! x (! (car x)))
+          (set-cdr! x (loop (cdr x)))) x)))
+  ;; Force and split resulting values.
+  (define (!values x)
+    (split-values (! x)))
+  ;; Similar, but forces the actual values too.
+  (define (!!values x)
+    (let ([x (! x)])
+      (if (multiple-values? x)
+        (apply values (map ! (multiple-values-values x)))
+        x)))
+
+  ;; Multiple values are problematic: MzScheme promises can use multiple
+  ;; values, but to carry that out `call-with-values' should be used in all
+  ;; places that deal with multiple values, which will make the whole thing
+  ;; much slower -- but multiple values are rarely used (spceifically, students
+  ;; never use them).  Instead, `values' is redefined to produce a first-class
+  ;; tuple-holding struct, and `split-values' turns that into multiple values.
+  (define-struct multiple-values (values))
+  (define (split-values x)
+    (let ([x (! x)])
+      (if (multiple-values? x) (apply values (multiple-values-values x)) x)))
+
+  ;; Force a nested structure -- we don't distinguish values from promises so
+  ;; it's fine to destructively modify the structure.
+  (define (do-!! x translate-procedures?)
+    (define table (make-hash-table)) ; avoid loops due to sharing
+    (split-values ; see below
+     (let loop ([x x])
+       (let ([x (! x)])
+         (unless (hash-table-get table x (lambda () #f))
+           (hash-table-put! table x #t)
+           (cond [(pair? x)
+                  (set-car! x (loop (car x)))
+                  (set-cdr! x (loop (cdr x)))]
+                 [(vector? x)
+                  (let loop ([i 0])
+                    (when (< i (vector-length x))
+                      (vector-set! x (loop (vector-ref x i)))
+                      (loop (add1 i))))]
+                 [(box? x) (set-box! x (loop (unbox x)))]
+                 [(struct? x)
+                  (let-values ([(type skipped?) (struct-info x)])
+                    (if type
+                      (let*-values ([(name initk autok ref set imms spr skp?)
+                                     (struct-type-info type)]
+                                    [(k) (+ initk autok)])
+                        (let sloop ([i 0])
+                          (unless (= i k)
+                            (set x i (loop (ref x i)))
+                            (sloop (add1 i)))))
+                      x))]))
+         (if (and (procedure? x) translate-procedures?)
+           (lambda args (do-!! (apply x args) #t))
+           x))))))

collects/lazy/lazy.ss

@@ -43,89 +43,30 @@
   ;; --------------------------------------------------------------------------
   ;; Delay/force etc
 
-  (provide ~)
+  (require "force.ss")
-  (defsubst (~ x) (delay x))
+
+  (provide ~)
 
-  (define (! x) (if (promise? x) (! (force x)) x))
   ;; the exposed `!' must be a special form
   (provide (rename special-form-! !))
+  (defsubst special-form-! !)
   ;; hack to see if it solves a certificate problem:
   (provide (rename ! crazythingthatwillneverbereferredto))
-  (defsubst (special-form-! x) (! x) special-form-! !)
 
   ;; These things are useful too, to write strict functions (with various
   ;; levels of strictness) -- need to provide them as special forms.
   (provide (rename special-form-!! !!))
-  (defsubst (special-form-!! x) (!! x) special-form-!! !!)
+  (defsubst special-form-!! !!)
   (provide (rename special-form-!!! !!!))
-  (defsubst (special-form-!!! x) (!!! x) special-form-!!! !!!)
+  (defsubst special-form-!!! !!!)
   (provide (rename special-form-!list !list))
-  (defsubst (special-form-!list x) (!list x) special-form-!list !list)
+  (defsubst special-form-!list !list)
   (provide (rename special-form-!!list !!list))
-  (defsubst (special-form-!!list x) (!!list x) special-form-!!list !!list)
+  (defsubst special-form-!!list !!list)
   (provide (rename special-form-!values !values))
-  (defsubst (special-form-!values x) (!values x) special-form-!values !values)
+  (defsubst special-form-!values !values)
   (provide (rename special-form-!!values !!values))
-  (defsubst (special-form-!!values x) (!!values x)
+  (defsubst special-form-!!values !!values)
-            special-form-!!values !!values)
-
-  ;; Force a nested structure -- we don't distinguish values from promises so
-  ;; it's fine to destructively modify the structure.
-  (define (do-!! x translate-procedures?)
-    (define table (make-hash-table)) ; avoid loops due to sharing
-    (split-values ; see below
-     (let loop ([x x])
-       (let ([x (! x)])
-         (unless (hash-table-get table x (lambda () #f))
-           (hash-table-put! table x #t)
-           (cond [(pair? x)
-                  (set-car! x (loop (car x)))
-                  (set-cdr! x (loop (cdr x)))]
-                 [(vector? x)
-                  (let loop ([i 0])
-                    (when (< i (vector-length x))
-                      (vector-set! x (loop (vector-ref x i)))
-                      (loop (add1 i))))]
-                 [(box? x) (set-box! x (loop (unbox x)))]
-                 [(struct? x)
-                  (let-values ([(type skipped?) (struct-info x)])
-                    (if type
-                      (let*-values ([(name initk autok ref set imms spr skp?)
-                                     (struct-type-info type)]
-                                    [(k) (+ initk autok)])
-                        (let sloop ([i 0])
-                          (unless (= i k)
-                            (set x i (loop (ref x i)))
-                            (sloop (add1 i)))))
-                      x))]))
-         (if (and (procedure? x) translate-procedures?)
-           (lambda args (do-!! (apply x args) #t))
-           x)))))
-  (define (!! x) (do-!! x #f))
-  ;; Similar to the above, but wrape procedure values too
-  (define (!!! x) (do-!! x #t))
-  ;; Force just a top-level list structure, similar to the above.
-  ;; (todo: this and the next assumes no cycles.)
-  (define (!list x)
-    (let loop ([x x])
-      (let ([x (! x)]) (when (pair? x) (set-cdr! x (loop (cdr x)))) x)))
-  ;; Force a top-level list structure and the first level of values, again,
-  ;; similar to the above.
-  (define (!!list x)
-    (let loop ([x x])
-      (let ([x (! x)])
-        (when (pair? x)
-          (set-car! x (! (car x)))
-          (set-cdr! x (loop (cdr x)))) x)))
-  ;; Force and split resulting values.
-  (define (!values x)
-    (split-values (! x)))
-  ;; Similar, but forces the actual values too.
-  (define (!!values x)
-    (let ([x (! x)])
-      (if (multiple-values? x)
-        (apply values (map ! (multiple-values-values x)))
-        x)))
 
   ;; --------------------------------------------------------------------------
   ;; Determine laziness
@@ -210,17 +151,7 @@
     ;; to whenever the value is actually forced
     (~ (parameterize ([param (! val)] ...) (~begin body ...))))
 
-  ;; Multiple values are problematic: MzScheme promises can use multiple
-  ;; values, but to carry that out `call-with-values' should be used in all
-  ;; places that deal with multiple values, which will make the whole thing
-  ;; much slower -- but multiple values are rarely used (spceifically, students
-  ;; never use them).  Instead, `values' is redefined to produce a special
-  ;; struct, and `split-values' turns that into multiple values.
-  (define-struct multiple-values (values))
   (define* (~values . xs) (make-multiple-values xs))
-  (define (split-values x)
-    (let ([x (! x)])
-      (if (multiple-values? x) (apply values (multiple-values-values x)) x)))
 
   ;; Redefine multiple-value constructs so they split the results
   (defsubst (~define-values (v ...) body)