(module future mzscheme
   (lib "contract.ss")
   (lib "etc.ss")
   (file "base.ss")
  ; 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)])
            (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)
        (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
       (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)])
           (if (and (not (null? trimmed-stack))
                    (equal? new-value (cdar trimmed-stack)))
               (cons (cons active-scope new-value)
                     (if (eq? (caar trimmed-stack) active-scope)
                         (cdr 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))
  ;; 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.
     '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