#lang scheme

(require "engine-interface.ss")

(require (prefix-in general: "general.ss"))
(require (prefix-in numeric: "numeric.ss"))
(require (prefix-in times: "times.ss"))
(require (prefix-in vector: "vector.ss"))

(define (with-engine engine thunk)
  (if (eq? *current-engine* engine) (thunk)
      (let ([old-engine *current-engine*])
        (dynamic-wind
         (λ () 
           (set! *current-engine* engine))
         thunk
         (λ () 
           (set! *current-engine* old-engine))))))

(define-struct codec (encoder decoder))

(define base-engine%
  (class* engine% (engine-interface%)
    (inspect #f)
    (inherit-field integer-time)
    (inherit-field oid-size)
    (field [parent *current-engine*])
    (super-new)
    
    (define codecs (make-immutable-hash null))
    (define vector-oids (make-immutable-hash null))
    (define/public (set-parent! parent-engine)
      (set! parent parent-engine))
    (define/public (set-codec! oid encode decode)
      ; but don't create or mutate any on parents!
      (set! codecs (hash-set codecs oid (make-codec encode decode))))
    
    (define/public (get-oids)
      (hash-map codecs (compose car list)))
    
    (define/public (vector-oid-for element)
      (hash-ref vector-oids element))
    
    ; this is kinda messy... the vector mutates the engine
    ; adds a codec diviner and such, but needs the engine passed
    ; so can't just return a codec.
    (define/public (set-vector-info! parent element length)
      (vector:set-info! parent element length this)
      (set! vector-oids (hash-set vector-oids element parent)))
    
    (define/public (get-codec oid)
      (hash-ref codecs oid 
                (λ () 
                  (if parent (send parent get-codec oid) 
                      (error (format "No codec found for OID ~s" oid))))))
    
    (define/public (encode oid value)
      ((codec-encoder (get-codec oid)) value))
    (define/public (decode oid bytes)
      (if bytes
          ((codec-decoder (get-codec oid)) bytes)
          #f))
      
    
    (define diviners null)
    
    (define/public (add-diviner! diviner)
      ; this is called rarely :p
      (set! diviners (append diviners (list diviner))))
    
    (define/public (divine value)
      (call/cc 
       (λ (return)
         (for-each
          (λ (diviner)
            (let ([oid (diviner value)])
              (when oid (return oid))))
          diviners)
         (if parent
             (send parent divine value)
             (error (format "Could not determine what OID ~s should be" value))))))))

(define *current-engine* #f)
; the secret root engine has no parent.
(set! *current-engine* (new base-engine% [integer-time #t])) ; this will hold defaults

(general:set-info! *current-engine*)
(numeric:set-info! *current-engine*)
(times:set-info! *current-engine*)

(define (get-engine) *current-engine*)

(provide/contract
 [with-engine (engine? (void? . -> . void?) . -> . void?)]
 [get-engine (-> engine?)])

(provide base-engine%)