diff options
| -rw-r--r-- | src/guile/skribilo/engine.scm | 10 | ||||
| -rw-r--r-- | src/guile/skribilo/resolve.scm | 52 |
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)) |