summaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Courtes2007-02-06 22:53:16 +0000
committerLudovic Courtes2007-02-06 22:53:16 +0000
commita0b080ec87104e8b2c030f1fde7f56dadb7f33dc (patch)
tree4bda718a428e3a80868bc77da50de853505332f2 /src/guile
parent980daea89d404610e09677b70fbb3f36c9e78608 (diff)
downloadskribilo-a0b080ec87104e8b2c030f1fde7f56dadb7f33dc.tar.gz
skribilo-a0b080ec87104e8b2c030f1fde7f56dadb7f33dc.tar.lz
skribilo-a0b080ec87104e8b2c030f1fde7f56dadb7f33dc.zip
evaluator: Made safer with respect to module excursions.
Patches applied: * lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2 (patch 11) * skribilo--engine-classes--1.2 (patch 7) - evaluator: Made safer with respect to module excursions. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-55
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/evaluator.scm75
1 files changed, 39 insertions, 36 deletions
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 8502d51..a397f29 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -58,18 +58,17 @@
;;; %EVALUATE
;;;
(define (%evaluate expr)
- ;; Evaluate EXPR, 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 (*skribilo-user-module*))))
-
+ ;; 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 (current-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))))
+ (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))
@@ -103,12 +102,19 @@
(debug-item "e=" e)
(if (not (engine? e))
(skribe-error 'evaluate-document-from-port "cannot find engine" engine)
- (let loop ((exp (reader port)))
- (with-debug 10 'evaluate-document-from-port
- (debug-item "exp=" exp))
- (unless (eof-object? exp)
- (evaluate-document (%evaluate exp) e :env env)
- (loop (reader port))))))))
+ (save-module-excursion
+ (lambda ()
+ (with-debug 10 'evaluate-document-from-port
+ (debug-item "exp=" exp))
+ (set-current-module (*skribilo-user-module*))
+
+ (let loop ((exp (reader port)))
+ (if (eof-object? exp)
+ (evaluate-document (%evaluate exp) e :env env)
+ (begin
+ (evaluate-document (%evaluate exp) e :env env)
+ (loop (reader port)))))))))))
+
;;;
@@ -123,7 +129,7 @@
(define* (load-document file :key (engine #f) (path #f) :allow-other-keys
:rest opt)
- (with-debug 4 'skribe-load
+ (with-debug 4 'load-document
(debug-item " engine=" engine)
(debug-item " path=" path)
(debug-item " opt=" opt)
@@ -138,15 +144,7 @@
(argument path)))))
(else path))
%load-path))
- (filep (or (search-path path file)
- (search-path (append path %load-path) file)
- (search-path (append path %load-path)
- (let ((dot (string-rindex file #\.)))
- (if dot
- (string-append
- (string-take file dot)
- ".scm")
- file))))))
+ (filep (search-path path file)))
(unless (and (string? filep) (file-exists? filep))
(raise (condition (&file-search-error
@@ -177,7 +175,8 @@
;;; INCLUDE-DOCUMENT
;;;
(define* (include-document file :key (path (*document-path*))
- (reader (*document-reader*)))
+ (reader (*document-reader*))
+ (module (current-module)))
(unless (every string? path)
(raise (condition (&invalid-argument-error (proc-name 'include-document)
(argument path)))))
@@ -193,11 +192,15 @@
(with-input-from-file full-path
(lambda ()
- (let Loop ((exp (reader (current-input-port)))
- (res '()))
- (if (eof-object? exp)
- (if (and (pair? res) (null? (cdr res)))
- (car res)
- (reverse! res))
- (Loop (reader (current-input-port))
- (cons (%evaluate exp) res))))))))
+ (save-module-excursion
+ (lambda ()
+ (set-current-module module)
+
+ (let Loop ((exp (reader (current-input-port)))
+ (res '()))
+ (if (eof-object? exp)
+ (if (and (pair? res) (null? (cdr res)))
+ (car res)
+ (reverse! res))
+ (Loop (reader (current-input-port))
+ (cons (%evaluate exp) res))))))))))