aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/ast.scm13
-rw-r--r--src/guile/skribilo/resolve.scm41
2 files changed, 35 insertions, 19 deletions
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? ast-loc ast-loc-set!
ast-parent ast->string ast->file-location
+ ast-resolved?
<command> command? command-fmt command-body
<unresolved> unresolved? unresolved-proc
@@ -71,8 +72,16 @@
;;; ======================================================================
;;FIXME: set! location in <ast>
(define-class <ast> ()
- (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 <ast>))
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 <node>) engine env)
- (let ((body (slot-ref node 'body))
- (options (slot-ref node 'options))
- (parent (slot-ref node 'parent)))
- (with-debug 5 'do-resolve<body>
- (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<body>
+ (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 <container>) engine env0)