;;; Alef Lazily Evaluates Functions
;;; (C) 2008-2009 Dr. Gergo ERDI <http://gergo.erdi.hu/>

(in-package :alef)

(defclass symbol-table ()
  ((parent :initarg :parent :initform nil :reader symbol-table-parent :type (or null symbol-table))
   (table :initform (make-hash-table :test #'equal) :reader symbol-table-table :type hash-table)))

(define-condition symbol-table-conflict ()
  ((key :initarg :key :reader conflict-key :type symbol)))

(define-condition symbol-table-missing ()
  ((key :initarg :key :reader missing-key :type symbol)))

(defun make-symbol-table ()
  (make-instance 'symbol-table))

(defun descend-symbol-table (symbol-table)
  (declare (symbol-table symbol-table))
  (make-instance 'symbol-table :parent symbol-table))

(defmacro with-symbol-table (symbol-table &body body)
  `(let ((,symbol-table (descend-symbol-table ,symbol-table)))
     ,@body))

(defun symbol-table-get (symbol-table key &optional default)
  (declare (symbol-table symbol-table))
  (multiple-value-bind (value foundp) (gethash key (symbol-table-table symbol-table))
    (if foundp
        (values value t)
        (if (symbol-table-parent symbol-table)
            (symbol-table-get (symbol-table-parent symbol-table) key default)
            (values default nil)))))

(defun symbol-table-overwrite (symbol-table key value)
  (unless (nth-value 1 (gethash key (symbol-table-table symbol-table)))
    (error 'symbol-table-missing :key key))
  (setf (gethash key (symbol-table-table symbol-table)) value))

(defun symbol-table-add (symbol-table key value)
  (declare (symbol-table symbol-table))
  (when (nth-value 1 (gethash key (symbol-table-table symbol-table)))
    (error 'symbol-table-conflict :key key))
  (setf (gethash key (symbol-table-table symbol-table)) value))