;;; Copyright (c) 1998-2017 John Carroll, Ann Copestake, Robert Malouf, Stephan Oepen ;;; see LICENSE for conditions (in-package :lkb) ;;; MRS related output functions to clean up MRS-less LKB ;;; generator output functions which are not dialect specific (defun show-gen-result nil (if #+:lui (lui-status-p :realization) #-:lui nil (lui-show-gen-result) #+:tty (show-gen-result-tty) #-:tty (if *gen-record* (draw-active-list (mapcar #'(lambda (edge) (cons (g-edge-string edge) edge)) *gen-record*) (format nil "Generator Results (~A)" (length *gen-record*)) (list (cons "Feature structure" #'(lambda (edge) (display-fs (g-edge-dag edge) (format nil "Edge ~A G - Edge FS" (g-edge-id edge))))) (cons "Tree" #'(lambda (edge) (display-parse-tree edge nil))) (cons "MRS" #'(lambda (edge) (show-mrs-window edge))))) (show-message-window "No strings generated")))) #-:tty (defun show-generator-input () (when *generator-input* #+:mrs (mrs::browse-mrs *generator-input* "Generator Input MRS" :display :indexed))) #-:tty (defun show-generator-internal-mrs () (when *generator-internal-mrs* #+:mrs (mrs::browse-mrs *generator-internal-mrs* "Generator Internal MRS" :display :indexed))) #-:tty (defun show-gen-edge (&optional id) (let ((possible-edge-name (if (numberp id) (list id) (ask-for-lisp-movable "Current Interaction" `(("Specify an edge number" . ,*edge-id*)) nil)))) (when possible-edge-name (let* ((edge-id (car possible-edge-name)) (edge-record (find-gen-edge-given-id edge-id))) (when edge-record (display-parse-tree edge-record t)))))) (defun find-gen-edge-given-id (edge-id) (flet ((find-edge-in-gen-chart (edge-id) (dolist (entry *gen-chart*) (dolist (rels-and-edges (append (cadr entry) (cddr entry))) (dolist (edge (cdr rels-and-edges)) (when (eql edge-id (g-edge-id edge)) (return-from find-edge-in-gen-chart edge))))))) (or (find-edge-in-gen-chart edge-id) (loop for g in *gen-record* thereis (find-edge-in-gen-result edge-id g))))) (defun find-edge-in-gen-result (edge-id e) (if (eql (g-edge-id e) edge-id) e (loop for c in (g-edge-children e) thereis (find-edge-in-gen-result edge-id c)))) ;;; Graphical display of generator chart (show-gen-chart) (show-gen-chart t) #-:tty (defun show-gen-chart (&optional all-p) (if *gen-chart* (let ((root (make-symbol ""))) (create-gen-chart-pointers root all-p) (draw-chart-lattice root (format nil "Generator Chart (~A edges)" (if all-p "all" "inactive"))) root) (lkb-beep))) (defun create-gen-chart-pointers (root all-p) ;; create a global mapping from edge-ids to symbols, not interned - so we don't ;; end up hanging on to old edges (let ((edge-symbols nil)) (dolist (entry *gen-chart*) (dolist (rels-edges (append (cadr entry) (cddr entry))) (dolist (e (cdr rels-edges)) (push (list* (edge-id e) (make-edge-symbol (edge-id e)) (g-edge-needed e)) edge-symbols)))) (dolist (entry *gen-chart*) (let ((chart-index (string-downcase (string (car entry))))) (dolist (rels-edges (append (cadr entry) (cddr entry))) (dolist (e (cdr rels-edges)) (let ((edge-symbol (cadr (assoc (edge-id e) edge-symbols)))) (setf (get edge-symbol 'chart-edge-name) (chart-edge-text-string e chart-index nil)) (when (g-edge-needed e) (setf (get edge-symbol 'chart-edge-name) (concatenate 'string (get edge-symbol 'chart-edge-name) " A"))) (setf (get edge-symbol 'chart-edge-leaves) (edge-leaves e)) (setf (get edge-symbol 'chart-edge-id) (edge-id e)) (if (edge-children e) (dolist (c (edge-children e)) (when c (push edge-symbol (get (cadr (assoc (edge-id c) edge-symbols)) 'chart-edge-descendants)))) (push edge-symbol (get root 'chart-edge-descendants)))))))) (unless all-p ;; remove intermediate links consisting of active edges (dolist (pair edge-symbols) (setf (get (cadr pair) 'chart-edge-descendants) (create-gen-chart-pointers-collapse (get (cadr pair) 'chart-edge-descendants) edge-symbols)))))) (defun create-gen-chart-pointers-collapse (nodes edge-symbols) (mapcan #'(lambda (node) (if (cddr (find node edge-symbols :key #'cadr)) (create-gen-chart-pointers-collapse (get node 'chart-edge-descendants) edge-symbols) (list node))) nodes)) ;;; from toplevel.lsp ;;; "Generate" ;;; ;;; "Generate" generate-from-edge (defparameter *last-generate-from-edge* nil) (defun generate-edge-suggestion nil (or *last-generate-from-edge* (and *parse-record* (edge-id (car *parse-record*))) *edge-id*)) #-:tty (defun generate-from-edge nil (let ((possible-edge-name (ask-for-lisp-movable "Current Interaction" `(("Parser edge number for input MRS?" . ,(generate-edge-suggestion))) nil))) (when possible-edge-name (setq *last-generate-from-edge* (car possible-edge-name)) (let ((parser-edge (find-edge-given-id (car possible-edge-name)))) (if parser-edge (really-generate-from-edge parser-edge) (show-message-window (format nil "No parser edge ~A" (car possible-edge-name)))))))) #-:tty (defun really-generate-from-edge (parser-edge) (declare (special *dmrs-grammar-p*)) (let ((input-sem (if *dmrs-grammar-p* (mrs::extract-dmrs parser-edge) (mrs::extract-mrs parser-edge)))) (cond (*dmrs-grammar-p* (show-message-window (format nil "Generation from native DMRS not implemented yet"))) #| (when (and input-sem (mrs::dmrs-nodes input-sem)) (close-existing-chart-windows) (generate-from-dmrs input-sem) (show-gen-result)) |# ((and input-sem (mrs::psoa-p input-sem) (mrs::psoa-liszt input-sem)) (close-existing-chart-windows) (generate-from-mrs input-sem) (show-gen-result)) (t (show-message-window (format nil "Could not extract valid *MRS from edge ~A" (edge-id parser-edge))))))) ;;; logic of choose-mrs-output-level was getting horrible ;;; and it didn't work on Windows (XP) anyway ;;; ;;; new functionality means you can have as many (or as few) ;;; types of output as you like #-:tty (defun toggle-mrs-base nil (setf mrs::*mrs-base-output-p* (not mrs::*mrs-base-output-p*))) (defun toggle-mrs-scoping nil (setf mrs::*mrs-scoping-output-p* (not mrs::*mrs-scoping-output-p*))) (defun toggle-rmrs-xml nil (setf mrs::*rmrs-xml-output-p* (not mrs::*rmrs-xml-output-p*))) (defun toggle-rmrs nil (setf mrs::*rmrs-compact-output-p* (not mrs::*rmrs-compact-output-p*))) ;;; tty version ;;; fix_me - shouldn't we close any existing generator chart windows, c.f. do-parse-tty? (defun do-generate-tty (&optional edge-name debugp) (let ((possible-edge-name (or edge-name (generate-edge-suggestion)))) (when possible-edge-name (setq *last-generate-from-edge* edge-name) (let ((parser-edge (find-edge-given-id possible-edge-name))) (if parser-edge (let ((input-sem (mrs::extract-mrs parser-edge))) (if (mrs::psoa-liszt input-sem) (progn (format t "~&Generating from parser edge ~A~%" possible-edge-name) (generate-from-mrs input-sem :signal debugp) (show-gen-result-tty)) (format t "~&Could not extract any MRS relations from edge ~A~%" possible-edge-name))) (format t "~&No parser edge ~A~%" possible-edge-name)))))) (defun show-gen-result-tty () (if *gen-record* (dolist (edge *gen-record*) (format t "~&Edge ~A G:~%~A~%" (edge-id edge) (edge-string edge)) (write (parse-tree-structure edge) :escape nil :pretty t :right-margin 80) (terpri)) (format t "~&No strings generated~%")))