(module future mzscheme (require (lib "contract.ss") (lib "etc.ss") (file "base.ss") ) (provide next-future-scope make-future future? future-current? ) ; Futures are like parameters, except that they are always mutated destructively. ; All futures share a common "active scope". A new scope is started with the ; macro: ; ; (next-future-scope ; ...) ; ; When a new scope is entered, the old scope is saved. Any changes to the values ; of futures in the new scope will be lost upon re-entry to the old scope, *unless* ; the old scope is resumed by continuation. ; ; TODO: Is this good behaviour? Noel seems to know how to fix this stuff up so that ; futures obey continuation jumps and so on. ; ; Futures are created with the make-future form, which accepts an optional initial ; value: ; ; make-future : [any] -> (future any) ; ; These auxiliary type definitions apply in this file: ; ; scope : symbol ; stack : (alist-of scope any) ;; current-scopes : (list-of scope) ;; ;; scope : symbol (define current-scopes (make-parameter (list (gensym)))) ;; active-scope : -> scope (define (active-scope) (car (current-scopes))) ;; syntax next-future-scope (define-syntax (next-future-scope stx) (syntax-case stx () [(_ stmt ...) ;#'(parameterize ([current-scopes (cons (gensym) (current-scopes))]) ; stmt ...)])) #'(let ([next-scope (gensym)]) (dynamic-wind (lambda () (printf "Entering scope: ~a~n" next-scope)) (lambda () (parameterize ([current-scopes (cons next-scope (current-scopes))]) stmt ...)) (lambda () (printf "Exiting scope: ~a~n" next-scope))))])) ;; make-future : any flat-contract -> future (define make-future (opt-lambda ([initial-value (void)]) (create-future (list (cons (active-scope) initial-value))))) ;; future-stack : future -> (alist-of scope any) ;; ;; Returns the stack for the specified future. (define (future-stack future) (future-ref future 0)) ;; set-future-stack! : future stack -> void ;; ;; Changes the stack in the specified future. (define (set-future-stack! future stack) (future-set! future 0 stack)) ;; trim-stack : stack (list-of scope) -> stack ;; ;; Returns a trimmed stack, containing only scopes in the provided list. (define (trim-stack stack scopes) (if (member (caar stack) scopes) stack (trim-stack (cdr stack) scopes))) ;; future-proc : future [any] -> any ;; ;; If an argument is supplied, sets the future's value and returns the new value. ;; If no argument is supplied, simply returns the current value. (define future-proc (case-lambda [(future) (future-value future)] [(future new-value) (set-future-value! future new-value)])) ;; future-value : future -> any ;; ;; Returns the value of the future in the active scope. (define (future-value future) (let ([trimmed-stack (trim-stack (future-stack future) (current-scopes))]) (set-future-stack! future trimmed-stack) (cdar trimmed-stack))) ;; set-future! : future any -> void ;; ;; Sets the value of the future in the active scope. (define (set-future-value! future new-value) (let* ([current-scopes (current-scopes)] [active-scope (active-scope)] [trimmed-stack (trim-stack (future-stack future) current-scopes)]) (set-future-stack! future (if (and (not (null? trimmed-stack)) (equal? new-value (cdar trimmed-stack))) trimmed-stack (cons (cons active-scope new-value) (if (eq? (caar trimmed-stack) active-scope) (cdr trimmed-stack) trimmed-stack)))))) ;; future-current? : future -> boolean ;; ;; Returns #t if the specified future has been updated this scope, #f otherwise. (define (future-current? future) (eq? (caar (future-stack future)) (active-scope))) ;; struct future : stack (-> any) (any -> void) ;; ;; A future is a structure containing a value stack. ;; ;; MzScheme's structures-as-procedures code is used such that, if a future ;; is called like a procedure, its current value is returned. (define-values (struct:future create-future future? future-ref future-set!) (make-struct-type 'future ; name-symbol #f ; super-struct-type 1 ; init-field-k 0 ; auto-field-k #f ; auto-v null ; prop-value-list (make-inspector) ; inspector-or-false future-proc ; proc-spec null ; immutable-k-list #f)) ; guard-spec )