;;; -*- Mode: Scheme; scheme48-package: package-state -*-

;;;; Compiled Code Storage for Scheme48
;;;; In-Image Package State

;;; This code is written by Taylor Campbell and placed in the Public
;;; Domain.  All warranties are disclaimed.

(define early-bound?-table)

(define (package-early-bound? package)
  (or (package-loaded? package)         ;ground
      (table-ref early-bound?-table package)))

(define (set-package-early-bound?! package early-bound?)
  (table-set! early-bound?-table package early-bound?))

(define (flush-package-early-bound . packages)
  (if (null? packages)
      (set! early-bound?-table (make-table package-uid))
      (for-each (lambda (package)
                  (set-package-early-bound?! package #f))
                packages)))

(define expanded-forms-table)

(define (package-expanded-forms package)
  (table-ref expanded-forms-table package))

(define (set-package-expanded-forms! package expanded-forms)
  (table-set! expanded-forms-table package expanded-forms))

(define (flush-package-expanded-forms . packages)
  (if (null? packages)
      (set! expanded-forms-table (make-table package-uid))
      (for-each (lambda (package)
                  (set-package-expanded-forms! package #f))
                packages)))

(define template-table)

(define (package-template package)
  (table-ref template-table package))

(define (set-package-template! package template)
  (table-set! template-table package template))

(define (flush-package-template . packages)
  (if (null? packages)
      (set! template-table (make-table package-uid))
      (for-each (lambda (package)
                  (set-package-template! package #f))
                packages)))

(define (flush-package-loaded . packages)
  (for-each (lambda (package)
              (set-package-loaded?! package #f))
            packages))

(define location-map-table)

(define (make-location-map) (make-table location-id))

(define (package-location-map package)
  (table-ref location-map-table package))

(define (create-package-location-map package)
  (table-set! location-map-table package (make-location-map)))

(define (flush-package-location-map . packages)
  (if (null? packages)
      (set! location-map-table (make-table package-uid))
      (for-each (lambda (package)
                  (table-set! location-map-table package #f))
                packages)))

(define qualified->generated-tables)

(define make-qualified-table
  (make-table-maker (let ()
                      (define (qualified-equal? a b)
                        (or (eq? a b)
                            (and (eq? (vector-ref a 2)
                                      (vector-ref b 2))
                                 (= (vector-ref a 3)
                                    (vector-ref b 3))
                                 (qualified-equal? (vector-ref a 1)
                                                   (vector-ref b 1)))))
                      qualified-equal?)
                    (let ()
                      (define (qualified-hash qname)
                        (+ (string-hash
                            (symbol->string (vector-ref qname 2)))
                           (vector-ref qname 3)))
                      qualified-hash)))

(define (package-qualified->generated-table package)
  (table-ref qualified->generated-tables package))

(define (create-package-qualified->generated-table package)
  (table-set! qualified->generated-tables
              package
              (make-qualified-table)))

(define (flush-package-qualified->generated-table . packages)
  (if (null? packages)
      (set! qualified->generated-tables (make-table package-uid))
      (for-each (lambda (package)
                  (table-set! qualified->generated-tables
                              package
                              #f))
                packages)))

(flush-package-early-bound)
(flush-package-expanded-forms)
(flush-package-template)
(flush-package-location-map)
(flush-package-qualified->generated-table)