(FILECREATED " 6-Aug-84 11:54:08" {PHYLUM}<SPEECH>LEXICON>DFOOT.;1 31607
changes to: (FNS CATEGORIZE VVAS.RULE FOOT? HEAVY-SYLLABLE-FOOT HEAVY-SYLLABLE? MAKE-FOOT
PENULTRULE PRINTFOOT SYLLABLE-STACKER DEFAULT.FOOT)
(VARS DFOOTCOMS)
previous date: " 3-Aug-84 22:56:34" {ERIS}<SPEECH>HALVORSEN>DFOOT.;2)
(* 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 (1740 27609 (ANAPEST-FOOT 1750 . 2617) (ANTEPENULTSYLLABLE 2619 . 2944) (CATEGORIZE 2946
. 4194) (CONSONANT? 4196 . 4516) (VVAS.RULE 4518 . 5616) (EDGEMARKER 5618 . 6113) (FALLING-FOOT 6115
. 7177) (FIND-1-STRESS 7179 . 7704) (FOOT-PARSER 7706 . 8696) (FOOT? 8698 . 8895) (
HEAVY-SYLLABLE-FOOT 8897 . 9552) (HEAVY-SYLLABLE? 9554 . 10020) (LASTSYLLABLE 10022 . 10177) (LOADFOOT
10179 . 11008) (LONG-VOWEL? 11010 . 11408) (MAINSTRESS 11410 . 11776) (MAKE-FOOT 11778 . 11922) (
ONSET 11924 . 12071) (PACKFEET 12073 . 12606) (PARSE 12608 . 12774) (PARSE-TEST 12776 . 13777) (
FOOT.DOMAINS 13779 . 13991) (PENULTRULE 13993 . 14739) (PENULTSYLLABLE 14741 . 15069) (PRETTYFOOT
15071 . 15529) (PRINTFOOT 15531 . 16899) (LEFT.WEAK.BRACKET 16901 . 17154) (RIGHT.STRONG.BRACKET 17156
. 17300) (LEFT.STRONG.BRACKET 17302 . 17557) (RIGHT.WEAK.BRACKET 17559 . 17701) (PRINTSTRONGFOOT
17703 . 17927) (PRUNE 17929 . 18062) (PRUNE1 18064 . 18641) (REAL-LONG-VOWEL? 18643 . 19077) (RUNFEET
19079 . 19293) (SECONDARY-STRESS 19295 . 19465) (SELECTIVE-PARSE 19467 . 19785) (STRESS 19787 . 21544)
(STRESS&STRIP 21546 . 22102) (STRESS-SYLLABLE 22104 . 22476) (STRESS-VOWEL 22478 . 23192) (
MAINSTRESS.FOOT 23194 . 23384) (STRESS? 23386 . 23849) (STRIPFOOT 23851 . 24020) (SYLLABLE-STACKER
24022 . 25832) (TERTIARY-STRESS 25834 . 26003) (TEST-FUNCTION 26005 . 26446) (TEST-STRESSER 26448 .
26984) (TRANSFORMFOOT 26986 . 27251) (VOWEL? 27253 . 27607)) (27610 29938 (DEBUG 27620 . 27685) (
FOOTSUBSCRIPT 27687 . 28160) (MARKED.STRONG 28162 . 28508) (SETUP.FOOTWINDOW 28510 . 28842) (FOOTFONTS
28844 . 29301) (DEFAULT.FOOT 29303 . 29936)))))
STOP