;;;   -*- Mode: LISP; Package: CGP; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;
;; Copyright (C) Paul Meurer 1999 - 2004. All rights reserved.
;; paul.meurer@hit.uib.no
;; Aksis, University of Bergen
;;
;; Constraint Grammar Parser utility functions 
;;
;; load this file after the rules files

;;-------------------------------------------------------------------------------------
;; TO DO:
;;
;;-------------------------------------------------------------------------------------

(in-package "CGP")

(setf *nbo-cg* (gethash "nbo" *cg-table*)
      *nny-cg* (gethash "nny" *cg-table*))

(defun d (string &optional (version "nbo"))
  (disambiguate-from-string string :cg (gethash version *cg-table*)))
(defun dc (string &optional (version "nbo"))
  (disambiguate-from-string string :cg (gethash version *cg-table*) :context-size *context-size*))
(defun mt (string) (disambiguate-from-string string :tagging-niveau :multi-tagging :cg *nbo-cg*))
(defun ds (string) (disambiguate-from-string string :tagging-niveau :syntactic-disambiguation :cg *nbo-cg*))
(defun dn (string) (disambiguate-from-string string :tagging-niveau :named-entity-disambiguation :cg *nbo-cg* :context-size *context-size*))
(defun dm (string) (disambiguate-from-string string :tagging-niveau :syntactic-mapping :cg *nbo-cg*))
(defun d-nn (string) (disambiguate-from-string string :cg (gethash "nny-aug" *cg-table*)))
(defun mt-nn (string) (disambiguate-from-string string :tagging-niveau :multi-tagging :cg *nny-cg*))
(defun ds-nn (string) (disambiguate-from-string string :tagging-niveau :syntactic-disambiguation :cg *nny-cg*))

(defun escape-quotes (str)
  (subst-substrings str '("\"" "\\\"" "oe" "ø" "aa" "å" "ae" "æ"))
  #+ignore
  (let ((quote-pos (position #\" str)))
    (if quote-pos
      (concat (subseq str 0 quote-pos) "\\\"" (escape-quotes (subseq str (1+ quote-pos))))
      str)))

;(escape-quotes "as\"df")
;(subst-substrings "as\"df" '("\"" "\\\""))

(defun include-comments (rule-file out-file)
  (with-open-file (stream out-file :direction :output
		   :if-does-not-exist :create :if-exists :supersede)
    (let ((prev-line "")
	  (grc-count 73)
          (niveau 0)
          (in-group-comment-p nil)
          (group-comment-p nil)
          (in-comment-p nil))
      (with-file-lines (line rule-file)
        (let ((pos (search "=s" line)))
          (when pos
            (let ((c (char line (+ pos 4))))
              (cond ((and (char= c #\1)
                          (/= niveau 1))
                     (setf niveau 1 group-comment-p nil))
                    ((and (char= c #\3)
                          (/= niveau 3))
                     (setf niveau 3 group-comment-p nil))
                    ((and (char/= c #\1)
                          (char/= c #\3)
                          (/= niveau 0))
                     (setf niveau 0 group-comment-p nil))))))
	;(print line)
        (cond ((and (string/= prev-line "")
                    (char= (last-char prev-line) #\))
                    (string/= prev-line "; " :end1 2)
                    (string/= prev-line ";")
		    (string= (string-trim " " line) "")
                    group-comment-p)
               (write-line (subseq prev-line 0 (1- (length prev-line))) stream)
               (format stream "   (:group ~d))~%" grc-count)
               (setf prev-line line))
              ((and (string/= line ";")
		    (or (< (length line) 3)
			(string/= line "; " :end1 2)))
               (write-string prev-line	;(if in-comment-p (escape-quotes prev-line) prev-line)
                             stream)
               (when in-comment-p
                 (setf in-comment-p nil)
                 (write-string "\"))" stream))
	       (when in-group-comment-p
                 (setf in-group-comment-p nil)
                 (write-line "\")" stream))
               (terpri stream)
               (setf prev-line line))
              (in-comment-p
               (write-line prev-line stream)
               (setf prev-line (escape-quotes (subseq line (min 2 (length line))))))
	      (in-group-comment-p
               (write-line prev-line stream)
               (setf prev-line (escape-quotes (subseq line (min 2 (length line))))))
	      ((and (string/= prev-line "")
                    (char= (last-char prev-line) #\))
                    (string/= prev-line "; " :end1 2))
               (write-line (subseq prev-line 0 (1- (length prev-line))) stream)
               (setf prev-line (concat (if group-comment-p 
                                         (format nil
                                          "   (:group ~d~%    :comment \""
                                          grc-count)
                                         "   (:comment \"")
                                       (escape-quotes (subseq line 2)))
                     in-comment-p t))
              ((and (string= (string-trim " " prev-line) "")
		    (string= line "; " :end1 2))
	       (write-line prev-line stream)
	       (setf prev-line (format nil "(:group-comment ~d \"~a"
                                       (incf grc-count)
                                       (escape-quotes (subseq line 2))) 
		     in-group-comment-p t
                     group-comment-p t))
	      (t
	       (write-line prev-line stream)
	       (setf prev-line line))))
      (write-line prev-line stream))))

#+test
(include-comments "projects:cgp;rules;nny-syn-h.lisp" "projects:cgp;rules;nny-syn-q.lisp")
#+test
(include-comments "projects:cgp;rules;nny-map-h.lisp" "projects:cgp;rules;nny-map-q.lisp")

#+test
(include-comments "projects:cgp;rules;norsk-syn-orig.lisp" "projects:cgp;rules;norsk-syn.lisp")
#+test
(include-comments "/home/paul/lisp/projects/cgp/rules/norsk-map_nn.rle" "projects:cgp;rules;nny-map.lisp")
#+test
(include-comments "/home/paul/lisp/projects/cgp/rules/nny-map.lisp" "projects:cgp;rules;nny-map-q.lisp")


#+test
(print (probe-file #p"lisp:projects;cgp;rules;norsk-map_nn.rle"))

#+test
(print (directory "projects:cgp;rules;*.rle"))

#+test
(print (probe-file #p"/home/paul/lisp/projects/cgp/rules/norsk-map_nn.rle"))

(defun add-heuristic-niveaus (rule-file out-file)
  (with-open-file (stream out-file :direction :output
		          :if-does-not-exist :create :if-exists :supersede)
    (let ((niveau 0))
      (with-file-lines (line rule-file)
        (cond ((string= (string-trim " " line) "0:")
               (setf niveau 0))
              ((string= (string-trim " " line) "1:")
               (setf niveau 1))
              ((string= (string-trim " " line) "3:")
               (setf niveau 3)))
        (let ((pos (search "=s" line)))
          (if (and pos (> niveau 0))
            (write-line (concat (subseq line 0 (+ pos 3))
                                (format nil "h~d" niveau)
                                (subseq line (+ pos 3) ))
                        stream)
            (write-line line stream)))))))

#+test
(add-heuristic-niveaus "projects:cgp;rules;nny-syn.lisp" "projects:cgp;rules;nny-syn-h.lisp")


:eof