;;;-*- Package: FST; Mode: Lisp; Base: 10 -*-
 
;;; Copyright (c) 1992 by Xerox Corporation

;;;; Skip list implementation of FSA relation protocol

(cl:in-package :fst)

(defclass fs-relation (relation)
  ((hash-table :initarg :hash-table :accessor relation-hash-table)))

(defmethod shared-initialize :after ((relation fs-relation) slots
				     &key &allow-other-keys)
  (declare (ignore slots))
  (setf (relation-hash-table relation) (make-hash-table :test #'equal)))

(defmethod print-object ((relation fs-relation) stream)
  (format stream "#<fs-relation: ~s>" (relation-hash-table relation)))

(defclass fs-relations () ())

(defmethod make-relation (order (relations fs-relations))
  (declare (ignore order))
  (make-instance 'fs-relation))

(defparameter *non-tp* "-")

(defmethod relation-get (key (relation fs-relation))
  (let ((tp-p (transducer-pair-p key))) 
    (gethash (if tp-p 
               (cons (fst::tp-upper key)(fst::tp-lower key))
               key)
             (relation-hash-table relation))))

(defmethod (setf relation-get) (value key (relation fs-relation))
  (let ((tp-p (transducer-pair-p key))) 
    (setf 
     (gethash (Print (if tp-p 
                (cons (fst::tp-upper key)(fst::tp-lower key))
                key))
              (relation-hash-table relation))
     value)))

(defmethod relation-map (fn (relation fs-relation))
  (maphash (lambda (key value)
             (funcall fn (if (consp key)
                           (make-transducer-pair (car key) (cdr key))
                           key)
                      value))
           (relation-hash-table relation)))