(FILECREATED " 6-Aug-84 12:00:06" {PHYLUM}<SPEECH>LEXICON>DFOOT.;2 31607  

      changes to:  (VARS DFOOTCOMS)
		   (FNS CATEGORIZE VVAS.RULE FOOT? HEAVY-SYLLABLE-FOOT HEAVY-SYLLABLE? MAKE-FOOT 
			PENULTRULE PRINTFOOT SYLLABLE-STACKER DEFAULT.FOOT)

      previous date: " 6-Aug-84 11:54:08" {PHYLUM}<SPEECH>LEXICON>DFOOT.;1)


(* Copyright (c) 1984 by XEROX. All rights reserved.)

(PRETTYCOMPRINT DFOOTCOMS)

(RPAQQ DFOOTCOMS [(FNS ANAPEST-FOOT ANTEPENULTSYLLABLE CATEGORIZE CONSONANT? VVAS.RULE EDGEMARKER 
		       FALLING-FOOT FIND-1-STRESS FOOT-PARSER FOOT? HEAVY-SYLLABLE-FOOT 
		       HEAVY-SYLLABLE? LASTSYLLABLE LOADFOOT LONG-VOWEL? MAINSTRESS MAKE-FOOT ONSET 
		       PACKFEET PARSE PARSE-TEST FOOT.DOMAINS PENULTRULE PENULTSYLLABLE PRETTYFOOT 
		       PRINTFOOT LEFT.WEAK.BRACKET RIGHT.STRONG.BRACKET LEFT.STRONG.BRACKET 
		       RIGHT.WEAK.BRACKET PRINTSTRONGFOOT PRUNE PRUNE1 REAL-LONG-VOWEL? RUNFEET 
		       SECONDARY-STRESS SELECTIVE-PARSE STRESS STRESS&STRIP STRESS-SYLLABLE 
		       STRESS-VOWEL MAINSTRESS.FOOT STRESS? STRIPFOOT SYLLABLE-STACKER 
		       TERTIARY-STRESS TEST-FUNCTION TEST-STRESSER TRANSFORMFOOT VOWEL?)
	(FNS DEBUG FOOTSUBSCRIPT MARKED.STRONG SETUP.FOOTWINDOW FOOTFONTS DEFAULT.FOOT)
	(* Functions to parse feet)
	(VARS CONSONANTS FONTDIRECTORIES FOOT-RULES FOOTFILES LONG-CONSONANTS LONG-VOWELS NAMEFILES 
	      VOWELS TEST-WORDS Z)
	(INITVARS (FOOTFONT (FONTCREATE (QUOTE GACHA)
					10))
		  (FOOTSUBFONT (FONTCREATE (QUOTE HIPPO)
					   10))
		  (FOOTSUBOFFSET 2)
		  (DEBUG NIL))
	(ADDVARS (FOOTFILES SYLLABLE)
		 (FOOT-RULES (FALLING-FOOT)))
	(RECORDS DOMAINS FOOT WORD)
	(P (LOAD (QUOTE {ERIS}<SPEECH>LEXICON>SYLLABLE.DCOM))
	   (LOAD? (QUOTE {ERIS}<LISP>LIBRARY>DECL.DCOM])
(DEFINEQ

(ANAPEST-FOOT
  [LAMBDA (SYLLABLES)                                        (* kh: " 5-APR-83 14:24")
    (for SYLLABLE-TAIL on old SYLLABLES collect (COND
						  [(AND (NOT (FOOT? (CAR SYLLABLE-TAIL)))
							(NOT (FOOT? (CADR SYLLABLE-TAIL)))
							(NOT (FOOT? (CADDR SYLLABLE-TAIL)))
							(STRESS? (CAR SYLLABLE-TAIL)
								 1)
							(STRESS? (CADR SYLLABLE-TAIL)
								 0)
							(STRESS? (CADDR SYLLABLE-TAIL)
								 0))
						    (SETQ SYLLABLES (CDDR SYLLABLES))
                                                             (* SYLLABLES will be decremented when we iterate as 
							     well%, therefore no ADD1)
						    (MAKE-FOOT (LIST (CAR SYLLABLE-TAIL)
								     (CADR SYLLABLE-TAIL)
								     (CADDR SYLLABLE-TAIL]
						  (T (CAR SYLLABLE-TAIL)))
       finally $$VAL])

(ANTEPENULTSYLLABLE
  [LAMBDA (SYLLABLES)                                        (* kh: "29-Mar-82 21:21" posted: "29-Mar-82 21:47")
                                                             (* Returns the antepenultimate syllable of a word given 
							     the syllables as input)
    (CADDR SYLLABLES])

(CATEGORIZE
  [DLAMBDA ((W WORD))
                                                             (* kh: " 5-APR-83 11:23" posted: "29-Mar-82 00:22")
                                                             (* Finds the / which indicates the morphological info in
							     a word, and puts it on the porperty list of the word)
                                                             (* / Indicates beginning of morphological information.
							     If WORD has it, POS will be the character-position 
							     following /)
    [COND
      [(SETQ POS (STRPOS (QUOTE "/")
			 (fetch INPUT of W)
			 NIL NIL NIL T))
	[replace CATEGORY of W with (MKATOM (U-CASE (SUBSTRING (fetch INPUT of W)
							       POS]
                                                             (* The category is that part of the word which follows 
							     /)
                                                             (* The word itself is the substring preceding /)
	(replace TRANSCRIPTION of W with (MKATOM (SUBSTRING (fetch INPUT of W)
							    1
							    (IDIFFERENCE POS 2]
      (T (replace TRANSCRIPTION of W with (fetch INPUT of W]])

(CONSONANT?
  [LAMBDA (SEGMENT)                                          (* kh: "30-Mar-82 21:41" posted: "30-Mar-82 21:37")
                                                             (* Returns the consonant if a syllable contains one)
    (COND
      ((MEMBER SEGMENT CONSONANTS)
	SEGMENT)
      (T NIL])

(VVAS.RULE
  [LAMBDA (SYLLABLE)                                         (* pkh: " 3-Aug-84 21:40" posted: "29-Mar-82 21:33")
    (PROG (TEMP)
          (COND
	    ((MEMBER (fetch (WORD CATEGORY) of WREC)
		     (QUOTE (a v)))                          (* Shouldn't use WREC freely here)

          (* Special treatment of verbs and adjectives. They get stressed if the last syllables has a long vowel or if it 
	  has a vowel followed by at least 2 consonants)


	      (COND
		((NULL (LONG-VOWEL? (HEAVY-SYLLABLE? SYLLABLE)))
                                                             (* Long vowels that are the final segment don't count as
							     long)
		  (RETURN (STRESS-SYLLABLE SYLLABLE 11)))
		(T NIL)))
	    ([AND (SETQ TEMP (SOME SYLLABLE (QUOTE LONG-VOWEL?)))
		  (CDR TEMP)
		  (NOT (NUMBERP (CADR TEMP]

          (* The VVAS.RULE says to stress the last syllable if there is a long-vowel in it, provided this vowel is not the 
	  last segment in the word)


	      (RETURN (STRESS-SYLLABLE SYLLABLE 11)))
	    (T NIL])

(EDGEMARKER
  [LAMBDA (SYLLABLES)                                        (* edited: " 8-Apr-82 21:21")
                                                             (* Stresses the edge of a word with 1 if it isn%'t 
							     already stressed)
    (PROG [(FIRST (CAR SYLLABLES))
	   (LAST (CAR (LAST SYLLABLES]
          (COND
	    ((STRESS? FIRST 0)
	      (STRESS-SYLLABLE FIRST 1)))
          (COND
	    ((STRESS? LAST 0)
	      (STRESS-SYLLABLE LAST 1])

(FALLING-FOOT
  [LAMBDA (SYLLABLES)                                        (* pkh: " 3-Aug-84 22:13")
    (for SYLLABLE-TAIL on old SYLLABLES bind REST DOMAIN-3-1 collect (COND
								       ([AND (STRESS? (CAR 
										    SYLLABLE-TAIL)
										      3)
									     (SETQ REST
									       (FIND-1-STRESS
										 (CDR SYLLABLE-TAIL]
									 (SETQ DOMAIN-3-1
									   (CONS (CAR SYLLABLE-TAIL)
										 REST))

          (* Recurse down the syllable-tail until a 3 stress is found, if FIND-1-STRESS can find a 1 stress on the tail then
	  make this domain of a 3 and 1 stress into a foot pop it off the stack (i.e. remainder))


									 (SETQ SYLLABLES
									   (NTH SYLLABLES
										(LENGTH DOMAIN-3-1)))
									 (MAKE-FOOT DOMAIN-3-1))
								       (T 
                                                             (* If we don't find a foot return the syllable at top of
							     the stack unchanged)
									  (CAR SYLLABLE-TAIL)))
       finally (RETURN $$VAL])

(FIND-1-STRESS
  [LAMBDA (SYLLABLES)                                        (* edited: "10-Apr-82 18:15")

          (* Walks down a list of with 0 stress syllables until a 1 stress is found. Returns the list of the unstressed 
	  syllables and the 1 stress%, if failure NIL is returned)


    (for SYLLABLE in old SYLLABLES while (STRESS? SYLLABLE 0) collect SYLLABLE
       finally (COND
		 [(STRESS? SYLLABLE 1)
		   (RETURN (APPEND $$VAL (LIST SYLLABLE]
		 (T (RETURN NIL])

(FOOT-PARSER
  [LAMBDA (WREC)                                             (* pkh: " 3-Aug-84 22:54")
    (PROG (FEET (SYLLABLES (fetch STRUCTURE of WREC)))
          (COND
	    ((AND (BOUNDP DEBUG)
		  DEBUG)))
          (SETQ FEET (FALLING-FOOT SYLLABLES))
          (COND
	    ((AND (BOUNDP DEBUG)
		  DEBUG)
	      (printout NIL (QUOTE "Falling-foot ===>  ")
			T FEET T)))
          (SETQ FEET (HEAVY-SYLLABLE-FOOT FEET))
          (COND
	    ((AND (BOUNDP DEBUG)
		  DEBUG)
	      (printout NIL (QUOTE "Heavy-syllable-foot ===>  ")
			T FEET T)))
          (SETQ FEET (ANAPEST-FOOT FEET))
          (COND
	    ((AND (BOUNDP DEBUG)
		  DEBUG)
	      (printout NIL (QUOTE "Anapest-foot ===>  ")
			T FEET T)))
          (SETQ FEET (DEFAULT.FOOT FEET))
          (COND
	    ((AND (BOUNDP DEBUG)
		  DEBUG)
	      (printout NIL (QUOTE "Default-foot ===>  ")
			T FEET T)))
          (RETURN (replace STRUCTURE of WREC with FEET])

(FOOT?
  [LAMBDA (FOOTCANDIDATE)                                    (* kh: "23-MAR-83 20:28")
    (COND
      ((EQUAL (CAR FOOTCANDIDATE)
	      (QUOTE FOOT))
	FOOTCANDIDATE)
      (T NIL])

(HEAVY-SYLLABLE-FOOT
  [LAMBDA (SYLLABLES)                                        (* kh: "23-MAR-83 16:53")
    (for SYLLABLE in SYLLABLES bind (HEAVYSYLLABLERESULT (SYLL# ← (LENGTH SYLLABLES))
							 FOOTHOLDER)
       do [COND
	    [[AND (NOT (FOOT? SYLLABLE))
		  (AND (SETQ HEAVYSYLLABLEHOLDER (HEAVY-SYLLABLE? SYLLABLE))
		       (OR [NOT (EQUAL SYLL# (ADD1 (LENGTH FOOTHOLDER]
			   (NOT (LONG-VOWEL? (CAR (LAST HEAVYSYLLABLEHOLDER]
	      (SETQ FOOTHOLDER (APPEND FOOTHOLDER (LIST (MAKE-FOOT (LIST SYLLABLE]
	    (T (SETQ FOOTHOLDER (APPEND FOOTHOLDER (LIST SYLLABLE]
       finally (RETURN FOOTHOLDER])

(HEAVY-SYLLABLE?
  [LAMBDA (SYLLABLE)                                         (* edited: "11-Apr-82 14:21")

          (* Returns the rest of the syllable starting with a long-vowel (VV's have to be treated separately) or starting 
	  with the VCC sequence if the syllables isn't long returns NIL)


    (OR (SOME SYLLABLE (QUOTE LONG-VOWEL?))
	(SOME (CDR (SOME (CDR (SOME SYLLABLE (QUOTE VOWEL?)))
			 (QUOTE CONSONANT?)))
	      (QUOTE CONSONANT?])

(LASTSYLLABLE
  [LAMBDA (SYLLABLES)                                        (* kh: "29-Mar-82 18:31" posted: "29-Mar-82 18:41")
    (CAR SYLLABLES])

(LOADFOOT
  [LAMBDA (FLG)                                              (* pkh: " 1-Aug-84 20:39")
                                                             (* Loads the files necessary to run the foot parser)
                                                             (* I use DLAMBDAs so this file from <lisp>library> needs
							     to be loaded)
    (LOAD? (QUOTE DECL.DCOM))
    (COND
      [FLG (PROGN (LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>DFOOT.DCOM))
		  (LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>SYLLABLE.DCOM))
		  (LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>METRICS.DCOM))
		  (LOAD (QUOTE {PHYLUM}<HALVORSEN>LISP>METRICSPATCH]
      (T (PROGN (LOAD? (QUOTE {PHYLUM}<HALVORSEN>LISP>DFOOT.DCOM))
		(LOAD? (QUOTE {PHYLUM}<HALVORSEN>LISP>SYLLABLE.DCOM))
		(LOAD? (QUOTE {PHYLUM}<HALVORSEN>LISP>METRICS.DCOM])

(LONG-VOWEL?
  [LAMBDA (SEGMENT)                                          (* kh: "29-Mar-82 13:33" posted: "28-Mar-82 23:09")
                                                             (* Checks to see of the segment is among the long-vowels
							     listed in LONG-VOWELS (and returns the vowel if it is))
    (COND
      ((MEMBER SEGMENT LONG-VOWELS)
	SEGMENT)
      (T NIL])

(MAINSTRESS
  [LAMBDA (SYLLABLE)                                      (* kh: "29-Mar-82 15:56" posted: "29-Mar-82 16:44")
                                                          (* Takes a syllable and inserts main stress indication
							  (3) after the first vowel; SHOULDNT if there is no 
							  vowel)
    (STRESS-VOWEL SYLLABLE 3])

(MAKE-FOOT
  [LAMBDA (DOMAIN)                                           (* edited: " 8-Apr-82 15:44")
    (LIST (QUOTE FOOT)
	  DOMAIN])

(ONSET
  [LAMBDA (SYLLABLE)                                         (* kh: "31-Mar-82 20:33" posted: "31-Mar-82 20:37")
    (CAR SYLLABLE])

(PACKFEET
  [LAMBDA (FEET)                                          (* edited: "11-Apr-82 18:16")
    (for ELT in old FEET bind PACKEDFEET first ELT#←(LENGTH FEET) do (if (FOOT? ELT)
									 then ELT←(TRANSFORMFOOT
										ELT))
								     (if (LENGTH FEET) gt 1
									 then PACKEDFEET←
									      < ! PACKEDFEET
										! ELT '- >
								       else PACKEDFEET←
									    < ! PACKEDFEET
									      ! ELT>)
       finally (RETURN PACKEDFEET])

(PARSE
  [LAMBDA (WORDLIST CATEGORIES)                           (* edited: " 8-Apr-82 22:44")
    (for WORD in WORDLIST do (PARSE-TEST WORD])

(PARSE-TEST
  [LAMBDA (WREC)                                             (* pkh: " 3-Aug-84 21:33")
    (PROGN (SYLLABLE-STACKER WREC)                           (* Takes word with syllables indicated by -, explodes 
							     the strings and puts them in reverse order under the 
							     property SYLLABLES)
	   (STRESS WREC)                                     (* Replace with English stress rule)
	   (EDGEMARKER (fetch STRUCTURE of WREC))            (* Put the stress-indications on the list under the 
							     SYLLABLES property; ready to do a parse of feet)
	   (replace STRUCTURE of WREC with (REVERSE (fetch STRUCTURE of WREC)))
                                                             (* Get the syllables in the correct order 
							     (left-to-right))
	   (COND
	     ((AND (BOUNDP DEBUG)
		   DEBUG)
	       (printout NIL T WREC T)))
	   (FOOT-PARSER WREC)
	   (FOOT.DOMAINS WREC])

(FOOT.DOMAINS
  [LAMBDA (WREC)                                             (* pkh: " 3-Aug-84 22:21")
    (PROG ((FEET (fetch STRUCTURE of WREC)))
          (create DOMAINS
		  STRONG ← FEET])

(PENULTRULE
  [LAMBDA (SYLLABLE)                                         (* edited: "11-Apr-82 14:57" posted: "30-Mar-82 21:38")
                                                             (* Stresses a syllable if it is long, i.e. if it has a 
							     long vowel, or is closed (finnsonant))
    (PROG [(LONG-VOWEL (SOME SYLLABLE (QUOTE LONG-VOWEL?]
          (COND
	    ([OR (CONSONANT? (CAR (LAST SYLLABLE)))
		 (REAL-LONG-VOWEL? LONG-VOWEL (ONSET (LASTSYLLABLE SYLLABLES]

          (* Stress the penult if it is closed or if it has a long-vowel provided it is not immediately succeeded by an 
	  initial-vowel in the next syllable)


	      (RETURN (STRESS-SYLLABLE SYLLABLE 3)))
	    (T NIL])

(PENULTSYLLABLE
  [LAMBDA (SYLLABLES)                                        (* kh: "29-Mar-82 21:20" posted: "29-Mar-82 21:48")
                                                             (* Returns the penultimate syllable of a word given the 
							     syllables of the word as input)
    (CADR SYLLABLES])

(PRETTYFOOT
  [LAMBDA (LONGFOOT)                                         (* kh: "23-MAR-83 20:30")
    (for ELT in (if (type? DOMAINS LONGFOOT)
		    then < ! LONGFOOT:WEAK ! LONGFOOT:STRONG>
		  else LONGFOOT)
       join (if (FOOT? ELT)
		then (STRIPFOOT ELT)
	      elseif (LISTP ELT:1)
		then (PRETTYFOOT FOOT)
	      else <(QUOTE -) ! ELT (QUOTE -)
		     >)
       finally $$VAL])

(PRINTFOOT
  [LAMBDA (FOOT)                                             (* pkh: " 3-Aug-84 21:24")
    (COND
      [(type? DOMAINS FOOT)                                  (* We are at the first pass through PRINTFOOT;
							     there is only one domain in a word)
	(COND
	  ((fetch WEAK of FOOT)
	    (LEFT.WEAK.BRACKET)
	    (PRINTFOOT (fetch WEAK of FOOT))
	    (RIGHT.WEAK.BRACKET)))
	(COND
	  ((fetch STRONG of FOOT)
	    (PRINTSTRONGFOOT (fetch STRONG of FOOT]
      [(type? FOOT (CAR FOOT))

          (* Input must be a WEAK or a STRONG from a DOMAIN; There will be one or more feet, print them with vertical bars 
"\" in between)


	(for F FLG in FOOT do (COND
				(FLG (printout NIL "\")
				     (PRINTFOOT F))
				(T (SETQ FLG T)
				   (PRINTFOOT F]
      [(type? FOOT FOOT)
	(for SYLLABLE FLG in (fetch SYLLABLES of FOOT) do (COND
							    (FLG (printout NIL (QUOTE -))
								 (PRINTFOOT SYLLABLE))
							    (T (SETQ FLG T)
							       (PRINTFOOT SYLLABLE]
      (T (for ELT in FOOT when (NOT (NUMBERP ELT)) do (COND
							((LISTP ELT)
							  (for SOUND in ELT
							     when (NOT (NUMBERP SOUND))
							     do (printout NIL SOUND)))
							(T (printout NIL ELT])

(LEFT.WEAK.BRACKET
  [LAMBDA NIL                                                (* kh: " 6-APR-83 21:03")
    (FOOTSUBSCRIPT "a")
    (printout NIL # (DSPFONT FOOTFONT (TTYDISPLAYSTREAM))
	      "[")
    (DSPFONT FOOTFONT (TTYDISPLAYSTREAM])

(RIGHT.STRONG.BRACKET
  [LAMBDA NIL                                                (* kh: " 6-APR-83 20:47")
    (printout NIL "]"])

(LEFT.STRONG.BRACKET
  [LAMBDA NIL                                                (* kh: " 6-APR-83 21:03")
    (FOOTSUBSCRIPT "b")
    (printout NIL # (DSPFONT FOOTFONT (TTYDISPLAYSTREAM))
	      "[")
    (DSPFONT FOOTFONT (TTYDISPLAYSTREAM])

(RIGHT.WEAK.BRACKET
  [LAMBDA NIL                                                (* kh: " 6-APR-83 20:45")
    (printout NIL "]"])

(PRINTSTRONGFOOT
  [LAMBDA (STRONGFOOT)                                       (* kh: "24-MAR-83 12:35")
    (LEFT.STRONG.BRACKET)
    (PRINTFOOT (fetch STRONG of FOOT))
    (RIGHT.STRONG.BRACKET])

(PRUNE
  [LAMBDA (FOOT)                                          (* edited: "12-Apr-82 02:21")
    (PRUNE1 (LEAVES FOOT])

(PRUNE1
  [LAMBDA (TREE)                                          (* edited: "13-Apr-82 23:57")
    (for LEAF in old TREE join (if (AND (EQUAL LEAF '-)
					~$$VAL)
				   then NIL
				 elseif (AND (EQUAL LEAF '-)
					     (MEMBER TREE:2 '(- %] %[)))
				   then NIL
				 elseif (AND (OR (EQUAL LEAF '%[)
						 (EQUAL LEAF '%]))
					     (EQUAL TREE:2 '-))
				   then (TREE←TREE::1)
					(<LEAF>)
				 elseif (AND (EQUAL LEAF '-)
					     TREE::1=NIL)
				   then NIL
				 else <LEAF>)
       finally $$VAL])

(REAL-LONG-VOWEL?
  [LAMBDA (SYLLABLETAIL NEXTONSET)                           (* kh: "31-Mar-82 20:27" posted: "31-Mar-82 20:37")
                                                             (* Checks that the long-vowel isn%'t followed by a 
							     vowel-onset in the next syllable)
    (COND
      ((OR (IGREATERP (LENGTH SYLLABLETAIL)
		      1)
	   (NOT (VOWEL? NEXTONSET)))
	SYLLABLETAIL)
      (T NIL])

(RUNFEET
  [LAMBDA NIL                                                (* kh: "23-MAR-83 16:38")
    (LOAD (QUOTE {PHYLUM}<HALVORSEN>FOOT>DFOOT.DCOM))
    (LOAD (QUOTE {PHYLUM}<HALVORSEN>FOOT>SYLLABLE.DCOM])

(SECONDARY-STRESS
  [LAMBDA (SYLLABLE)                                      (* kh: "29-Mar-82 16:40" posted: "29-Mar-82 16:43")
    (STRESS-VOWEL SYLLABLE 2])

(SELECTIVE-PARSE
  [LAMBDA (WORDLIST CATEGORY)                             (* edited: " 8-Apr-82 23:04")
    (for WORD in WORDLIST do (PROG ((WORDSTRIPPED (CATEGORIZE WORD))
				    TEMP)
			           (if (EQUAL CATEGORY (GETP WORDSTRIPPED 'CAT))
				       then (PARSE-TEST WORD])

(STRESS
  [LAMBDA (WREC)                                             (* pkh: " 3-Aug-84 18:13" posted: "29-Mar-82 16:46")

          (* Top-level function for stress-assignment. Takes a word (with the morphological information stripped off) and 
	  assigns stress to the syllables of the word according to the stress-rules. Outputs the word on the terminal and 
	  stores the stress-indication (PRINT-STRESSED-WORD))


    (PROG ((SYLLABLES (fetch STRUCTURE of WREC))
	   (SYLLABLE# (fetch SYLLABLE# of WREC)))
          (COND
	    ((EQ SYLLABLE# 1)
	      (STRESS-SYLLABLE (LASTSYLLABLE SYLLABLES)
			       3)
	      (RETURN WREC))
	    ((VVAS.RULE (LASTSYLLABLE SYLLABLES))
	      (RETURN WREC)))                                (* If it is a monosyllable%, stress it and quit%, else 
							     see if there is a long vowel in the last syllable)
          (COND
	    ((EQ SYLLABLE# 2)
	      (STRESS-SYLLABLE (PENULTSYLLABLE SYLLABLES)
			       3)
	      (RETURN WREC))
	    ((PENULTRULE (PENULTSYLLABLE SYLLABLES))
	      (RETURN WREC)))

          (* If it is a diasyllable (which didn%'t match the VVAS.RULE) stress the penult%, for longer words see if the 
	  PENTULTRULE (long V or closed syllable) is matched)


          (STRESS-SYLLABLE (ANTEPENULTSYLLABLE SYLLABLES)
			   3)
          (for SYLL in SYLLABLES do (COND
				      ((MARKED.STRONG SYLL)
                                                             (* REMOVE.MARK SYLL)
					(STRESS-SYLLABLE SYLL 3)))
	     finally (RETURN WREC))                          (* If everything else fails the antepenult gets the 
							     stress)
          (RETURN WREC])

(STRESS&STRIP
  [LAMBDA (WORD)                                          (* kh: " 7-Apr-82 00:35" posted: " 7-Apr-82 00:40")

          (* Takes a word, strips off the category indication and puts it on the property-list of the word 
	  (minus the /<cat>) under the property name CAT)


    (PROG ((STRIPPED-WORD (CATEGORIZE WORD)))
          (SYLLABLE-STACKER STRIPPED-WORD)
          (STRESS STRIPPED-WORD)
          (PUTPROP STRIPPED-WORD 'SYLLABLES (REVERSE (GETP STRIPPED-WORD 'SYLLABLES)))
          (RETURN STRIPPED-WORD])

(STRESS-SYLLABLE
  [LAMBDA (SYLLABLE STRESS)                                  (* kh: " 4-APR-83 21:00" posted: "30-Mar-82 20:52")

          (* Smashes STRESS%, which should be an integer (3 for main stress%, 2 for secondary and 1 for tertiary), onto the 
	  end of the list of characters which represents the syllable)


    (NCONC SYLLABLE (LIST STRESS])

(STRESS-VOWEL
  [LAMBDA (SYLLABLE STRESS)                               (* kh: "29-Mar-82 16:37" posted: "29-Mar-82 16:44")

          (* Iterate down the segments in the syllable, if it isn't a vowel put it at the end of the list TEMP, and set
	  REST to the remainder of the syllable; if it is a vowel splice in the stress (an integer) in a list inbetween
	  TEMP (the front) and (CDR REST))


    (for SEGMENT in SYLLABLE bind (TEMP REST←SYLLABLE)
       do (if ~(VOWEL? SEGMENT)
	      then (TEMP← < ! TEMP SEGMENT>)
		   (REST←REST::1)
	    else (RETURN < ! TEMP SEGMENT STRESS ! REST::1>))
       finally (if $$VAL=NIL
		   then (SHOULDNT])

(MAINSTRESS.FOOT
  [LAMBDA (FOOT)                                             (* kh: "23-MAR-83 19:36")
    (for SYLLABLE in (CADR FOOT) thereis (STRESS? SYLLABLE 3])

(STRESS?
  [LAMBDA (SYLLABLE STRESS#)                                 (* pkh: " 3-Aug-84 21:53")

          (* Returns the stress# if a syllable is stressed, returns NIL if the syllable is empty and 0 if the stress# is 0 
	  and the syllable is infact unstressed)


    (COND
      ((EQ NIL SYLLABLE)
	NIL)
      ((OR [AND (ZEROP STRESS#)
		(NOT (NUMBERP (CAR (LAST SYLLABLE]
	   (EQUAL (CAR (LAST SYLLABLE))
		  STRESS#))
	STRESS#)
      (T NIL])

(STRIPFOOT
  [LAMBDA (FOOT)                                             (* kh: "23-MAR-83 19:16")
    <(QUOTE %[) !(PRETTYFOOT FOOT:2)
    (QUOTE %])
    >])

(SYLLABLE-STACKER
  [LAMBDA (WREC)                                             (* kh: " 4-APR-83 20:43" posted: "29-Mar-82 15:09")
                                                             (* edited: "10-Apr-82 03:47")

          (* Finds the syllables in a word (no morphological info (/-info) allowed) and puts them (represented as a list of 
	  characters) last syllable first on a stack on the the property list of the word under the property-name SYLLABLES.
	  The property-name SYLLABLE# gives the number of syllables in the word)


    (PROG (SYLLABLE-STACK SYLLABLE# (BPOS 0)
			  EPOS
			  (SYLLABIFIEDWORD (fetch STRUCTURE of WREC)))
                                                             (* The STRUCTURE of the word is at this point simply the
							     syllabified version of the word 
							     (hyphens indicating syllabification))
          (while BPOS count (COND
			      ((SETQ EPOS (STRPOS (QUOTE -)
						  SYLLABIFIEDWORD
						  (ADD1 BPOS)))

          (* if -
	  is found put the material from the beginning of the word or the last -
	  on the syllable stack, and set BPOS to the character-position where the search is to resume)


				[push SYLLABLE-STACK (UNPACK (SUBSTRING SYLLABIFIEDWORD (ADD1 BPOS)
									(SUB1 EPOS]
				(SETQ BPOS EPOS))
			      (T                             (* -
							     hasn't been found; put whole word or rest of word on the
							     syllable-stack and set BPOS to NIL so we quit)
				 (push SYLLABLE-STACK (UNPACK (SUBSTRING SYLLABIFIEDWORD
									 (ADD1 BPOS)
									 NIL)))
				 (SETQ BPOS EPOS)))
	     finally ((replace STRUCTURE of WREC with SYLLABLE-STACK)
		      (replace SYLLABLE# of WREC with (ADD1 $$VAL])

(TERTIARY-STRESS
  [LAMBDA (SYLLABLE)                                      (* kh: "29-Mar-82 16:40" posted: "29-Mar-82 16:43")
    (STRESS-VOWEL SYLLABLE 1])

(TEST-FUNCTION
  [LAMBDA (WORDLIST)                                      (* edited: "10-Apr-82 04:07" posted: " 7-Apr-82 00:08"
)
    (for WORD in WORDLIST do (PROG ((TEMP (CATEGORIZE WORD)))
			           (TEST-STRESSER TEMP)
			           (EDGEMARKER TEMP)
			           (if (AND (BOUNDP DEBUG)
					    DEBUG)
				       then (printout NIL T (REVERSE (GETP TEMP 'SYLLABLES))
						      T])

(TEST-STRESSER
  [LAMBDA (WORD)                                             (* pkh: " 3-Aug-84 20:33" posted: "30-Mar-82 21:40")
                                                             (* Test-function for the foot-parser, extendable)
    (CATEGORIZE WORD)
    (SYLLABLE-STACKER WORD)
    (STRESS WORD)
    (if (AND (NEQ (QUOTE NOBIND)
		  (EVALV (QUOTE DEBUG)))
	     DEBUG)
	then (printout NIL , WORD (' " has the stress pattern")
		       , , , , (REVERSE (GETP WORD 'SYLLABLES))
		       T])

(TRANSFORMFOOT
  [LAMBDA (FOOT)                                          (* edited: "10-Apr-82 19:02")
    (PROG (TEMP)
          (RETURN (if ELT#=1
		      then (PACKFEET FOOT:2)
		    else TEMP← <'%[ !(PACKFEET FOOT:2)
				 '%] >])

(VOWEL?
  [LAMBDA (SEGMENT)                                          (* kh: "29-Mar-82 13:33" posted: "28-Mar-82 23:10")
                                                             (* Checks if segment is a vowel according to VOWELS.
							     Returns the vowel or NIL)
    (COND
      ((MEMBER SEGMENT VOWELS)
	SEGMENT)
      (T NIL])
)
(DEFINEQ

(DEBUG
  [LAMBDA (FLG)
    (GLOBALVARS DEBUG)
    DEBUG←FLG])

(FOOTSUBSCRIPT
  [LAMBDA (X)                                                (* kh: " 6-APR-83 21:09")
                                                             (* Prints X as a subscript in the LFGSMALLFONT)
    (DECLARE (GLOBALVARS FOOTSUBFONT FOOTSUBOFFSET))
    (RELMOVETO 0 (IMINUS FOOTSUBOFFSET)
	       (TTYDISPLAYSTREAM))
    (RESETFORM (DSPFONT FOOTSUBFONT (TTYDISPLAYSTREAM))
	       (PRIN1 X))
    (RELMOVETO 0 FOOTSUBOFFSET (TTYDISPLAYSTREAM])

(MARKED.STRONG
  [LAMBDA (SYLLABLE)                                         (* pkh: " 3-Aug-84 18:10" posted: "29-Mar-82 21:33")
                                                             (* COND ((MEMBER NIL) (for SOUND in SYLLABLE collect 
							     SOUND unless (EQ (QUOTE (QUOTE NIL) SOUND)))))
    (DREMOVE NIL SYLLABLE])

(SETUP.FOOTWINDOW
  [LAMBDA NIL                                                (* kh: " 6-APR-83 21:18")
    (PROG ((W (CREATEW (create REGION
			       LEFT ← 10
			       BOTTOM ← 15
			       WIDTH ← 560
			       HEIGHT ← 370)
		       "Prosodic Structure")))
          (DSPRIGHTMARGIN 32000 W)
          (RETURN W])

(FOOTFONTS
  [LAMBDA (FONT)                                             (* kh: " 6-APR-83 21:04")
    (DECLARE (GLOBALVARS FOOTFONT FOOTSUBFONT FOOTSUBOFFSET))
    (SELECTQ FONT
	     (LARGE FONT← '(GACHA 12))
	     ((SMALL NIL)
	       FONT←
	       '(GACHA 10))
	     NIL)
    FOOTFONT←
    (FONTCREATE FONT)
    FOOTSUBFONT←
    (FONTCREATE '(HIPPO 10))
    FOOTSUBOFFSET←
    (FONTPROP FOOTFONT 'SIZE)/2
    (DSPFONT FONT (TTYDISPLAYSTREAM])

(DEFAULT.FOOT
  [LAMBDA (SYLLABLES)                                        (* pkh: " 3-Aug-84 22:46")
    (for SYLL TEMP TEMP1 KEEPER in old SYLLABLES
       do [COND
	    [(type? FOOT SYLL)
	      (SETQ KEEPER (APPEND KEEPER (LIST SYLL]
	    [(AND (OR (NULL (CDR SYLLABLES))
		      (type? FOOT (CADR SYLLABLES)))
		  (NOT (MEMBER (QUOTE SYLL)))
		  (NOT (MEMBER (QUOTE x)
			       SYLL)))
	      (SETQ TEMP1 TEMP)
	      (SETQ TEMP NIL)
	      (SETQ KEEPER (APPEND KEEPER (LIST (MAKE-FOOT (APPEND TEMP1 (LIST SYLL]
	    (T (SETQ TEMP (APPEND TEMP (LIST SYLL]
       finally (RETURN KEEPER])
)



(* Functions to parse feet)


(RPAQQ CONSONANTS (w r t T y p s S d D f g G h J k l z Z C v b n m))

(RPAQQ FONTDIRECTORIES ({ROSEBOWL}<FONTS> {INDIGO}<ALTOFONTS> {INDIGO}<ALTOFONTS>ORIGINAL> {DSK}))

(RPAQQ FOOT-RULES ((FALLING-FOOT)
		   FALLING-FOOT HEAVY-SYLLABLE-FOOT ANAPEST-FOOT))

(RPAQQ FOOTFILES (SYLLABLE))

(RPAQQ LONG-CONSONANTS (G))

(RPAQQ LONG-VOWELS (A e u Y i o W))

(RPAQQ NAMEFILES (<LFG.PARSER>LFG.NAMES))

(RPAQQ VOWELS (@ ↑ e E u U i I o O a A R L N c Y W x))

(RPAQQ TEST-WORDS (bi b@-bxl/v beb be-bxl b@-bun bx-bUS-kx be-bi b@-kx-lc-ri-xt b@-kx-nel-yx b@-Cx-lR 
		      b@-Cx-lE-ri bx-sI-lxs b@k b@k-fild/c b@k-g@-mxn b@k-rEst/c b@k-sAd/c b@k-spIn/c 
		      b@k-wcS/c be-kxn b@k-tI-ri-a-lx-Ji b@k-tI-ri-xm b@d/a bed/v b@J b@-JR b@d-x-naZ 
		      b@d-mIn-txn b@-fxl/v b@g bx-g@s b@-gx-tEl be-gxl JRnLIstIk J↑kstxpoz JuJItsu 
		      xt@lyxn @bxtwar xt bl@ndISmxnt bl@Gkxt bl@st bletNt blit))

(RPAQQ Z (JRnLIstIk J↑kstxpoz/a JuJItsu xt@lyxn @bxtwar xt bl@ndISmxnt bl@Gkxt bl@st bletNt blit))

(RPAQ? FOOTFONT (FONTCREATE (QUOTE GACHA)
			    10))

(RPAQ? FOOTSUBFONT (FONTCREATE (QUOTE HIPPO)
			       10))

(RPAQ? FOOTSUBOFFSET 2)

(RPAQ? DEBUG NIL)

(ADDTOVAR FOOTFILES SYLLABLE)

(ADDTOVAR FOOT-RULES (FALLING-FOOT))
[DECLARE: EVAL@COMPILE 

(TYPERECORD DOMAINS (NONFOOT WEAK STRONG))

(TYPERECORD FOOT (SYLLABLES))

(TYPERECORD WORD (INPUT SPELLING TRANSCRIPTION STRUCTURE CATEGORY SYLLABLE#))
]
(LOAD (QUOTE {ERIS}<SPEECH>LEXICON>SYLLABLE.DCOM))
(LOAD? (QUOTE {ERIS}<LISP>LIBRARY>DECL.DCOM))
(PUTPROPS DFOOT COPYRIGHT ("XEROX" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1739 27608 (ANAPEST-FOOT 1749 . 2616) (ANTEPENULTSYLLABLE 2618 . 2943) (CATEGORIZE 2945
 . 4193) (CONSONANT? 4195 . 4515) (VVAS.RULE 4517 . 5615) (EDGEMARKER 5617 . 6112) (FALLING-FOOT 6114
 . 7176) (FIND-1-STRESS 7178 . 7703) (FOOT-PARSER 7705 . 8695) (FOOT? 8697 . 8894) (
HEAVY-SYLLABLE-FOOT 8896 . 9551) (HEAVY-SYLLABLE? 9553 . 10019) (LASTSYLLABLE 10021 . 10176) (LOADFOOT
 10178 . 11007) (LONG-VOWEL? 11009 . 11407) (MAINSTRESS 11409 . 11775) (MAKE-FOOT 11777 . 11921) (
ONSET 11923 . 12070) (PACKFEET 12072 . 12605) (PARSE 12607 . 12773) (PARSE-TEST 12775 . 13776) (
FOOT.DOMAINS 13778 . 13990) (PENULTRULE 13992 . 14738) (PENULTSYLLABLE 14740 . 15068) (PRETTYFOOT 
15070 . 15528) (PRINTFOOT 15530 . 16898) (LEFT.WEAK.BRACKET 16900 . 17153) (RIGHT.STRONG.BRACKET 17155
 . 17299) (LEFT.STRONG.BRACKET 17301 . 17556) (RIGHT.WEAK.BRACKET 17558 . 17700) (PRINTSTRONGFOOT 
17702 . 17926) (PRUNE 17928 . 18061) (PRUNE1 18063 . 18640) (REAL-LONG-VOWEL? 18642 . 19076) (RUNFEET 
19078 . 19292) (SECONDARY-STRESS 19294 . 19464) (SELECTIVE-PARSE 19466 . 19784) (STRESS 19786 . 21543)
 (STRESS&STRIP 21545 . 22101) (STRESS-SYLLABLE 22103 . 22475) (STRESS-VOWEL 22477 . 23191) (
MAINSTRESS.FOOT 23193 . 23383) (STRESS? 23385 . 23848) (STRIPFOOT 23850 . 24019) (SYLLABLE-STACKER 
24021 . 25831) (TERTIARY-STRESS 25833 . 26002) (TEST-FUNCTION 26004 . 26445) (TEST-STRESSER 26447 . 
26983) (TRANSFORMFOOT 26985 . 27250) (VOWEL? 27252 . 27606)) (27609 29937 (DEBUG 27619 . 27684) (
FOOTSUBSCRIPT 27686 . 28159) (MARKED.STRONG 28161 . 28507) (SETUP.FOOTWINDOW 28509 . 28841) (FOOTFONTS
 28843 . 29300) (DEFAULT.FOOT 29302 . 29935)))))
STOP