aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/ast.scm98
-rw-r--r--src/guile/skribilo/output.scm12
-rw-r--r--src/guile/skribilo/resolve.scm76
-rw-r--r--src/guile/skribilo/utils/compat.scm39
4 files changed, 151 insertions, 74 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
diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm
index 7a49fd1..a33c040 100644
--- a/src/guile/skribilo/output.scm
+++ b/src/guile/skribilo/output.scm
@@ -1,6 +1,6 @@
;;; output.scm -- Skribilo output stage.
;;;
-;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
@@ -32,8 +32,10 @@
:use-module (skribilo condition)
:use-module (srfi srfi-35)
:use-module (srfi srfi-34)
+ :use-module (srfi srfi-39)
:export (output
+ *document-being-output*
&output-error &output-unresolved-error &output-writer-error
output-error? output-unresolved-error? output-writer-error?))
@@ -85,6 +87,10 @@
;;; Output method.
;;;
+;; The document being output. Note: This is only meant to be used by the
+;; compatibility layer in order to implement things like `find-markups'!
+(define *document-being-output* (make-parameter #f))
+
(define-generic out)
(define (%out/writer n e w)
@@ -122,6 +128,10 @@
(define-method (out node e)
#f)
+(define-method (out (node <document>) e)
+ ;; Only needed by the compatibility layer.
+ (parameterize ((*document-being-output* node))
+ (next-method)))
(define-method (out (node <pair>) e)
(let loop ((n* node))
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index 224bc06..c2e2c35 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -1,7 +1,7 @@
;;; resolve.scm -- Skribilo reference resolution.
;;;
-;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -33,6 +33,7 @@
:export (resolve! resolve-search-parent resolve-children resolve-children*
find1 resolve-counter resolve-parent resolve-ident
+ *document-being-resolved*
&resolution-error resolution-error?
&resolution-orphan-error resolution-orphan-error?
@@ -80,6 +81,10 @@
;;; Resolving nodes.
;;;
+;; The document being resolved. Note: This is only meant to be used by the
+;; compatibility layer in order to implement things like `find-markups'!
+(define *document-being-resolved* (make-parameter #f))
+
(define *unresolved* (make-parameter #f))
(define-generic do-resolve!)
@@ -95,6 +100,13 @@
(define (resolve! ast engine env)
(with-debug 3 'resolve
(debug-item "ast=" ast)
+
+ (if (document? ast)
+ ;; Bind nodes prior to resolution so that unresolved nodes can
+ ;; lookup nodes by identifier using `document-lookup-node' or
+ ;; `resolve-ident'.
+ (document-bind-nodes! ast))
+
(parameterize ((*unresolved* #f))
(let Loop ((ast ast))
(*unresolved* #f)
@@ -187,16 +199,17 @@
(define-method (do-resolve! (node <document>) engine env0)
- (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)))
- node)
+ (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)))
+ node))
(define-method (do-resolve! (node <unresolved>) engine env)
@@ -209,7 +222,8 @@
(res (proc node engine env))
(loc (ast-loc node)))
(when (ast? res)
- (ast-loc-set! res loc))
+ (ast-loc-set! res loc)
+ (slot-set! res 'parent (assq 'parent env)))
(debug-item "res=" res)
(*unresolved* #t)
res)))
@@ -289,12 +303,19 @@
(set-car! (cdr c) (+ 1 num))
(+ 1 num)))))))
-;;;; ======================================================================
-;;;;
-;;;; RESOLVE-IDENT
-;;;;
-;;;; ======================================================================
+
+;;;
+;;; `resolve-ident'.
+;;;
+;;; This function kind of sucks because the document where IDENT is to be
+;;; searched is not explictly passed. Thus, using `document-lookup-node' is
+;;; recommended instead of using this function.
+;;;
+
(define (resolve-ident ident markup n e)
+ ;; Search for a node with identifier IDENT and markup type MARKUP. N is
+ ;; typically an `<unresolved>' node and the node lookup should be performed
+ ;; in its parent document. E is the "environment" (an alist).
(with-debug 4 'resolve-ident
(debug-item "ident=" ident)
(debug-item "markup=" markup)
@@ -303,15 +324,10 @@
(raise (condition (&invalid-argument-error ;; type error
(proc-name "resolve-ident")
(argument ident))))
- (let ((mks (find-markups ident)))
- (and mks
- (if (not markup)
- (car mks)
- (let loop ((mks mks))
- (cond
- ((null? mks)
- #f)
- ((is-markup? (car mks) markup)
- (car mks))
- (else
- (loop (cdr mks)))))))))))
+ (let* ((doc (ast-document n))
+ (result (and doc (document-lookup-node doc ident))))
+ (if (or (not markup)
+ (and (markup? result) (eq? (markup-markup result) markup)))
+ result
+ #f)))))
+
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index c8c3bd0..118f294 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -25,15 +25,18 @@
:use-module (skribilo parameters)
:use-module (skribilo evaluator)
:use-module (srfi srfi-1)
- :autoload (srfi srfi-13) (string-rindex)
+ :autoload (srfi srfi-13) (string-rindex)
:use-module (srfi srfi-34)
:use-module (srfi srfi-35)
:use-module (ice-9 optargs)
- :autoload (skribilo ast) (ast?)
+ :autoload (skribilo ast) (ast? document? document-lookup-node)
:autoload (skribilo condition) (file-search-error? &file-search-error)
- :autoload (skribilo reader) (make-reader)
- :autoload (skribilo lib) (type-name)
+ :autoload (skribilo reader) (make-reader)
+ :autoload (skribilo lib) (type-name)
+ :autoload (skribilo resolve) (*document-being-resolved*)
+ :autoload (skribilo output) (*document-being-output*)
:use-module (skribilo debug)
+
:re-export (file-size) ;; re-exported from `(skribilo utils files)'
:replace (gensym))
@@ -178,6 +181,34 @@
;;;
+;;; Node lookup (formerly provided by `ast.scm').
+;;;
+
+(define-public (bind-markup! node)
+ (let ((doc (or (*document-being-resolved*)
+ (*document-being-output*))))
+ (if (document? doc)
+ (document-bind-node! doc node)
+ (error "Sorry, unable to achieve `bind-markup!'. Use `document-bind-node!' instead."
+ node))))
+
+(define-public (find-markups ident)
+ (let ((doc (or (*document-being-resolved*)
+ (*document-being-output*))))
+ (if (document? doc)
+ (let ((result (document-lookup-node doc ident)))
+ (if result
+ (list result)
+ #f))
+ (error "Sorry, unable to achieve `find-markups'. Use `document-lookup-node' instead."
+ ident))))
+
+(define-public (find-markup-ident ident)
+ (or (find-markups ident) '()))
+
+
+
+;;;
;;; Debugging facilities.
;;;
generated by cgit v1.2.3 (git 2.45.2) at 2024-11-20 08:57:52 +0000