cgit.sxemacs.org Git - gnus/blob - lisp/gnus-fallback-lib/eieio/eieio-comp.el

   1 ;;; eieio-comp.el -- eieio routines to help with byte compilation
   2
   3 ;; Copyright (C) 1995-1996, 1998-2002, 2005, 2008-2014
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   7 ;; Version: 0.2
   8 ;; Keywords: lisp, tools
   9 ;; Package: eieio
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; Byte compiler functions for defmethod.  This will affect the new GNU
  29 ;; byte compiler for Emacs 19 and better.  This function will be called by
  30 ;; the byte compiler whenever a `defmethod' is encountered in a file.
  31 ;; It will output a function call to `eieio--defmethod' with the byte
  32 ;; compiled function as a parameter.
  33
  34 ;;; Code:
  35
  36 (declare-function eieio-defgeneric-form "eieio" (method doc-string))
  37
  38 ;; Some compatibility stuff
  39 (eval-and-compile
  40   (if (not (fboundp 'byte-compile-compiled-obj-to-list))
  41       (defun byte-compile-compiled-obj-to-list (moose) nil))
  42
  43   (if (not (boundp 'byte-compile-outbuffer))
  44       (defvar byte-compile-outbuffer nil))
  45   )
  46
  47 ;; This teaches the byte compiler how to do this sort of thing.
  48 (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod)
  49
  50 (defun byte-compile-file-form-defmethod (form)
  51   "Mumble about the method we are compiling.
  52 This function is mostly ripped from `byte-compile-file-form-defun',
  53 but it's been modified to handle the special syntax of the `defmethod'
  54 command.  There should probably be one for `defgeneric' as well, but
  55 that is called but rarely.  Argument FORM is the body of the method."
  56   (setq form (cdr form))
  57   (let* ((meth (car form))
  58          (key (progn (setq form (cdr form))
  59                      (cond ((or (eq ':BEFORE (car form))
  60                                 (eq ':before (car form)))
  61                             (setq form (cdr form))
  62                             ":before ")
  63                            ((or (eq ':AFTER (car form))
  64                                 (eq ':after (car form)))
  65                             (setq form (cdr form))
  66                             ":after ")
  67                            ((or (eq ':PRIMARY (car form))
  68                                 (eq ':primary (car form)))
  69                             (setq form (cdr form))
  70                             ":primary ")
  71                            ((or (eq ':STATIC (car form))
  72                                 (eq ':static (car form)))
  73                             (setq form (cdr form))
  74                             ":static ")
  75                            (t ""))))
  76          (params (car form))
  77          (lamparams (byte-compile-defmethod-param-convert params))
  78          (arg1 (car params))
  79          (class (if (listp arg1) (nth 1 arg1) nil))
  80          (my-outbuffer (if (eval-when-compile (featurep 'xemacs))
  81                            byte-compile-outbuffer
  82                          (cond ((boundp 'bytecomp-outbuffer)
  83                                 bytecomp-outbuffer) ; Emacs >= 23.2
  84                                ((boundp 'outbuffer) outbuffer)
  85                                (t (error "Unable to set outbuffer"))))))
  86     (let ((name (format "%s::%s" (or class "#<generic>") meth)))
  87       (if byte-compile-verbose
  88           ;; #### filename used free
  89           (message "Compiling %s... (%s)"
  90                    (cond ((boundp 'bytecomp-filename) bytecomp-filename)
  91                          ((boundp 'filename) filename)
  92                          (t ""))
  93                    name))
  94       (setq byte-compile-current-form name) ; for warnings
  95       )
  96     ;; Flush any pending output
  97     (byte-compile-flush-pending)
  98     ;; Byte compile the body.  For the byte compiled forms, add the
  99     ;; rest arguments, which will get ignored by the engine which will
 100     ;; add them later (I hope)
 101     (let* ((new-one (byte-compile-lambda
 102                      (append (list 'lambda lamparams)
 103                              (cdr form))))
 104            (code (byte-compile-byte-code-maker new-one)))
 105       (princ "\n(eieio--defmethod '" my-outbuffer)
 106       (princ meth my-outbuffer)
 107       (princ " '(" my-outbuffer)
 108       (princ key my-outbuffer)
 109       (prin1 params my-outbuffer)
 110       (princ " " my-outbuffer)
 111       (prin1 code my-outbuffer)
 112       (princ "))" my-outbuffer)
 113       )
 114     ;; Now add this function to the list of known functions.
 115     ;; Don't bother with a doc string.   Not relevant here.
 116     (add-to-list 'byte-compile-function-environment
 117                  (cons meth
 118                        (eieio-defgeneric-form meth "")))
 119
 120     ;; Remove it from the undefined list if it is there.
 121     (let ((elt (assq meth byte-compile-unresolved-functions)))
 122       (if elt (setq byte-compile-unresolved-functions
 123                     (delq elt byte-compile-unresolved-functions))))
 124
 125     ;; nil prevents cruft from appearing in the output buffer.
 126     nil))
 127
 128 (defun byte-compile-defmethod-param-convert (paramlist)
 129   "Convert method params into the params used by the `defmethod' thingy.
 130 Argument PARAMLIST is the parameter list to convert."
 131   (let ((argfix nil))
 132     (while paramlist
 133       (setq argfix (cons (if (listp (car paramlist))
 134                              (car (car paramlist))
 135                            (car paramlist))
 136                          argfix))
 137       (setq paramlist (cdr paramlist)))
 138     (nreverse argfix)))
 139
 140 (provide 'eieio-comp)
 141
 142 ;;; eieio-comp.el ends here