diff --git a/collects/lazy/doc.txt b/collects/lazy/doc.txt index 21604357f3..d85350bf5f 100644 --- a/collects/lazy/doc.txt +++ b/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.] diff --git a/collects/lazy/force.ss b/collects/lazy/force.ss new file mode 100644 index 0000000000..4b612573e8 --- /dev/null +++ b/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)))))) diff --git a/collects/lazy/lazy.ss b/collects/lazy/lazy.ss index 9b7d3eff83..ff3b701f7a 100644 --- a/collects/lazy/lazy.ss +++ b/collects/lazy/lazy.ss @@ -43,89 +43,30 @@ ;; -------------------------------------------------------------------------- ;; Delay/force etc - (provide ~) - (defsubst (~ x) (delay x)) + (require "force.ss") + + (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) - 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))) + (defsubst special-form-!!values !!values) ;; -------------------------------------------------------------------------- ;; 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)