(defun concord-object-p (object)
  (eq (aref object 0) :concord))

(defun concord-object-type (object)
  (and (concord-object-p object)
       (aref object 1)))

(defun concord-object-id (object)
  (and (concord-object-p object)
       (aref object 2)))

(defun concord-define-object (type spec &optional id)
  (concord-el-define-object type spec id))

(defun concord-object-get-value (object feature)
  (concord-el-object-get-value object feature))

(defun concord-object-spec (object)
  (concord-el-object-spec object))

(defun concord-feature-list (type)
  (concord-el-feature-list type))

(defun concord-map-objects (function type)
  (concord-el-map-objects function type))

(defun concord-map-feature (function feature type)
  (concord-el-map-feature function feature type))


(defvar concord-el-type-list-table
  (make-hash-table))

(defun concord-el-get-type-table (type)
  (gethash type concord-el-type-list-table))

(defun concord-el-get-type-table-create (type)
  (let ((type-table (gethash type concord-el-type-list-table)))
    (unless type-table
      (setq type-table (make-hash-table))
      (puthash type type-table concord-el-type-list-table))
    type-table))

(defun concord-el-type-table-get-feature-table (type-table feature)
  (gethash feature type-table))

(defun concord-el-type-table-get-feature-table-create (type-table feature)
  (let ((feature-table (gethash feature type-table)))
    (unless feature-table
      (setq feature-table (make-hash-table))
      (puthash feature feature-table type-table))
    feature-table))


(defun concord-el-type-table-get-object-feature (type-table object-id feature)
  (let ((feature-table
	 (concord-el-type-table-get-feature-table type-table feature)))
    (if feature-table
	(gethash object-id feature-table))))

(defun concord-el-type-table-put-object-feature (type-table object-id
							    feature value)
  (let ((feature-table
	 (concord-el-type-table-get-feature-table-create type-table feature)))
    (cond
     ((eq '->subsumptive feature)
      (dolist (spec value)
	(concord-el-type-table-put-object type-table spec))))
    (puthash object-id value feature-table)))


(defun concord-el-type-table-put-object (type-table spec &optional id)
  (let (self)
    (unless id
      (setq id (cdr (assq '=id spec))))
    (when id
      (dolist (feature spec)
	(concord-el-type-table-put-object-feature
	 type-table id (car feature)(cdr feature)))
      (setq self (vector :concord type id))
      (concord-el-type-table-put-object-feature
       type-table id '=self self)
      self)))

(defun concord-el-define-object (type spec &optional id)
  (let ((type-table (concord-el-get-type-table-create type)))
    (if type-table
	(concord-el-type-table-put-object type-table spec id))))

(defun concord-el-object-get-value (object feature)
  (let ((type (concord-object-type object))
	type-table id)
    (when (and (setq type-table (concord-el-get-type-table type))
	       (setq id (concord-object-id object)))
      (concord-el-type-table-get-object-feature type-table id feature))))

(defun concord-el-object-spec (object)
  (let ((type (concord-object-type object))
	dest ret)
    (dolist (feature (concord-el-feature-list type))
      (when (setq ret (concord-el-object-get-value object feature))
	(setq dest (cons (cons feature ret) dest))))
    dest))

(defun concord-el-map-feature (function feature type)
  (let ((type-table (concord-el-get-type-table type))
	feature-table self)
    (if type-table
	(if (setq feature-table
		  (concord-el-type-table-get-feature-table
		   type-table feature))
	    (maphash (lambda (id val)
		       (setq self
			     (concord-el-type-table-get-object-feature
			      type-table id '=self))
		       (funcall function self val))
		     feature-table)))))

(defun concord-el-map-objects (function type)
  (let ((type-table (concord-el-get-type-table type))
	feature-table)
    (if type-table
	(if (setq feature-table
		  (concord-el-type-table-get-feature-table
		   type-table '=self))
	    (maphash (lambda (id self)
		       (funcall function self))
		     feature-table)))))

(defun concord-el-feature-list (type)
  (let (dest)
    (maphash (lambda (key val)
	       (setq dest (cons key dest))
	       nil)
	     (concord-el-get-type-table type))
    dest))