diff options
author | Ludovic Courtes | 2006-09-03 11:43:55 +0000 |
---|---|---|
committer | Ludovic Courtes | 2006-09-03 11:43:55 +0000 |
commit | 8008a4d20f277910d5524e7704db32068010a0a5 (patch) | |
tree | da43ca1820ca9d83845112963af054da748e96d0 /src/guile/skribilo/ast.scm | |
parent | 242821c06c44429369cbf1f542bf07be5d51e955 (diff) | |
download | skribilo-8008a4d20f277910d5524e7704db32068010a0a5.tar.gz skribilo-8008a4d20f277910d5524e7704db32068010a0a5.tar.lz skribilo-8008a4d20f277910d5524e7704db32068010a0a5.zip |
Implemented per-document node identifiers.
* src/guile/skribilo/ast.scm: Autoload `srfi-1' on `fold'.
(*node-table*): Removed.
(bind-markup!): Removed.
(initialize<markup>): Removed.
(find-markups): Removed.
(write<markup>): Commented out debugging `format'.
(<document>)[node-table]: New slot.
[nodes-bound?]: New slot.
(document-lookup-node): New.
(document-bind-node!): New.
(document-bind-nodes!): New.
(ast-fold): New.
(find-markup-ident): Removed.
* src/guile/skribilo/output.scm (*document-being-output*): New.
(out<document>): New.
* src/guile/skribilo/resolve.scm (*document-being-resolved*): New.
(resolve!): Invoke `document-bind-nodes!' before resolving the
document.
(do-resolve!<document>): Parameterize `*document-being-resolved*'.
(resolve-ident): Use `document-lookup-node' instead of `find-markups'.
* src/guile/skribilo/utils/compat.scm (bind-markup!): New.
(find-markups): New.
(find-markup-ident): New.
git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-57
Diffstat (limited to 'src/guile/skribilo/ast.scm')
-rw-r--r-- | src/guile/skribilo/ast.scm | 98 |
1 files changed, 59 insertions, 39 deletions
diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index f8ee519..e17b2dd 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -24,6 +24,7 @@ :use-module (oop goops) :autoload (skribilo location) (location?) :autoload (skribilo lib) (skribe-type-error skribe-error) + :autoload (srfi srfi-1) (fold) :use-module (skribilo utils syntax) :export (<ast> ast? ast-loc ast-loc-set! ast-parent ast->string ast->file-location @@ -35,10 +36,9 @@ <node> node? node-options node-loc node-body <processor> processor? processor-combinator processor-engine - <markup> markup? bind-markup! markup-options is-markup? + <markup> markup? markup-options is-markup? markup-markup markup-body markup-body-set! markup-ident markup-class - find-markups markup-option markup-option-set! markup-option-add! markup-output markup-parent markup-document markup-chapter @@ -49,9 +49,11 @@ <document> document? document-ident document-body document-options document-end + document-lookup-node document-bind-node! + document-bind-nodes! ;; traversal - find-markup-ident + ast-fold container-search-down search-down find-down find1-down find-up find1-up ast-document ast-chapter ast-section)) @@ -68,18 +70,13 @@ (fluid-set! current-reader %skribilo-module-reader) -(define *node-table* (make-hash-table)) - ; Used to stores the nodes of an AST. - ; It permits to retrieve a node from its - ; identifier. -;;; ====================================================================== ;;; -;;; <AST> +;;; Abstract syntax tree (AST). ;;; -;;; ====================================================================== + ;;FIXME: set! location in <ast> (define-class <ast> () ;; Parent of this guy. @@ -198,29 +195,16 @@ -;;; ====================================================================== ;;; -;;; <MARKUP> +;;; Markup. ;;; -;;; ====================================================================== + (define-class <markup> (<node>) (ident :init-keyword :ident :getter markup-ident :init-value #f) (class :init-keyword :class :getter markup-class :init-value #f) (markup :init-keyword :markup :getter markup-markup)) -(define (bind-markup! node) - (hash-set! *node-table* - (markup-ident node) - ;(lambda (cur) (cons node cur)) - (list node))) - - -(define-method (initialize (self <markup>) initargs) - (next-method) - (bind-markup! self)) - - (define (markup? obj) (is-a? obj <markup>)) (define (markup-options obj) (slot-ref obj 'options)) (define markup-body node-body) @@ -280,9 +264,6 @@ -(define (find-markups ident) - (hash-ref *node-table* ident #f)) - (define-method (write (obj <markup>) port) (format port "#<~A (~A/~A) ~A>" @@ -299,7 +280,7 @@ (source (procedure-source proc)) (file (and source (source-property source 'filename))) (line (and source (source-property source 'line)))) - (format (current-error-port) "src=~a~%" source) + ;;(format (current-error-port) "src=~a~%" source) (string-append name (if file (string-append " " file @@ -358,12 +339,15 @@ (and (pair? c) (cadr c)))) -;;; ====================================================================== + ;;; -;;; <DOCUMENT> +;;; Document. ;;; -;;; ====================================================================== -(define-class <document> (<container>)) + +(define-class <document> (<container>) + (node-table :init-thunk make-hash-table :getter document-node-table) + (nodes-bound? :init-value #f :getter document-nodes-bound?)) + (define (document? obj) (is-a? obj <document>)) (define (document-ident obj) (slot-ref obj 'ident)) @@ -371,24 +355,60 @@ (define document-options markup-options) (define document-env container-env) +(define (document-lookup-node doc ident) + ;; Lookup the node with identifier IDENT (a string) in document DOC. + (hash-ref (document-node-table doc) ident)) + +(define (document-bind-node! doc node . ident) + ;; Bind NODE (a markup object) to DOC (a document object). + (let ((ident (if (null? ident) (markup-ident node) (car ident)))) + (if ident + (let ((handle (hash-get-handle (document-node-table doc) ident))) + ;;(format (current-error-port) "binding `~a' in `~a'~%" ident node) + (if (and (pair? handle) (not (eq? (cdr handle) node))) + (error "node identifier already bound" + (cdr handle)) ;; FIXME: use `raise' + (hash-set! (document-node-table doc) ident node)))))) + +(define (document-bind-nodes! doc) + ;; Bind all the nodes contained in DOC if they are not already bound. + ;; Once, this is done, `document-lookup-node' can be used to search a node + ;; by its identifier. + + ;; We assume that unresolved nodes do not introduce any new identifier, + ;; hence this optimization. + (if (document-nodes-bound? doc) + #t + (begin + (ast-fold (lambda (node result) + (if (markup? node) (document-bind-node! doc node)) + #t) + #t ;; unused + doc) + (slot-set! doc 'nodes-bound? #t)))) ;;; ;;; AST traversal utilities. ;;; +(define (ast-fold proc init ast) + ;; Apply PROC to each node in AST (per `node?'), in a way similar to `fold' + ;; (in SRFI-1). + (let loop ((ast ast) + (result init)) + (cond ((pair? ast) + (fold loop result ast)) + ((node? ast) + (loop (node-body ast) (proc ast result))) + (else result)))) + ;; The procedures below are almost unchanged compared to Skribe 1.2d's ;; `lib.scm' file found in the `common' directory, written by Manuel Serrano ;; (I removed uses of `with-debug' et al., though). -(define (find-markup-ident ident) - (let ((r (find-markups ident))) - (if (or (pair? r) (null? r)) - r - '()))) - (define (container-search-down pred obj) (let loop ((obj (markup-body obj))) (cond |