;;;   -*- Mode: LISP; Package: CGP; BASE: 10; Syntax: ANSI-Common-Lisp; -*-

(in-package :cgp)

(defparameter *punctuation-function*
  '("<punkt>" "<komma>" "<spm>" "<utrop>" "<kolon>" "<strek>" "<semi>"))

(defparameter *verbose-preprocessing-p* nil)

(defun preprocess-for-visl (string &key (verbose *verbose-preprocessing-p*))
  (let* ((last nil)
         (result
          (with-output-to-string (output)
            (disambiguate-from-string string
             :cg (gethash "nbo" *cg-table*) :context-size nil
             :tagging-niveau :syntactic-disambiguation
             :print-function #'print-sentence
             :token-print-fn
             (lambda (token &key concat-token stream &allow-other-keys)
               (declare (ignore stream))
               (loop
                   with token = (or concat-token token)
                   with form = (let ((form (token-value token)))
                                 (if (stringp form) 
                                   (substitute #\_ #\Space form)
                                   form))
                   with analyses = (token-features token)
                   with result = nil
                   with break = nil
                   for analysis in analyses
                   while (null break)
                   when analysis do
                     (let* ((stem (first analysis))
                            (stem (or (and (stringp stem)
                                           (substitute #\_ #\Space stem))
                                      form))
                            (features (when (rest analysis)
                                        (code-features (rest analysis))))
                            (tag (first features))
                            (punctuationp (or 
                                           (eq tag 'clb)
                                           (intersection 
                                            features *punctuation-function* 
                                            :test #'string-equal)))
                            (functions 
                             (loop 
                                 for feature in features
                                 when (find #\@ (string feature) :test #'char=)
                                 collect feature)))
                       (unless (eq form :newline)
                         (cond
                          (punctuationp
                           (setf form (format nil "$~a" form))
                           (setf result nil)
                           (setf break t))
                          ((and stem tag functions)
                           (loop
                               for function in functions
                               for analysis = (list stem tag function)
                               unless (member analysis result :test #'equal) 
                               do (push analysis result))))))
                   finally
                     (if break
                       (format output "~a~%" form)
                       (cond
                        ((equal result last)
                         (format
                          t
                          "preprocess-for-visl(): ~
                           ignoring `duplicate' token `~a'.~%"
                          form))
                        (result
                         (setf last result)
                         (format output "~a" form)
                         (loop
                             for (stem tag function) in (nreverse result)
                             do 
                               (format
                                output
                                " ~s ~(~a~) ~(~a~)"
                                stem tag function))
                         (format output "~%"))
                        (t
                         (format
                          t
                          "preprocess-for-visl(): ~
                           null analysis for `~a'.~%"
                          form))))))))))
    (when verbose
      (format t "~&~%~a~%-->~%~a~%" string result))
    result))