cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/wisent/wisent-debug.el

   1 ;;; wisent-debug.el --- GNU Bison for Emacs - Debugging
   2
   3 ;; Copyright (C) 2003, 2007 David Ponce
   4
   5 ;; Author: David Ponce <david@dponce.com>
   6 ;; Maintainer: David Ponce <david@dponce.com>
   7 ;; Created: 11 February 2003
   8 ;; Keywords: syntax
   9 ;; X-RCS: $Id: wisent-debug.el,v 1.1 2007-11-26 15:12:30 michaels Exp $
  10
  11 ;; This file is not part of GNU Emacs.
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29 ;;
  30 ;; Investigating what is happening during execution of the Wisent parser.
  31 ;;
  32 ;; Wisent (the European Bison ;-) is an Elisp implementation of the
  33 ;; GNU Compiler Compiler Bison.
  34 ;;
  35 ;; For more details on the basic concepts for understanding Wisent,
  36 ;; read the Bison manual ;)
  37 ;;
  38 ;; For more details on Wisent itself read the Wisent manual.
  39
  40 ;;; History:
  41 ;;
  42
  43 ;;; Code:
  44 (require 'wisent)
  45 (require 'debug)
  46
  47 (defsubst wisent-debug-on-entry-p (function)
  48   "Return t if FUNCTION invoke debugger each time it is called.
  49 FUNCTION must be a semantic action symbol."
  50   (if (memq function debug-function-list)
  51       t))
  52
  53 (defun wisent-debug-on-automaton-p (automaton)
  54   "Return t if there is a debug-enabled function in AUTOMATON."
  55   (catch 'found
  56     (mapatoms
  57      #'(lambda (function)
  58          (if (wisent-debug-on-entry-p function)
  59              (throw 'found t)))
  60      (aref automaton 3))))
  61
  62 (defsubst wisent-debug-semantic-action-source (function)
  63   "Return source expression of semantic action FUNCTION.
  64 FUNCTION must be a semantic action symbol."
  65   (symbol-function function))
  66
  67 (defun wisent-debug-read-entry (flag)
  68   "Read a semantic action symbol from the minibuffer.
  69 Return a list (AUTOMATON FUNCTION) suitable for an `interactive' spec.
  70 AUTOMATON is a LALR automaton variable.  FUNCTION is a semantic action
  71 symbol defined in AUTOMATON.  If FLAG is t, only consider
  72 debug-enabled actions.  If nil, only consider not debug-enabled
  73 actions.  If 'any consider all available semantic action symbols."
  74   (let ((vn (completing-read
  75              "LALR automaton name: " obarray
  76              (if (eq flag t)
  77                  #'(lambda (e)
  78                      (and (wisent-automaton-p e)
  79                           (wisent-debug-on-automaton-p
  80                            (symbol-value e))))
  81                'wisent-automaton-p)
  82              t))
  83         ob am sy)
  84     (unless (string-equal "" vn)
  85       (setq am (intern-soft vn)
  86             ob (aref (symbol-value am) 3)
  87             vn (completing-read
  88                 (format "Semantic action symbol in `%s': " am)
  89                 ob
  90                 (unless (eq flag 'any)
  91                   #'(lambda (e)
  92                       (eq (wisent-debug-on-entry-p e) flag)))
  93                 t))
  94       (unless (string-equal "" vn)
  95         (setq sy (intern-soft vn ob))))
  96     (list am sy)))
  97
  98 (defun wisent-debug-check-entry (automaton function)
  99   "Check that AUTOMATON owns symbol FUNCTION.
 100 Always return a symbol FUNCTION interned in the semantic action symbol
 101 table of AUTOMATON."
 102   (and (wisent-automaton-p automaton)
 103        function (symbolp function)
 104        (intern-soft (symbol-name function)
 105                     (aref (symbol-value automaton) 3))))
 106
 107 ;;;###autoload
 108 (defun wisent-debug-on-entry (automaton function)
 109   "Request AUTOMATON's FUNCTION to invoke debugger each time it is called.
 110 FUNCTION must be a semantic action symbol that exists in AUTOMATON."
 111   (interactive (wisent-debug-read-entry nil))
 112   (when (setq function (wisent-debug-check-entry automaton function))
 113     (debug-on-entry function)))
 114
 115 ;;;###autoload
 116 (defun wisent-cancel-debug-on-entry (automaton function)
 117   "Undo effect of \\[wisent-debug-on-entry] on AUTOMATON's FUNCTION.
 118 FUNCTION must be a semantic action symbol that exists in AUTOMATON."
 119   (interactive (wisent-debug-read-entry t))
 120   (when (setq function (wisent-debug-check-entry automaton function))
 121     (cancel-debug-on-entry function)))
 122
 123 (condition-case nil
 124     (require 'pprint)
 125   (error
 126    (require 'pp)))
 127
 128 (if (fboundp 'pprint-to-string)
 129     (eval-and-compile
 130       (defalias 'wisent-debug-pp-to-string 'pprint-to-string))
 131   (eval-and-compile
 132     (defalias 'wisent-debug-pp-to-string 'pp-to-string)))
 133
 134 ;;;###autoload
 135 (defun wisent-debug-show-entry (automaton function)
 136   "Show the source of AUTOMATON's semantic action FUNCTION.
 137 FUNCTION must be a semantic action symbol that exists in AUTOMATON."
 138   (interactive (wisent-debug-read-entry 'any))
 139   (when (setq function (wisent-debug-check-entry automaton function))
 140     (with-current-buffer
 141         (get-buffer-create (format "*%s/%s*" automaton function))
 142       (erase-buffer)
 143       (kill-all-local-variables)
 144       (erase-buffer)
 145       (setq buffer-undo-list t
 146             buffer-read-only nil)
 147       (emacs-lisp-mode)
 148       (insert
 149        (wisent-debug-pp-to-string
 150         (wisent-debug-semantic-action-source function)))
 151       (goto-char (point-min))
 152       (pop-to-buffer (current-buffer)))))
 153
 154 (provide 'wisent-debug)
 155
 156 ;;; wisent-debug.el ends here