suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

moved forcers into their own module for easier access

Browse Source 
svn: r4526
This commit is contained in:
Eli Barzilay 2006-10-09 02:46:44 +00:00
parent c7c8858083
commit e3c1b3022a
3 changed files with 115 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/lazy/doc.txt
View File

@ -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.]

78
collects/lazy/force.ss Normal file
View File

@ -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))))))

89
collects/lazy/lazy.ss
View File

@ -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)