OSDN Git Service

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