(in-package :mt)

(let ((logon (let ((root (system:getenv "LOGONROOT")))
               (when root (namestring (parse-namestring root))))))
  (lkb:read-script-file-aux (format nil "~a/uio/noen/lkb/script" logon))
  (with-open-file (stream (format nil "~a/uio/noen/norgram.unknown" logon)
                   :direction :output :if-exists :supersede)
    (loop
        with *package* = (find-package :lkb)
        with semi
        = (read-semi
           (format nil "~a/parc/pargram/norwegian/bokmal/norgram.smi" logon))
        with transfer = (tl-input *transfer-lexicon*)
        for pred being each hash-key in transfer
        unless (or (null pred) (lookup-predicate pred semi))
        do
          (let ((ids (loop
                         for mtr in (gethash pred transfer)
                         for name = (string-downcase (string (mtr-id mtr)))
                         unless (ppcre:scan "_[nce]f$" name)
                         collect (mtr-id mtr))))
            (when ids
              (format
               stream
               "~:[~(~a~)~;~s~] ~{~(~a~)~^ ~}~%"
               (stringp pred) pred ids)))))
  (with-open-file (stream (format nil "~a/uio/noen/noen.unknown" logon)
                   :direction :output :if-exists :supersede)
    (loop
        with semi
        = (read-semi
           (format nil "~a/parc/pargram/norwegian/bokmal/norgram.smi" logon))
        with transfer = (tl-input *transfer-lexicon*)
        with preds
        = (sort
           (loop
               for pred being each hash-key in (semi-predicates semi)
               collect pred)
           #'string<)
        for pred in preds
        unless (or (null pred) (search "_sel_" pred)
                   (gethash pred transfer))
        do (format stream "~:[~(~a~)~;~s~]~%" (stringp pred) pred)))
  ;;
  ;; also re-generate the dis-preference transfer rules for NorGram
  ;;
  (with-open-file (out (format
                           nil
                           "~a/parc/pargram/norwegian/bokmal/lkb/filter.mtr"
                           logon)
                   :direction :output :if-exists :supersede
                   :external-format :iso-8859-1)
    (format
     out
     ";;; Hey, emacs(1), ~
      this is -*- Mode: TDL; Coding: iso-8859-1; -*- got it?~%~%~%")
    (labels ((normalize (pred)
               (multiple-value-bind (end foo) (ppcre:scan "_rel$" pred)
                 (declare (ignore foo))
                 (loop
                     with start = (if (char= (char pred 0) #\_) 1 0)
                     for c across (subseq pred start end)
                     unless (member c '(#\( #\) #\. #\"))
                     collect c into result
                     finally (return (coerce result 'string))))))
      (with-open-file (stream (format nil "~a/uio/noen/noen.unknown" logon)
                       :direction :input :external-format :utf-8)
        (loop
            for pred = (read stream nil nil)
            while pred do
              (format
               out
               "~a_warn_nf := monotonic_mtr &~%~
                [ INPUT.RELS < [ PRED ~s ] >,~%  ~
                  FLAGS.WARN \"unknown transfer predicate: |~a|\" ].~%~%"
               (normalize pred) pred pred)))))
  
  (with-open-file (stream (format nil "~a/uio/noen/erg.unknown" logon)
                   :direction :output :if-exists :supersede)
    (loop
        with *package* = (find-package :lkb)
        with semi
        = (read-semi (format nil "~a/lingo/erg/erg.smi" logon))
        with transfer = (tl-output *transfer-lexicon*)
        for pred being each hash-key in transfer
        unless (or (null pred) (lookup-predicate pred semi))
        do
          (let ((ids (loop
                         for mtr in (gethash pred transfer)
                         for name = (string-downcase (string (mtr-id mtr)))
                         unless (ppcre:scan "_[nce]f$" name)
                         collect (mtr-id mtr))))
            (when ids
              (format
               stream
               "~:[~(~a~)~;~s~] ~{~(~a~)~^ ~}~%"
               (stringp pred) pred ids))))))