Module: ddo-txpath

 XPath implementation with distinct document order support

 This software is in Public Domain.
 IT IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND.

 Please send bug reports and comments to:
   lizorkin@hotbox.ru    Dmitry Lizorkin


Miscellaneous
f: ddo:or
f: ddo:foldr
f: ddo:type-nodeset
f: ddo:type-number
f: ddo:type-string
f: ddo:type-boolean
f: ddo:type-any
Comparison for nodesets
f: ddo:nset-contained?
f: ddo:nset-equal?

Different cases of nodeset filtering
Filtering pos-result with (position-based) predicates and combining
f: ddo:pos-result-forward?
f: ddo:pos-result->nodeset
f: ddo:location-step-pos
Implementation for location step for the other cases
f: ddo:location-step-non-intersect
f: ddo:location-step-non-pos
Implementations for FilterExpr
f: ddo:filter-expr-general
f: ddo:filter-expr-non-pos
f: ddo:filter-expr-special-predicate

Uniting context-sets, preserving distinct document order
f: ddo:all-contexts-in-doc
f: ddo:unite-2-contextsets
f: ddo:unite-multiple-context-sets

Optimizing special predicates like [position()=1] and the like
f: ddo:list-tail
f: ddo:list-head
f: ddo:list-ref
Checks for a special structure of the predicate in its AST representation
f: ddo:check-ast-position?
f: ddo:check4ast-number
f: ddo:check-special-predicate

Some simple rewrites for XPath AST
f: ddo:check-ast-desc-os?
f: ddo:rewrite-step*

Optimization for deeply nested predicates
f: ddo:generate-pred-id
Search for predicate values
f: ddo:get-pred-value
f: ddo:get-pred-value-pos
f: ddo:get-abs-lpath-value
Construct predicate values
f: ddo:construct-pred-values
f: ddo:construct-pred-values-pos
f: ddo:vector-copy-set
f: ddo:add-vector-to-var-binding
Methods similar to radix sort for linear access time for all variables
f: ddo:charlst->branch
f: ddo:add-var-to-tree
f: ddo:var-binding->tree
f: ddo:get-var-value-from-tree

XPath AST processing
f: ddo:ast-axis-specifier
f: ddo:ast-location-path
f: ddo:ast-absolute-location-path
f: ddo:ast-relative-location-path
f: ddo:ast-step
f: ddo:ast-step-list
f: ddo:ast-predicate
f: ddo:ast-predicate-list
f: ddo:ast-expr
f: ddo:apply-ast-procedure
f: ddo:ast-or-expr
f: ddo:ast-and-expr
f: ddo:ast-equality-expr
f: ddo:ast-relational-expr
f: ddo:ast-additive-expr
f: ddo:ast-multiplicative-expr
f: ddo:ast-union-expr
f: ddo:ast-path-expr
f: ddo:ast-filter-expr
f: ddo:ast-variable-reference
f: ddo:ast-literal
f: ddo:ast-number
f: ddo:ast-function-call
f: ddo:ast-function-arguments

Highest level API functions
f: ddo:api-helper
f: ddo:txpath
f: ddo:xpath-expr
f: ddo:sxpath

Miscellaneous


ddo:or

(define (ddo:or . args)
... Full Code ... )
 Implement 'or' as a function, so that we could 'apply' it


ddo:foldr

(define (ddo:foldr op init lst)
... Full Code ... )
  (if (null? lst)
      init
      (ddo:foldl op (op (car lst) init) (cdr lst))))


ddo:type-nodeset

(define ddo:type-nodeset
... Full Code ... )
 Definition of types


ddo:type-number

(define ddo:type-number
... Full Code ... )


ddo:type-string

(define ddo:type-string
... Full Code ... )


ddo:type-boolean

(define ddo:type-boolean
... Full Code ... )


ddo:type-any

(define ddo:type-any
... Full Code ... )



Comparison for nodesets

 In order to compare nodesets produced by conventional SXPath and SXPath with
 distinct document order support, we must take into account that members in
 each of the nodesets being compared can be ordered differently.

ddo:nset-contained?

(define (ddo:nset-contained? nodeset1 nodeset2)
... Full Code ... )
 Whether all members from the first nodeset are contained in the second
 nodeset


ddo:nset-equal?

(define (ddo:nset-equal? nodeset1 nodeset2)
... Full Code ... )



Different cases of nodeset filtering



Filtering pos-result with (position-based) predicates and combining

 a filtered pos-result into a distinct document order nodeset
  pos-result ::= (listof pos-nodeset)
  pos-nodeset ::= (listof (cons node order-num))
 Each pos-nodeset is a result of applying the axis to a single node in the
 input nodeset. Pos-result can be informally considered as
  (map axis-pos input-nodeset)
 Each node in the pos-nodeset comes with its order number. An order-num is
 an integer, possibly a negative one. A node precedes another node in
 document order if the order-num of the former node is less than the order-num
 of the latter node. Equal order-nums (in different pos-nodesets) correspond
 to equal nodes.
 Each pos-nodeset is sorted in accordance with the position() of each of its
 members. Consequently, order-nums increase within pos-nodeset for forward
 XPath axes and decrease for reverse XPath axes.

ddo:pos-result-forward?

(define (ddo:pos-result-forward? pos-result)
... Full Code ... )
 Whether pos-result in a forward order
 Return #t if in document order, #f if in reverse document order


ddo:pos-result->nodeset

(define (ddo:pos-result->nodeset pos-result)
... Full Code ... )
 Unites pos-result into a nodeset in distinct document order


ddo:location-step-pos

(define (ddo:location-step-pos pos-axis-impl pred-impl-lst)
... Full Code ... )
  pos-axis-impl ::= lambda
  pred-impl-lst ::= (listof lambda)
 Every predicate is called with respect to each node
 Returns:  lambda
  lambda ::= (lambda (nodeset position+size var-binding) ...)



Implementation for location step for the other cases


ddo:location-step-non-intersect

(define (ddo:location-step-non-intersect axis-impl pred-impl-lst)
... Full Code ... )
 A location step for the axis which doesn't return a result in the form of
 a pos-nodeset, but instead resulting nodesets for each input node are in
 document order
  pos-axis-impl ::= lambda
  pred-impl-lst ::= (listof lambda)
 Every predicate is called with respect to each node
 Returns:  lambda
  lambda ::= (lambda (nodeset position+size var-binding) ...)
 This function is somewhat similar to 'sxml:xpath-nodeset-filter' from
 "txpath.scm"


ddo:location-step-non-pos

(define (ddo:location-step-non-pos axis-impl pred-impl-lst)
... Full Code ... )
 A location step doesn't contain position-based predicates



Implementations for FilterExpr


ddo:filter-expr-general

(define (ddo:filter-expr-general expr-impl pred-impl-lst)
... Full Code ... )
 Implementing FilterExpr in the general case, for position-based predicates


ddo:filter-expr-non-pos

(define (ddo:filter-expr-non-pos expr-impl pred-impl-lst)
... Full Code ... )
 A FilterExpr doesn't contain position-based predicates
 NOTE: This function is very similar to 'ddo:location-step-non-pos'
  Should think of combining them.


ddo:filter-expr-special-predicate

(define (ddo:filter-expr-special-predicate expr-impl special-pred-impl)
... Full Code ... )
  Filter expression, with a single predicate of the special structure, like
  [position()=1]
 special-pred-impl ::= (lambda (nodeset) ...)  - filters the nodeset



Uniting context-sets, preserving distinct document order

 Is required for XPath UnionExpr

ddo:all-contexts-in-doc

(define (ddo:all-contexts-in-doc doc)
... Full Code ... )
 Returns all contexts of the document, including the ones for attribute nodes
 and for attribute value nodes. All contexts are returned in document order,
 attribute value nodes immediately follow attribute nodes


ddo:unite-2-contextsets

(define (ddo:unite-2-contextsets cntset1 cntset2)
... Full Code ... )
 Every context in both context-sets must contain all the ancestors of the
 context node (this corresponds to the num-ancestors=#f)
 All nodes must have one and the same root node (i.e. this function cannot
 correctly unite context-sets whose members belong to different documents)
 Returns the context-set that is a distinct-document-order union of the
 argument context-sets


ddo:unite-multiple-context-sets

(define (ddo:unite-multiple-context-sets . context-sets)
... Full Code ... )
 Based on the function for uniting 2 context-sets, unites multiple
 context-sets



Optimizing special predicates like [position()=1] and the like


ddo:list-tail

(define (ddo:list-tail lst k)
... Full Code ... )
 Similar to R5RS list-tail, but returns an empty list when k > (length lst)


ddo:list-head

(define (ddo:list-head lst k)
... Full Code ... )
 Takes the first k members of the list
 The whole list is taken when k > (length lst)


ddo:list-ref

(define (ddo:list-ref lst k)
... Full Code ... )
 Similar to R5RS list-tail, but returns an empty list when
 (or (< k 0) (> k (length lst))



Checks for a special structure of the predicate in its AST representation


ddo:check-ast-position?

(define ddo:check-ast-position?
... Full Code ... )
 Checks whether the given op is the AST representation to a function call
 to position()


ddo:check4ast-number

(define (ddo:check4ast-number op)
... Full Code ... )
 If the given op is the AST representation for a number and this number is
 exact, returns this number. Otherwise returns #f


ddo:check-special-predicate

(define (ddo:check-special-predicate op)
... Full Code ... )
  In case when the predicate has one of the following forms:
 SpecialPredicate ::= [ Number ]
                      | [ position() CmpOp Number ]
                      | [ Number CmpOp position() ]
 CmpOp ::= > | < | >= | <= | =
 Number - an integer
  than returns (lambda (nodeset) ...), where the lambda performs the required
  filtering as specified by the predicate.
  For a different sort of a predicate, returns #f
  The function doesn't signal of any semantic errors.



Some simple rewrites for XPath AST


ddo:check-ast-desc-os?

(define ddo:check-ast-desc-os?
... Full Code ... )
 Whether a given AST node is the representation of the location step
 "descendant-or-self::node()", which is the full syntax for its abbreviated
 equivalent "//"


ddo:rewrite-step*

(define (ddo:rewrite-step* op-lst)
... Full Code ... )
 Rewrites the sequence of location steps, by combining the two consecutive
 steps "//para" into a single one "descendant::para"
 Returns the reconstructed list of steps



Optimization for deeply nested predicates

 For predicates whose level of nesting exceeds 3, these predicates are likely
 to be called for more than n^3 times, where n is the number of nodes in an
 SXML document being processed. For such predicates, it is desirable to
 evaluate them in advance, for every combination of context node, context
 position and context size (the latter two components are not even required
 if the predicate doesn't use position).
 Such an optimization allows achieving a polinomial-time complexity for any
 XPath expression

ddo:generate-pred-id

(define (ddo:generate-pred-id)
... Full Code ... )



Search for predicate values

 Predicate values are added to var-binding

ddo:get-pred-value

(define (ddo:get-pred-value pred-id)
... Full Code ... )
 Predicate value for a predicate that doesn't require position
 Predicate values are stored in the form of
 pred-values ::= (listof  (cons  node  pred-value))
 NOTE: A node (and not a context) is used as a key in the alist


ddo:get-pred-value-pos

(define (ddo:get-pred-value-pos pred-id)
... Full Code ... )
 Predicate value for a predicate that requires position
 Predicate values are stored in the form of
 pred-values ::=
        (listof
         (cons node
               (listof
                (cons size
                      (listof
                       (cons position pred-value))))))
 NOTE: A node (and not a context) is used as a key in the alist


ddo:get-abs-lpath-value

(define (ddo:get-abs-lpath-value pred-id)
... Full Code ... )
 Value that results from evaluating the absolute location path
 The argument is named `pred-id' for the sake of mere unification with
 deep predicates



Construct predicate values


ddo:construct-pred-values

(define (ddo:construct-pred-values pred-impl context-set var-binding)
... Full Code ... )
 Construct alist of values for a predicate that doesn't require position
 pred-impl - lambda that implements the predicate
 context-set - set of contexts for all nodes in the source document
 var-bindings - include variables supplied by user and the ones formed by
  deeper level predicates


ddo:construct-pred-values-pos

(define (ddo:construct-pred-values-pos pred-impl context-set var-binding max-size)
... Full Code ... )
 Construct alist of values for a predicate that requires position
  pred-impl - lambda that implements the predicate
  context-set - set of contexts for all nodes in the source document
  var-bindings - include variables supplied by user and the ones formed by
 deeper level predicates
  max-size - maximal context size possible in the document


ddo:vector-copy-set

(define (ddo:vector-copy-set vect k obj)
... Full Code ... )
 is replaced with `obj'


ddo:add-vector-to-var-binding

(define (ddo:add-vector-to-var-binding vars2offsets deep-predicates doc var-binding)
... Full Code ... )
 Extends `var-binding' with a vector data structure for binding variable
 values and values for deep predicates.
 Returns extended var-binding, which is constructed as follows:
 (cons (cons '*var-vector* ,vector)
       var-binding)



Methods similar to radix sort for linear access time for all variables


ddo:charlst->branch

(define (ddo:charlst->branch lst value)
... Full Code ... )
 Represents a list of chars as a branch in the string-tree
 The list of chars must be non-empty


ddo:add-var-to-tree

(define (ddo:add-var-to-tree var-name var-value tree)
... Full Code ... )
 Adds a new string to string-tree


ddo:var-binding->tree

(define (ddo:var-binding->tree var-binding)
... Full Code ... )
 Convert var-binding to their tree representation
 var-binding is supposed to be non-null


ddo:get-var-value-from-tree

(define (ddo:get-var-value-from-tree var-name tree)
... Full Code ... )
 Obtain variable value from the tree



XPath AST processing

 AST is considered to be properly formed
 In the signature of functions below, the following terms are taken:
  op - S-expression which represents the operation
  num-anc - how many ancestors are required in the context after that
   operation

ddo:ast-axis-specifier

(define (ddo:ast-axis-specifier op num-anc single-level? requires-position?)
... Full Code ... )
 {5} <AxisSpecifier> ::= (axis-specifier  <AxisName> )
 {6} <AxisName> ::= (ancestor)
                    | (ancestor-or-self)
                    | (attribute)
                    | (child)
                    | (descendant)
                    | (descendant-or-self)
                    | (following)
                    | (following-sibling)
                    | (namespace)
                    | (parent)
                    | (preceding)
                    | (preceding-sibling)
                    | (self)

 single-level? - whether all nodes in the input nodeset are located on the
  same level of tree hierarchy
 requires-position? - whether context position or context size are required to
  filter the result produced by the axis

 For requires-position?=#f, the function returns
  (list  axis-lambda
         num-anc-it-requires
         single-level?)
 For requires-position?=#t, the function returns
  (list  axis-lambda
         num-anc-it-requires
         single-level?
         pos-result?)
  single-level? - whether nodes are in the single level after the axis
  pos-result? - whether the result of the axis has the form of pos-result.
   If #f, the axis returns its result in the form of the common nodeset


ddo:ast-location-path

(define (ddo:ast-location-path op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
                        | <AbsoluteLocationPath>


ddo:ast-absolute-location-path

(define (ddo:ast-absolute-location-path op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {2} <AbsoluteLocationPath> ::= (absolute-location-path  <Step>* )
 NOTE: single-level? is dummy here, since AbsoluteLocationPath always
 starts from a single node - the root of the document


ddo:ast-relative-location-path

(define (ddo:ast-relative-location-path op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {3} <RelativeLocationPath> ::= (relative-location-path  <Step>+ )


ddo:ast-step

(define (ddo:ast-step op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {4} <Step> ::= (step  <AxisSpecifier> <NodeTest> <Predicate>* )
                | (range-to  (expr <Expr>)  <Predicate>* )


ddo:ast-step-list

(define (ddo:ast-step-list step-lst num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {4a} ( <Step>+ )
 Returns (list (listof step-impl)
               num-anc single-level? requires-position? expr-type
               deep-predicates vars2offsets)
 or #f
 TECHNICAL NOTE: To calculate 'single-level?', we need to process steps in
 straight orger. To calculate 'num-anc', we need to process steps in reverse
 order. This thus has to be implemented in 2 passes


ddo:ast-predicate

(define (ddo:ast-predicate op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {8} <Predicate> ::= (predicate  <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for Predicates
 NOTE: single-level? is dummy here, since a Predicate is always called for
  a single node to be filtered
 NOTE: Unlike 'draft:ast-predicate', we don't implement any filtering here,
  because it depends on the particular axis in the step. Filtering is
  performed on the higher level


ddo:ast-predicate-list

(define (ddo:ast-predicate-list op-lst num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {8a} ( <Predicate>+ )
 Returns (list (listof pred-impl)
               num-anc single-level? requires-position? expr-type
               deep-predicates)
 or #f
 NOTE: num-anc is dummy here, since it is always 0 for Predicates
 NOTE: single-level? is dummy here, since a Predicate is always called for
  a single node to be filtered
 NOTE: information about the type for each Predicate is lost


ddo:ast-expr

(define (ddo:ast-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {9} <Expr> ::= <OrExpr>
                | <AndExpr>
                | <EqualityExpr>
                | <RelationalExpr>
                | <AdditiveExpr>
                | <MultiplicativeExpr>
                | <UnionExpr>
                | <PathExpr>
                | <FilterExpr>
                | <VariableReference>
                | <Literal>
                | <Number>
                | <FunctionCall>
                | <LocationPath>


ddo:apply-ast-procedure

(define (ddo:apply-ast-procedure ast-procedure op-lst num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 Applies AST processing to a list of operations


ddo:ast-or-expr

(define (ddo:ast-or-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {10} <OrExpr> ::= (or <Expr> <Expr>+ )
 NOTE: num-anc is dummy here, since it is always 0 for OrExpr


ddo:ast-and-expr

(define (ddo:ast-and-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {11} <AndExpr> ::= (and <Expr> <Expr>+ )
 NOTE: num-anc is dummy here, since it is always 0 for AndExpr


ddo:ast-equality-expr

(define (ddo:ast-equality-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {12} <EqualityExpr> ::= (=  <Expr> <Expr> )
                         | (!=  <Expr> <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for EqualityExpr


ddo:ast-relational-expr

(define (ddo:ast-relational-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {13} <RelationalExpr> ::= (<  <Expr> <Expr> )
                           | (>  <Expr> <Expr> )
                           | (<=  <Expr> <Expr> )
                           | (>=  <Expr> <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for RelationalExpr


ddo:ast-additive-expr

(define (ddo:ast-additive-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {14} <AdditiveExpr> ::= (+  <Expr> <Expr> )
                         | (-  <Expr> <Expr>? )
 NOTE: num-anc is dummy here, since it is always 0 for AdditiveExpr


ddo:ast-multiplicative-expr

(define (ddo:ast-multiplicative-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {15} <MultiplicativeExpr> ::= (*  <Expr> <Expr> )
                               | (div  <Expr> <Expr> )
                               | (mod  <Expr> <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for MultiplicativeExpr


ddo:ast-union-expr

(define (ddo:ast-union-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {16} <UnionExpr> ::= (union-expr  <Expr> <Expr>+ )
 TECHNICAL NOTE: For implementing the union while supporting distinct document
 order, we need num-ancestors=#f for the arguments of the union-expr. This
 operation is time-consuming and should be avoided


ddo:ast-path-expr

(define (ddo:ast-path-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {17} <PathExpr> ::= (path-expr  <FilterExpr> <Step>+ )
 TECHNICAL NOTE: To calculate 'single-level?', we need to process components
 in straight orger. To calculate 'num-anc', we need to process steps in
 reverse order. It is too expensive to make the 2 passes, that's why we
 consider single-level?=#f for steps


ddo:ast-filter-expr

(define (ddo:ast-filter-expr op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {18} <FilterExpr> ::= (filter-expr (primary-expr  <Expr> )
                                    <Predicate>* )


ddo:ast-variable-reference

(define (ddo:ast-variable-reference op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {19} <VariableReference> ::= (variable-reference  <String> )


ddo:ast-literal

(define (ddo:ast-literal op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {20} <Literal> ::= (literal  <String> )


ddo:ast-number

(define (ddo:ast-number op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {21} <Number> :: (number  <Number> )


ddo:ast-function-call

(define (ddo:ast-function-call op num-anc single-level? pred-nesting vars2offsets)
... Full Code ... )
 {22} <FunctionCall> ::= (function-call (function-name  <String> )
                                        (argument  <Expr> )* )


ddo:ast-function-arguments

(define (ddo:ast-function-arguments op-lst single-level? pred-nesting vars2offsets)
... Full Code ... )
 {22a} ( (argument  <Expr> )* )
 na-lst - number of ancestors required for each of the arguments
 Returns:  #f  or
  (listof 
    (list expr-impl num-anc single-level? requires-position? expr-type
          deep-predicates vars2offsets))
 NOTE: In XPath Core Function Library, none of the function arguments
 is required to save any ancestors in the context



Highest level API functions

 procedure ddo:sxpath :: query [ns-binding] [num-ancestors] ->
                          -> node-or-nodeset [var-binding] -> nodeset
 procedure ddo:txpath :: location-path [ns-binding] [num-ancestors] ->
                          -> node-or-nodeset [var-binding] -> nodeset

 Polynomial-time XPath implementation with distinct document order support.

 The API is identical to the API of a context-based SXPath (here we even use
 API helpers from "xpath-context.scm"). For convenience, below we repeat
 comments for the API (borrowed from "xpath-context.scm").

 query - a query in SXPath native syntax
 location-path - XPath location path represented as a string
 ns-binding - declared namespace prefixes (an optional argument)
  ns-binding ::= (listof (prefix . uri))
  prefix - a symbol
  uri - a string
 num-ancestors - number of ancestors required for resulting nodeset. Can
  generally be omitted and is than defaulted to 0, which denotes a
  _conventional_  nodeset. If a negative number, this signals that all
  ancestors should be remembered in the context.

 Returns: (lambda (node-or-nodeset . var-binding) ...)
 var-binding - XPath variable bindings (an optional argument)
  var-binding = (listof (var-name . value))
  var-name - (a symbol) a name of a variable
  value - its value. The value can have the following type: boolean, number,
  string, nodeset. NOTE: a node must be represented as a singleton nodeset.

 The result of applying the latter lambda to an SXML node or nodeset is the
 result of evaluating the query / location-path for that node / nodeset.

ddo:api-helper

(define (ddo:api-helper grammar-parser ast-parser)
... Full Code ... )
 Helper for constructing several highest-level API functions
 ns+na - can contain 'ns-binding' and/or 'num-ancestors' and/or none of them


ddo:txpath

(define ddo:txpath
... Full Code ... )


ddo:xpath-expr

(define ddo:xpath-expr
... Full Code ... )


ddo:sxpath

(define ddo:sxpath
... Full Code ... )


Code

ddo:or

Index
 Implement 'or' as a function, so that we could 'apply' it
(define (ddo:or . args)
  (if (null? args) #f (or (car args) (apply ddo:or (cdr args)))))

ddo:foldr

Index
  (if (null? lst)
      init
      (ddo:foldl op (op (car lst) init) (cdr lst))))
(define (ddo:foldr op init lst)
  (if (null? lst)
      init
      (op (car lst)
          (ddo:foldr op init (cdr lst)))))

ddo:type-nodeset

Index
 Definition of types
(define ddo:type-nodeset 'ddo:type-nodeset)

ddo:type-number

Index
(define ddo:type-number 'ddo:type-number)

ddo:type-string

Index
(define ddo:type-string 'ddo:type-string)

ddo:type-boolean

Index
(define ddo:type-boolean 'ddo:type-boolean)

ddo:type-any

Index
(define ddo:type-any 'ddo:type-any)

ddo:all-contexts-in-doc

Index
 Returns all contexts of the document, including the ones for attribute nodes
 and for attribute value nodes. All contexts are returned in document order,
 attribute value nodes immediately follow attribute nodes
(define (ddo:all-contexts-in-doc doc)
  (let iter-nodes ((contents (map
                              (lambda (kid) (list kid doc))
                              ((sxml:child sxml:node?) doc)))
                   (res (list doc)))
    (cond
      ((null? contents)  ; every content processed
       (reverse res))
      ((not ((ntype?? '*) (caar contents)))  ; text node or PI or etc.
       (iter-nodes (cdr contents)
                   (cons
                    (draft:make-context (caar contents) (cdar contents))
                    res)))
      (else  ; element node
       (let iter-attrs ((attrs (sxml:attr-list (caar contents)))
                        (res (cons
                              (draft:make-context
                               (caar contents) (cdar contents))
                              res)))
         (cond
           ((null? attrs)  ; all attributes of a given element processed
            (iter-nodes
             (append (map
                      (lambda (kid) (cons kid (car contents)))
                      ((sxml:child sxml:node?) (caar contents)))
                     (cdr contents))
             res))
           ((not (sxml:node? (car attrs)))  ; aux node of SXML 3.0
            (iter-attrs (cdr attrs) res))
           ((null? (cdar attrs))  ; singular attribute
            (iter-attrs (cdr attrs)
                        (cons
                         (draft:make-context (car attrs) (car contents))
                         res)))
           (else  ; an attribute has a value
            (iter-attrs
             (cdr attrs)
             (cons  ; attribute value
              (draft:make-context (cadar attrs)
                                  (cons (car attrs) (car contents)))
              (cons
               (draft:make-context (car attrs) (car contents))
               res))))))))))

ddo:unite-2-contextsets

Index
 Every context in both context-sets must contain all the ancestors of the
 context node (this corresponds to the num-ancestors=#f)
 All nodes must have one and the same root node (i.e. this function cannot
 correctly unite context-sets whose members belong to different documents)
 Returns the context-set that is a distinct-document-order union of the
 argument context-sets
(define (ddo:unite-2-contextsets cntset1 cntset2)
  (if
   (null? cntset1)  ; nothing to do
   cntset2
   (let loop ((order (ddo:all-contexts-in-doc
                      (draft:list-last
                       (sxml:context->content (car cntset1)))))
              (cntset1 cntset1)
              (cntset2 cntset2)
              (res '()))
     (cond
       ((null? cntset1)
        (append (reverse res) cntset2))
       ((null? cntset2)
        (append (reverse res) cntset1))
       ; order should never be null
       ((eq? (sxml:context->node (car order))
             (sxml:context->node (car cntset1)))
        (loop (cdr order)
              (cdr cntset1)
              (if (eq? (sxml:context->node (car cntset1))
                       (sxml:context->node (car cntset2)))
                  (cdr cntset2)
                  cntset2)
              (cons (car cntset1) res)))
       ((eq? (sxml:context->node (car order))
             (sxml:context->node (car cntset2)))
        (loop (cdr order)
              cntset1
              (cdr cntset2)              
              (cons (car cntset2) res)))
       (else
        (loop (cdr order) cntset1 cntset2 res))))))

ddo:unite-multiple-context-sets

Index
 Based on the function for uniting 2 context-sets, unites multiple
 context-sets
(define (ddo:unite-multiple-context-sets . context-sets)
  (if (null? context-sets)  ; nothing to do
      '()
      (let loop ((res (car context-sets))
                 (more (cdr context-sets)))
        (if (null? more)
            res
            (loop (ddo:unite-2-contextsets res (car more))
                  (cdr more))))))

ddo:list-tail

Index
 Similar to R5RS list-tail, but returns an empty list when k > (length lst)
(define (ddo:list-tail lst k)
  (if (or (null? lst) (<= k 0))
      lst
      (ddo:list-tail (cdr lst) (- k 1))))

ddo:list-head

Index
 Takes the first k members of the list
 The whole list is taken when k > (length lst)
(define (ddo:list-head lst k)
  (if (or (null? lst) (<= k 0))
      '()
      (cons (car lst) (ddo:list-head (cdr lst) (- k 1)))))

ddo:list-ref

Index
 Similar to R5RS list-tail, but returns an empty list when
 (or (< k 0) (> k (length lst))
(define (ddo:list-ref lst k)
  (cond ((null? lst) lst)
        ((zero? k) (car lst))
        (else (ddo:list-ref (cdr lst) (- k 1)))))

ddo:check-ast-desc-os?

Index
 Whether a given AST node is the representation of the location step
 "descendant-or-self::node()", which is the full syntax for its abbreviated
 equivalent "//"
(define ddo:check-ast-desc-os?
  (let ((ddo:ast-for-desc-os   ; evaluate just once
         (cadr  ; selects the first location step
          (txp:xpath->ast "//dummy"))))
    (lambda (op)
      (equal? op ddo:ast-for-desc-os))))

ddo:rewrite-step*

Index
 Rewrites the sequence of location steps, by combining the two consecutive
 steps "//para" into a single one "descendant::para"
 Returns the reconstructed list of steps
(define (ddo:rewrite-step* op-lst)
  (cond
    ((or (null? op-lst) (null? (cdr op-lst)))  ; nothing to rewrite
     op-lst)
    ; There are at least 2 steps in a sequence of steps
    ((and (ddo:check-ast-desc-os? (car op-lst))
          ; Next step uses a child axis specifier
          (equal? (txp:step-axis (cadr op-lst)) '(child))
          ; Next step doesn't use any predicates
          (null? (txp:step-preds (cadr op-lst))))
     (cons
      (txp:construct-step
       '(descendant)  ; rewrite into descendant axis
       (txp:step-node-test (cadr op-lst))  ; Node test of the next step
       )
      (ddo:rewrite-step* (cddr op-lst))))
    (else  ; Any other case
     (cons (car op-lst)
           (ddo:rewrite-step* (cdr op-lst))))))

ddo:generate-pred-id

Index
(define (ddo:generate-pred-id)
  (string->symbol
   (string-append "*predicate-" (symbol->string (gensym)) "*")))

ddo:ast-axis-specifier

Index
 {5} <AxisSpecifier> ::= (axis-specifier  <AxisName> )
 {6} <AxisName> ::= (ancestor)
                    | (ancestor-or-self)
                    | (attribute)
                    | (child)
                    | (descendant)
                    | (descendant-or-self)
                    | (following)
                    | (following-sibling)
                    | (namespace)
                    | (parent)
                    | (preceding)
                    | (preceding-sibling)
                    | (self)

 single-level? - whether all nodes in the input nodeset are located on the
  same level of tree hierarchy
 requires-position? - whether context position or context size are required to
  filter the result produced by the axis

 For requires-position?=#f, the function returns
  (list  axis-lambda
         num-anc-it-requires
         single-level?)
 For requires-position?=#t, the function returns
  (list  axis-lambda
         num-anc-it-requires
         single-level?
         pos-result?)
  single-level? - whether nodes are in the single level after the axis
  pos-result? - whether the result of the axis has the form of pos-result.
   If #f, the axis returns its result in the form of the common nodeset
(define (ddo:ast-axis-specifier op num-anc single-level? requires-position?)
  (cond
    ((not (eq? (car op) 'axis-specifier))  ; AST error
     (draft:signal-semantic-error "not an AxisSpecifier - " op))
    (requires-position?
     (case (caadr op)  ; AxisName
       ((ancestor)
        (list ddo:ancestor-pos
              #f #f #t))
       ((ancestor-or-self)
        (list ddo:ancestor-or-self-pos
              #f #f #t))
       ((attribute)
        (list draft:attribute
              (draft:na-minus-nneg num-anc 1) single-level? #f))
       ((child)
        (if single-level?
            (list draft:child
                  (draft:na-minus-nneg num-anc 1) #t #f)
            (list ddo:child-pos
                  (draft:na-minus-nneg num-anc 1) #f #t)))
       ((descendant)
        (if single-level?
            (list draft:descendant
                  (draft:na-minus-nneg num-anc 1) #f #f)
            (list ddo:descendant-pos
                  (draft:na-minus-nneg num-anc 1) #f #t)))
       ((descendant-or-self)
        (if single-level?
            (list draft:descendant-or-self
                  num-anc #f #f)
            (list ddo:descendant-or-self-pos
                  num-anc #f #t)))
       ((following)
        ; DL: this is incorrect for single-level?=#f
        (list ddo:following-single-level-pos
              #f #f #t))
       ((following-sibling)
        (list (if single-level?
                  ddo:following-sibling-single-level-pos
                  ddo:following-sibling-pos)
              (draft:na-max num-anc 1) single-level? #t))
       ((namespace)
        (list draft:namespace
              (draft:na-minus-nneg num-anc 1) single-level? #f))
       ((parent)
        (list (if single-level? ddo:parent-single-level-pos ddo:parent-pos)
              (draft:na+ num-anc 1) single-level? #t))
       ((preceding)
        ; DL: this is incorrect for single-level?=#f
        (list ddo:preceding-single-level-pos
              #f #f #t))
       ((preceding-sibling)
        (list (if single-level?
                  ddo:preceding-sibling-single-level-pos
                  ddo:preceding-sibling-pos)
              (draft:na-max num-anc 1) single-level? #t))
       ((self)
        (list draft:self num-anc single-level? #f))
       (else
        (draft:signal-semantic-error "unknown AxisName - " op))))
    (else  ; doesn't require to keep position
     (case (caadr op)  ; AxisName
       ((ancestor)
        (list ddo:ancestor #f #f))
       ((ancestor-or-self)
        (list ddo:ancestor-or-self #f #f))
       ((attribute)
        (list draft:attribute
              (draft:na-minus-nneg num-anc 1) single-level?))
       ((child)
        (list (if single-level? draft:child ddo:child)
              (draft:na-minus-nneg num-anc 1) single-level?))
       ((descendant)
        (list (if single-level? draft:descendant ddo:descendant)
              (draft:na-minus-nneg num-anc 1) #f))
       ((descendant-or-self)
        (list (if single-level?
                  draft:descendant-or-self ddo:descendant-or-self)
              num-anc #f))
       ((following)
        (list (if single-level? ddo:following-single-level ddo:following)
              #f #f))
       ((following-sibling)
        (list (if single-level?
                  ddo:following-sibling-single-level ddo:following-sibling)
              (draft:na-max num-anc 1) single-level?))
       ((namespace)
        (list draft:namespace
              (draft:na-minus-nneg num-anc 1) single-level?))
       ((parent)
        (list (if single-level? ddo:parent-single-level ddo:parent)
              (draft:na+ num-anc 1) single-level?))
       ((preceding)
        (list (if single-level? ddo:preceding-single-level ddo:preceding)
              #f #f))
       ((preceding-sibling)
        (list (if single-level?
                  ddo:preceding-sibling-single-level ddo:preceding-sibling)
              (draft:na-max num-anc 1) single-level?))
       ((self)
        (list draft:self num-anc single-level?))
       (else
        (draft:signal-semantic-error "unknown AxisName - " op))))))

ddo:ast-location-path

Index
                        | <AbsoluteLocationPath>
(define (ddo:ast-location-path
         op num-anc single-level? pred-nesting vars2offsets)
  (case (car op)
    ((absolute-location-path)
     (ddo:ast-absolute-location-path
      op num-anc single-level? pred-nesting vars2offsets))
    ((relative-location-path)
     (ddo:ast-relative-location-path
      op num-anc single-level? pred-nesting vars2offsets))
    (else
     (draft:signal-semantic-error "improper LocationPath - " op))))

ddo:ast-absolute-location-path

Index
 {2} <AbsoluteLocationPath> ::= (absolute-location-path  <Step>* )
 NOTE: single-level? is dummy here, since AbsoluteLocationPath always
 starts from a single node - the root of the document
(define (ddo:ast-absolute-location-path
         op num-anc single-level? pred-nesting vars2offsets)
  (cond
    ((not (eq? (car op) 'absolute-location-path))
     (draft:signal-semantic-error "not an AbsoluteLocationPath - " op))
    ((null? (cdr op))  ; no Steps
     (list
      (lambda (nodeset position+size var-binding)
        (draft:reach-root nodeset))
      #f  ; requires all ancestors
      #t  ; on single level
      #f  ; doesn't require position
      ddo:type-nodeset
      '()  ; no deep predicates
      vars2offsets
      ))
    (else
     (and-let*
      ((steps-res (ddo:ast-step-list
                   (cdr op) num-anc #t pred-nesting vars2offsets)))
      (let ((impl  ; implementation of the absolute location path
             (if
              (null? (cdar steps-res))  ; only a single step
              (let ((step-impl (caar steps-res)))
                (lambda (nodeset position+size var-binding)
                  (step-impl
                   (draft:reach-root nodeset) position+size var-binding)))
              (let ((converters (car steps-res)))
                (lambda (nodeset position+size var-binding)
                  (let rpt ((nset (draft:reach-root nodeset))
                            (fs converters))
                    (if (null? fs)
                        nset
                        (rpt ((car fs) nset position+size var-binding)
                             (cdr fs)))))))))
        (if
         (> pred-nesting 0)  ; absolute location path inside a predicate
         (let ((vars2offsets (list-ref steps-res 6)))
           (list
            (ddo:get-abs-lpath-value (car vars2offsets))
            #f  ; all ancestors required
            (caddr steps-res)  ; single-level
            #f  ; doesn't require position
            ddo:type-nodeset
            (cons
             (list (car vars2offsets)  ; identifier
                   'absolute-location-path  ; flag to denote absolute lpath
                   impl)
             (list-ref steps-res 5)  ; deep-predicates
             )
            (cons (+ (car vars2offsets) 1)
                  (cdr vars2offsets))))
         (cons impl
               (cons #f  ; all ancestors required
                     (cddr steps-res)   ; the remaining parameters
                     ))))))))

ddo:ast-relative-location-path

Index
 {3} <RelativeLocationPath> ::= (relative-location-path  <Step>+ )
(define (ddo:ast-relative-location-path
         op num-anc single-level? pred-nesting vars2offsets)
  (if
   (not (eq? (car op) 'relative-location-path))
   (draft:signal-semantic-error "not a RelativeLocationPath - " op)
   (and-let*
    ((steps-res
      (ddo:ast-step-list
       (cdr op) num-anc single-level? pred-nesting vars2offsets)))
    (cons
     (if
      (null? (cdar steps-res))  ; only a single step
      (caar steps-res)
      (let ((converters (car steps-res)))
        (lambda (nodeset position+size var-binding)
          (let rpt ((nset nodeset)
                    (fs converters))
            (if (null? fs)
                nset
                (rpt ((car fs) nset position+size var-binding)
                     (cdr fs)))))))
     (cdr steps-res)  ; the remaining parameters
     ))))

ddo:ast-step

Index
 {4} <Step> ::= (step  <AxisSpecifier> <NodeTest> <Predicate>* )
                | (range-to  (expr <Expr>)  <Predicate>* )
(define (ddo:ast-step op num-anc single-level? pred-nesting vars2offsets)
  (cond
    ((eq? (car op) 'range-to)
     (draft:signal-semantic-error "range-to function not implemented"))
    ((eq? (car op) 'filter-expr)
     (ddo:ast-filter-expr op num-anc single-level? pred-nesting vars2offsets))
    ((eq? (car op) 'lambda-step)  ; created by sxpath
     (let ((proc (cadr op)))
       (list
        (if
         (and num-anc (zero? num-anc))  ; no ancestors required
         (lambda (nodeset position+size var-binding)
           (proc (draft:contextset->nodeset (as-nodeset nodeset))
                 (if (and (pair? var-binding)  ; non-null
                          (eq? (caar var-binding) '*var-vector*))
                     (cdr var-binding) var-binding)))
         (lambda (nodeset position+size var-binding)
           (draft:find-proper-context
            (proc (draft:contextset->nodeset (as-nodeset nodeset))
                  (if (and (pair? var-binding)  ; non-null
                           (eq? (caar var-binding) '*var-vector*))
                      (cdr var-binding) var-binding))
            (map sxml:context->content   ; TODO: should add variables
                 (as-nodeset nodeset))
            num-anc)))
        num-anc  ; num-ancestors
        #f  ; single-level? after this step
        #f  ; position-required?
        ddo:type-any
        '()  ; no deep predicates
        vars2offsets
        )))
    ((eq? (car op) 'step)
     (if
      (null? (cdddr op))  ; no Predicates
      (and-let*
       ((axis-lst (ddo:ast-axis-specifier
                   (cadr op) num-anc single-level? #f))
        (ntest (draft:ast-node-test (caddr op))))
       (let ((axis ((car axis-lst) ntest num-anc)))
         (list
          (lambda (nodeset position+size var-binding)
            (axis nodeset))
          (cadr axis-lst)
          (caddr axis-lst)
          #f
          ddo:type-nodeset
          '()  ; no deep predicates
          vars2offsets
          )))
      ; There are Predicates
      (and-let*
       ((preds-res (ddo:ast-predicate-list
                    (cdddr op) 0 #t (+ pred-nesting 1) vars2offsets))
        (preds-res
         (if (and (list-ref preds-res 3)  ; position required for the predicate
                  (< pred-nesting 3))  ; level of nesting matters
             (ddo:ast-predicate-list  ; the second pass
              (cdddr op) 0 #t
              (+ pred-nesting 2)  ; called for quadratic number of times
              vars2offsets
              )
             preds-res  ; do not need to change anything
             ))
        (axis-lst (ddo:ast-axis-specifier
                   (cadr op)
                   (draft:na-max num-anc (cadr preds-res))
                   single-level?
                   (list-ref preds-res 3)  ; whether position required
                   ))
        (ntest (draft:ast-node-test (caddr op))))
       (let ((axis ((car axis-lst)
                    ntest (draft:na-max num-anc (cadr preds-res))))
             (pred-impl-lst (car preds-res)))
         (list
          (cond
            ((not (list-ref preds-res 3))  ; whether position required
             (ddo:location-step-non-pos axis pred-impl-lst))
            ((list-ref axis-lst 3)  ; pos-result?
             (ddo:location-step-pos axis pred-impl-lst))
            (else  ; non-intersect
             (ddo:location-step-non-intersect axis pred-impl-lst)))
          (cadr axis-lst)  ; num-ancestors
          (caddr axis-lst)  ; single-level? after this step
          #f  ; position-required?
          ddo:type-nodeset
          (list-ref preds-res 5)  ; deep predicates
          (list-ref preds-res 6)  ; new var-binding
          )))))
    (else
     (draft:signal-semantic-error "not a Step - " op))))

ddo:ast-step-list

Index
 {4a} ( <Step>+ )
 Returns (list (listof step-impl)
               num-anc single-level? requires-position? expr-type
               deep-predicates vars2offsets)
 or #f
 TECHNICAL NOTE: To calculate 'single-level?', we need to process steps in
 straight orger. To calculate 'num-anc', we need to process steps in reverse
 order. This thus has to be implemented in 2 passes
(define (ddo:ast-step-list
         step-lst num-anc single-level? pred-nesting vars2offsets)
  (let ((step-lst (ddo:rewrite-step* step-lst))
        ; Calculates single-level? for each step in the step-lst
        ; Returns: (listof single-level?)
        ; where each member of the REVERSED result list corresponds to the step
        ; in the corresponding position of a step-lst
        ; We can notice that when single-level?=#f for some step, it remains
        ; #f for all the subsequent steps
        (calculate-single-level
         (lambda (step-lst single-level?)
           (let iter-steps ((steps step-lst)
                            (sl? single-level?)
                            (res '()))
             (cond
               ((null? steps) res)
               ((or (memq (caar steps) '(range-to filter-expr lambda-step))
                    (not sl?))
                ; #f for the remaining steps
                (append (map
                         (lambda (step) #f)
                         steps)   ; DL: was: step-lst
                        res))
               (else  ; evaluate single-level? for the current step
                (and-let*
                 ((axis-lst (ddo:ast-axis-specifier
                             (cadar steps)  ; is to be axis specifier
                             0 sl? #f)))
                 (iter-steps (cdr steps)
                             (caddr axis-lst)  ; single-level for next step
                             (cons sl? res)))))))))
    (and-let*
     ((single-level-lst (calculate-single-level step-lst single-level?)))
     (let loop ((steps-to-view (reverse step-lst))
                (sl?-lst single-level-lst)
                (res-lst '())
                (num-anc num-anc)
                (deep-predicates '())
                (vars2offsets vars2offsets))
       (if
        (null? steps-to-view)  ; everyone processed
        (list res-lst
              num-anc (car single-level-lst) #f
              ddo:type-nodeset deep-predicates vars2offsets)
        (and-let*
         ((step-res
           (ddo:ast-step
            (car steps-to-view) num-anc (car sl?-lst)
            pred-nesting vars2offsets)))
         (loop
          (cdr steps-to-view)
          (cdr sl?-lst)
          (cons (car step-res) res-lst)
          (cadr step-res)
          (append (list-ref step-res 5) deep-predicates)
          (list-ref step-res 6)  ; new vars2offsets
          )))))))

ddo:ast-predicate

Index
 {8} <Predicate> ::= (predicate  <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for Predicates
 NOTE: single-level? is dummy here, since a Predicate is always called for
  a single node to be filtered
 NOTE: Unlike 'draft:ast-predicate', we don't implement any filtering here,
  because it depends on the particular axis in the step. Filtering is
  performed on the higher level
(define (ddo:ast-predicate op num-anc single-level? pred-nesting vars2offsets)
  (if
   (not (eq? (car op) 'predicate))
   (draft:signal-semantic-error "not an Predicate - " op)
   (and-let*
    ((expr-res (ddo:ast-expr (cadr op) 0 #t pred-nesting vars2offsets)))
    (let ((requires-position?
           (or (cadddr expr-res)  ; predicate expression requires position
               (memq (list-ref expr-res 4)  ; involves position implicitly
                     '(ddo:type-number ddo:type-any))))
          (vars2offsets (list-ref expr-res 6)))
      (call-with-values
       (lambda ()
         (if
          (or    ; this is a deep predicate
           (> pred-nesting 3)
           ; DL: theoretically reasonable although impractical condition:
           ;(and (not requires-position?) (> pred-nesting 1))
          )
          (let ((pred-id (car vars2offsets)
                         ; was: (ddo:generate-pred-id)
                         ))
            (values
             ((if requires-position?
                  ddo:get-pred-value-pos ddo:get-pred-value)
              pred-id)
             (cons
              (list pred-id
                    requires-position?
                    (car expr-res)  ; implementation
                    )
              (list-ref expr-res 5)  ; deep-predicates
              )
             (cons (+ (car vars2offsets) 1)
                   (cdr vars2offsets))))
          (values (car expr-res)  ; implementation
                  (list-ref expr-res 5)
                  vars2offsets)))
       (lambda (pred-impl deep-predicates vars2offsets)
         (list pred-impl
               (cadr expr-res)  ; num-ancestors required
               (caddr expr-res)  ; single-level? - we don't care
               requires-position?
               (list-ref expr-res 4)  ; return type
               deep-predicates
               vars2offsets)))))))

ddo:ast-predicate-list

Index
 {8a} ( <Predicate>+ )
 Returns (list (listof pred-impl)
               num-anc single-level? requires-position? expr-type
               deep-predicates)
 or #f
 NOTE: num-anc is dummy here, since it is always 0 for Predicates
 NOTE: single-level? is dummy here, since a Predicate is always called for
  a single node to be filtered
 NOTE: information about the type for each Predicate is lost
(define (ddo:ast-predicate-list
         op-lst num-anc single-level? pred-nesting vars2offsets)
  (let ((pred-res-lst
         (ddo:foldr          
          (lambda (op init)
            (cons
             (ddo:ast-predicate
              op 0 #t pred-nesting
              (if (or (null? init)  ; called for the first time
                      (not (car init)))
                  vars2offsets
                  (list-ref (car init) 6)  ; vars2offsets from previous pred
                  ))
             init))
          '()
          op-lst)))
    (and
     (not (memv #f pred-res-lst))  ; error detected
     (list (map car pred-res-lst)
           (apply draft:na-max (map cadr pred-res-lst))
           #t
           (apply ddo:or (map cadddr pred-res-lst))
           ddo:type-any
           (apply append   ; deep-predicates
                  (map
                   (lambda (pred-res) (list-ref pred-res 5))
                   pred-res-lst))
           (list-ref (car pred-res-lst) 6)  ; vars2offsets
           ))))

ddo:ast-expr

Index
 {9} <Expr> ::= <OrExpr>
                | <AndExpr>
                | <EqualityExpr>
                | <RelationalExpr>
                | <AdditiveExpr>
                | <MultiplicativeExpr>
                | <UnionExpr>
                | <PathExpr>
                | <FilterExpr>
                | <VariableReference>
                | <Literal>
                | <Number>
                | <FunctionCall>
                | <LocationPath>
(define (ddo:ast-expr op num-anc single-level? pred-nesting vars2offsets)
  (case (car op)
    ((or)
     (ddo:ast-or-expr op num-anc single-level? pred-nesting vars2offsets))
    ((and)
     (ddo:ast-and-expr op num-anc single-level? pred-nesting vars2offsets))
    ((= !=)
     (ddo:ast-equality-expr op num-anc single-level? pred-nesting vars2offsets))
    ((< > <= >=)
     (ddo:ast-relational-expr
      op num-anc single-level? pred-nesting vars2offsets))
    ((+ -)
     (ddo:ast-additive-expr op num-anc single-level? pred-nesting vars2offsets))
    ((* div mod)
     (ddo:ast-multiplicative-expr
      op num-anc single-level? pred-nesting vars2offsets))
    ((union-expr)
     (ddo:ast-union-expr op num-anc single-level? pred-nesting vars2offsets))
    ((path-expr)
     (ddo:ast-path-expr op num-anc single-level? pred-nesting vars2offsets))
    ((filter-expr)
     (ddo:ast-filter-expr op num-anc single-level? pred-nesting vars2offsets))
    ((variable-reference)
     (ddo:ast-variable-reference
      op num-anc single-level? pred-nesting vars2offsets))
    ((literal)
     (ddo:ast-literal op num-anc single-level? pred-nesting vars2offsets))
    ((number)
     (ddo:ast-number op num-anc single-level? pred-nesting vars2offsets))
    ((function-call)
     (ddo:ast-function-call op num-anc single-level? pred-nesting vars2offsets))
    ((absolute-location-path)
     (ddo:ast-absolute-location-path
      op num-anc single-level? pred-nesting vars2offsets))
    ((relative-location-path)
     (ddo:ast-relative-location-path
      op num-anc single-level? pred-nesting vars2offsets))
    (else
     (draft:signal-semantic-error "unknown Expr - " op))))

ddo:apply-ast-procedure

Index
 Applies AST processing to a list of operations
(define (ddo:apply-ast-procedure
         ast-procedure op-lst num-anc single-level? pred-nesting vars2offsets)
  (ddo:foldr
   (lambda (expr init)
     (cons
      (ast-procedure
       expr num-anc single-level? pred-nesting
       (if (or (null? init)  ; called for the first time
               (not (car init))  ; error during previously processed expr
               )
           vars2offsets
           (list-ref (car init) 6)  ; vars2offsets from previous expr
           ))
      init))
   '()
   op-lst))

ddo:ast-or-expr

Index
 {10} <OrExpr> ::= (or <Expr> <Expr>+ )
 NOTE: num-anc is dummy here, since it is always 0 for OrExpr
(define (ddo:ast-or-expr op num-anc single-level? pred-nesting vars2offsets)
  (let ((expr-res-lst
         (ddo:apply-ast-procedure
          ddo:ast-expr
          (cdr op) 0 single-level? pred-nesting vars2offsets)))
    (and
     (not (memv #f expr-res-lst))  ; error detected
     (let ((expr-impls (map car expr-res-lst)))
     (list
      (lambda (nodeset position+size var-binding)
        (let rpt ((fs expr-impls))
          (cond
            ((null? fs) #f)
            ((sxml:boolean ((car fs) nodeset position+size var-binding)) #t)
            (else (rpt (cdr fs))))))
      (apply draft:na-max (map cadr expr-res-lst))  ; num-ancestors
      #t     ; single-level? after this step
      (apply ddo:or (map cadddr expr-res-lst))  ; position-required?
      ddo:type-boolean
      (apply append   ; deep-predicates
             (map
              (lambda (expr-res) (list-ref expr-res 5))
              expr-res-lst))
      (list-ref (car expr-res-lst) 6)  ; vars2offsets
      )))))

ddo:ast-and-expr

Index
 {11} <AndExpr> ::= (and <Expr> <Expr>+ )
 NOTE: num-anc is dummy here, since it is always 0 for AndExpr
(define (ddo:ast-and-expr op num-anc single-level? pred-nesting vars2offsets)
  (let ((expr-res-lst
         (ddo:apply-ast-procedure
          ddo:ast-expr
          (cdr op) 0 single-level? pred-nesting vars2offsets)))
    (and
     (not (memv #f expr-res-lst))  ; error detected
     (let ((expr-impls (map car expr-res-lst)))
     (list
      (lambda (nodeset position+size var-binding)
        (let rpt ((fs expr-impls))
          (cond
            ((null? fs) #t)
            ((not
              (sxml:boolean ((car fs) nodeset position+size var-binding)))
             #f)
            (else (rpt (cdr fs))))))
      (apply draft:na-max (map cadr expr-res-lst))  ; num-ancestors
      #t     ; single-level? after this step
      (apply ddo:or (map cadddr expr-res-lst))  ; position-required?
      ddo:type-boolean
      (apply append   ; deep-predicates
             (map
              (lambda (expr-res) (list-ref expr-res 5))
              expr-res-lst))
      (list-ref (car expr-res-lst) 6)  ; vars2offsets
      )))))

ddo:ast-equality-expr

Index
 {12} <EqualityExpr> ::= (=  <Expr> <Expr> )
                         | (!=  <Expr> <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for EqualityExpr
(define (ddo:ast-equality-expr
         op num-anc single-level? pred-nesting vars2offsets)
  (and-let*
   ((left-lst
     (ddo:ast-expr (cadr op) 0 single-level? pred-nesting vars2offsets))
    (right-lst
     (ddo:ast-expr (caddr op) 0 single-level? pred-nesting
                   (list-ref left-lst 6)  ; vars2offsets for left part
                   )))
   (let ((cmp-op (cadr (assq (car op) `((= ,sxml:equal?)
                                        (!= ,sxml:not-equal?)))))
         (left (car left-lst))
         (right (car right-lst)))
     (list
      (lambda (nodeset position+size var-binding)
        (cmp-op
         (draft:contextset->nodeset
          (left nodeset position+size var-binding))
         (draft:contextset->nodeset
          (right nodeset position+size var-binding))))
      (draft:na-max (cadr left-lst) (cadr right-lst))   ; num-ancestors
      #t     ; single-level? after this step
      (or (cadddr left-lst) (cadddr right-lst))  ; position-required?
      ddo:type-boolean
      (append (list-ref left-lst 5)   ; deep-predicates
              (list-ref right-lst 5))
      (list-ref right-lst 6)  ; vars2offsets for right part
      ))))

ddo:ast-relational-expr

Index
 {13} <RelationalExpr> ::= (<  <Expr> <Expr> )
                           | (>  <Expr> <Expr> )
                           | (<=  <Expr> <Expr> )
                           | (>=  <Expr> <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for RelationalExpr
(define (ddo:ast-relational-expr
         op num-anc single-level? pred-nesting vars2offsets)
  (and-let*
   ((left-lst
     (ddo:ast-expr (cadr op) 0 single-level? pred-nesting vars2offsets))
    (right-lst
     (ddo:ast-expr (caddr op) 0 single-level? pred-nesting
                   (list-ref left-lst 6)  ; vars2offsets for left part
                   )))
   (let ((cmp-op
          (sxml:relational-cmp
           (cadr (assq (car op) `((< ,<) (> ,>) (<= ,<=) (>= ,>=))))))
         (left (car left-lst))
         (right (car right-lst)))
     (list
      (lambda (nodeset position+size var-binding)
        (cmp-op
         (draft:contextset->nodeset
          (left nodeset position+size var-binding))
         (draft:contextset->nodeset
          (right nodeset position+size var-binding))))
      (draft:na-max (cadr left-lst) (cadr right-lst))   ; num-ancestors
      #t     ; single-level? after this step
      (or (cadddr left-lst) (cadddr right-lst))  ; position-required?
      ddo:type-boolean
      (append (list-ref left-lst 5)   ; deep-predicates
              (list-ref right-lst 5))
      (list-ref right-lst 6)  ; vars2offsets for right part
      ))))

ddo:ast-additive-expr

Index
 {14} <AdditiveExpr> ::= (+  <Expr> <Expr> )
                         | (-  <Expr> <Expr>? )
 NOTE: num-anc is dummy here, since it is always 0 for AdditiveExpr
(define (ddo:ast-additive-expr
         op num-anc single-level? pred-nesting vars2offsets)
  (let ((expr-res-lst
         (ddo:apply-ast-procedure
          ddo:ast-expr
          (cdr op) 0 single-level? pred-nesting vars2offsets)))
    (and
     (not (memv #f expr-res-lst))  ; error detected
     (let ((add-op (cadr (assq (car op) `((+ ,+) (- ,-)))))
           (expr-impls (map car expr-res-lst)))
     (list
      (lambda (nodeset position+size var-binding)
        (apply
         add-op
         (map
          (lambda (expr)
            (sxml:number
             (draft:contextset->nodeset
              (expr nodeset position+size var-binding))))
          expr-impls)))
      (apply draft:na-max (map cadr expr-res-lst))  ; num-ancestors
      #t     ; single-level? after this step
      (apply ddo:or (map cadddr expr-res-lst))  ; position-required?
      ddo:type-number
      (apply append   ; deep-predicates
             (map
              (lambda (expr-res) (list-ref expr-res 5))
              expr-res-lst))
      (list-ref (car expr-res-lst) 6)  ; vars2offsets
      )))))

ddo:ast-multiplicative-expr

Index
 {15} <MultiplicativeExpr> ::= (*  <Expr> <Expr> )
                               | (div  <Expr> <Expr> )
                               | (mod  <Expr> <Expr> )
 NOTE: num-anc is dummy here, since it is always 0 for MultiplicativeExpr
(define (ddo:ast-multiplicative-expr
         op num-anc single-level? pred-nesting vars2offsets)
  (and-let*
   ((left-lst
     (ddo:ast-expr (cadr op) 0 single-level? pred-nesting vars2offsets))
    (right-lst
     (ddo:ast-expr (caddr op) 0 single-level? pred-nesting
                   (list-ref left-lst 6)  ; vars2offsets for left part
                   )))
   (let ((mul-op
          (sxml:relational-cmp
           (cadr (assq (car op) `((* ,*) (div ,/) (mod ,remainder))))))
         (left (car left-lst))
         (right (car right-lst)))
     (list
      (lambda (nodeset position+size var-binding)
        (mul-op
         (sxml:number
          (draft:contextset->nodeset
           (left nodeset position+size var-binding)))
         (sxml:number
          (draft:contextset->nodeset
           (right nodeset position+size var-binding)))))
      (draft:na-max (cadr left-lst) (cadr right-lst))   ; num-ancestors
      #t     ; single-level? after this step
      (or (cadddr left-lst) (cadddr right-lst))  ; position-required?
      ddo:type-number
      (append (list-ref left-lst 5)   ; deep-predicates
              (list-ref right-lst 5))
      (list-ref right-lst 6)  ; vars2offsets for right part
      ))))

ddo:ast-union-expr

Index
 {16} <UnionExpr> ::= (union-expr  <Expr> <Expr>+ )
 TECHNICAL NOTE: For implementing the union while supporting distinct document
 order, we need num-ancestors=#f for the arguments of the union-expr. This
 operation is time-consuming and should be avoided
(define (ddo:ast-union-expr op num-anc single-level? pred-nesting vars2offsets)
  (let ((expr-res-lst
         (ddo:foldr
          (lambda (expr init)
            (let ((expr-res
                   (if 
                    (or (null? init)  ; called for the first time
                        (not (car init)))                   
                    (ddo:ast-expr
                     expr num-anc  ; not necessarily all ancestors
                     single-level? pred-nesting vars2offsets)
                    (ddo:ast-expr
                     expr #f single-level? pred-nesting
                     (list-ref (car init) 6)  ; vars2offsets from previous expr
                     ))))
              (cons
               (if
                (not (or (eq? (list-ref expr-res 4) ddo:type-nodeset)
                         (eq? (list-ref expr-res 4) ddo:type-any)))               
                (draft:signal-semantic-error
                 "expression to be unioned evaluates to a non-nodeset - "
                 expr)
                expr-res)
               init)))
          '()
          (cdr op))))
    (and
     (not (memv #f expr-res-lst))  ; error detected
     (let ((expr-impls (map car expr-res-lst)))
       (list
        (lambda (nodeset position+size var-binding)
          (let rpt ((res '())
                    (fs expr-impls))
            (if
             (null? fs)
             res
             (let ((nset ((car fs) nodeset position+size var-binding)))
               (rpt
                (ddo:unite-2-contextsets 
                 res
                 (cond
                   ((not (nodeset? nset))
                    (sxml:xpointer-runtime-error
                     "expected - nodeset instead of " nset)
                    '())
                   (else nset)))
                (cdr fs))))))
        #f  ; num-ancestors
        #f     ; single-level? after this step
        (apply ddo:or (map cadddr expr-res-lst))  ; position-required?
        ddo:type-nodeset
        (apply append   ; deep-predicates
               (map
                (lambda (expr-res) (list-ref expr-res 5))
                expr-res-lst))
        (list-ref (car expr-res-lst) 6)  ; vars2offsets
        )))))

ddo:ast-path-expr

Index
 {17} <PathExpr> ::= (path-expr  <FilterExpr> <Step>+ )
 TECHNICAL NOTE: To calculate 'single-level?', we need to process components
 in straight orger. To calculate 'num-anc', we need to process steps in
 reverse order. It is too expensive to make the 2 passes, that's why we
 consider single-level?=#f for steps
(define (ddo:ast-path-expr op num-anc single-level? pred-nesting vars2offsets)
  (and-let*
    ((steps-res (ddo:ast-step-list
                 (cddr op) num-anc
                 #f  ; consider single-level?=#f after FilterExpr
                 pred-nesting
                 vars2offsets))
     (filter-lst (ddo:ast-filter-expr
                  (cadr op)
                  (cadr steps-res)  ; num-ancestors
                  single-level?
                  pred-nesting
                  (list-ref steps-res 6)  ; vars2offsets from steps-list
                  )))
    (if
     (not (or (eq? (list-ref filter-lst 4) ddo:type-nodeset)
              (eq? (list-ref filter-lst 4) ddo:type-any)))
     (draft:signal-semantic-error
      "location steps are applied to a non-nodeset result - " (cadr op))
     (let ((init-impl (car filter-lst))
           (converters (car steps-res)))
       (list
        (lambda (nodeset position+size var-binding)
          (let ((nset
                 (init-impl nodeset position+size var-binding)))
            (let rpt ((nset
                       (cond
                         ((nodeset? nset) nset)
                         (else
                          (sxml:xpointer-runtime-error 
                           "expected - nodeset instead of " nset)
                          '())))
                      (fs converters))
              (if (null? fs)
                  nset
                  (rpt ((car fs) nset position+size var-binding)
                       (cdr fs))))))
        (cadr filter-lst)  ; num-ancestors
        (cadddr steps-res)     ; single-level?, =#f in our assumption
        (cadddr filter-lst)  ; position-required?
        ddo:type-nodeset
        (append (list-ref filter-lst 5)   ; deep-predicates
                (list-ref steps-res 5))
        (list-ref filter-lst 6)  ; vars2offsets from filter-lst
        )))))

ddo:ast-filter-expr

Index
 {18} <FilterExpr> ::= (filter-expr (primary-expr  <Expr> )
                                    <Predicate>* )
(define (ddo:ast-filter-expr op num-anc single-level? pred-nesting vars2offsets)
  (cond
    ((not (eq? (car op) 'filter-expr))
     (draft:signal-semantic-error "not an FilterExpr - " op))
    ((not (eq? (caadr op) 'primary-expr))
     (draft:signal-semantic-error "not an PrimaryExpr - " (cadr op)))
    ((null? (cddr op))  ; no Predicates
     (ddo:ast-expr (cadadr op) num-anc single-level? pred-nesting vars2offsets))
    ((and (null? (cdddr op))   ; a single predicate
          (ddo:check-special-predicate (caddr op)))
     => (lambda (special-pred-impl)          
          (and-let*
           ((expr-lst (ddo:ast-expr
                       (cadadr op)
                       num-anc   ; special predicate doesn't require ancestors
                       single-level? pred-nesting vars2offsets)))
           (list
            (ddo:filter-expr-special-predicate
             (car expr-lst) special-pred-impl)
            (cadr expr-lst)  ; num-ancestors
            (caddr expr-lst)  ; single-level? after this step
            (cadddr expr-lst)  ; position-required?
            ddo:type-nodeset
            (list-ref expr-lst 5)  ; deep-predicates
            (list-ref expr-lst 6)  ; vars2offsets
            ))))
    (else   ; the general case
     (and-let*
       ((preds-res (ddo:ast-predicate-list
                    (cddr op) 0 #t (+ pred-nesting 1) vars2offsets))
        (expr-lst (ddo:ast-expr
                   (cadadr op)
                   (draft:na-max num-anc (cadr preds-res))  ; num-anc
                   single-level? pred-nesting
                   (list-ref preds-res 6)  ; vars2offsets from predicates
                   )))
       (if
        (not (or (eq? (list-ref expr-lst 4) ddo:type-nodeset)
                 (eq? (list-ref expr-lst 4) ddo:type-any)))
        (draft:signal-semantic-error
         "expression to be filtered evaluates to a non-nodeset - " (cadr op)) 
        (let ((expr-impl (car expr-lst))
              (pred-impl-lst (car preds-res)))
          (list
           (if
            (list-ref preds-res 3)  ; position required
            (ddo:filter-expr-general expr-impl pred-impl-lst)
            (ddo:filter-expr-non-pos expr-impl pred-impl-lst))
           (cadr expr-lst)  ; num-ancestors
           (caddr expr-lst)  ; single-level? after this step
           (cadddr expr-lst)  ; position-required?
           ddo:type-nodeset
           (append (list-ref expr-lst 5)   ; deep-predicates
                   (list-ref preds-res 5))
           (list-ref expr-lst 6)  ; vars2offsets from expr-lst
           )))))))

ddo:ast-variable-reference

Index
 {19} <VariableReference> ::= (variable-reference  <String> )
(define (ddo:ast-variable-reference
         op num-anc single-level? pred-nesting vars2offsets)
  (let ((name (string->symbol (cadr op))))
    (call-with-values
     (lambda ()
       (cond
         ((assq name (cdr vars2offsets))  ; this variable already in alist
          => (lambda (pair)
               (values (cdr pair) vars2offsets)))
         (else  ; this is a new variable
          (values (car vars2offsets)
                  (cons
                   (+ (car vars2offsets) 1)
                   (cons (cons name (car vars2offsets))      
                         (cdr vars2offsets)))))))
     (lambda (var-offset new-vars2offsets)
       (list
        (lambda (nodeset position+size var-binding)
          (cond
            ((and (not (null? var-binding))
                  (eq? (caar var-binding) '*var-vector*))
             (vector-ref (cdar var-binding) var-offset))
            ; For backward compatibility
            ((assq name var-binding)
             => cdr)
            (else
             (sxml:xpointer-runtime-error "unbound variable - " name)
             '())))
        0
        #t  ; ATTENTION: in is not generally on the single-level
        #f
        ddo:type-any  ; type cannot be statically determined
        '()  ; deep-predicates     
        new-vars2offsets)))))

ddo:ast-literal

Index
 {20} <Literal> ::= (literal  <String> )
(define (ddo:ast-literal op num-anc single-level? pred-nesting vars2offsets)
  (let ((literal (cadr op)))
    (list
     (lambda (nodeset position+size var-binding) literal)
     0 #t #f ddo:type-string '() vars2offsets)))

ddo:ast-number

Index
 {21} <Number> :: (number  <Number> )
(define (ddo:ast-number op num-anc single-level? pred-nesting vars2offsets)
  (let ((number (cadr op)))
    (list
     (lambda (nodeset position+size var-binding) number)
     0 #t #f ddo:type-number '() vars2offsets)))

ddo:ast-function-call

Index
 {22} <FunctionCall> ::= (function-call (function-name  <String> )
                                        (argument  <Expr> )* )
(define (ddo:ast-function-call
         op num-anc single-level? pred-nesting vars2offsets)
  (let ((core-alist
         ; (list fun-name min-num-args max-num-args na4res impl
         ;       single-level? requires-position? expr-type)         
         `((last 0 0 0 ,draft:core-last
                 #t #t ,ddo:type-number)
           (position 0 0 0 ,draft:core-position
                     #t #t ,ddo:type-number)
           (count 1 1 0 ,draft:core-count
                  #t #f ,ddo:type-number)
           (id 1 1 #f ,draft:core-id
               #f #f ,ddo:type-nodeset)
           (local-name 0 1 0 ,draft:core-local-name
                       #t #f ,ddo:type-string)
           (namespace-uri 0 1 0 ,draft:core-namespace-uri
                          #t #f ,ddo:type-string)
           (name 0 1 0 ,draft:core-name
                 #t #f ,ddo:type-string)
           (string 0 1 0 ,draft:core-string
                   #t #f ,ddo:type-string)
           (concat 2 -1 0 ,draft:core-concat
                   #t #f ,ddo:type-string)
           (starts-with 2 2 0 ,draft:core-starts-with
                        #t #f ,ddo:type-boolean)
           (contains 2 2 0 ,draft:core-contains
                     #t #f ,ddo:type-boolean)
           (substring-before 2 2 0 ,draft:core-substring-before
                             #t #f ,ddo:type-boolean)
           (substring-after 2 2 0 ,draft:core-substring-after
                            #t #f ,ddo:type-boolean)
           (substring 2 3 0 ,draft:core-substring
                      #t #f ,ddo:type-boolean)
           (string-length 0 1 0 ,draft:core-string-length
                          #t #f ,ddo:type-number)
           (normalize-space 0 1 0 ,draft:core-normalize-space
                            #t #f ,ddo:type-string)
           (translate 3 3 0 ,draft:core-translate
                      #t #f ,ddo:type-string)
           (boolean 1 1 0 ,draft:core-boolean
                    #t #f ,ddo:type-boolean)
           (not 1 1 0 ,draft:core-not
                #t #f ,ddo:type-boolean)
           (true 0 0 0 ,draft:core-true
                 #t #f ,ddo:type-boolean)
           (false 0 0 0 ,draft:core-false
                  #t #f ,ddo:type-boolean)
           (lang 1 1 #f ,draft:core-lang
                 #t #f ,ddo:type-boolean)
           (number 0 1 0 ,draft:core-number
                   #t #f ,ddo:type-number)
           (sum 1 1 0 ,draft:core-sum
                #t #f ,ddo:type-number)
           (floor 1 1 0 ,draft:core-floor
                  #t #f ,ddo:type-number)
           (ceiling 1 1 0 ,draft:core-ceiling
                    #t #f ,ddo:type-number)
           (round 1 1 0 ,draft:core-round
                  #t #f ,ddo:type-number))))
    (cond
      ((not (eq? (caadr op) 'function-name))
       (draft:signal-semantic-error "not an FunctionName - " (cadr op)))
      ((assq (string->symbol (cadadr op)) core-alist)       
       => (lambda (description)  ; Core function found
            (cond
              ((< (length (cddr op)) (cadr description))
               (draft:signal-semantic-error
                "too few arguments for the Core Function call - "
                (cadadr op)))
              ((and (>= (caddr description) 0)
                    (> (length (cddr op)) (caddr description)))
               (draft:signal-semantic-error
                "too many arguments for the Core Function call - "
                (cadadr op)))
              (else  ; correct number of arguments
               (and-let*
                ((args-impl-lst (ddo:ast-function-arguments
                                 (cddr op)  ; list of arguments
                                 single-level? pred-nesting vars2offsets)))
                (list
                 ; Producing a function implementation
                 (apply (list-ref description 4)
                        num-anc
                        (map car args-impl-lst))
                 (apply  ; num-ancestors required for function
                  draft:na-max
                  (cons
                   (list-ref description 3)  ; from function description
                   (map cadr args-impl-lst)  ; from arguments
                   ))                    
                 (list-ref description 5)  ; single-level?
                 (or (list-ref description 6)  ; position-required?
                     (not (null?
                           (filter cadddr args-impl-lst))))
                 (list-ref description 7)  ; return type
                 (apply append   ; deep-predicates
                        (map
                         (lambda (arg-res) (list-ref arg-res 5))
                         args-impl-lst))
                 (if (null? args-impl-lst)  ; no arguments
                     vars2offsets
                     (list-ref (car args-impl-lst) 6))
                 ))))))
           (else  ; function definition not found
            (draft:signal-semantic-error
             "function call to an unknown function - " (cadadr op))))))

ddo:ast-function-arguments

Index
 {22a} ( (argument  <Expr> )* )
 na-lst - number of ancestors required for each of the arguments
 Returns:  #f  or
  (listof 
    (list expr-impl num-anc single-level? requires-position? expr-type
          deep-predicates vars2offsets))
 NOTE: In XPath Core Function Library, none of the function arguments
 is required to save any ancestors in the context
(define (ddo:ast-function-arguments
         op-lst single-level? pred-nesting vars2offsets)
  (let ((arg-res-lst
         (ddo:foldr
          (lambda (op init)            
            (cons
             (if
              (not (eq? (car op) 'argument))
              (draft:signal-semantic-error "not an Argument - " op)
              (ddo:ast-expr
               (cadr op) 0 single-level? pred-nesting
               (if (or (null? init)  ; called for the first time
                       (not (car init)))
                   vars2offsets
                   (list-ref (car init) 6)  ; vars2offsets from previous pred
                   )))
             init))
          '()
          op-lst)))
    (and
     (not (memv #f arg-res-lst))  ; semantic error detected
     arg-res-lst)))

ddo:api-helper

Index
 Helper for constructing several highest-level API functions
 ns+na - can contain 'ns-binding' and/or 'num-ancestors' and/or none of them
(define (ddo:api-helper grammar-parser ast-parser)
  (lambda (xpath-string . ns+na)
    (call-with-values
     (lambda () (draft:arglist->ns+na ns+na))
     (lambda (ns-binding num-anc)
       (and-let*
        ((ast (grammar-parser xpath-string ns-binding))
         (impl-lst (ast-parser ast num-anc
                               #t  ; we suppose single-level?=#t for src
                               0  ; predicate nesting is zero
                               '(0)  ; initial vars2offsets
                               )))
        (let ((impl-lambda
               (if
                (and num-anc (zero? num-anc))
                (let ((impl-car (car impl-lst)))
                  (lambda (node position+size var-binding)
                    (draft:contextset->nodeset
                     (impl-car node position+size var-binding))))                
                (car impl-lst))))
          (lambda (node . var-binding)   ; common implementation
            (impl-lambda
             (as-nodeset node)
             (cons 1 1)
             (ddo:add-vector-to-var-binding
              (list-ref impl-lst 6)  ; vars2offsets
              (reverse  ; deep-predicates: need to reverse
               (list-ref impl-lst 5))
              node
              (if (null? var-binding) var-binding (car var-binding)))))))))))

ddo:txpath

Index
(define ddo:txpath (ddo:api-helper txp:xpath->ast ddo:ast-location-path))

ddo:xpath-expr

Index
(define ddo:xpath-expr (ddo:api-helper txp:expr->ast ddo:ast-expr))

ddo:sxpath

Index
(define ddo:sxpath (ddo:api-helper txp:sxpath->ast ddo:ast-expr))

ddo:nset-contained?

Index
 Whether all members from the first nodeset are contained in the second
 nodeset
(define (ddo:nset-contained? nodeset1 nodeset2)
  (cond
    ((null? nodeset1) #t)
    ((memq (car nodeset1) nodeset2)
     (ddo:nset-contained? (cdr nodeset1) nodeset2))
    (else #f)))

ddo:nset-equal?

Index
(define (ddo:nset-equal? nodeset1 nodeset2)
  (and (ddo:nset-contained? nodeset1 nodeset2)
       (ddo:nset-contained? nodeset2 nodeset1)))

ddo:pos-result-forward?

Index
 Whether pos-result in a forward order
 Return #t if in document order, #f if in reverse document order
(define (ddo:pos-result-forward? pos-result)
  (let loop ((pos-res pos-result))
    (cond
      ((null? pos-res)  ; every pos-nodeset has the length of <2
       #t)
      ((or (null? (car pos-res)) (null? (cdar pos-res)))
       ; this pos-nodeset has the length of less or equal to 1
       (loop (cdr pos-res)))
      (else
       (< (cdaar pos-res) (cdadar pos-res))))))

ddo:pos-result->nodeset

Index
 Unites pos-result into a nodeset in distinct document order
(define (ddo:pos-result->nodeset pos-result)
  (letrec (; Combines 2 pos-nodesets into a single one
           (combine-2-pos-nodesets
            (lambda (chain1 chain2)
              (cond
                ((null? chain1) chain2)                
                ((null? chain2) chain1)
                ; None of the chains are null
                ((eq? (caar chain1) (caar chain2))  ; equal nodes
                 ; the same with (= (cdar chain1) (cdar chain2))
                 (cons (car chain1)
                       (combine-2-pos-nodesets (cdr chain1) (cdr chain2))))
                ((< (cdar chain1) (cdar chain2))
                 (cons (car chain1)
                       (combine-2-pos-nodesets (cdr chain1) chain2)))
                (else
                 (cons (car chain2)
                       (combine-2-pos-nodesets chain1 (cdr chain2))))))))
    (if
     (null? pos-result)  ; nothing to do
     pos-result
     (let ((pos-result (if (ddo:pos-result-forward? pos-result)
                           pos-result
                           (map reverse pos-result))))
      (let loop ((res (car pos-result))
                 (to-scan (cdr pos-result)))
        (if (null? to-scan)
            res
            (loop (combine-2-pos-nodesets res (car to-scan))
                  (cdr to-scan))))))))

ddo:location-step-pos

Index
  pos-axis-impl ::= lambda
  pred-impl-lst ::= (listof lambda)
 Every predicate is called with respect to each node
 Returns:  lambda
  lambda ::= (lambda (nodeset position+size var-binding) ...)
(define (ddo:location-step-pos pos-axis-impl pred-impl-lst) 
  (lambda (nodeset position+size var-binding)
    (map
     car
     (ddo:pos-result->nodeset
      (map
       (lambda (pos-nodeset)
         (let iter-preds ((nset pos-nodeset)
                          (preds pred-impl-lst))
           (if
            (null? preds)
            nset
            (let ((size (length nset)))  ; context size
              (let iter-pairs ((nset nset)
                               (res '())
                               (pos 1))                          
                (if
                 (null? nset)  ; continue with the next predicate
                 (iter-preds (reverse res) (cdr preds))
                 (let ((val ((car preds)  ; predicate value
                             (list (caar nset)) (cons pos size) var-binding)))
                   (iter-pairs (cdr nset)
                               (if (if (number? val)
                                       (= val pos)
                                       (sxml:boolean val))
                                   (cons (car nset) res)
                                   res)
                               (+ pos 1)))))))))
       (pos-axis-impl nodeset))))))

ddo:location-step-non-intersect

Index
 A location step for the axis which doesn't return a result in the form of
 a pos-nodeset, but instead resulting nodesets for each input node are in
 document order
  pos-axis-impl ::= lambda
  pred-impl-lst ::= (listof lambda)
 Every predicate is called with respect to each node
 Returns:  lambda
  lambda ::= (lambda (nodeset position+size var-binding) ...)
 This function is somewhat similar to 'sxml:xpath-nodeset-filter' from
 "txpath.scm"
(define (ddo:location-step-non-intersect axis-impl pred-impl-lst)
  (lambda (nodeset position+size var-binding)
    (map-union
     (lambda (node)
       (let iter-preds ((nset (axis-impl node))
                        (preds pred-impl-lst))
         (if
          (null? preds)
          nset
          (let ((size (length nset)))  ; context size
            (let iter-nodes ((nset nset)
                             (res '())
                             (pos 1))                        
              (if
               (null? nset)  ; continue with the next predicate
               (iter-preds (reverse res) (cdr preds))
               (let ((val ((car preds)  ; predicate value
                           (list (car nset)) (cons pos size) var-binding)))
                 (iter-nodes (cdr nset)
                             (if (if (number? val)
                                     (= val pos)
                                     (sxml:boolean val))
                                 (cons (car nset) res)
                                 res)
                             (+ pos 1)))))))))
     nodeset)))

ddo:location-step-non-pos

Index
 A location step doesn't contain position-based predicates
(define (ddo:location-step-non-pos axis-impl pred-impl-lst)
  (lambda (nodeset position+size var-binding)
    (let iter-preds ((nset (axis-impl nodeset))
                     (preds pred-impl-lst))
      (if
       (null? preds)
       nset
       (let ((curr-pred (car preds)))
         (iter-preds
          (filter
           (lambda (node)
             (sxml:boolean
              (curr-pred (list node)
                         (cons 1 1)  ; dummy
                         var-binding)))
           nset)
          (cdr preds)))))))

ddo:filter-expr-general

Index
 Implementing FilterExpr in the general case, for position-based predicates
(define (ddo:filter-expr-general expr-impl pred-impl-lst)
  (lambda (nodeset position+size var-binding)
    (let ((prim-res (expr-impl nodeset position+size var-binding)))
      (cond
        ((not (nodeset? prim-res))
         (sxml:xpointer-runtime-error 
          "expected - nodeset instead of " prim-res)
         '())
        (else
         (let iter-preds ((nset prim-res)
                          (preds pred-impl-lst))
           (if
            (null? preds)
            nset
            (let ((size (length nset)))  ; context size
              (let iter-nodes ((nset nset)
                               (res '())
                               (pos 1))
                (if
                 (null? nset)  ; continue with the next predicate
                 (iter-preds (reverse res) (cdr preds))
                 (let ((val ((car preds)  ; predicate value
                             (list (car nset)) (cons pos size) var-binding)))
                   (iter-nodes (cdr nset)
                               (if (if (number? val)
                                       (= val pos)
                                       (sxml:boolean val))
                                   (cons (car nset) res)
                                   res)
                               (+ pos 1)))))))))))))

ddo:filter-expr-non-pos

Index
 A FilterExpr doesn't contain position-based predicates
 NOTE: This function is very similar to 'ddo:location-step-non-pos'
  Should think of combining them.
(define (ddo:filter-expr-non-pos expr-impl pred-impl-lst)
  (lambda (nodeset position+size var-binding)
    (let ((prim-res (expr-impl nodeset position+size var-binding)))
      (cond
        ((not (nodeset? prim-res))
         (sxml:xpointer-runtime-error 
          "expected - nodeset instead of " prim-res)
         '())
        (else
         (let iter-preds ((nset prim-res)
                          (preds pred-impl-lst))
           (if
            (null? preds)
            nset
            (let ((curr-pred (car preds)))
              (iter-preds
               (filter
                (lambda (node)
                  (sxml:boolean
                   (curr-pred (list node)
                              (cons 1 1)  ; dummy
                              var-binding)))
                nset)
               (cdr preds))))))))))

ddo:filter-expr-special-predicate

Index
  Filter expression, with a single predicate of the special structure, like
  [position()=1]
 special-pred-impl ::= (lambda (nodeset) ...)  - filters the nodeset
(define (ddo:filter-expr-special-predicate expr-impl special-pred-impl)
  (lambda (nodeset position+size var-binding)
    (let ((prim-res (expr-impl nodeset position+size var-binding)))
      (if
       (not (nodeset? prim-res))
       (begin
         (sxml:xpointer-runtime-error
          "expected - nodeset instead of " prim-res)
         '())
       (special-pred-impl prim-res)))))

ddo:check-ast-position?

Index
 Checks whether the given op is the AST representation to a function call
 to position()
(define ddo:check-ast-position?
  (let ((ddo:ast-for-position-fun-call   ; evaluate just once
         (txp:expr->ast "position()")))
    (lambda (op)
      (equal? op ddo:ast-for-position-fun-call))))

ddo:check4ast-number

Index
 If the given op is the AST representation for a number and this number is
 exact, returns this number. Otherwise returns #f
(define (ddo:check4ast-number op)
  (if
   (eq? (car op) 'number)    
   (let ((number (cadr op)))
     (if (and (number? number) (exact? number))
         number #f))
   #f))

ddo:check-special-predicate

Index
  In case when the predicate has one of the following forms:
 SpecialPredicate ::= [ Number ]
                      | [ position() CmpOp Number ]
                      | [ Number CmpOp position() ]
 CmpOp ::= > | < | >= | <= | =
 Number - an integer
  than returns (lambda (nodeset) ...), where the lambda performs the required
  filtering as specified by the predicate.
  For a different sort of a predicate, returns #f
  The function doesn't signal of any semantic errors.
(define (ddo:check-special-predicate op)
  (if
   (not (eq? (car op) 'predicate))
   #f  ; an improper AST
   (let ((expr (cadr op)))
     (cond
       ((ddo:check4ast-number expr)
        => (lambda (num)
             (lambda (nodeset) (ddo:list-ref nodeset (- num 1)))))
       ((and (memq (car expr) '(= > < >= <=))
             (= (length expr) 3))
        (call-with-values
         (lambda ()
           (cond
             ((and (ddo:check-ast-position? (cadr expr))
                   (ddo:check4ast-number (caddr expr)))
              => (lambda (num) (values (car expr) num)))
             ((and (ddo:check-ast-position? (caddr expr))
                   (ddo:check4ast-number (cadr expr)))
              => (lambda (num)
                   (values
                    (cond   ; invert the cmp-op
                      ((assq (car expr)
                             '((< . >) (> . <) (>= . <=) (<= . >=)))
                       => cdr)
                      (else (car expr)))
                    num)))
             (else
              (values #f #f))))
         (lambda (cmp-op num)
           (if
            (not num)
            #f
            (case cmp-op
              ((=)
               (lambda (nodeset) (ddo:list-ref nodeset (- num 1))))
              ((>)
               (lambda (nodeset) (ddo:list-tail nodeset num)))
              ((>=)
               (lambda (nodeset) (ddo:list-tail nodeset (- num 1))))
              ((<)
               (lambda (nodeset) (ddo:list-head nodeset (- num 1))))
              ((<=)
               (lambda (nodeset) (ddo:list-head nodeset num)))
              (else   ; internal error
               #f))))))
       (else  ; not an equality or relational expr with 2 arguments
        #f)))))

ddo:get-pred-value

Index
 Predicate value for a predicate that doesn't require position
 Predicate values are stored in the form of
 pred-values ::= (listof  (cons  node  pred-value))
 NOTE: A node (and not a context) is used as a key in the alist
(define (ddo:get-pred-value pred-id)
  (lambda (nodeset position+size var-binding)
    (cond
      ((not (and (nodeset? nodeset)
                 (null? (cdr nodeset))))
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - "
        "a predicate is supplied with a non-singleton nodeset: " pred-id)
       #f)
      ((or (null? var-binding)
           (not (eq? (caar var-binding) '*var-vector*)))
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - predicate value not found: " pred-id)
       #f)
      ; predicate value as expected
      ((assq (sxml:context->node (car nodeset))
             (vector-ref (cdar var-binding) pred-id))
       => (lambda (pair) (force (cdr pair)))
       ; => cdr   ; DL: was
       )
      (else  ; predicate value for the given node not found
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - no predicate value for node: "
        pred-id (sxml:context->node (car nodeset)))
       #f))))

ddo:get-pred-value-pos

Index
 Predicate value for a predicate that requires position
 Predicate values are stored in the form of
 pred-values ::=
        (listof
         (cons node
               (listof
                (cons size
                      (listof
                       (cons position pred-value))))))
 NOTE: A node (and not a context) is used as a key in the alist
(define (ddo:get-pred-value-pos pred-id)
  (lambda (nodeset position+size var-binding)
    (cond
      ((not (and (nodeset? nodeset)
                 (null? (cdr nodeset))))
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - "
        "a predicate is supplied with a non-singleton nodeset: " pred-id)
       #f)
      ((or (null? var-binding)
           (not (eq? (caar var-binding) '*var-vector*)))
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - predicate value not found: " pred-id)
       #f)
      ; predicate value as expected
      ((assq (sxml:context->node (car nodeset))
             (vector-ref (cdar var-binding) pred-id))
       => (lambda (size-pair)
            (if
             (> (cdr position+size)  ; context size
                (vector-length (cdr size-pair)))
             (begin
               (sxml:xpointer-runtime-error
                "internal DDO SXPath error - "
                "vector member for context size not found: " pred-id)
               #f)
             (let ((pos-vect (vector-ref (cdr size-pair)
                                         (- (cdr position+size) 1))))
               (if
                (> (car position+size)  ; context position
                   (vector-length pos-vect))
                (begin
                  (sxml:xpointer-runtime-error
                   "internal DDO SXPath error - "
                   "vector member for context position not found: "
                   pred-id)
                  #f)
                (force (vector-ref pos-vect
                                   (- (car position+size) 1))))))))
      (else  ; predicate value for the given node not found
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - no predicate value for node: "
        pred-id (sxml:context->node (car nodeset)))
       #f))))

ddo:get-abs-lpath-value

Index
 Value that results from evaluating the absolute location path
 The argument is named `pred-id' for the sake of mere unification with
 deep predicates
(define (ddo:get-abs-lpath-value pred-id)
  (lambda (nodeset position+size var-binding)
    (if
     (or (null? var-binding)
         (not (eq? (caar var-binding) '*var-vector*)))
     (begin
       (sxml:xpointer-runtime-error
        "internal DDO SXPath error - "
        "value for absolute location path not found: " pred-id)
       '()  ; the value defaults to an empty nodeset
       )     
     (vector-ref (cdar var-binding) pred-id))))

ddo:construct-pred-values

Index
 Construct alist of values for a predicate that doesn't require position
 pred-impl - lambda that implements the predicate
 context-set - set of contexts for all nodes in the source document
 var-bindings - include variables supplied by user and the ones formed by
  deeper level predicates
(define (ddo:construct-pred-values pred-impl context-set var-binding)  
  (map
   (lambda (context)
     (cons (sxml:context->node context)
           (delay
             (sxml:boolean  ; since return type cannot be number
              (pred-impl (list context)
                         (cons 1 1)  ; dummy context position and size
                         var-binding)))))
   context-set))

ddo:construct-pred-values-pos

Index
 Construct alist of values for a predicate that requires position
  pred-impl - lambda that implements the predicate
  context-set - set of contexts for all nodes in the source document
  var-bindings - include variables supplied by user and the ones formed by
 deeper level predicates
  max-size - maximal context size possible in the document
(define (ddo:construct-pred-values-pos
         pred-impl context-set var-binding max-size)
  (map
   (lambda (context)      
     (cons
      (sxml:context->node context)
      (let ((context (list context)))
        (let iter-size ((size 1)
                        (size-lst '()))
          (if
           (> size max-size)  ; iteration is over
           (list->vector (reverse size-lst))
           (let iter-pos ((position 1)
                          (pos-lst '()))
             (if
              (> position size)  ; iteration is over               
              (iter-size
               (+ size 1)
               (cons (list->vector (reverse pos-lst))
                     size-lst))
              (iter-pos
               (+ position 1)
               (cons
                (delay
                  (let ((pred-value
                         (pred-impl
                          context (cons position size) var-binding)))
                    (if (number? pred-value)
                        (= pred-value position)
                        (sxml:boolean pred-value))))
                pos-lst)))))))))
   context-set))

ddo:vector-copy-set

Index
 is replaced with `obj'
(define (ddo:vector-copy-set vect k obj)
  (let loop ((src (vector->list vect))
             (pos 0)
             (res '()))
    (if
     (null? src)  ; iteration is over
     (list->vector (reverse res))
     (loop (cdr src)
           (+ pos 1)
           (cons
            (if (= pos k) obj (car src))
            res)))))

ddo:add-vector-to-var-binding

Index
 Extends `var-binding' with a vector data structure for binding variable
 values and values for deep predicates.
 Returns extended var-binding, which is constructed as follows:
 (cons (cons '*var-vector* ,vector)
       var-binding)
(define (ddo:add-vector-to-var-binding
         vars2offsets deep-predicates doc var-binding)
  (let ((cons-var-vector  ; cons var-vector to var-binding
         (lambda (var-vector var-binding)
           (cons (cons '*var-vector* var-vector)
                 var-binding))))
    (if
     (and (null? deep-predicates) (null? var-binding))
     var-binding  ; nothing to add
     (let* ((var-tree
             (if
              (< (length var-binding) 100)  ; not too many variables
              #f  ; do not need any tree
              (ddo:var-binding->tree var-binding)))
            (var-vector
             (let iter-offsets ((pos (- (car vars2offsets) 1))
                                (vars-alist (cdr vars2offsets))
                                (lst '()))
               (cond
                 ((< pos 0)  ; iteration is over
                  (list->vector lst))
                 ((or (null? vars-alist)  ; no more vars in the alist
                      (not (= pos (cdar vars-alist))))
                  (iter-offsets (- pos 1)
                                vars-alist
                                (cons #f lst)  ; cons a dummy value
                                ))
                 (else  ; this position is in the 1st member of vars-alist
                  (iter-offsets
                   (- pos 1)
                   (cdr vars-alist)
                   (cons
                    (cond  ; more sophisticated way of searching for value
                      (var-tree  ; access variables through var-tree
                       (ddo:get-var-value-from-tree  ; checks for declared var
                        (caar vars-alist) var-tree))
                      ((assq (caar vars-alist) var-binding)
                       => cdr)
                      (else
                       (sxml:xpointer-runtime-error "unbound variable - "
                                                    (cdar vars-alist))
                       '()))
                    lst)))))))
       (if
        (null? deep-predicates)
        (cons-var-vector var-vector var-binding)
        (let* ((context-set
                (if (null?  ; just absolute location paths
                     (filter
                      (lambda (triple)
                        (not (eq? (cadr triple) 'absolute-location-path)))
                      deep-predicates))
                    '()  ; dummy
                    (ddo:all-contexts-in-doc doc)))
               (max-size
                (if  ; position-required? for at least one deep predicate
                 (not (null? (filter cadr deep-predicates)))
                 (length context-set)
                 1  ; dummy
                 )))
          (let iter-preds ((deep-predicates deep-predicates)
                           (var-vector var-vector))
            (if
             (null? deep-predicates)  ; iteration is over
             (cons-var-vector var-vector var-binding)
             (iter-preds
              (cdr deep-predicates)
              (ddo:vector-copy-set
               var-vector
               (caar deep-predicates)  ; pred-id
               (cond
                 ((eq? (cadar deep-predicates) 'absolute-location-path)
                  ((caddar deep-predicates)  ; absolute lpath impl
                   (as-nodeset doc)
                   (cons 1 1)  ; dummy context position and size
                   (cons-var-vector var-vector var-binding)))
                 ((cadar deep-predicates)  ; requires-position?
                  (ddo:construct-pred-values-pos 
                   (caddar deep-predicates)  ; pred-impl
                   context-set
                   (cons-var-vector var-vector var-binding)
                   max-size))
                 (else
                  (ddo:construct-pred-values
                   (caddar deep-predicates)  ; pred-impl
                   context-set
                   (cons-var-vector var-vector var-binding))))))))))))))

ddo:charlst->branch

Index
 Represents a list of chars as a branch in the string-tree
 The list of chars must be non-empty
(define (ddo:charlst->branch lst value)
  (if (null? (cdr lst))  ; this is the last character in the lst
      (list (car lst) (cons 'value value))
      `(,(car lst) #f ,(ddo:charlst->branch (cdr lst) value))))

ddo:add-var-to-tree

Index
 Adds a new string to string-tree
(define (ddo:add-var-to-tree var-name var-value tree)
  (letrec
      ((add-lst-to-tree   ; adds the list of chars to tree
        (lambda (lst tree)
          (if
           (null? lst)  ; the lst is over
           (cons (car tree)
                 (cons (cons 'value var-value)  ; replace variable value
                       (cddr tree)))
           (let ((curr-char (car lst)))
             (let iter-alist ((alist (cddr tree))
                              (res (list (cadr tree) (car tree))))
               (cond
                 ((null? alist)  ; branch not in a tree
                  (reverse
                   (cons
                    (ddo:charlst->branch lst var-value)
                    res)))
                 ((char=? (caar alist) curr-char)  ; entry found
                  (if
                   (null? (cdr alist))  ; nothing more in the alist
                   (reverse
                    (cons
                     (add-lst-to-tree (cdr lst) (car alist))
                     res))
                   (append
                    (reverse
                     (cons
                      (add-lst-to-tree (cdr lst) (car alist))
                      res))
                    (cdr alist))))
                 ((char>? (caar alist) curr-char)
                  (if
                   (null? (cdr alist))  ; nothing more in the alist
                   (reverse
                    (cons
                     (car alist)
                     (cons (ddo:charlst->branch lst var-value)
                           res)))
                   (append
                    (reverse
                     (cons
                      (ddo:charlst->branch lst var-value)
                      res))
                    alist)))
                 (else
                  (iter-alist (cdr alist)
                              (cons (car alist) res))))))))))
    (add-lst-to-tree (string->list (symbol->string var-name))
                     tree)))

ddo:var-binding->tree

Index
 Convert var-binding to their tree representation
 var-binding is supposed to be non-null
(define (ddo:var-binding->tree var-binding)
  (let loop ((var-binding (cdr var-binding))
             (tree
              (list '*top*
                    #f
                    (ddo:charlst->branch
                     (string->list
                      (symbol->string (caar var-binding)))  ; var name
                     (cdar var-binding)))))
    (if (null? var-binding)
        tree
        (loop (cdr var-binding)
              (ddo:add-var-to-tree
               (caar var-binding) (cdar var-binding) tree)))))

ddo:get-var-value-from-tree

Index
 Obtain variable value from the tree
(define (ddo:get-var-value-from-tree var-name tree)
  (let loop ((lst (string->list (symbol->string var-name)))
             (tree tree))
    (cond
      ((and (not (null? lst))
            (assv (car lst) (cddr tree)))
       => (lambda (new-tree)
            (loop (cdr lst) new-tree)))
      ((and (null? lst)  ; lst is over
            (cadr tree)  ; value for variable in the tree supplied
            )
       (cdadr tree))
      (else
       (sxml:xpointer-runtime-error "unbound variable - " var-name)
       '()  ; dummy value
       ))))