(FILECREATED " 6-Sep-84 23:15:16" {ERIS}<SPEECH>LEXICON>MODIFY-LFG.;12 9118   

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

      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
  [LAMBDA NIL                                                (* mmw: " 6-Sep-84 23:15")
    (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 2181 (MODIFY.LFG 630 . 1395) (RESTORE.LFG 1397 . 2179)) (2279 9015 (PPLEX 2289 . 
2835) (PPWORDS 2837 . 3712) (READWORDS 3714 . 5126) (PARSE 5128 . 5770) (MORPHEMES 5772 . 6995) (
MORPHANAL 6997 . 7124) (DSHOWPARSES 7126 . 8482) (TREEPRINT 8484 . 9013)))))
STOP