(in-package :tsdb)

(defparameter *feature-preference-weightings*
    '((0 :binary) ))


;;; Patches to disable bold fonts in the LKB


(in-package :lkb)
(defun generate-from-mrs-internal (input-sem &key nanalyses)

  ;; (ERB 2003-10-08) For aligned generation -- if we're in first only
  ;; mode, break up the tree in *parse-record* for reference by
  ;; ag-gen-lex-priority and ag-gen-rule-priority.  Store in *found-configs*.
  #+:arboretum
  (populate-found-configs)

  ;;
  ;; inside the generator, apply the VPM in reverse mode to map to grammar-
  ;; internal variable types, properties, and values.  the internal MRS, beyond
  ;; doubt, is what we should use for lexical instantiations and Skolemization.
  ;; regarding trigger rules and the post-generation MRS compatibility test, on
  ;; the other hand, we have a choice.  in principle, these should operate in
  ;; the external (SEM-I) MRS namespace (the real MRS layer); however, trigger
  ;; rules are created from FSs (using grammar-internal nomenclature) and, more
  ;; importantly, the post-generation test uses the grammar-internal hierarchy
  ;; to test for predicate, variable type, and property subsumption.  hence, it
  ;; is currently convenient to apply these MRS-level operations with grammar-
  ;; internal names, i.e. at an ill-defined intermediate layer.
  ;;
  ;; _fix_me_
  ;; the proper solution to all this mysery will be to create separate SEM-I
  ;; hierarchies, i.e. enrich the SEM-I files with whatever underspecifications
  ;; the grammar wants to provide at the MRS level, and then import that file
  ;; into its own, grammar-specific namespace.  one day soon, i hope, i might
  ;; actually get to implementing this design ...               (22-jan-09; oe)
  ;;
  (setf input-sem (mt:map-mrs input-sem :semi :backward))
  
  ;;
  ;; as of late in 2006, progress on the SMAF front required dan to change all
  ;; `ersatz' entries (as they are currently identified by sub-string match on
  ;; their orthography :-{) to be [ CARG *top* ].  while recorded derivations
  ;; in [incr tsdb()] do not preserve the actual surface form, reconstructing
  ;; derivations and reading off MRSs results in ill-formed EPs, viz. ones with
  ;; an underdetermined CARG.  to at least allow re-generation from such MRSs,
  ;; attempt to frob our input MRS as needed.                   (23-dec-06; oe)
  ;;
  #+:logon
  (loop
      with carg = (mrs:vsym "CARG")
      for ep in (mrs:psoa-liszt input-sem)
      for pred = (mrs:rel-pred ep)
      for constant
      = (cond
         ((string-equal pred "yofc_rel") "DecimalErsatz")
         ((string-equal pred "card_rel") "DecimalErsatz")
         ((string-equal pred "ord_rel") "DecimalErsatz")
         ((string-equal pred "dofw_rel") "DateErsatz")
         ((string-equal pred "dofm_rel") "DateErsatz")
         ((string-equal pred "gen_numval_rel") "DecadeErsatz")
         ((string-equal pred "numbered_hour_rel") "HourErsatz")
         ((string-equal pred "named_rel") "NameErsatz")
         (t "CARG"))
      for parameterizedp = (consp (gethash pred mrs::*relation-index*))
      do
        (loop
            for role in (mrs:rel-flist ep)
            for value = (mrs:fvpair-value role)
            when (eq (mrs:fvpair-feature role) carg) do
              (when (or (eq value *toptype*) (eq value *string-type*))
                (setf (mrs:fvpair-value role) constant))
              (setf parameterizedp nil)
            finally
              (when parameterizedp
                (push
                 (mrs::make-fvpair :feature carg :value constant)
                 (mrs:rel-flist ep)))))
                          
  (let ((fixup (mt::transfer-mrs input-sem :filter nil :task :generate)))
    (when (rest fixup)
      (error 'generation/fixup-ambiguity :mrss fixup))
    (when fixup
      (setf input-sem (mt::edge-mrs (first fixup)))))
  
  (setf *generator-internal-mrs* input-sem)
  (with-package (:lkb)
    (clear-gen-chart)
    (setf *cached-category-abbs* nil)

    ;;
    ;; no need to even try generating when there is no relation index
    ;;
    (unless (and (hash-table-p mrs::*relation-index*)
                 (> (hash-table-count mrs::*relation-index*) 0))
      (error 'generator-uninitialized))
    
    (let ((*gen-packing-p* (if *gen-first-only-p* nil *gen-packing-p*))
          lex-results lex-items grules lex-orderings 
          tgc tcpu conses symbols others)
      (time-a-funcall
       #'(lambda () 
           (multiple-value-setq (lex-results grules lex-orderings)
             (mrs::collect-lex-entries-from-mrs input-sem))
           (multiple-value-setq (lex-items grules lex-orderings)
             (filter-generator-lexical-items 
              (apply #'append lex-results) grules lex-orderings)))
       #'(lambda (tgcu tgcs tu ts tr scons ssym sother &rest ignore)
           (declare (ignore tr ignore))
           (setf tgc (+ tgcu tgcs) tcpu (+ tu ts)
                 conses (* scons 8) symbols (* ssym 24) others sother)))
      (setq %generator-statistics%
        (pairlis '(:ltgc :ltcpu :lconses :lsymbols :lothers)
                 (list tgc tcpu conses symbols others)))
      
      (when *debugging* (print-generator-lookup-summary lex-items grules))
      
      (let ((rel-indexes nil) (rel-indexes-n -1) (input-rels 0))
        (dolist (lex lex-items)
          (loop
              with eps = (mrs::found-lex-main-rels lex)
              initially (setf (mrs::found-lex-main-rels lex) 0)
              for ep in eps
              for index = (ash 1 (or (getf rel-indexes ep)
                                     (setf (getf rel-indexes ep)
                                           (incf rel-indexes-n))))
              do 
                (setf (mrs::found-lex-main-rels lex)
                  (logior (mrs::found-lex-main-rels lex) index))))
        (dolist (grule grules)
          (when (mrs::found-rule-p grule)
            (loop
                with eps = (mrs::found-rule-main-rels grule)
                initially (setf (mrs::found-rule-main-rels grule) 0)
                for ep in eps
                for index = (ash 1 (or (getf rel-indexes ep)
                                       (setf (getf rel-indexes ep)
                                             (incf rel-indexes-n))))
                do
                  (setf (mrs::found-rule-main-rels grule)
                    (logior (mrs::found-rule-main-rels grule) index)))))
        (setf %generator-unknown-eps% nil)
        (loop
            for ep in (mrs::psoa-liszt input-sem)
            do
              (if (getf rel-indexes ep)
                (setq input-rels
                   (logior input-rels (ash 1 (getf rel-indexes ep))))
                (push ep %generator-unknown-eps%)))
        (when %generator-unknown-eps%
           (error 'unknown-predicates :eps %generator-unknown-eps%))

        #+:debug
        (setf %rel-indexes rel-indexes %input-rels input-rels)
        
        (chart-generate
         input-sem input-rels lex-items grules lex-orderings rel-indexes
         *gen-first-only-p* :nanalyses nanalyses)))))



;;; Works around CLIM's failure to load iso10646-encoded fonts in 
;;; faces other than Helvetica 12pt medium regular

(in-package :lkb)



(defun draw-chart-window (window stream &key max-width max-height)
  (declare (ignore max-width max-height))
  (let ((*chart-edges* nil))
    (declare (special *chart-edges*))
    ;; Don't bother if there's no chart
    (unless (null (get (chart-window-root window) 'chart-edge-descendents))
      (clim:format-graph-from-root
       (chart-window-root window) 
       #'(lambda (node stream)
           (multiple-value-bind (s bold-p)
               (chart-node-text-string node)
             (clim:with-text-face (stream 
					;  (if bold-p :bold :roman)
					  )
               (let ((cont (get node 'chart-edge-contents)))
                 (if cont
                     (progn
                       (push cont *chart-edges*)
                       (clim:with-output-as-presentation 
                           (stream cont 'edge)
                         (write-string s stream)))
		   (clim:with-output-as-presentation 
		       (stream (symbol-name node) 'word)
		     (write-string s stream)))))))
       #'(lambda (node) 
           (get node 'chart-edge-descendents))
       ;; This trickery is to avoid drawing the connections from the dummy
       ;; root node to the lexical edges
       :arc-drawer #'(lambda (stream from to x1 y1 x2 y2 &rest args)
                       (when (or (not (symbolp to))
                                 (not (get from 'root)))
			 (apply #'clim-internals::draw-linear-arc
			        (append (list stream from to x1 y1 x2 y2)
			                args))))   
       :stream stream 
       :graph-type :dag
       :merge-duplicates t
       :orientation :horizontal
       :maximize-generations t
       :generation-separation *tree-level-sep*
       :within-generation-separation *tree-node-sep*
       :center-nodes nil)
      (setf (chart-window-edges window) *chart-edges*))))

(defun display-basic-fs-really (fs title parents paths id)
  (let ((fs-window 
         (clim:make-application-frame 'active-fs-window)))
    (setf (active-fs-window-fs fs-window) 
      (make-fs-display-record :fs fs :title title :paths paths 
			      :parents parents
			      :type-fs-display *type-fs-display*
                              :id id))
    (setf (clim:frame-pretty-name fs-window) title)
    ;; Initialize fonts
    (setf *normal* (clim:parse-text-style (list :sans-serif :roman *fs-type-font-size*)))
    (setf *bold* (clim:parse-text-style (list :sans-serif :roman *fs-type-font-size*)))
 ;     (clim:merge-text-styles '(nil :bold nil) *normal*))
    ;; Set up path display
    (let ((path-pane 
	   (find :path (clim:frame-current-panes fs-window)
		 :test #'eq :key #'clim:pane-name)))
      (setf (lkb-window-doc-pane fs-window) path-pane)
      #+:allegro
      (clim:change-space-requirements 
       path-pane
       :resize-frame t
       :height (clim:text-style-height *normal* path-pane)
       :max-height (clim:text-style-height *normal* path-pane)))
    ; Run it
    (clim:run-frame-top-level fs-window)))


(defun draw-parse-tree (ptree-frame stream &key max-width max-height)
  (declare (ignore max-width max-height))
  (let ((node-tree (parse-tree-nodes ptree-frame)))
    (clim:with-text-style (stream (lkb-parse-tree-font))
      (clim:format-graph-from-root
       node-tree
       #'(lambda (node stream)
	   (multiple-value-bind (s bold-p) 
	       (get-string-for-edge node)
	     (clim:with-text-face (stream 
					;(if bold-p :bold :roman)
				   )
	       (if (get node 'edge-record)
		   (clim:with-output-as-presentation (stream node 'symbol)
		     (write-string s stream))
		 (write-string s stream)))))
       #'find-children
       :graph-type :parse-tree
       :stream stream 
       :merge-duplicates nil
       :orientation :vertical
       :generation-separation *ptree-level-sep*
       :within-generation-separation *ptree-node-sep*
       :center-nodes nil))))

(defun draw-res-trees-window (window stream &key max-width max-height)
  (declare (ignore max-width max-height))
  (dolist (tree (parse-tree-frame-trees window))
    (setf (prtree-output-record tree)
    (clim:with-text-style (stream (lkb-summary-tree-font))
      (clim:with-new-output-record (stream)
	(clim:with-output-recording-options (stream :record t)
	  (clim:with-output-as-presentation 
	      (stream tree 'prtree :single-box t)
	    (clim:format-graph-from-root
	     (prtree-top tree)
	     #'(lambda (node stream)
		 (multiple-value-bind (s bold-p) 
		     (get-string-for-edge node)
		   (clim:with-text-face (stream 
					;(if bold-p :bold :roman)
					 )
		     (write-string s stream))))
	     #'find-children
	     :graph-type :parse-tree
	     :stream stream 
	     :merge-duplicates nil
	     :orientation :vertical
	     :generation-separation 5
	     :move-cursor t
	     :within-generation-separation 5
	     :center-nodes nil)))
	(terpri stream))))))


(defun draw-trees-window (frame stream &rest rest)

  (declare (ignore rest))
  ;;
  ;; in case we were displaying the window with an uninitialized frame
  ;;
  (when (null (compare-frame-edges frame))
    (return-from draw-trees-window))

  (setf (compare-frame-tstream frame) stream)
  (unless (and (integerp *tree-display-threshold*)
               (eq (compare-frame-view frame) :classic)
               (> (length (compare-frame-trees frame)) 
                  *tree-display-threshold*))
    (clim:formatting-table (stream :x-spacing "X")
      (loop
          for tree in (compare-frame-trees frame)
          do
            (setf (ctree-ink tree) clim:+foreground-ink+)
            (setf (ctree-record tree)
              (clim:with-new-output-record (stream)
                (clim:with-text-style (stream (comparison-tree-font))
                  (clim:with-output-recording-options (stream :record t)
                    (clim:formatting-row (stream)
                      (clim:formatting-cell 
                          (stream :align-x :center :align-y :top)
                        (clim:with-text-style 
                            (stream 
                             (clim:parse-text-style '(:sans-serif :roman 12)))
                          (format stream "~%[~a]" (ctree-id tree))))
                      (clim:formatting-cell 
                          (stream :align-x :left :align-y :center)
                        (clim:formatting-row (stream)
                          (clim:formatting-cell 
                              (stream :align-x :left :align-y :top)
                            (format stream "~@[(~a)~]~%" (ctree-score tree)))
                          (clim:formatting-cell 
                              (stream :align-x :center :align-y :top)
                            (clim:with-output-as-presentation 
                                (stream tree 'ctree :single-box t)
                              (if (eq (compare-frame-view frame) :classic)
                                (clim:format-graph-from-root
                                 (or (ctree-symbol tree)
                                     (setf (ctree-symbol tree)
                                       (make-new-parse-tree 
                                        (ctree-edge tree) 1)))
                                 #'(lambda (node stream)
                                     (multiple-value-bind (s bold-p) 
                                         (get-string-for-edge node)
                                       (clim:with-text-face
                                           (stream 
					    ;(if bold-p :bold :roman)
					    )
                                         (write-string s stream))))
                                 #'(lambda (node) (get node 'daughters))
                                 :graph-type :parse-tree
                                 :stream stream 
                                 :merge-duplicates nil
                                 :orientation :vertical
                                 :generation-separation 7
                                 :move-cursor t
                                 :within-generation-separation 7
                                 :center-nodes nil)
                                (let ((mrs (edge-mrs (ctree-edge tree))))
                                  (when mrs
                                    (mrs::ed-output-psoa
                                     mrs :stream stream))))))))
                      (terpri stream)))))))
      (when (and (compare-frame-trees frame)
                 (null (rest (compare-frame-trees frame))))
        (draw-trees-window-completion frame stream)))
    (update-tree-colours frame)))


(defun draw-trees-window-completion (frame stream)
  (let* ((hook *tree-completion-hook*)
         (hook (typecase hook
                 (null nil)
                 (function hook)
                 (symbol (and (fboundp hook) (symbol-function hook)))
                 (string (ignore-errors 
                          (symbol-function (read-from-string hook))))))
         (tree (first (compare-frame-trees frame)))
         (edge (ctree-edge tree))
         (mrs (or (edge-mrs edge)
                  (ignore-errors (mrs::extract-mrs edge))))
         (eds (when mrs (ignore-errors (mrs::ed-convert-psoa mrs)))))
    
    (multiple-value-bind (result condition) 
        (when (functionp hook) (ignore-errors (funcall hook edge mrs)))
      (when condition
        (clim:beep)
        (format
         #+:allegro excl:*initial-terminal-io* #-:allegro *terminal-io*
         "tree-completion-hook(): error `~a'.~%"
         (normalize-string (format nil "~a" condition))))
      (let* ((comment (if (stringp result)
                        result
                        (rest (assoc :comment result))))
             (result (unless (stringp result) result))
             (font (rest (assoc :font result)))
             (face (rest (assoc :face result)))
             (size (rest (assoc :size result)))
             (style (when (or font face size)
                      (clim:merge-text-styles
                       (list font face size) '(:sans-serif :bold 12))))
             (color (rest (assoc :color result)))
             (color (ignore-errors (apply #'clim:make-rgb-color color)))
             (bottomp (rest (assoc :bottom result)))
             (align (or (rest (assoc :align result)) :center)))
        (when (and comment (null bottomp))
          (clim:formatting-row (stream)
            (clim:formatting-cell (stream :align-x :center :align-y :top)
              (format stream " ")))
          (let ((record
                 (clim:with-new-output-record (stream)
                   (clim:formatting-row (stream)
                     (clim:formatting-cell 
                         (stream :align-x :center :align-y :top)
                       (format stream "" (ctree-id tree)))
                     (clim:formatting-cell (stream :align-x align)
                       (clim:with-text-style (stream style)
                         (format stream "~%~a" comment)))))))
            (when color (recolor-record record color))
            (clim:replay record stream)))
        (when (and eds (not (eq (compare-frame-view frame) :modern)))
          (clim:formatting-row (stream)
            (clim:formatting-cell (stream :align-x :center :align-y :top)
              (format stream " ")))
          (let ((record 
                 (clim:with-new-output-record (stream)
                   (clim:formatting-row (stream)
                     (clim:formatting-cell 
                         (stream :align-x :center :align-y :top)
                       (clim:with-text-style 
                           (stream 
                            (clim:parse-text-style '(:sans-serif :roman 12)))
                         (format stream "[~a]" (ctree-id tree))))
                     (clim:formatting-cell (stream :align-x :left)
                       (clim:formatting-column (stream)
                         (clim:formatting-cell (stream :align-x :left)
                           (format stream "~@[(~a)~]~%" (ctree-score tree)))
                         (clim:formatting-cell (stream :align-x :center)
                           (clim:with-text-style 
                               (stream (comparison-dependencies-font))
                             (format stream "~a" eds)))))))))
            (recolor-record 
             record
             (let ((status (mrs::ed-suspicious-p eds))
                   (orange (or (clim:find-named-color
                                "orange" (clim:frame-palette frame) 
                                :errorp nil)
                               clim:+yellow+)))
               (cond
                ((member :cyclic status) clim:+red+)
                ((member :fragmented status) orange)
                (t (if (update-match-p frame) clim:+magenta+ clim:+blue+)))))
            (clim:replay record stream)))
        (when (and comment bottomp)
          (clim:formatting-row (stream)
            (clim:formatting-cell (stream :align-x :center :align-y :top)
              (format stream " ")))
          (let ((record
                 (clim:with-new-output-record (stream)
                   (clim:formatting-row (stream)
                     (clim:formatting-cell 
                         (stream :align-x :center :align-y :top)
                       (format stream "" (ctree-id tree)))
                     (clim:formatting-cell (stream :align-x align)
                       (clim:with-text-style (stream style)
                         (format stream "~%~a" comment)))))))
            (when color (recolor-record record color))
            (clim:replay record stream)))))))

(defun add-mrs-pred-region (stream val)
  (let ((pred-rec
         (make-mrs-type-thing :value val)))
    (clim:with-text-style (stream (clim:parse-text-style
    (make-active-fs-type-font-spec)))
      (clim:with-output-as-presentation 
	  (stream pred-rec 'mrs-type-thing)
        (if (stringp val)
          (format stream "~s" val)
          (format stream "~(~a~)" val))))))

(defun show-mrs-window-really (edge &optional mrs title)
  (let ((mframe (clim:make-application-frame 'mrs-simple)))
    (setf *normal* (clim:parse-text-style (make-active-fs-type-font-spec)))
    (setf *bold* (clim:merge-text-styles '(nil :roman nil) *normal*))
    (setf (mrs-simple-mrsstruct mframe) 
      (or mrs (and edge (mrs::extract-mrs edge))))
    (setf (clim:frame-pretty-name mframe) (or title "Simple MRS"))
    (clim:run-frame-top-level mframe)))

(defun generate-from-mrs-internal (input-sem &key nanalyses)

  ;; (ERB 2003-10-08) For aligned generation -- if we're in first only
  ;; mode, break up the tree in *parse-record* for reference by
  ;; ag-gen-lex-priority and ag-gen-rule-priority.  Store in *found-configs*.
  #+:arboretum
  (populate-found-configs)

  ;;
  ;; inside the generator, apply the VPM in reverse mode to map to grammar-
  ;; internal variable types, properties, and values.  the internal MRS, beyond
  ;; doubt, is what we should use for lexical instantiations and Skolemization.
  ;; regarding trigger rules and the post-generation MRS compatibility test, on
  ;; the other hand, we have a choice.  in principle, these should operate in
  ;; the external (SEM-I) MRS namespace (the real MRS layer); however, trigger
  ;; rules are created from FSs (using grammar-internal nomenclature) and, more
  ;; importantly, the post-generation test uses the grammar-internal hierarchy
  ;; to test for predicate, variable type, and property subsumption.  hence, it
  ;; is currently convenient to apply these MRS-level operations with grammar-
  ;; internal names, i.e. at an ill-defined intermediate layer.
  ;;
  ;; _fix_me_
  ;; the proper solution to all this mysery will be to create separate SEM-I
  ;; hierarchies, i.e. enrich the SEM-I files with whatever underspecifications
  ;; the grammar wants to provide at the MRS level, and then import that file
  ;; into its own, grammar-specific namespace.  one day soon, i hope, i might
  ;; actually get to implementing this design ...               (22-jan-09; oe)
  ;;
  (setf input-sem (mt:map-mrs input-sem :semi :backward))
  
  ;;
  ;; as of late in 2006, progress on the SMAF front required dan to change all
  ;; `ersatz' entries (as they are currently identified by sub-string match on
  ;; their orthography :-{) to be [ CARG *top* ].  while recorded derivations
  ;; in [incr tsdb()] do not preserve the actual surface form, reconstructing
  ;; derivations and reading off MRSs results in ill-formed EPs, viz. ones with
  ;; an underdetermined CARG.  to at least allow re-generation from such MRSs,
  ;; attempt to frob our input MRS as needed.                   (23-dec-06; oe)
  ;;
  #+:logon
  (loop
      with carg = (mrs:vsym "CARG")
      for ep in (mrs:psoa-liszt input-sem)
      for pred = (mrs:rel-pred ep)
      for constant
      = (cond
         ((string-equal pred "yofc_rel") "DecimalErsatz")
         ((string-equal pred "card_rel") "DecimalErsatz")
         ((string-equal pred "ord_rel") "DecimalErsatz")
         ((string-equal pred "dofw_rel") "DateErsatz")
         ((string-equal pred "dofm_rel") "DateErsatz")
         ((string-equal pred "gen_numval_rel") "DecadeErsatz")
         ((string-equal pred "numbered_hour_rel") "HourErsatz")
         ((string-equal pred "named_rel") "NameErsatz")
         (t "CARG"))
      for parameterizedp = (consp (gethash pred mrs::*relation-index*))
      do
        (loop
            for role in (mrs:rel-flist ep)
            for value = (mrs:fvpair-value role)
            when (eq (mrs:fvpair-feature role) carg) do
              (when (or (eq value *toptype*) (eq value *string-type*))
                (setf (mrs:fvpair-value role) constant))
              (setf parameterizedp nil)
            finally
              (when parameterizedp
                (push
                 (mrs::make-fvpair :feature carg :value constant)
                 (mrs:rel-flist ep)))))
                          
					;  #+:null 
  ;;; Enable pre-geration MRS fixup.
  (let ((fixup (mt::transfer-mrs input-sem :filter nil :task :generate)))
    (when (rest fixup)
      (error 'generation/fixup-ambiguity :mrss fixup))
    (when fixup
      (setf input-sem (mt::edge-mrs (first fixup)))))
  
  (setf *generator-internal-mrs* input-sem)
  (with-package (:lkb)
    (clear-gen-chart)
    (setf *cached-category-abbs* nil)

    ;;
    ;; no need to even try generating when there is no relation index
    ;;
    (unless (and (hash-table-p mrs::*relation-index*)
                 (> (hash-table-count mrs::*relation-index*) 0))
      (error 'generator-uninitialized))
    
    (let ((*gen-packing-p* (if *gen-first-only-p* nil *gen-packing-p*))
          lex-results lex-items grules lex-orderings 
          tgc tcpu conses symbols others)
      (time-a-funcall
       #'(lambda () 
           (multiple-value-setq (lex-results grules lex-orderings)
             (mrs::collect-lex-entries-from-mrs input-sem))
           (multiple-value-setq (lex-items grules lex-orderings)
             (filter-generator-lexical-items 
              (apply #'append lex-results) grules lex-orderings)))
       #'(lambda (tgcu tgcs tu ts tr scons ssym sother &rest ignore)
           (declare (ignore tr ignore))
           (setf tgc (+ tgcu tgcs) tcpu (+ tu ts)
                 conses (* scons 8) symbols (* ssym 24) others sother)))
      (setq %generator-statistics%
        (pairlis '(:ltgc :ltcpu :lconses :lsymbols :lothers)
                 (list tgc tcpu conses symbols others)))
      
      (when *debugging* (print-generator-lookup-summary lex-items grules))
      
      (let ((rel-indexes nil) (rel-indexes-n -1) (input-rels 0))
        (dolist (lex lex-items)
          (loop
              with eps = (mrs::found-lex-main-rels lex)
              initially (setf (mrs::found-lex-main-rels lex) 0)
              for ep in eps
              for index = (ash 1 (or (getf rel-indexes ep)
                                     (setf (getf rel-indexes ep)
                                           (incf rel-indexes-n))))
              do 
                (setf (mrs::found-lex-main-rels lex)
                  (logior (mrs::found-lex-main-rels lex) index))))
        (dolist (grule grules)
          (when (mrs::found-rule-p grule)
            (loop
                with eps = (mrs::found-rule-main-rels grule)
                initially (setf (mrs::found-rule-main-rels grule) 0)
                for ep in eps
                for index = (ash 1 (or (getf rel-indexes ep)
                                       (setf (getf rel-indexes ep)
                                             (incf rel-indexes-n))))
                do
                  (setf (mrs::found-rule-main-rels grule)
                    (logior (mrs::found-rule-main-rels grule) index)))))
        (setf %generator-unknown-eps% nil)
        (loop
            for ep in (mrs::psoa-liszt input-sem)
            do
              (if (getf rel-indexes ep)
                (setq input-rels
                   (logior input-rels (ash 1 (getf rel-indexes ep))))
                (push ep %generator-unknown-eps%)))
        (when %generator-unknown-eps%
           (error 'unknown-predicates :eps %generator-unknown-eps%))

        #+:debug
        (setf %rel-indexes rel-indexes %input-rels input-rels)
        
        (chart-generate
         input-sem input-rels lex-items grules lex-orderings rel-indexes
         *gen-first-only-p* :nanalyses nanalyses)))))


(in-package :mt)
(defun mrs-transfer-font ()
  '(:sans-serif :roman 12))