Transform hierarchical document to flat document

(=> (current-root)
    (create-root
     #f
     (subgrove-spec
      subgrove: (sgml-parse-prolog "flat.sgm"))))

(=> (q-element 'doc)
    (default-transform))

(=> (union
     (union-for-each
      x
      (q-element 'p)
      (node-list-first (select-by-class (children x)
                                        'data-char)))
     (union-for-each
      x
      (q-element 'l)
      (node-list-first (select-by-class (follow x)
                                        'data-char))))
    (create-sub (ancestor "doc" (current-node))
                (subgrove-spec
                 class: 'element
                 add: '((gi "P"))
                 children: (list (copy-current))
                 sub: (list (cons
                             'attributes
                             (generate-para-attributes)))
                 label: 'ignore))
    1)  ; higher priority

(=> (select-by-class (subgrove (current-root))
                     'data-char)
    (identity-transform-by-ipreced))
    
(define (generate-para-attributes)
  (let ((cur (current-node)))
    (list (subgrove-spec
           class: 'attribute-assignment
           add: '((name "MARK"))
           children:
           (subgrove-spec
            class: 'attribute-value-token
            add: `((token ,(if (p-marked? cur)
                               "MARK"
                               "NOMARK")))))
          (subgrove-spec
           class: 'attribute-assignment
           add: '((name "LEVEL"))
           children:
           (subgrove-spec
            class: 'attribute-value-token
            add: `((token ,(number->string
                            (p-level cur))))))
          (subgrove-spec
           class: 'attribute-assignment
           add: '((name "CONT"))
           children:
           (subgrove-spec
            class: 'attribute-value-token
            add: `((token ,(if (p-continued? cur)
                               "CONT"
                               "NOCONT"))))))))

(define (p-level nd)
  (node-list-count
   (select-element (ancestors nd) 'L)))

(define (p-continued? nd)
  (not
   (node-list-empty?
    (select-by-class (preced nd)
                     'element))))

(define (p-marked? nd)
  (and (not (p-continued? nd))
       (let ((p (parent nd)))
         (and (match-element? (parent p) 'I)
              (node-list-empty?
               (select-element (preced p)
                               'P))))))