diff options
| -rw-r--r-- | ChangeLog | 25 | ||||
| -rw-r--r-- | src/guile/skribilo.scm | 61 | ||||
| -rw-r--r-- | src/guile/skribilo/evaluator.scm | 22 | ||||
| -rw-r--r-- | src/guile/skribilo/location.scm | 28 |
4 files changed, 80 insertions, 56 deletions
@@ -2,6 +2,31 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-04-03 14:57:19 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-82 + + Summary: + Reduced reliance on the debugging evaluator (improves performance). + Revision: + skribilo--devo--1.2--patch-82 + + * src/guile/skribilo.scm (skribilo): Do not impose use of the debugging + evaluator, allowing for significant performance improvements. + + * src/guile/skribilo/evaluator.scm (%evaluate): Use the debugging + evaluator when evaluating EXPR. + + * src/guile/skribilo/location.scm (invocation-location): Return `#f' when + the debugging evaluator is not being used. + + modified files: + ChangeLog src/guile/skribilo.scm + src/guile/skribilo/evaluator.scm + src/guile/skribilo/location.scm + + new patches: + lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-41 + + 2007-04-03 11:58:43 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-81 Summary: diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm index 531b0fb..106fc71 100644 --- a/src/guile/skribilo.scm +++ b/src/guile/skribilo.scm @@ -4,34 +4,34 @@ main='(module-ref (resolve-module '\''(skribilo)) '\'main')' exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# -;;;; skribilo.scm -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> -;;;; -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2 of the License, or -;;;; (at your option) any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this program; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;;;; USA. - -;;;; Commentary: -;;;; -;;;; Usage: skribilo [ARGS] -;;;; -;;;; Process a skribilo document. -;;;; -;;;; Code: +;;; skribilo.scm -- The Skribilo document processor. +;;; +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2005, 2006, 2007 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +;;; Commentary: +;;; +;;; Usage: skribilo [ARGS] +;;; +;;; Process a skribilo document. +;;; +;;; Code: @@ -406,11 +406,6 @@ Processes a Skribilo/Skribe source file and produces its output. (help-wanted (option-ref options 'help #f)) (version-wanted (option-ref options 'version #f))) - ;; Set up the debugging infrastructure. - (debug-enable 'debug) - (debug-enable 'backtrace) - (debug-enable 'procnames) - (cond (help-wanted (begin (skribilo-show-help) (exit 1))) (version-wanted (begin (skribilo-show-version) (exit 1)))) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index 0598c86..3e984fc 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -62,16 +62,18 @@ ;; Evaluate EXPR in the current module. EXPR is an arbitrary S-expression ;; that may contain calls to the markup functions defined in a markup ;; package such as `(skribilo package base)', e.g., `(bold "hello")'. - (let ((result (eval expr module))) - (if (ast? result) - (let ((file (source-property expr 'filename)) - (line (source-property expr 'line)) - (column (source-property expr 'column))) - (slot-set! result 'loc - (make <location> - :file file :line line :pos column)))) - - result)) + (let ((opts (debug-options))) + (dynamic-wind + (lambda () + ;; Force use of the debugging evaluator so that we can track source + ;; location. + (debug-enable 'debug) + (debug-enable 'backtrace)) + (lambda () + (eval expr module)) + (lambda () + ;; Restore previous evaluator options. + (debug-options opts))))) ;;; diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm index 6c23f76..e4583ff 100644 --- a/src/guile/skribilo/location.scm +++ b/src/guile/skribilo/location.scm @@ -79,19 +79,21 @@ (define (invocation-location . depth) ;; Return a location object denoting the place of invocation of this - ;; function's caller. - (let ((depth (if (null? depth) 4 (car depth)))) - (let* ((stack (make-stack #t)) - (frame (stack-ref stack depth)) - (source (frame-source frame))) - (and source - (let ((file (source-property source 'filename)) - (line (source-property source 'line)) - (col (source-property source 'column))) - (and file - (make <location> :file file - :line (and line (+ line 1)) - :column col))))))) + ;; function's caller. Debugging must be enable for this to work, via + ;; `(debug-enable 'debug)', otherwise `#f' is returned. + (let ((depth (if (null? depth) 4 (car depth))) + (stack (make-stack #t))) + (and stack + (let* ((frame (stack-ref stack depth)) + (source (frame-source frame))) + (and source + (let ((file (source-property source 'filename)) + (line (source-property source 'line)) + (col (source-property source 'column))) + (and file + (make <location> :file file + :line (and line (+ line 1)) + :column col)))))))) ;;; arch-tag: d68fa45d-a200-465e-a3c2-eb2861907f83 |