OSDN Git Service

set version as 1.4.5-snapshot2
[howm/howm.git] / gfunc.el
1 ;;; gfunc.el --- support for generic function
2 ;;; Copyright (C) 2005-2018
3 ;;;   HIRAOKA Kazuyuki <khi@users.osdn.me>
4 ;;;
5 ;;; This program is free software; you can redistribute it and/or modify
6 ;;; it under the terms of the GNU General Public License as published by
7 ;;; the Free Software Foundation; either version 1, or (at your option)
8 ;;; any later version.
9 ;;;
10 ;;; This program is distributed in the hope that it will be useful,
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;;; GNU General Public License for more details.
14 ;;;
15 ;;; The GNU General Public License is available by anonymouse ftp from
16 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
17 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
18 ;;; USA.
19 ;;;--------------------------------------------------------------------
20
21 ;; sample
22 ;; 
23 ;; (defun less-than:num (x y)
24 ;;   (< x y))
25 ;; (defun less-than:str (x y)
26 ;;   (string< x y))
27 ;; (defun type-of (x y)
28 ;;   (cond ((numberp x) ':num)
29 ;;         ((stringp x) ':str)))
30 ;; (defvar disp-list (list #'type-of))
31 ;; (gfunc-define-function less-than (x y) disp-list)  ;; --- <*>
32 ;; (less-than 3 8)          ;; (less-than:num 3 8)         ==> t
33 ;; (less-than "xyz" "abc")  ;; (less-than:str "xyz" "abc") ==> nil
34 ;; (pp (macroexpand '(gfunc-def less-than (x y) disp-list)))
35 ;; 
36 ;; ;; This is equivalent to above <*>.
37 ;; (gfunc-with disp-list
38 ;;   (gfunc-def less-than (x y))
39 ;;   ;; You can insert more methods here. For example...
40 ;;   ;; (less-or-equal (x y))
41 ;;   ;; (more-than (x y))
42 ;;   )
43
44 (defvar *gfunc-dispatchers-var* nil
45   "For internal use")
46 (put '*gfunc-dispatchers-var* 'risky-local-variable t)
47
48 ;; loop version
49 (defun gfunc-call (base-name dispatchers args)
50   (let (type)
51     (catch 'done
52       (while dispatchers
53         (setq type (apply (car dispatchers) args))
54         (if type
55             (throw 'done
56                    (apply (intern-soft (format "%s%s" base-name type))
57                           args))
58           (setq dispatchers (cdr dispatchers))))
59       (error "Can't detect type of %s for %s." args base-name))))
60
61 ;; (defun gfunc-call (base-name dispatchers args)
62 ;;   (if (null dispatchers)
63 ;;       (error "Can't detect type of %s for %s." args base-name)
64 ;;     (let ((type (apply (car dispatchers) args)))
65 ;;       (if (null type)
66 ;;           (gfunc-call base-name (cdr dispatchers) args)
67 ;;         (let ((f (intern-soft (format "%s%s" base-name type))))
68 ;;           (apply f args))))))
69
70 ;; (put 'gfunc-def 'lisp-indent-hook 2)
71 (defmacro gfunc-define-function (base-name args-declaration dispatchers-var
72                                            &optional description)
73   "Define generic function.
74 BASE-NAME is name of generic function.
75 ARGS-DECLARATION has no effect; it is merely note for programmers.
76 DISPATCHERS-VAR is name of variable whose value is list of type-detectors.
77 Type-detector receives arguments to the function BASE-NAME, and returns
78 its 'type' symbol.
79 Then, BASE-NAME + type is the name of real function.
80 Type detector must return nil if it cannot determine the type, so that
81 the task is chained to next detector."
82   (let ((desc-str (format "%s
83
84 ARGS = %s
85
86 Internally, %s___ is called according to the type of ARGS.
87 The type part ___ is determined by functions in the list `%s'.
88 This function is generated by `gfunc-define-function'."
89                           (or description "Generic function.")
90                           args-declaration
91                           base-name
92                           dispatchers-var)))
93     `(defun ,base-name (&rest args)
94        ,desc-str
95        (gfunc-call (quote ,base-name) ,dispatchers-var args))))
96
97 (defmacro gfunc-def (base-name args-declaration &optional description)
98   "Define generic function like `gfunc-define-function'.
99 The only difference is omission of dispatchers; it must be specified
100 by `gfunc-with' outside."
101   (declare (indent 2))
102   `(gfunc-define-function ,base-name ,args-declaration ,*gfunc-dispatchers-var*
103                           ,description))
104
105 (defmacro gfunc-with (dispatchers-var &rest body)
106   "With the defalut DISPATCHERS-VAR, execute BODY.
107 BODY is typically a set of `gfunc-def', and DISPATCHERS-VAR is used
108 as their dispatchers.
109 This macro cannot be nested."
110   (declare (indent 1))
111   ;; Be careful to etc/NEWS in Emacs 24.3 or
112   ;; http://www.masteringemacs.org/articles/2013/03/11/whats-new-emacs-24-3/
113   ;; "Emacs tries to macroexpand interpreted (non-compiled) files during load."
114   (setq *gfunc-dispatchers-var* dispatchers-var)
115   `(eval-and-compile
116      ,@body))
117
118 (provide 'gfunc)
119
120 ;;; gfunc.el ends here