From bc9090d69ebe3c2612efd830b859d4c1c896aae0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Tue, 28 Feb 2006 21:40:26 +0000 Subject: Slightly optimized the resolution process (added `ast-resolved?'). * src/guile/skribilo/ast.scm (): Added a `resolved?' slot, with accessor `ast-resolved?'. * src/guile/skribilo/resolve.scm (do-resolve!)[]: Check whether `ast-resolved?' is true and set it once it's resolved. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-37 --- ChangeLog | 18 ++++++++++++++++++ src/guile/skribilo/ast.scm | 13 +++++++++++-- src/guile/skribilo/resolve.scm | 41 ++++++++++++++++++++++++----------------- 3 files changed, 53 insertions(+), 19 deletions(-) diff --git a/ChangeLog b/ChangeLog index 20d8a03..2ba8d09 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,24 @@ # arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2 # +2006-02-28 21:40:26 GMT Ludovic Courtes patch-37 + + Summary: + Slightly optimized the resolution process (added `ast-resolved?'). + Revision: + skribilo--devel--1.2--patch-37 + + * src/guile/skribilo/ast.scm (): Added a `resolved?' slot, with + accessor `ast-resolved?'. + + * src/guile/skribilo/resolve.scm (do-resolve!)[]: Check whether + `ast-resolved?' is true and set it once it's resolved. + + modified files: + ChangeLog src/guile/skribilo/ast.scm + src/guile/skribilo/resolve.scm + + 2006-02-28 20:08:45 GMT Ludovic Courtes patch-36 Summary: diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index 1856389..3968b18 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -25,6 +25,7 @@ :use-module (skribilo utils syntax) :export ( ast? ast-loc ast-loc-set! ast-parent ast->string ast->file-location + ast-resolved? command? command-fmt command-body unresolved? unresolved-proc @@ -71,8 +72,16 @@ ;;; ====================================================================== ;;FIXME: set! location in (define-class () - (parent :accessor ast-parent :init-keyword :parent :init-value 'unspecified) - (loc :init-value #f)) + ;; Parent of this guy. + (parent :accessor ast-parent :init-keyword :parent :init-value 'unspecified) + + ;; Its source location. + (loc :init-value #f) + + ;; This slot is used as an optimization when resolving an AST: sub-parts of + ;; the tree are marked as resolved as soon as they are and don't need to be + ;; traversed again. + (resolved? :accessor ast-resolved? :init-value #f)) (define (ast? obj) (is-a? obj )) diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm index cbb939d..34d6bde 100644 --- a/src/guile/skribilo/resolve.scm +++ b/src/guile/skribilo/resolve.scm @@ -85,24 +85,31 @@ (define-method (do-resolve! (node ) engine env) - (let ((body (slot-ref node 'body)) - (options (slot-ref node 'options)) - (parent (slot-ref node 'parent))) - (with-debug 5 'do-resolve - (debug-item "body=" body) - (when (eq? parent 'unspecified) - (let ((p (assq 'parent env))) - (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p))) - (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)))) - (slot-set! node 'body (do-resolve! body engine env)) - node))) + (if (ast-resolved? node) + node + (let ((body (slot-ref node 'body)) + (options (slot-ref node 'options)) + (parent (slot-ref node 'parent)) + (unresolved? (*unresolved*))) + (with-debug 5 'do-resolve + (debug-item "body=" body) + (parameterize ((*unresolved* #f)) + (when (eq? parent 'unspecified) + (let ((p (assq 'parent env))) + (slot-set! node 'parent + (and (pair? p) (pair? (cdr p)) (cadr p))) + (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)))) + (slot-set! node 'body (do-resolve! body engine env)) + (slot-set! node 'resolved? (not (*unresolved*)))) + (*unresolved* (or unresolved? (not (ast-resolved? node)))) + node)))) (define-method (do-resolve! (node ) engine env0) -- cgit v1.2.3