3.9.1 Example: Converter to GIT Configuration Format

Here is a more practical example of Scheme scripting. This script converts entire parse tree into a GIT configuration file format. The format itself is described in GIT Configuration File.

The script traverses entire tree itself, so it must be called only once, for the root node of the parse tree. The root node is denoted by a single dot, so the invocation syntax is:

 
cfpeek -f togit.scm sample.conf .

Traversal is performed by the main function, cfpeek, using the grecs-node-next and grecs-node-down functions. The grecs-node-next function returns a node which follows its argument at the same nesting level. For example, if n is the very first node in our sample parse tree, then:

 
n ⇒ #<node .user: "smith">
(grecs-node-next n) ⇒ #<node .group: "mail">

Similarly, the grecs-node-down function returns the first subordinate node of its argument. For example:

 
n ⇒ #<node .logging>
(grecs-node-down n) ⇒ #<node .logging.facility: "daemon">

Both functions return ‘#f’ if there are no next or subordinate node, correspondingly.

The grecs-node-type function is used to determine how to handle that particular node. It returns a type of the node given to it as argument. The type is an integer constant, with the following possible values:

Type The node is
grecs-node-root the root (topmost) node
grecs-node-stmt a simple statement
grecs-node-block a compound (block) statement

The print-section function prints a GIT section header corresponding to its node. It ascends the parent node chain to find the topmost node and prints the traversed nodes in the correct order.

To summarize, here is the listing of the ‘togit.scm’ script:

 
(define (print-section node delim)
  "Print a Git section header for the given node.
End it with delim.

The function recursively calls itself until the topmost
node is reached.
"
  (cond
   ((grecs-node-up? node)
    ;; Ascend to the parent node
    (print-section (grecs-node-up node) #\space)
    ;; Print its identifier, ...
    (display (grecs-node-ident node))
    (if (grecs-node-has-value? node)
        ;; ... value,
        (begin
          (display " ")
          (display (grecs-node-value node))))
    ;; ... and delimiter
    (display delim))
   (else              ;; mark the root node
    (display "["))))  ;;  with a [


(define (cfpeek node)
  "Main entry point.  Calls itself recursively to descend
into subordinate nodes and to iterate over nodes on the
same nesting level (tail recursion)."
  (let loop ((node node))
    (if node
        (let ((type (grecs-node-type node)))
          (cond
           ((= type grecs-node-root)
            (let ((dn (grecs-node-down node)))
              ;; Each statement in a Git config file must
              ;; belong to a section.  If the first node
              ;; is not a block statement, provide the
              ;; default [core] section:
              (if (not (= (grecs-node-type dn)
                          grecs-node-block))
                  (display "[core]\n"))
              ;; Continue from the first node
              (loop dn)))
           ((= type grecs-node-block)
            ;; print the section header
            (print-section node #\])
            (newline)
            ;; descend into subnodes
            (loop (grecs-node-down node))
            ;; continue from the next node
            (loop (grecs-node-next node)))
           ((= type grecs-node-stmt)
            ;; print the simple statement
            (display #\tab)
            (display (grecs-node-ident node))
            (display " = ")
            (display (grecs-node-value node))
            (newline)
            ;; continue from the next node
            (loop (grecs-node-next node))))))))

If run on our sample configuration file, it produces:

 
$ cfpeek -f togit.scm sample.conf .
[core]
        user = smith
        group = mail
        pidfile = /var/run/example
[logging]
        facility = daemon
        tag = example
[program a]
        command = a.out
[program a logging]
        facility = local0
        tag = a
[program b]
        command = b.out
        wait = yes
        pidfile = /var/run/b.pid