#lang scheme/base (require mzlib/etc (only-in srfi/43/vector-lib s:vector->list)) (require "base.ss" "era/era.ss" "sql/sql.ss") (provide make-struct-extractor) ; (U (listof (U entity type)) entity type) ; -> ; ((U (vectorof scheme-primitive) #f) ; -> ; (U (listof (U persistent-struct scheme-primitive)) ; persistent-struct ; scheme-primitive))) ; ; Creates a procedure that extracts persistent-structs from a vector of scheme primitives. (define (make-struct-extractor extract-info) ; (listof (U entity #f)) ; boolean (define-values (entities single-item?) (if (or (pair? extract-info) (null? extract-info)) (values (map (lambda (item) (if (entity? item) item #f)) extract-info) #f) (values (if (entity? extract-info) (list extract-info) (list #f)) #t))) (let ([cache (make-hasheq)]) (if single-item? (lambda (source) (if source (car (row->structs source 0 entities cache)) #f)) (lambda (source) (if source (row->structs source 0 entities cache) #f))))) ; (-> (vectorof scheme-primitive) ; integer ; (listof (U entity #f)) ; (hashof entity (hashof integer persistent-struct)) ; (listof (U persistent-struct scheme-primitive))) ; ; Loads a list of persistent-structs, created from the data stored from ; start-col to the end of row. The types of the persistent-structs are ; determined by the supplied list of entities. ; ; Rersistent structs are cached when they are encountered for the first time ; if the same record is discovered again later on in the result set, the cached ; structure is re-used. (define (row->structs row start-col entities cache) (cond [(null? entities) null] [(entity? (car entities)) (begin-with-definitions (define entity (car entities)) (define-values (struct end-col) (row->struct row start-col entity cache)) (cons struct (row->structs row end-col (cdr entities) cache)))] [else (cons (vector-ref row start-col) (row->structs row (add1 start-col) (cdr entities) cache))])) ; (vectorof scheme-primitive) ; (listof entity) ; (hashof entity (hashof integer persistent-struct)) ; -> ; (listof (U persistent-struct #f)) ; integer ; ; Loads a persistent-struct, created from the relevant amount of data stored from ; start-col of row. The type of the persistent-struct is determined by the supplied ; entity. ; ; If the struct is already in the supplied cache, the cached version is returned. ; Otherwise, the struct is created from scractch and cached before it is returned. ; ; The procedure returns two values: the struct, and the index in row at which the ; ID of the next struct can be found. (define (row->struct row start-col entity cache) (begin-with-definitions (unless (< start-col (vector-length row)) (raise-exn exn:fail:snooze (format "Start column index too high: ~a ~a" start-col row))) (define id (vector-ref row start-col)) (define end-col (+ start-col (length (entity-attributes entity)))) (define cached (cache-ref cache entity id)) (values (cond [(not id) #f] [cached cached] [else (cache-put! cache entity id (apply (entity-constructor entity) (s:vector->list row start-col end-col)))]) end-col))) ; Cache for rows->structs ------------------ ; (hashof entity (hashof integer persistent-struct)) ; entity ; (U integer #f) ; -> ; (U persistent-struct #f) ; ; Tries to retrieve a persistent struct from the cache. Returns #f if ; the struct is not cached. (define (cache-ref cache entity id) (if id (let ([subtable (cache-subtable cache entity)]) (hash-ref subtable id #f)) #f)) ; (hashof entity (hashof integer persistent-struct)) ; entity ; integer ; persistent-struct ; -> ; persistent-struct ; ; Caches and returns a (newly created) persistent struct. (define (cache-put! cache entity id struct) (define subtable (cache-subtable cache entity)) (hash-set! subtable id struct) struct) ; (hashof entity (hashof integer persistent-struct)) ; -> ; (hashof integer persistent-struct) ; ; Utility procedure. Used in cache-ref and cache-put!. (define (cache-subtable cache entity) (hash-ref cache entity (lambda () (let ([subtable (make-hasheq)]) (hash-set! cache entity subtable) subtable))))