aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/engine.scm10
-rw-r--r--src/guile/skribilo/resolve.scm52
2 files changed, 29 insertions, 33 deletions
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index fb1bcb2..5f82044 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -29,6 +29,7 @@
:use-module (ice-9 optargs)
:use-module (ice-9 format)
+ :use-module (srfi srfi-1)
:autoload (srfi srfi-34) (raise guard)
:use-module (srfi srfi-35)
:autoload (srfi srfi-39) (make-parameter)
@@ -350,11 +351,10 @@ otherwise the requested engine is returned."
(define (engine-custom-set! e id val)
- (let* ((customs (slot-ref e 'customs))
- (c (assq id customs)))
- (if (pair? c)
- (set-car! (cdr c) val)
- (slot-set! e 'customs (cons (list id val) customs)))))
+ (let ((customs (slot-ref e 'customs)))
+ (slot-set! e 'customs
+ (cons (list id val)
+ (alist-delete id customs eq?)))))
(define (engine-custom-add! e id val)
(let ((old (engine-custom e id)))
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index 2ef49b1..7058d90 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -1,6 +1,6 @@
;;; resolve.scm -- Skribilo reference resolution.
;;;
-;;; Copyright 2005, 2006, 2008, 2009 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright 2005, 2006, 2008, 2009, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;
;;;
@@ -30,6 +30,7 @@
:use-module (skribilo condition)
:use-module (srfi srfi-34)
:use-module (srfi srfi-35)
+ :use-module (ice-9 match)
:export (resolve! resolve-search-parent
resolve-counter resolve-parent resolve-ident
@@ -91,21 +92,14 @@
(define-method (do-resolve! (ast <pair>) engine env)
- (let Loop ((n* ast))
- (cond
- ((null? n*)
- ast)
- ((list? n*)
- (set-car! n* (do-resolve! (car n*) engine env))
- (Loop (cdr n*)))
- ((pair? n*)
- (set-car! n* (do-resolve! (car n*) engine env))
- (set-cdr! n* (do-resolve! (cdr n*) engine env))
- n*)
- (else
- (raise (condition (&invalid-argument-error
- (proc-name "do-resolve!<pair>")
- (argument n*))))))))
+ (match ast
+ ((? list?) ;proper list
+ (map (lambda (elt)
+ (do-resolve! elt engine env))
+ ast))
+ ((head . tail) ;pair or improper list
+ (cons (do-resolve! head engine env)
+ (do-resolve! tail engine env)))))
(define-method (do-resolve! (node <node>) engine env)
@@ -125,11 +119,13 @@
(when (pair? options)
(debug-item "unresolved options=" options)
- (for-each (lambda (o)
- (set-car! (cdr o)
- (do-resolve! (cadr o) engine env)))
- options)
- (debug-item "resolved options=" options))
+ (let ((resolved (map (match-lambda
+ ((option value)
+ (list option
+ (do-resolve! value engine env))))
+ options)))
+ (slot-set! node 'options resolved)
+ (debug-item "resolved options=" options)))
(slot-set! node 'body (do-resolve! body engine env))
(slot-set! node 'resolved? (not (*unresolved*))))
@@ -182,13 +178,13 @@
(parameterize ((*document-being-resolved* node))
(next-method)
;; resolve the engine custom
- (let ((env (append `((parent ,node)) env0)))
- (for-each (lambda (c)
- (let ((i (car c))
- (a (cadr c)))
- (debug-item "custom=" i " " a)
- (set-car! (cdr c) (do-resolve! a engine env))))
- (slot-ref engine 'customs)))
+ (let* ((env (append `((parent ,node)) env0))
+ (resolved (map (match-lambda
+ ((i a)
+ (debug-item "custom=" i " " a)
+ (list i (do-resolve! a engine env))))
+ (slot-ref engine 'customs))))
+ (slot-set! engine 'customs resolved))
node))