1 ;;; liece-handler.el --- function overloading facilities
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; This file is part of Liece.
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
30 (eval-when-compile (require 'cl))
32 (eval-when-compile (require 'liece-inlines))
34 (eval-when-compile (require 'liece-clfns))
36 (defmacro liece-handler-make-obarray (backend)
37 `(defvar ,(intern (format "liece-handler-%s-obarray" backend))
40 (defmacro liece-handler-obarray (backend)
41 `(symbol-value (intern-soft (format "liece-handler-%s-obarray" ,backend))))
43 (defun liece-handler-override-function-definition (name backend args function)
44 (let ((ref (symbol-name (liece-gensym))))
46 (setq name (symbol-name name)))
47 (put (intern name (liece-handler-obarray backend)) 'unifiers
48 (nconc (get (intern name (liece-handler-obarray backend)) 'unifiers)
49 (list `(,(intern ref (liece-handler-obarray backend))
51 (fset (intern ref (liece-handler-obarray backend)) function)))
53 (defun liece-handler-unify-argument-list-function (args unifiers)
55 (unfs (copy-alist unifiers))
59 (remove-if (lambda (unf) (/= (length (cdr unf)) len)) unfs))
62 (setq unfs (remove-if-not
64 (let ((spec (nth index (cdr unf))))
65 (or (not (listp spec))
66 (eq (car spec) (car arg)))))
70 (symbol-function (caar unfs)))))
72 (defmacro liece-handler-define-backend (type &optional parents)
73 `(liece-handler-make-obarray ,type))
75 (defun liece-handler-find-function (name args backend)
76 (let* ((fsym (intern-soft name (liece-handler-obarray backend)))
77 (unifiers (if fsym (get fsym 'unifiers))))
78 (liece-handler-unify-argument-list-function args unifiers)))
80 (defun liece-handler-define-function (name specs function)
81 (let ((args (butlast specs))
82 (backend (car (last specs))))
83 (liece-handler-override-function-definition name backend args function)))
85 (provide 'liece-handler)
87 ;;; liece-handler.el ends here