1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
guile/module/sxml/apply-templates.scm
Ludovic Courtès e2ed33ef04
Remove unnecessary module imports.
These were found with:

  make GUILE_WARNINGS='-W1 -Wunused-module'

* module/ice-9/copy-tree.scm:
* module/ice-9/eval-string.scm:
* module/ice-9/getopt-long.scm:
* module/ice-9/poll.scm:
* module/ice-9/popen.scm:
* module/ice-9/sandbox.scm:
* module/ice-9/threads.scm:
* module/sxml/apply-templates.scm:
* module/sxml/simple.scm:
* module/system/base/types.scm:
* module/system/repl/command.scm:
* module/system/repl/common.scm:
* module/system/repl/coop-server.scm:
* module/system/repl/debug.scm:
* module/system/repl/error-handling.scm:
* module/system/repl/repl.scm:
* module/system/repl/server.scm:
* module/system/vm/assembler.scm:
* module/system/vm/disassembler.scm:
* module/system/vm/dwarf.scm:
* module/system/vm/elf.scm:
* module/system/vm/frame.scm:
* module/system/vm/inspect.scm:
* module/system/vm/linker.scm:
* module/system/vm/program.scm:
* module/system/vm/trace.scm:
* module/system/vm/trap-state.scm:
* module/system/vm/traps.scm:
* module/system/xref.scm:
* module/texinfo/indexing.scm:
* module/texinfo/plain-text.scm:
* module/texinfo/reflection.scm:
* module/texinfo/string-utils.scm:
* module/web/client.scm:
* module/web/http.scm:
* module/web/request.scm:
* module/web/response.scm: Remove imports of unused modules.
2023-02-24 16:49:00 +01:00

100 lines
3.8 KiB
Scheme
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; (sxml apply-templates) -- xslt-like transformation for sxml
;;;;
;;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;; Copyright 2004 by Andy Wingo <wingo at pobox dot com>.
;;;; Written 2003 by Oleg Kiselyov <oleg at pobox dot com> as apply-templates.scm.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;
;;; Commentary:
;;
;; Pre-order traversal of a tree and creation of a new tree:
;;
;;@smallexample
;; apply-templates:: tree x <templates> -> <new-tree>
;;@end smallexample
;; where
;;@smallexample
;; <templates> ::= (<template> ...)
;; <template> ::= (<node-test> <node-test> ... <node-test> . <handler>)
;; <node-test> ::= an argument to node-typeof? above
;; <handler> ::= <tree> -> <new-tree>
;;@end smallexample
;;
;; This procedure does a @emph{normal}, pre-order traversal of an SXML
;; tree. It walks the tree, checking at each node against the list of
;; matching templates.
;;
;; If the match is found (which must be unique, i.e., unambiguous), the
;; corresponding handler is invoked and given the current node as an
;; argument. The result from the handler, which must be a @code{<tree>},
;; takes place of the current node in the resulting tree.
;;
;; The name of the function is not accidental: it resembles rather
;; closely an @code{apply-templates} function of XSLT.
;;
;;; Code:
(define-module (sxml apply-templates)
#:use-module ((sxml xpath) :hide (filter))
#:export (apply-templates))
(define (apply-templates tree templates)
; Filter the list of templates. If a template does not
; contradict the given node (that is, its head matches
; the type of the node), chop off the head and keep the
; rest as the result. All contradicting templates are removed.
(define (filter-templates node templates)
(cond
((null? templates) templates)
((not (pair? (car templates))) ; A good template must be a list
(filter-templates node (cdr templates)))
(((node-typeof? (caar templates)) node)
(cons (cdar templates) (filter-templates node (cdr templates))))
(else
(filter-templates node (cdr templates)))))
; Here <templates> ::= [<template> | <handler>]
; If there is a <handler> in the above list, it must
; be only one. If found, return it; otherwise, return #f
(define (find-handler templates)
(and (pair? templates)
(cond
((procedure? (car templates))
(if (find-handler (cdr templates))
(error "ambiguous template match"))
(car templates))
(else (find-handler (cdr templates))))))
(let loop ((tree tree) (active-templates '()))
;(cout "active-templates: " active-templates nl "tree: " tree nl)
(if (nodeset? tree)
(map-union (lambda (a-tree) (loop a-tree active-templates)) tree)
(let ((still-active-templates
(append
(filter-templates tree active-templates)
(filter-templates tree templates))))
(cond
;((null? still-active-templates) '())
((find-handler still-active-templates) =>
(lambda (handler) (handler tree)))
((not (pair? tree)) '())
(else
(loop (cdr tree) still-active-templates)))))))
;;; arch-tag: 88cd87de-8825-4ab3-9721-cf99694fb787
;;; templates.scm ends here