(FILECREATED " 7-Aug-84 12:39:29" {ERIS}<SPEECH>LEXICON>DFOOT.;20 41742
changes to: (FNS HEAVY-SYLLABLE-FOOT HEAVY-SYLLABLE? LONG-VOWEL? STRESS? LAST.BUT.NOT.SEPR
PACKFOOT PACKWORD FIND-BOUNDARY-IN-SECONDARY-FOOT FIND-BOUNDARY PRINTFOOT
FALLING-FOOT SECONDARY-FOOT DEFAULT.FOOT FIND-STRESS COUNTTHEM
LEFT.SYLLABLE.INCORPORATION FOOT-PARSER PARSE-1-WORD)
(VARS DFOOTCOMS)
previous date: " 6-Aug-84 12:36:00" {ERIS}<SPEECH>LEXICON>DFOOT.;8)
(* Copyright (c) 1984 by XEROX. All rights reserved.)
(PRETTYCOMPRINT DFOOTCOMS)
(RPAQQ DFOOTCOMS [(FNS ANAPEST-FOOT ANTEPENULTSYLLABLE CATEGORIZE CONSONANT? COUNTTHEM VVAS.RULE
EDGEMARKER FALLING-FOOT FIND-BOUNDARY FIND-1-STRESS
FIND-BOUNDARY-IN-SECONDARY-FOOT FIND-STRESS FOOT-PARSER FOOT?
HEAVY-SYLLABLE-FOOT LAST.BUT.NOT.SEPR HEAVY-SYLLABLE? LASTSYLLABLE LOADFOOT
LONG-VOWEL? MAINSTRESS MAKE-FOOT ONSET PACKFEET PACKWORD PACKFOOT PARSE
PARSE-1-WORD PARSE-TEST FOOT.DOMAINS PENULTRULE PENULTSYLLABLE PRETTYFOOT
PRINTFOOT LEFT.WEAK.BRACKET RIGHT.STRONG.BRACKET LEFT.STRONG.BRACKET
LEFT.SYLLABLE.INCORPORATION RIGHT.WEAK.BRACKET PRINTSTRONGFOOT PRUNE PRUNE1
REAL-LONG-VOWEL? RUNFEET SECONDARY-FOOT 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 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])
(COUNTTHEM
[LAMBDA (ARRAY) (* pkh: " 6-Aug-84 16:59")
(for X from 1 to (ARRAYSIZE ARRAY) do (printout T X " " (ELT ARRAY X)
T])
(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: " 6-Aug-84 19:45")
(for SYLLABLE-TAIL on old SYLLABLES bind AFTER-STRESS-STRETCH MAIN-UPTO-SECONDARY
MAIN-UPTO-BOUNDARY
collect (COND
((AND (STRESS? (CAR SYLLABLE-TAIL)
3)
(SETQ AFTER-STRESS-STRETCH (FIND-STRESS (CDR SYLLABLE-TAIL)
2)))
(* Looking for a main-stress followed by a secondary-stress; makes a foot out of the main-stress syllable and the
unstressed syllables up to the seocndary stress)
[SETQ MAIN-UPTO-SECONDARY (CONS (CAR SYLLABLE-TAIL)
(REVERSE (CDR (REVERSE AFTER-STRESS-STRETCH]
(* 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 MAIN-UPTO-SECONDARY)))
(MAKE-FOOT MAIN-UPTO-SECONDARY))
([AND (STRESS? (CAR SYLLABLE-TAIL)
3)
(SETQ AFTER-STRESS-TO-BOUNDARY (FIND-BOUNDARY (CDR SYLLABLE-TAIL]
(* Looking for a main-stress followed by a secondary-stress; makes a foot out of the main-stress syllable and the
unstressed syllables up to the seocndary stress)
(SETQ MAIN-UPTO-BOUNDARY (CONS (CAR SYLLABLE-TAIL)
AFTER-STRESS-TO-BOUNDARY))
(* 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 MAIN-UPTO-BOUNDARY)))
(MAKE-FOOT MAIN-UPTO-BOUNDARY))
((STRESS? (CAR SYLLABLE-TAIL)
3)
(* Make a foot of the domain from the main-stress to the end of the word when there is no secondary stress
following the main-stress)
(PROG1 (MAKE-FOOT SYLLABLE-TAIL)
(SETQ SYLLABLES NIL)))
(T (* If we don't find a foot return the syllable at top of
the stack unchanged)
(CAR SYLLABLE-TAIL)))
finally (RETURN $$VAL])
(FIND-BOUNDARY
[LAMBDA (SYLLABLES) (* pkh: " 6-Aug-84 19:23")
(for SYLLABLE in old SYLLABLES while (NOT (SETQ FOOTFLG (type? FOOT SYLLABLE))) collect SYLLABLE
finally (COND
(FOOTFLG (RETURN $$VAL))
(T $$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])
(FIND-STRESS
[LAMBDA (SYLLABLES STRESS) (* pkh: " 6-Aug-84 18:48")
(* Walks down a list of with 0 stress syllables until a stress is found. Returns the list of the unstressed
syllables and the stressed syllable if failure NIL is returned)
(* If you want to find the first stressed syllable regardless of whether it has primary or secondary stress use
NIL for the STRESS parameter)
(for SYLLABLE FOOTFLG in old SYLLABLES while (AND (NOT (SETQ FOOTFLG (type? FOOT SYLLABLE)))
(STRESS? SYLLABLE 0))
collect SYLLABLE finally (RETURN (COND
(FOOTFLG (RETURN NIL))
((NULL SYLLABLES)
NIL)
[(NULL STRESS)
(COND
((OR (STRESS? SYLLABLE 2)
(STRESS? SYLLABLE 3))
(RETURN (APPEND $$VAL (LIST SYLLABLE]
[(STRESS? SYLLABLE STRESS)
(RETURN (APPEND $$VAL (LIST SYLLABLE]
(T NIL])
(FOOT-PARSER
[LAMBDA (WREC) (* pkh: " 6-Aug-84 16:53")
(PROG (FEET (SYLLABLES (fetch STRUCTURE of WREC)))
(SETQ FEET (FALLING-FOOT SYLLABLES))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout NIL (QUOTE "Falling-foot ===> ")
T FEET T)))
(SETQ FEET (SECONDARY-FOOT FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout NIL (QUOTE "Secondary-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)))
(SETQ FEET (LEFT.SYLLABLE.INCORPORATION FEET))
(COND
((AND (BOUNDP DEBUG)
DEBUG)
(printout NIL (QUOTE "Left Syllable Incorporation ===> ")
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) (* pkh: " 7-Aug-84 11:41")
(* Makes a heavy-syllable into a foot provided either that it is not the final syllable or that provided that
there is no long vowel in the syllable (tentative comment))
(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.BUT.NOT.SEPR HEAVYSYLLABLEHOLDER]
(SETQ FOOTHOLDER (APPEND FOOTHOLDER (LIST (MAKE-FOOT (LIST SYLLABLE]
(T (SETQ FOOTHOLDER (APPEND FOOTHOLDER (LIST SYLLABLE]
finally (RETURN FOOTHOLDER])
(LAST.BUT.NOT.SEPR
[LAMBDA (SYLLABLE) (* pkh: " 7-Aug-84 11:42")
(COND
((MEMBER (CAR (LAST SYLLABLE))
(QUOTE (- < *)))
(NTH SYLLABLE (LENGTH HEAVYSYLLABLEHOLDER)))
(T (LAST SYLLABLE])
(HEAVY-SYLLABLE?
[LAMBDA (SYLLABLE) (* pkh: " 7-Aug-84 10:35")
(* 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 syllable isn't long we return 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) (* pkh: " 7-Aug-84 10:32" posted: "28-Mar-82 23:09")
(* Checks to see if 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])
(PACKWORD
[LAMBDA (STRUC) (* pkh: " 7-Aug-84 12:00")
(* Takes as input the structure field of a WORD-record
and produces string output which goes back into the
dictionary as a pronunciation)
(for FOOT FLG in old STRUC collect (COND
(FLG (CONS (QUOTE \)
(PACKFOOT FOOT)))
(T (PACKFOOT FOOT)))
finally (RETURN (PROG 1
(SETQ FLG (PACK $$VAL))
(printout T FLG T])
(PACKFOOT
[LAMBDA (FOOT) (* pkh: " 7-Aug-84 11:59")
(* Takes a foot and returns a string with syllable
indications)
(PROG [(SEGMENTS (COND
((type? FOOT FOOT)
(fetch (FOOT SYLLABLES) of FOOT))
(T FOOT]
(RETURN (PACK SEGMENTS])
(PARSE
[LAMBDA (WORDLIST CATEGORIES) (* edited: " 8-Apr-82 22:44")
(for WORD in WORDLIST do (PARSE-TEST WORD])
(PARSE-1-WORD
[LAMBDA (ARRAYENTRY) (* pkh: " 6-Aug-84 14:15")
(* "Gumby" " 2-Aug-84 18:43")
(* CATEGORY is a filter on what words to parse)
(* This is the top level-function of the foot and syllable-parsing system. We first CATEGORIZE the word
(based on the presence of a string ".../CAT" at the end of the word); next, do a syllable parse
(NEW-SYLLABLE-PARSER); finally do a foot-parse (PARSE-TEST); the global variable DEBUG controls the printout of
information about the parse)
(PROG [(BITTBL (MAKEBITTABLE (QUOTE (- < *]
(SETQ WREC (create WORD
INPUT ← (fetch (LEXENTRY ORTH) of ARRAYENTRY)))
(replace (WORD STRUCTURE) of WREC with (LISTIFY.SYLLABIFICATION (fetch (LEXENTRY PRON)
of ARRAYENTRY)
BITTBL))
(PARSE-WORD-RECORD WREC)
(printout NIL (fetch INPUT of WREC)
.TAB 22 # (PRINTFOOT (fetch STRUCTURE of WREC))
T])
(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 (F) (* pkh: " 6-Aug-84 16:13")
(COND
[(type? DOMAINS F) (* We are at the first pass through PRINTFOOT;
there is only one domain in a word)
(COND
((fetch WEAK of F)
(LEFT.WEAK.BRACKET)
(PRINTFOOT (fetch WEAK of F))
(RIGHT.WEAK.BRACKET)))
(COND
((fetch STRONG of F)
(PRINTSTRONGFOOT (fetch STRONG of F]
((type? FOOT (CAR F))
(* 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 F
do (printout NIL "\")
(PRINTFOOT F)))
[(type? FOOT F)
(for SYLLABLE FLG in (fetch SYLLABLES of F) do (COND
(FLG (printout NIL (QUOTE -))
(PRINTFOOT SYLLABLE))
(T (SETQ FLG T)
(PRINTFOOT SYLLABLE]
(T (for ELT in F do (COND
[(LISTP ELT)
(for SOUND in ELT do (printout NIL (COND
((EQ SOUND 3)
1)
(T SOUND]
(T (printout NIL (COND
((EQ ELT 3)
1)
(T 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])
(LEFT.SYLLABLE.INCORPORATION
[LAMBDA (SYLLABLES) (* pkh: " 6-Aug-84 17:30")
(* Incorporate the unstressed syllable before a foot
into the foot)
(for SYLL KEEPER in old SYLLABLES collect (COND
((type? FOOT SYLL)
SYLL)
[(AND (STRESS? SYLL 0)
(type? FOOT (CADR SYLLABLES)))
(SETQ KEEPER SYLLABLES)
(SETQ SYLLABLES (CDR SYLLABLES))
(MAKE-FOOT (APPEND (LIST SYLL)
(fetch (FOOT SYLLABLES)
of (CADR KEEPER]
(T SYLL))
finally $$VAL])
(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-FOOT
[LAMBDA (SYLLABLES) (* pkh: " 6-Aug-84 19:26")
(* Makes a foot of a domain consisting of a secondary
stress and following unstressed syllables up to a stress
of a foot)
(for SYLLABLE-TAIL on old SYLLABLES bind AFTER-STRESS-STRETCH FOOT-SECONDARY-UPTO-STRESS
collect (COND
([AND (NOT (type? FOOT (CAR SYLLABLE-TAIL)))
(STRESS? (CAR SYLLABLE-TAIL)
2)
(SETQ AFTER-STRESS-STRETCH (FIND-STRESS (CDR SYLLABLE-TAIL]
[SETQ FOOT-SECONDARY-UPTO-STRESS (CONS (CAR SYLLABLE-TAIL)
(REVERSE (CDR (REVERSE AFTER-STRESS-STRETCH]
(* 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 (SUB1 (LENGTH FOOT-SECONDARY-UPTO-STRESS]
(MAKE-FOOT FOOT-SECONDARY-UPTO-STRESS))
([AND (NOT (type? FOOT (CAR SYLLABLE-TAIL)))
(STRESS? (CAR SYLLABLE-TAIL)
2)
(SETQ AFTER-STRESS-STRETCH (FIND-BOUNDARY (CDR SYLLABLE-TAIL]
(SETQ FOOT-SECONDARY-UPTO-STRESS (CONS (CAR SYLLABLE-TAIL)
AFTER-STRESS-STRETCH))
(* 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 FOOT-SECONDARY-UPTO-STRESS)))
(MAKE-FOOT FOOT-SECONDARY-UPTO-STRESS))
(T (* If we don't find a foot return the syllable at top of
the stack unchanged)
(CAR SYLLABLE-TAIL)))
finally (RETURN $$VAL])
(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: " 7-Aug-84 11:44")
(* 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) (* Didn't find a stress)
NIL)
((OR [AND (ZEROP STRESS#)
(NOT (NUMBERP (CAR (LAST.BUT.NOT.SEPR SYLLABLE]
(EQUAL (CAR (LAST SYLLABLE))
STRESS#))
(* If STRESS# is 0 then we are looking for an UNstressed syllable, therefore we return a non-nil value
(i.e. STRESS#) when there is no stress indication (i.e. no number at the end of the list of segments))
(* If the STRESS# is a number other than 0 then return the STRESS# when we find its match at the end of the
segment list)
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: " 6-Aug-84 20:11")
(* Looks at individual syllables;
the variable SYLL holds the syllables/feet)
(* Finds a final syllable, whether it is in a foot or on its own and makes a foot of it if there is a tense vowel)
(for SYLL TEMP LASTINFOOT in old SYLLABLES
join (COND
[[AND (type? FOOT SYLL)
(NULL (CDR SYLLABLES))
(NEQ 1 (LENGTH (SETQ TEMP (fetch (FOOT SYLLABLES) of SYLL]
(* The final syllable is in a foot;
look inside it)
(SETQ LASTINFOOT (CAR (LAST TEMP)))
(COND
[(NOT (OR (MEMBER (QUOTE x)
LASTINFOOT)
(MEMBER (QUOTE %|)
LASTINFOOT)
(MEMBER (QUOTE i)
LASTINFOOT)
(MEMBER (QUOTE I)
LASTINFOOT)
(MEMBER (QUOTE E)
LASTINFOOT)
(MEMBER (QUOTE ↑)
LASTINFOOT)
(MEMBER (QUOTE U)
LASTINFOOT)
(MEMBER (QUOTE N)
LASTINFOOT)
(MEMBER (QUOTE X)
LASTINFOOT)))
(LIST [MAKE-FOOT (REVERSE (CDR (REVERSE TEMP]
(MAKE-FOOT (LIST LASTINFOOT]
(T (LIST SYLL]
([AND (NOT (type? FOOT SYLL))
(NULL (CDR SYLLABLES))
(NOT (OR (MEMBER (QUOTE x)
SYLL)
(MEMBER (QUOTE %|)
SYLL)
(MEMBER (QUOTE i)
SYLL)
(MEMBER (QUOTE I)
SYLL)
(MEMBER (QUOTE E)
SYLL)
(MEMBER (QUOTE ↑)
SYLL)
(MEMBER (QUOTE U)
SYLL] (* The final syllable is not in a foot and it is tense)
(LIST (MAKE-FOOT SYLL)))
(T (LIST SYLL)))
finally $$VAL])
)
(* 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 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 (2058 36635 (ANAPEST-FOOT 2068 . 2934) (ANTEPENULTSYLLABLE 2936 . 3261) (CATEGORIZE 3263
. 4511) (CONSONANT? 4513 . 4833) (COUNTTHEM 4835 . 5050) (VVAS.RULE 5052 . 6150) (EDGEMARKER 6152 .
6646) (FALLING-FOOT 6648 . 8910) (FIND-BOUNDARY 8912 . 9214) (FIND-1-STRESS 9216 . 9740) (FIND-STRESS
9743 . 10751) (FOOT-PARSER 10753 . 12060) (FOOT? 12062 . 12259) (HEAVY-SYLLABLE-FOOT 12261 . 13129) (
LAST.BUT.NOT.SEPR 13131 . 13389) (HEAVY-SYLLABLE? 13391 . 13856) (LASTSYLLABLE 13858 . 14013) (
LOADFOOT 14015 . 14844) (LONG-VOWEL? 14846 . 15245) (MAINSTRESS 15247 . 15626) (MAKE-FOOT 15628 .
15772) (ONSET 15774 . 15921) (PACKFEET 15923 . 16379) (PACKWORD 16381 . 16973) (PACKFOOT 16975 . 17384
) (PARSE 17386 . 17555) (PARSE-1-WORD 17557 . 18741) (PARSE-TEST 18743 . 19744) (FOOT.DOMAINS 19746 .
19958) (PENULTRULE 19960 . 20706) (PENULTSYLLABLE 20708 . 21036) (PRETTYFOOT 21038 . 21497) (PRINTFOOT
21499 . 22805) (LEFT.WEAK.BRACKET 22807 . 23064) (RIGHT.STRONG.BRACKET 23066 . 23210) (
LEFT.STRONG.BRACKET 23212 . 23471) (LEFT.SYLLABLE.INCORPORATION 23473 . 24168) (RIGHT.WEAK.BRACKET
24170 . 24312) (PRINTSTRONGFOOT 24314 . 24538) (PRUNE 24540 . 24676) (PRUNE1 24678 . 25259) (
REAL-LONG-VOWEL? 25261 . 25694) (RUNFEET 25696 . 25910) (SECONDARY-FOOT 25912 . 27849) (
SECONDARY-STRESS 27851 . 28024) (SELECTIVE-PARSE 28026 . 28347) (STRESS 28349 . 30101) (STRESS&STRIP
30103 . 30662) (STRESS-SYLLABLE 30664 . 31034) (STRESS-VOWEL 31036 . 31751) (MAINSTRESS.FOOT 31753 .
31943) (STRESS? 31945 . 32868) (STRIPFOOT 32870 . 33045) (SYLLABLE-STACKER 33047 . 34857) (
TERTIARY-STRESS 34859 . 35031) (TEST-FUNCTION 35033 . 35472) (TEST-STRESSER 35474 . 36010) (
TRANSFORMFOOT 36012 . 36277) (VOWEL? 36279 . 36633)) (36636 40176 (DEBUG 36646 . 36711) (FOOTSUBSCRIPT
36713 . 37186) (MARKED.STRONG 37188 . 37534) (SETUP.FOOTWINDOW 37536 . 37868) (FOOTFONTS 37870 .
38322) (DEFAULT.FOOT 38324 . 40174)))))
STOP