(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 :utf-8) (format out ";;; Hey, emacs(1), ~ this is -*- Mode: TDL; Coding: utf-8; -*- 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))))) ;; ;; also, re-generate the ERG SEM-I `summary', i.e. the temporary expedient to ;; expose information about countability and pluralia tantia to transfer. ;; (with-open-file (stream (format nil "~a/uio/.semi.erg.mtr" logon) :direction :output :if-exists :supersede) (with-open-file (header (format nil "~a/uio/semi.erg.mtr" logon) :direction :input) (loop for line = (read-line header nil nil) repeat 12 while line do (write-string line stream) (terpri stream))) (labels ((normalize (pred) (let* ((start (if (char= (schar pred 0) #\_) 1 0)) (end (position #\_ pred :start start))) (subseq pred start end)))) (let (mass count plural) (loop for key being each hash-key in (tl-output *transfer-lexicon*) for sps = (lookup-predicate key (find :erg *semis* :key #'semi-name)) when sps do (when (and (stringp key) (search "_n_" key)) (cond ((loop with akey = (mrs:vsym "ARG0") with ikey = (mrs:vsym "IND") for minus = (mrs:vsym "-") for ep in (sps-synopses sps) for arg0 = (loop for role in (ep-roles ep) when (eq (role-name role) akey) return (role-value role)) for ind = (when (and arg0 (variable-p arg0)) (loop for property in (variable-properties arg0) for name = (property-name property) when (eq name ikey) return (property-value property))) always (eq ind minus)) (push key mass)) ((loop with akey = (mrs:vsym "ARG0") with ikey = (mrs:vsym "IND") for plus = (mrs:vsym "+") for ep in (sps-synopses sps) for arg0 = (loop for role in (ep-roles ep) when (eq (role-name role) akey) return (role-value role)) for ind = (when (and arg0 (variable-p arg0)) (loop for property in (variable-properties arg0) for name = (property-name property) when (eq name ikey) return (property-value property))) always (eq ind plus)) (push key count))) (when (loop with akey = (mrs:vsym "ARG0") with ikey = (mrs:vsym "NUM") for pl = (mrs:vsym "pl") for ep in (sps-synopses sps) for arg0 = (loop for role in (ep-roles ep) when (eq (role-name role) akey) return (role-value role)) for num = (when (and arg0 (variable-p arg0)) (loop for property in (variable-properties arg0) for name = (property-name property) when (eq name ikey) return (property-value property))) always (eq num pl)) (push key plural)))) (setf count (sort count #'string<)) (setf mass (sort mass #'string<)) (setf plural (sort plural #'string<)) (loop for pred in count do (format stream "count_mark_~a_ef := count_mark_amtr &~%~ [ CONTEXT.RELS < [ PRED ~s ] > ].~%~%" (normalize pred) pred)) (loop for pred in mass do (format stream "mass_mark_~a_ef := mass_mark_amtr &~%~ [ CONTEXT.RELS < [ PRED ~s ] > ].~%~%" (normalize pred) pred)) (loop for pred in plural do (format stream "pural_mark_~a_ef := plural_mark_amtr &~%~ [ CONTEXT.RELS < [ PRED ~s ] > ].~%~%" (normalize pred) pred))))) (rename-file (format nil "~a/uio/.semi.erg.mtr" logon) (format nil "~a/uio/semi.erg.mtr" logon)))