From 13460dbc76c37ef1257cff2e8e6f59f451148b82 Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Sat, 3 Dec 2005 16:44:38 +0000
Subject: Fixed the resolution mechanism and converted it to SRFI-39.

* src/guile/skribilo/output.scm: Cosmetic changes.

* src/guile/skribilo/resolve.scm: Use SRFI-39.
  (*unresolved*): Became an SRFI-39 parameter object.
  (resolve!): Use `parameterize' over `*unresolved*'.
  (do-resolve!): For `<container>', resolve the body of NODE even if
  PARENT is not unspecified.  A similar fix had gone into the Bigloo
  implementation of Skribe (the patch was never actually integrated as it
  seems).  This makes it possible to use `numref'.
  For `<unresolved>', to not invoke `do-resolve!' on the result of PROC's
  invocation.  Similarly, this had gone into Skribe.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-15
---
 src/guile/skribilo/output.scm  |  2 +-
 src/guile/skribilo/resolve.scm | 27 ++++++++++++++-------------
 2 files changed, 15 insertions(+), 14 deletions(-)

(limited to 'src/guile')

diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm
index 8110418..28e99a8 100644
--- a/src/guile/skribilo/output.scm
+++ b/src/guile/skribilo/output.scm
@@ -151,7 +151,7 @@
 
 
 (define-method (out (n <unresolved>) e)
-  (skribe-error 'output "Orphan unresolved" n))
+  (skribe-error 'output "orphan unresolved" n))
 
 
 (define-method (out (node <markup>) e)
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index cc1b14f..9ddbc32 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -26,6 +26,7 @@
   :use-module (skribilo utils syntax)
 
   :use-module (oop goops)
+  :use-module (srfi srfi-39)
 
   :export (resolve! resolve-search-parent resolve-children resolve-children*
 	   find1 resolve-counter resolve-parent resolve-ident))
@@ -33,7 +34,7 @@
 (set-current-reader %skribilo-module-reader)
 
 
-(define *unresolved* #f)
+(define *unresolved* (make-parameter #f))
 (define-generic do-resolve!)
 
 
@@ -48,14 +49,14 @@
 (define (resolve! ast engine env)
   (with-debug 3 'resolve
      (debug-item "ast=" ast)
-     (let ((*unresolved* (make-fluid)))
-       (fluid-set! *unresolved* #f)
-
+     (parameterize ((*unresolved* #f))
        (let Loop ((ast ast))
-	 (fluid-set! *unresolved* #f)
+	 (*unresolved* #f)
 	 (let ((ast (do-resolve! ast engine env)))
-	   (if (fluid-ref *unresolved*)
-	       (Loop ast)
+	   (if (*unresolved*)
+	       (begin
+		 (debug-item "iterating over ast " ast)
+		 (Loop ast))
 	       ast))))))
 
 ;;;; ======================================================================
@@ -75,7 +76,7 @@
        (set-car! n* (do-resolve! (car n*) engine env))
        (Loop (cdr n*)))
       ((not (null? n*))
-       (error 'do-resolve "Illegal argument" n*))
+       (error 'do-resolve "illegal argument" n*))
       (else
        ast))))
 
@@ -121,9 +122,9 @@
 			   (set-car! (cdr o)
 				     (do-resolve! (cadr o) engine e)))
 			 options)
-	       (debug-item "resolved options=" options)))
-	   (let ((e `((parent ,node) ,@env ,@env0)))
-	     (slot-set! node 'body (do-resolve! body engine e)))))
+	       (debug-item "resolved options=" options)))))
+       (let ((e `((parent ,node) ,@env ,@env0)))
+	 (slot-set! node 'body (do-resolve! body engine e)))
        node)))
 
 
@@ -147,12 +148,12 @@
        (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p))))
 
      (let* ((proc (slot-ref node 'proc))
-	    (res  (resolve! (proc node engine env) engine env))
+	    (res  (proc node engine env))
 	    (loc  (ast-loc node)))
        (when (ast? res)
 	 (ast-loc-set! res loc))
        (debug-item "res=" res)
-       (set! *unresolved* #t)
+       (*unresolved* #t)
        res)))
 
 
-- 
cgit v1.2.3