← Back to branch summary

~ubuntu-branches/ubuntu/hardy/texmacs/hardy

« back to all changes in this revision

Viewing changes to TeXmacs/progs/convert/tools/environment.scm

  • Committer: Bazaar Package Importer
  • Author(s): Ralf Treinen
  • Date: 2004-04-19 20:34:00 UTC
  • Revision ID: james.westby@ubuntu.com-20040419203400-g4e34ih0315wcn8v
Tags: upstream-1.0.3-R2
Import upstream version 1.0.3-R2

Show diffs side-by-side

added added

removed removed

Lines of Context:
TeXmacs/progs/convert/tools/environment.scm
 
1
 
 
2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
3
;;
 
4
;; MODULE      : environment.scm
 
5
;; DESCRIPTION : Converter environments.
 
6
;; COPYRIGHT   : (C) 2003  David Allouche
 
7
;;
 
8
;; This software falls under the GNU general public license and comes WITHOUT
 
9
;; ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for details.
 
10
;; If you don't have this file, write to the Free Software Foundation, Inc.,
 
11
;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
12
;;
 
13
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
14
 
 
15
(texmacs-module (convert tools environment)
 
16
  (:export environment environment-ref* environment-ref
 
17
           with-environment* with-environment
 
18
           initialize-xpath xpath-descend
 
19
           xpath-root xpath-parent xpath-current))
 
20
 
 
21
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
22
;; Converter environments
 
23
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
24
 
 
25
;; Environments are used by converters to accumulate dynamic state.
 
26
;;
 
27
;; By policy, an environment can only be mutated inside a bounded dynamic scope
 
28
;; (i.e. environment-set! must stay private).
 
29
;;
 
30
;; The intended semantics of environment is "functional operations on
 
31
;; hash-tables". However, for simplicity and efficiency a dynamic scoping
 
32
;; implementation is used.
 
33
;;
 
34
;; WARNING: environments are NOT continuation-correct. A continuation which
 
35
;; alters an environment is only garanteed to evaluate correctly _once_.
 
36
;;
 
37
;; WARNING: with-environment* does not restore the environment when it is
 
38
;; exited by stack unwinding (when an exception occurs).
 
39
;;
 
40
;; NOTE: a pure functional solution could be implemented using alists. If the
 
41
;; corner-case semantics of the hash-table based solution become problematic,
 
42
;; that should be the next thing to try. Since the list is not expected to grow
 
43
;; longer than a few dozen items, list lookup should not be a big problem.
 
44
;; Though a useful optimization may be adaptative ordering based on access
 
45
;; count.
 
46
 
 
47
;; Environment primitives
 
48
 
 
49
(define (environment)
 
50
  (make-ahash-table))
 
51
 
 
52
(define-macro (environment-set!* env key val) ; must stay private
 
53
  `(ahash-set! ,env ,key ,val))
 
54
 
 
55
(define-macro (environment-remove! env key) ; must stay private
 
56
  `(ahash-remove! ,env ,key))
 
57
 
 
58
(define (environment-ref* env key)
 
59
  (let ((h (ahash-get-handle env key)))
 
60
    (if h (cdr h)
 
61
        (texmacs-error "environment-ref*" "Unbound key ~S in environment: ~S"
 
62
                       key env))))
 
63
 
 
64
(define-macro (environment-ref env key)
 
65
  `(environment-ref* ,env (quote ,key)))
 
66
 
 
67
(define (environment-binding env key)
 
68
  ;; If @key is bound in @env returns (list @key value). Otherwise, return #f.
 
69
  ;; Unlike hash-get-handle, the return value is not mutable.
 
70
  (let ((h (ahash-get-handle env key)))
 
71
    (list key (and (pair? h) (list (cdr h))))))
 
72
 
 
73
;; Environment library (only use primitives)
 
74
 
 
75
(define (environment-bind! env binding) ; must stay private
 
76
  ;; Restore a binding previously saved with environment-binding.
 
77
  (if (second binding)      
 
78
      (environment-set!* env (first binding) (car (second binding)))
 
79
      (environment-remove! env (first binding))))
 
80
 
 
81
(define (with-environment* env bindings proc)
 
82
  (let ((saves '()) (result #f))
 
83
    (for-each (lambda (b)
 
84
                (set-cons! saves (environment-binding env (first b)))
 
85
                (environment-set!* env (first b) (second b)))
 
86
              bindings)
 
87
    (set! result (proc env))
 
88
    (for-each (lambda (b)
 
89
                (environment-bind! env b))
 
90
              saves)
 
91
    result))
 
92
 
 
93
(define-macro (with-environment env bindings . body)
 
94
  (if (not (list? bindings))
 
95
      (syntax-error "with-environment" "Bindings are not a list: ~A" bindings))
 
96
  `(with-environment* ,env
 
97
       (list ,@(map-in-order
 
98
                (lambda (b)
 
99
                  (if (not (list-length=2? b))
 
100
                      (syntax-error "with-environment"
 
101
                                    "Ill-formed binding: ~A" b))
 
102
                  `(list (quote ,(first b)) ,(second b)))
 
103
                bindings))
 
104
    (lambda (,env) ,@body)))
 
105
 
 
106
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
107
;; XPath environment
 
108
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
109
 
 
110
;; Currently, the xpath environment only stores the parent node.
 
111
;; Eventually, it should store an inverse list of ancestor nodes.
 
112
 
 
113
(define (initialize-xpath env root proc)
 
114
  (with-environment* env `((xpath:root ,root)
 
115
                           (xpath:parent #f)
 
116
                           (xpath:current ,root))
 
117
    proc))
 
118
 
 
119
(define (xpath-descend env child proc)
 
120
  (with-environment* env `((xpath:parent ,(xpath-current env))
 
121
                           (xpath:current ,child))
 
122
    proc))
 
123
 
 
124
(define (xpath-root env)
 
125
  (environment-ref env xpath:root))
 
126
(define (xpath-parent env)
 
127
  (environment-ref env xpath:parent))
 
128
(define (xpath-current env)
 
129
  (environment-ref env xpath:current))