(FILECREATED " 6-Sep-84 23:14:19" {ERIS}<SPEECH>LEXICON>MODIFY-LFG.;11 9022   

      changes to:  (VARS MODIFY-LFGCOMS)
		   (FNS RESTORE.LFG)

      previous date: " 6-Sep-84 22:50:52" {ERIS}<SPEECH>LEXICON>MODIFY-LFG.;10)


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MODIFY-LFGCOMS)

(RPAQQ MODIFY-LFGCOMS ((FNS MODIFY.LFG RESTORE.LFG)
		       (* LFG-system functions which have been modified to parse strings of 
			  transcribed speech)
		       (FNS PPLEX PPWORDS READWORDS PARSE MORPHEMES MORPHANAL DSHOWPARSES TREEPRINT)
		       (P (MODIFY.LFG)
			  (/ DI2s))))
(DEFINEQ

(MODIFY.LFG
  [LAMBDA NIL                                                (* mmw: " 6-Sep-84 22:06")
                                                             (* Modifies the LFG system to parse words and feet)
    [COND
      ((GETD (QUOTE CD))                                     (* Making sure we connect to the correct directory, and 
							     using PKs version of CNDIR if it is there)
	(CD (QUOTE {ERIS}<SPEECH>LEXICON>)))
      (T (CNDIR (QUOTE {ERIS}<SPEECH>LEXICON]
    (LOAD? (QUOTE PARSE-LEX.DCOM))
    (CLOSEW FSTRUCTUREFILE)
    (LOAD? (QUOTE PHONES))
    (LOAD? (QUOTE FOOT-GRAMMAR))                             (* Fix up the screen)
    (WINDOWPROP TREEFILE (QUOTE TITLE)
		"Foot-structure Window")
    (CLOSEW LFGLOGOW])

(RESTORE.LFG
  (LAMGDA NIL (CNDIR (QUOTE {PHYLUM}<LFG>PARSER>))
	  (LOADFNS (QUOTE PPLEX)
		   (QUOTE {PHYLUM}<LFG>PARSER>LEXFORMAT.DCOM))
	  (LOADFNS (QUOTE PPWORDS)
		   (QUOTE {PHYLUM}<LFG>PARSER>LEXFORMAT.DCOM))
	  (LOADFNS (QUOTE READWORDS)
		   (QUOTE {PHYLUM}<LFG>PARSER>LEXFORMAT.DCOM))
	  (LOADFNS (QUOTE PARSE)
		   (QUOTE {PHYLUM}<LFG>PARSER>GSP.DCOM))
	  (LOADFNS (QUOTE MORPHEMES)
		   (QUOTE {PHYLUM}<LFG>PARSER>MORPHOLOGY.DCOM))
	  (LOADFNS (QUOTE MORPHANAL)
		   (QUOTE {PHYLUM}<LFG>PARSER>MORPHOLOGY.DCOM))
	  (LOADFNS (QUOTE DSHOWPARSES)
		   (QUOTE {PHYLUM}<LFG>PARSER>STARTUP.DCOM))
	  (LOADFNS (QUOTE TREEPRINT)
		   (QUOTE {PHYLUM}<LFG>PARSER>PRINTLFG.DCOM))))
)



(* LFG-system functions which have been modified to parse strings of transcribed speech)

(DEFINEQ

(PPLEX
  [DLAMBDA ((WORDS (ONEOF LITATOM NUMBERP LISTP (LISTP OF LITATOM)))
            (LANGUAGE LITATOM)
            (FILE))
                                                             (* mmw: " 6-Sep-84 22:04")
    (COND
      ((NULL LANGUAGE)
	(SETQ LANGUAGE CURRENTLANGUAGE)))
    (AND (WINDOWP FILE)
	 (DSPRESET FILE))
    (RESETFORM (OUTPUT FILE)
	       (for M in (for W inside WORDS join (MORPHEMES W LANGUAGE))
		  do (printout NIL T .P2 M)
		     (PPENTRY (GETLEX LANGUAGE M)
			      FILE)))])

(PPWORDS
  [DLAMBDA ((LEXNAME [ONEOF NUMBERP LITATOM LISTP (LISTP OF LITATOM)
			    (LISTP (WHOSE (CAR (LISTP OF LITATOM))
					  (CDR NIL])
            (FILE))
                                                             (* mmw: " 6-Sep-84 22:02")
    [COND
      ((NLISTP LEXNAME)
	(SETQ LEXNAME (LIST CURRENTLANGUAGE LEXNAME)))
      ((LISTP (CAR LEXNAME))
	(SETQ LEXNAME (CAR LEXNAME]
    (RESETLST [COND
		((OPENP FILE (QUOTE OUTPUT))
		  (RESETSAVE (OUTPUT FILE)))
		(T (RESETSAVE (OUTFILE FILE)
			      (QUOTE (PROGN (CLOSEF? (OUTPUT OLDVALUE]
	      (AND (WINDOWP FILE)
		   (DSPRESET FILE))
	      (for W (L ←(CAR LEXNAME)) in (CDR LEXNAME)
		 first (printout NIL T .FONT BIGFONT .P2 L T T .FONT DEFAULTFONT)
		 do (PRIN2 W)
		    (PPENTRY (GETLEX L W)
			     FILE)
		    (TERPRI))
	      (printout NIL "----" T)
	      (OUTPUT))])

(READWORDS
  [LAMBDA (FILE)                                             (* mmw: " 6-Sep-84 21:59")
    (RESETLST [COND
		((OPENP FILE (QUOTE INPUT))
		  (RESETSAVE (INPUT FILE)))
		(T (RESETSAVE (INFILE FILE)
			      (QUOTE (PROGN (CLOSEF? (INPUT OLDVALUE]
	      (COND
		((EQ (SKIPSEPRS NIL FILERDTBL)
		     (QUOTE %())                             (* Skip the paren inserted on files to avoid 
							     bad-conmpiled-fn error)
		  (READC)))
	      (bind W (LANGUAGE ←(COND
				  ((SKIPSEPRS NIL FILERDTBL)
				    (RATOM NIL FILERDTBL))
				  (T CURRENTLANGUAGE)))
		 while (SELECTQ (SKIPSEPRS NIL FILERDTBL)
				(%. NIL)
				[- (READC)
				   (COND
				     ((NEQ (PEEKC)
					   (QUOTE -))

          (* Ends with a sequence of at least 2 hyphens. If only a single one, it's a word beginning with a hyphen and we 
	  have to pack it back on)


				       (SETQ W (PACK* (QUOTE -)
						      (RATOM NIL FILERDTBL]
				(NIL (RETURN $$VAL))
				(SETQ W (RATOM NIL FILERDTBL)))
		 collect (/STORELEX LANGUAGE W (READLEX))
			 W
		 finally (READC)
			 (while (FMEMB (SKIPSEPRS NIL FILERDTBL)
				       (QUOTE (%. -)))
			    do (READC))
			 (COND
			   ((EQ (SKIPSEPRS NIL FILERDTBL)
				(QUOTE %)))                  (* Skip the paren inserted on files to avoid 
							     bad-conmpiled-fn error)
			     (READC)))
			 (RETURN (CONS LANGUAGE $$VAL])

(PARSE
  [LAMBDA (SENTENCE)                                         (* mmw: " 6-Sep-84 21:56")
    (perform CONSTITUENT.CLEAR)
    (perform VARIABLE.CLEAR)
    (perform FSTRUCTURE.CLEAR)
    (SETQ AGENDA NIL)
    (perform ENTITY.CLEAR)
    (AND (type? CHART CHART)
	 (perform CHART.CLEAR CHART))
    [SETQ CHART (BUILDCHART (UNPACK (CAR SENTENCE]
    (if BOTTOMUPPARSEFLG
	then (for V in (fetch VERTEXSET of CHART) do (for CN in INCATNETLIST do (GSP.START CN V)))
      else (GSP.START ROOTCATNET (fetch FIRSTVERTEX of CHART)))
    (GSP.CONTINUE)
    CHART])

(MORPHEMES
  [LAMBDA (WORD LANGUAGE)                                    (* mmw: " 6-Sep-84 21:53")
                                                             (* Returns a list of the morphemes that can combine to 
							     make WORD)
    (OR LANGUAGE (SETQ LANGUAGE CURRENTLANGUAGE))
    (SINGLES (NCONC (AND (GETLEX LANGUAGE WORD)
			 (CONS WORD))
		    (GETROOT WORD LANGUAGE)
		    (GETROOTAFFIX WORD LANGUAGE)
		    (for TAB ROOT ROOTENTRY SUFFIXES in MORPHTABLE
		       when [AND (SETQ ROOT (SUFFIXCHECK WORD TAB))
				 (SETQ ROOTENTRY (GETLEX LANGUAGE ROOT))
				 (SETQ SUFFIXES (for MC R SCH in (fetch MTABCATS of TAB)
						   when (GETMORPHTERM ROOTENTRY
								      (fetch MCAT of MC)
								      (fetch INFLECT of MC))
						   join (COND
							  ((EQ (QUOTE --)
							       (SETQ R (fetch RESULT of MC)))
                                                             (* Return a value that will get singled out)
							    (CONS ROOT))
							  ((LISTP R)
							    (APPEND R))
							  (T (LIST R]
		       join (NCONC (AND (GETLEX LANGUAGE ROOT)
					(CONS ROOT))
				   (GETROOT ROOT LANGUAGE)
				   SUFFIXES])

(MORPHANAL
  [LAMBDA (WORD)                                             (* mmw: " 6-Sep-84 21:51")
    (SUFFIXES WORD])

(DSHOWPARSES
  [LAMBDA (NOFSFLG)                                          (* mmw: " 6-Sep-84 22:49")

          (* Count and display the number of C-structures, filtering by f-structure printout. If NOFSFLG 
	  (when ALL button is switched), don't change fs display)


    (DECLARE (GLOBALVARS TREEFILE CHART))
    (PROG ((PARSES (GETPARSES CHART)))
          (for P (#PARSES ←(LENGTH PARSES))
	       (#DISPLAYED ← 0) in PARSES as P# from 1 first [CLEARTREEWINDOW
							       (COND
								 ((ZEROP #PARSES)
								   (CONCAT "No " ROOTCAT 
									   " foot structures"))
								 (T (CONCAT #PARSES 
									    " foot structures"
									    (PLURALSUFF #PARSES)
									    (COND
									      (SHOWALLTREES "")
									      (T " . . ."]
	     do (COND
		  (SHOWALLTREES (add #DISPLAYED 1)
				(TREEPRINT P P# TREEFILE)))
	     finally [COND
		       ((ZEROP #DISPLAYED)                   (* Nothing passed the filter, show all trees)
			 (for P in PARSES as P# from 1 do (TREEPRINT P P# TREEFILE]
		     (OR (ZEROP #PARSES)
			 (WINDOWPROP TREEFILE (QUOTE TITLE)
				     (CONCAT #PARSES " foot structure" (PLURALSUFF #PARSES)
					     ", "
					     (COND
					       ((ZEROP #DISPLAYED)
						 "all")
					       (T #DISPLAYED))
					     " displayed"])

(TREEPRINT
  [DLAMBDA ((C CONSTITUENT)
            (CS# (ONEOF NIL FIXP)                            (* The sequence number of this parse))
            (FILE                                            (* Stream or window)))
                                                             (* mmw: " 6-Sep-84 21:39" posted: "26-AUG-81 22:24")
    (SELECTQ (SYSTEMTYPE)
	     (D (DTREEPRINT C CS# FILE))
	     (RESETFORM (OUTPUT FILE)
			(printout NIL T "Foot-structure " CS# ":" 1)
			(TREEPRINT1 C)
			(TERPRI)))])
)
(MODIFY.LFG)
(/ DI2s)
(PUTPROPS MODIFY-LFG COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (620 2085 (MODIFY.LFG 630 . 1395) (RESTORE.LFG 1397 . 2083)) (2183 8919 (PPLEX 2193 . 
2739) (PPWORDS 2741 . 3616) (READWORDS 3618 . 5030) (PARSE 5032 . 5674) (MORPHEMES 5676 . 6899) (
MORPHANAL 6901 . 7028) (DSHOWPARSES 7030 . 8386) (TREEPRINT 8388 . 8917)))))
STOP