(herald (assembler count t 45)
        (env tsys (assembler as_open) (assembler fg) (assembler ib)))

;;; Count number of marks, and number of span-dependent fg's

(define (count-spans ibv)
  (let ((ibv-length (vector-length ibv)))
    (iterate loop ((i 0) (marks 0) (sdfs 0))
       (cond ((fx>= i ibv-length) (return marks sdfs))
             (else 
              (receive (m' s') (count-ib (vref ibv i) marks sdfs)
                 (loop (fx+ i 1) m' s')))))))

(define (count-ib ib m first-s)
  (let ((new-s (cond ((pair? (ib-align ib))
                      (fx+ first-s 1))
                     (else first-s))))
    (set (ib-sdf-number ib) new-s)
    (iterate loop ((i's (ib-instructions ib)) (m m) (s new-s))
      (cond ((null? i's)
             (return m s))
            (else
             (receive (m' s') (count-fg (car i's) m s)
                (loop (cdr i's) m' s')))))))

(define (count-fg fg m s)
  (let* ((fgt (fg-type fg))
         (vars (fg-vars fg))
         (vals (fg-type-vals fgt)))
    (iterate loop ((ops (fg-type-ops fgt))
                   (m m)
                   (s s))
      (cond ((null? ops) (return m s))
            (else
             (xselect (car ops)
               ((wop/fix)
                (destructure (((#f width vop voc1 . ops) ops))
                  (loop ops m s)))
               ((wop/@fix)
                (destructure (((#f width-i vop voc1 . ops) ops))
                  (loop ops m s)))
               ((wop/variable)
                (destructure (((#f sdf-i mark-i fge-i . ops) ops))
                  (set (sdf-number (vref vars sdf-i)) s)
                  (loop ops m (fx+ s 1))))
               ((wop/subfield)
                (destructure (((#f sf-i . ops) ops))
                  (receive (m' s') (count-fg (vref vars sf-i) m s)
                    (loop ops m' s'))))
               ((wop/mark)
                (destructure (((#f count-i . ops) ops))
                  (let ((mark (vref vars count-i)))
                    (set (mark-number mark) m)
                    (set (mark-sdf-position mark) s)
                    (loop ops (fx+ m 1) s))))
               ((wop/group)
                (destructure (((#f start? . ops) ops))
                  (loop ops m s)))
               ))))))