#-garsia-wachs
(defun %analyse-compound (string start &optional
                                    (fullform-net *fullforms*)
                                    (lemma-net *lemmata*))
  (let* ((word-end-marker #\:)
         (length (length string))
         (count -1)
         (current-analysis *current-analysis*)
         (memory (make-array (1+ length) :initial-element t)))
    (with-slots (arcs compression-vector) lemma-net
      (let ((l-arcs arcs) (l-compression-vector compression-vector)) ; rename
        (with-slots (arcs compression-vector) fullform-net
          (labels
            ((walk-memoized (analysis) ; change name!
                (dolist (sub-analysis analysis)
                  (vector-push-extend (car sub-analysis) current-analysis)
                  (if (cdr sub-analysis)
                    (walk-memoized (cdr sub-analysis))
                    (vector-push-extend (compute-ranking-info (incf count) current-analysis) *ranking*))
                  (decf (fill-pointer current-analysis))))
             (analyse (start)
                (let ((memoized-analysis (aref memory start)))
                  (if (eq memoized-analysis t) ; means NOT memoized!
                    (setf (aref memory start)
                          (u:collecting 
                            (labels
                              ((walk (pos ff-n l-n)
                                  (let* ((ff-address (when (< pos length)
                                                       (get-arc arcs compression-vector
                                                                (char string pos) ff-n)))
                                         (ff-end-marker-address (get-arc arcs compression-vector 
                                                                         word-end-marker ff-n))
                                         (l-address (when (and l-n (< pos length))
                                                      (get-arc l-arcs l-compression-vector
                                                               (char string pos) l-n)))
                                         (l-end-marker-address (when l-n
                                                                 (get-arc l-arcs l-compression-vector 
                                                                          word-end-marker l-n))))
                                    (when ff-address
                                      (walk (1+ pos) ff-address l-address))
                                    (when ff-end-marker-address
                                      (multiple-value-bind 
                                        (address endp)
                                        (get-arc arcs compression-vector word-end-marker ff-n)
                                        (declare (ignore endp))
                                        ;; then, extract codes using the remaining sub-network
                                        (let ((codes ())
                                              (chunk (subseq string start pos)))
                                          (map-strings fullform-net (lambda (code) (push code codes)) address)
                                          (when (check-chunk current-analysis chunk codes nil)
                                            (let ((chunk+codes (cons chunk codes)))
                                              (vector-push-extend (cons nil chunk+codes) current-analysis)
                                              ;; check if this is not first chunk
                                              (multiple-value-bind (full-analysis) (analyse pos) 
                                                (let ((analysis (filter-two chunk codes full-analysis current-analysis)))
                                                  (when (or analysis (= pos length))
                                                    (unless (zerop start) (setf (aref *compound-chunks* pos) chunk))
                                                    (u:collect (cons (cons 
                                                                      ;; label the node by the number of complete paths starting from it
                                                                      (if analysis (reduce #'+ analysis :key #'caar) 1)
                                                                      chunk+codes)
                                                                     analysis)))
                                                  (decf (fill-pointer current-analysis)))))))))
                                    ;; the same for lemmata
                                    (when l-end-marker-address
                                      (multiple-value-bind 
                                        (address endp)
                                        (get-arc l-arcs l-compression-vector word-end-marker l-n)
                                        (declare (ignore endp))
                                        (let ((codes ())
                                              (chunk (subseq string start pos)))
                                          (map-strings lemma-net 
                                                       (lambda (code) (push code codes))
                                                       address)
                                          (when (check-chunk current-analysis chunk codes nil)
                                            ;; no juncture
                                            (let ((chunk+codes (cons chunk codes)))
                                              (vector-push-extend (cons nil chunk+codes) current-analysis)
                                              (multiple-value-bind (full-analysis) (analyse pos)
                                                (let ((analysis (filter-two chunk codes full-analysis current-analysis)))
                                                  (when (or analysis (= pos length))
                                                    (unless (zerop start) (setf (aref *compound-chunks* pos) chunk))
                                                    (u:collect (cons (cons (if analysis (reduce #'+ analysis :key #'caar) 1)
                                                                           chunk+codes) analysis)))
                                                  (decf (fill-pointer current-analysis)))))
                                            ;; juncture
                                            (unless (or (find-if #'adverb-p codes)
                                                        (= pos length))
                                              (cond ((and (char= (char string pos) #\e)
                                                          ;(print current-analysis)
                                                          (e-juncture-allowed-p chunk codes current-analysis))
                                                     (let ((chunk+codes (cons chunk codes))
                                                           (juncture (list "e" :e-juncture)))
                                                       (vector-push-extend (cons nil chunk+codes) current-analysis)
                                                       (vector-push-extend (cons nil juncture) current-analysis)
                                                       (multiple-value-bind (full-analysis) (analyse (1+ pos))
                                                         (let ((analysis (filter-two chunk codes full-analysis
                                                                                     current-analysis :e-juncture)))
                                                           (decf (fill-pointer current-analysis) 2)
                                                           (when analysis
                                                             (unless (zerop start) (setf (aref *compound-chunks* pos) chunk))
                                                             (let ((branch-count (reduce #'+ analysis :key #'caar)))
                                                               (u:collect (list (cons branch-count chunk+codes)
                                                                                (cons (cons branch-count juncture) analysis)))))))))
                                                    ;; code duplication!
                                                    ((and (char= (char string pos) #\s)
                                                          (s-juncture-allowed-p chunk codes current-analysis))
                                                     (let ((chunk+codes (cons chunk codes))
                                                           (juncture (list "s" :s-juncture)))
                                                       (vector-push-extend (cons nil chunk+codes) current-analysis)
                                                       (vector-push-extend (cons nil juncture) current-analysis)
                                                       (multiple-value-bind (full-analysis) (analyse (1+ pos))
                                                         (let ((analysis (filter-two chunk codes full-analysis
                                                                                   current-analysis :s-juncture)))
                                                           (decf (fill-pointer current-analysis) 2)
                                                           (when analysis
                                                             (unless (zerop start) (setf (aref *compound-chunks* pos) chunk))
                                                             (let ((branch-count (reduce #'+ analysis :key #'caar)))
                                                               (u:collect (list (cons branch-count chunk+codes)
                                                                                (cons (cons branch-count juncture) analysis))))))))))))))))))
                              (walk start 0 0))))
                    (values memoized-analysis t)))))
            (let ((analyses (if (zerop start)
                              (analyse start)
                              (progn
                                (vector-push-extend (list nil (subseq string 0 start)) current-analysis)
                                (let* ((sub-analysis (analyse start))
                                       (branch-count (count-analyses sub-analysis)))
                                  (prog1 (when sub-analysis
                                           (list (cons (list branch-count (subseq string 0 start)) sub-analysis)))
                                    (decf (fill-pointer current-analysis))))))))
              (walk-memoized analyses)
              analyses)))))))