;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               package.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             POSIX
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;NOTE
;;;;
;;;;    To implement a package system, we need foremost a hook in the
;;;;    lisp reader, to be able to interpret symbol names and
;;;;    qualified symbol names as we wish.
;;;;
;;;;    Given a reader hooks, we can use the native intern or
;;;;    implement it otherwise (emacs:intern vs. cl:intern).
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2012-12-17 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
;;;;    it under the terms of the GNU Affero General Public License as published by
;;;;    the Free Software Foundation, either version 3 of the License, or
;;;;    (at your option) any later version.
;;;;
;;;;    This program is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;;    GNU Affero General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************


(defstruct package
  name
  (external-table   (make-hash-table))
  (present-table    (make-hash-table))
  (shadowing-table  (make-hash-table))
  (used-packs       '())
  (used-by-packs    '())
  (nicknames        '())
  (documentation    nil)
  obarray)



(defun make-obarray (length) (make-vector length 0))

(defvar obarray (make-obarray 113) "Symbol table for use by `intern' and `read'.")

(defun intern (STRING &optional OBARRAY))
(defun intern-soft (STRING &optional OBARRAY))
(defun mapatoms (FUNCTION &optional OBARRAY))
(defun unintern (SYMBOL-OR-STRING OBARRAY))

(defun read (&optional STREAM))


(defun symbol-plist (symbol))
(defun setplist (symbol plist))
(defun get (symbol property))
(defun put (symbol property value))



(defun obarray-symbols (obarray)
  (let ((symbols '()))
    (mapatoms (lambda (symbol) (push symbol symbols)) obarray)
    (sort symbols (function string<))))

(obarray-symbols obarray)


(let ((results '()))
  (do-symbols (n)
    (when (and (fboundp n)
               (not (symbolp (symbol-function n)))
               (not (subrp   (symbol-function n))))
      (let ((pl (function-parameter-list n)))
        ;; (insert (format "%S %S\n" n pl))
        (when (member 'OBARRAY pl)
          (push (cons n pl) results)))))
  results)


(defvar ob1 (make-obarray 113))
(defvar ob2 (make-obarray 113))

(defvar s1 (intern "Hello" ob1))
(intern "World" ob1)
(mapatoms 'print ob1)
(eq 'Hello s1)

(defparameter *table*
  (let* ((symbols (obarray-symbols obarray))
         (table (make-hash-table :test 'eql :size (* 3 (length symbols)))))
    (dolist (sym symbols table)
      (setf (gethash (symbol-name sym) table) sym))))


(let* ((names (mapcar 'symbol-name (obarray-symbols obarray))))
  (insert (time (dolist (name names)
                  (intern name obarray)))
          (time (dolist (name names)
                  (gethash name *table*)))))


(intern 'hello ob1)
(hash-table-count *table*)