summaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Court`es2007-04-03 13:45:57 +0000
committerLudovic Court`es2007-04-03 13:45:57 +0000
commita5795533336152ba0e8534ea0fcef220ce04ccf5 (patch)
tree87ac50eeb02cec3963152c9a9b7b6e2bc07798e6 /src/guile
parent1d230301e1f70d39b6e5d96e12934546f1b126dd (diff)
downloadskribilo-a5795533336152ba0e8534ea0fcef220ce04ccf5.tar.gz
skribilo-a5795533336152ba0e8534ea0fcef220ce04ccf5.tar.lz
skribilo-a5795533336152ba0e8534ea0fcef220ce04ccf5.zip
Reduced reliance on the debugging evaluator (improves performance).
* 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. git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-41
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo.scm61
-rw-r--r--src/guile/skribilo/evaluator.scm22
-rw-r--r--src/guile/skribilo/location.scm28
3 files changed, 55 insertions, 56 deletions
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