;;;-*- Mode: Lisp; Package: CONSTRAINT-GRAMMAR-PARSER -*-

(in-package :cgp)

(defmethod print-lemmatized-sentence ((sentence sentence)
			                   &key (stream *standard-output*)
				           (expand-tokens-p t)
                                           print-wordform-p
                                           first-only-p
                                           &allow-other-keys)
  (let ((first-p t))
    (labels ((walk (token concat-token)
               (cond ((null token)
		      nil)
		     ((and expand-tokens-p (token-expansion token))
		      (do ((ex-token (car (token-expansion token)) (token-next ex-token)))
			  ((eq ex-token (cdr (token-expansion token)))
			   (walk ex-token token))
		        (walk ex-token token))
		      (walk (token-next token) nil))
                     ((insignificant-token-p token)
                      (walk (token-next token) nil))
		     (t
		      (let ((value (token-value token))
			    (features (token-features (or concat-token token))))
		        (when (stringp value)
                          (if first-p
                            (setf first-p nil)
                            (write-char #\Space stream))
                          (when print-wordform-p
                            (format stream "~a:" value))
                          (let ((pos-list ()))
                            (dolist (fl features)
                              (unless (and first-only-p pos-list)
                                (when (car fl)
                                  (let ((f (code-first-feature (cdr fl))))
                                    (unless (find-if (lambda (lemma.pos)
                                                       (destructuring-bind (lemma . pos) lemma.pos
                                                         (and (string= lemma (car fl))
                                                              (eq pos f))))
                                                     pos-list)
                                      (format stream "~@[~a~]~a/~a" (when pos-list "\\") 
                                              (remove #\$ (car fl)) f)
                                      (push (cons (car fl) f) pos-list))))))))
                        (unless (or (eq token (last-token sentence)) concat-token)
                          (walk (token-next token) nil)))))))
      (walk (first-token sentence) nil)))
  sentence)

(defun lemmatize-string (string &key (stream *standard-output*)
                                   (cg (gethash "nbo" *cg-table*))
                                   print-wordform-p
                                   first-only-p)
  (with-input-from-string (in-stream string)
    (disambiguate-stream *tokenizer* in-stream
                         :cg cg
                         :print-function
			 (lambda (s) (funcall #'print-lemmatized-sentence s :stream stream
                                              :print-wordform-p print-wordform-p
                                              :first-only-p first-only-p))
                         :tagging-niveau :morphological-disambiguation)))

#+test
(lemmatize-string "Hun kjøpte nye maskiner." :print-wordform-p nil)

;;; EOF