(FILECREATED " 1-Apr-86 17:44:04" {QV}<DICT>TOOLS>PROOFREADER.;23 24782
changes to: (FNS Proofreader.LookupBit)
previous date: " 1-Apr-86 17:17:51" {QV}<DICT>TOOLS>PROOFREADER.;22)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PROOFREADERCOMS)
(RPAQQ PROOFREADERCOMS [(FILES ANALYZER SPELLINGARRAY)
(FNS Proofreader.New Proofreader.Open Proofreader.AddEntry Proofreader.Lookup
Proofreader.AllForms)
(FNS Proofreader.BuildSpellingArray Proofreader.CharTable
Proofreader.LookupBit Proofreader.SetBit)
(FNS Proofreader.Correct Proofreader.NextWord)
(MACROS Proofreader.Hash1 Proofreader.Hash2 \Proofreader.TestCorruption)
(INITVARS Proofreader Proofreader.AutoLoad Proofreader.Lisp)
(* Proofreader.AutoLoad is a file or list of files to be loaded whenever a
proofreader is opened.)
(P (Analyzer.Establish (SETQ Proofreader (Proofreader.New 'Hash-English])
(FILESLOAD ANALYZER SPELLINGARRAY)
(DEFINEQ
(Proofreader.New
[LAMBDA (name fileName) (* jtm: " 4-Dec-85 13:16")
(PROG [(analyzer (create Analyzer
name ← name
openFn ←(FUNCTION Proofreader.Open)
lookupFn ←(FUNCTION Proofreader.Lookup)
addEntryFn ←(FUNCTION Proofreader.AddEntry]
(RETURN analyzer])
(Proofreader.Open
[LAMBDA (analyzer stream) (* jtm: "25-Oct-85 15:29")
(COND
((NULL (fetch (Analyzer index) of analyzer))
[replace (Analyzer index) of analyzer
with (PROG [(file (Analyzer.Prop analyzer 'FileName]
[COND
((NULL SpellingArray)
(COND
((NULL stream)
(PROMPTPRINT "initializing Proofreader"))
(T (TEDIT.PROMPTPRINT stream "initializing Proofreader" T)))
(RESETLST (PROG (LENGTH ALENGTH BLOCK STREAM (START 0)
(HEADERSIZE 6))
[RESETSAVE (SETQ STREAM (OPENSTREAM file 'INPUT
'OLD))
'(PROGN (CLOSEF OLDVALUE))]
(SETQ LENGTH (IDIFFERENCE (GETFILEINFO file 'LENGTH)
(IPLUS HEADERSIZE 2)))
(for i from 1 to HEADERSIZE do (BIN STREAM))
(* skip header)
(while (ILESSP START LENGTH)
do (SETQ ALENGTH (MIN 64000 (IDIFFERENCE LENGTH START)))
(SETQ BLOCK (\ALLOCBLOCK (LRSH (IPLUS 3 ALENGTH)
2)))
(\BINS STREAM BLOCK 0 ALENGTH)
(add START ALENGTH)
(push SpellingArray (CONS START BLOCK)))
(SETQ SpellingArray (REVERSE SpellingArray]
(RETURN (CONS SpellingArray (Proofreader.CharTable]
(for file inside Proofreader.AutoLoad do (Analyzer.DefaultLoadWordList analyzer file])
(Proofreader.AddEntry
[LAMBDA (analyzer lemma entry dontRecord) (* jtm: "23-Oct-85 08:49")
(* * adds "lemma" to the SpellingArray. This procedure is just like Lookup, only it sets the bits rather than just
reading them.)
(PROG (char p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 SpellingArray
SpellingArray.CharTable start length) (* first save the word on a property list.)
(COND
((NULL dontRecord)
(Analyzer.PushProp analyzer 'WordList
lemma)))
(SETQ SpellingArray (fetch (Analyzer index) of analyzer))
[COND
((NULL entry)
(SETQ entry (Proofreader.AllForms lemma]
[COND
((NULL SpellingArray)
(Proofreader.Open analyzer)
(SETQ SpellingArray (fetch (Analyzer index) of analyzer]
(SETQ SpellingArray.CharTable (CDR SpellingArray))
(SETQ SpellingArray (CAR SpellingArray))
(SETQ hash1 953)
(SETQ hash2 63869)
(SETQ hash3 2441)
(SETQ hash4 62265)
(SETQ hash5 4079)
(SETQ hash6 60585)
(SETQ hash7 5807)
(SETQ p 359)
(Stream.Init lemma start length)
(while (SETQ char (Stream.NextChar lemma length))
do (SETQ char (CHCON1 char))
[COND
((ALPHACHARP char)
(SETQ char (ELT SpellingArray.CharTable (IDIFFERENCE char 64]
(add p 1009)
(SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash2))
p)))
[SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 hash3)
char]
[SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4)
char]
(SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 hash5))
p)))
(SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash6))
p)))
(SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 hash7)
char)
p)))
[SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 hash1)
char]
(SETQ hash1 x1)
(SETQ hash2 x2)
(SETQ hash3 x3)
(SETQ hash4 x4)
(SETQ hash5 x5)
(SETQ hash6 x6)
(SETQ hash7 x7))
(* * set the bits.)
(Proofreader.SetBit hash1 hash7 SpellingArray)
(Proofreader.SetBit hash2 hash6 SpellingArray)
(Proofreader.SetBit hash3 hash5 SpellingArray)
(Proofreader.SetBit hash4 hash4 SpellingArray)
(Proofreader.SetBit hash5 hash3 SpellingArray)
(Proofreader.SetBit hash6 hash2 SpellingArray)
(Proofreader.SetBit hash7 hash1 SpellingArray])
(Proofreader.Lookup
[LAMBDA (analyzer stream start length) (* jtm: " 1-Apr-86 17:02")
(* * hashes the string into the array using a probabalistic technique. This may produce a false positive.)
(PROG (char p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 SpellingArray
SpellingArray.CharTable)
(SETQ SpellingArray (fetch (Analyzer index) of analyzer))
[COND
((NULL SpellingArray)
(Proofreader.Open analyzer)
(SETQ SpellingArray (fetch (Analyzer index) of analyzer]
(SETQ SpellingArray.CharTable (CDR SpellingArray))
(SETQ SpellingArray (CAR SpellingArray))
(SETQ hash1 953)
(SETQ hash2 63869)
(SETQ hash3 2441)
(SETQ hash4 62265)
(SETQ hash5 4079)
(SETQ hash6 60585)
(SETQ hash7 5807)
(SETQ p 359)
(Stream.Init stream start length)
(while (SETQ char (Stream.NextChar stream length start))
do [COND
((IGREATERP char 255)
(SETQ char (IMOD char 256]
[COND
((ALPHACHARP char)
(SETQ char (ELT SpellingArray.CharTable (IDIFFERENCE char 64]
(add p 1009)
(SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1
hash2))
p)))
[SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2
hash3)
char]
[SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4)
char]
(SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2
hash5))
p)))
(SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1
hash6))
p)))
(SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2
hash7)
char)
p)))
[SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1
hash1)
char]
(SETQ hash1 x1)
(SETQ hash2 x2)
(SETQ hash3 x3)
(SETQ hash4 x4)
(SETQ hash5 x5)
(SETQ hash6 x6)
(SETQ hash7 x7))
(RETURN (AND (Proofreader.LookupBit hash1 hash7 SpellingArray)
(Proofreader.LookupBit hash2 hash6 SpellingArray)
(Proofreader.LookupBit hash3 hash5 SpellingArray)
(Proofreader.LookupBit hash4 hash4 SpellingArray)
(Proofreader.LookupBit hash5 hash3 SpellingArray)
(Proofreader.LookupBit hash6 hash2 SpellingArray)
(Proofreader.LookupBit hash7 hash1 SpellingArray])
(Proofreader.AllForms
[LAMBDA (lemma) (* jtm: "16-Oct-85 14:59")
(* * ask the user for the forms to fill out this word.)
(PROG (forms form newForms menuPos)
(SETQ forms (LIST 'NOUN
'VERB
'ADJ
(English.Suffix lemma "s")
(English.Suffix lemma "s")
(English.Suffix lemma "er")
" "
(English.Suffix lemma "ed")
(English.Suffix lemma "est")
" "
(English.Suffix lemma "ing")
" " " " '*OTHER*))
(while [SETQ form
(MENU (create MENU
TITLE ← "parts of speech"
CENTERFLG ← T
ITEMS ← forms
MENUCOLUMNS ← 3
CHANGEOFFSETFLG ← T
MENUPOSITION ←(COND
(menuPos)
(T (GETMOUSESTATE)
(SETQ menuPos (CONS LASTMOUSEX LASTMOUSEY]
do (pushnew newForms form))
(RETURN newForms])
)
(DEFINEQ
(Proofreader.BuildSpellingArray
[LAMBDA NIL (* jtm: "25-Oct-85 13:36")
(* * build a spelling array from the forms in the English Morphology Dictionary.)
(PROG (analyzer)
(SETQ analyzer (Proofreader.New 'SpellingArray))
(replace (Analyzer index) of analyzer with (CONS (LIST (CONS 64000 (\ALLOCBLOCK 16000))
(CONS 101890 (\ALLOCBLOCK 9473)))
(Proofreader.CharTable)))
[Dict.MapEntries EngMorphDict
(FUNCTION (LAMBDA (dict entry lemma)
(PROG (lemma lemmaDone)
[SETQ lemma (CONCATLIST (DREMOVE '%|
(UNPACK (fetch (
EngMorphDict.Entry lemma) of entry]
(COND
((EQUAL 0 (IMOD (fetch (EngMorphDict.Entry entry#)
of entry)
100))
(printout T lemma ,)))
[COND
((STRPOSL '(% %.)
lemma)
NIL)
(T (for i in (fetch (EngMorphDict.Entry partsOfSpeech)
of entry)
do (COND
[(FMEMB (CAR i)
'(v vi vt n pn adj))
(COND
((NOT lemmaDone)
(Analyzer.AddEntry analyzer lemma T T)
(SETQ lemmaDone T)))
(COND
((AND (EQ (CAR i)
'n)
(NULL (CDR i)))
(Analyzer.AddEntry analyzer (English.Suffix
lemma "s")
T T))
(T (for j in (CDR i)
do (for k in (CDR j) when (STRINGP k)
do (Analyzer.AddEntry analyzer k T
T]
[(FMEMB (CAR i)
'(adv * prep pln interj conj contr pron))
(COND
((NOT lemmaDone)
(Analyzer.AddEntry analyzer lemma T T)
(SETQ lemmaDone T]
[(FMEMB (CAR i)
'(abbr acr prf psf var)]
(T (HELP "did not recognize" (CAR i]
NIL]
(Analyzer.Establish analyzer)
(RETURN analyzer])
(Proofreader.CharTable
[LAMBDA NIL (* jtm: "24-Oct-85 15:45")
(* * comment)
(PROG (SpellingArray.CharTable)
(SETQ SpellingArray.CharTable (ARRAY 58))
(for i in '(0 32)
do (SETA SpellingArray.CharTable (IPLUS i 1)
65325)
(SETA SpellingArray.CharTable (IPLUS i 2)
65204)
(SETA SpellingArray.CharTable (IPLUS i 3)
449)
(SETA SpellingArray.CharTable (IPLUS i 4)
588)
(SETA SpellingArray.CharTable (IPLUS i 5)
7102)
(SETA SpellingArray.CharTable (IPLUS i 6)
64682)
(SETA SpellingArray.CharTable (IPLUS i 7)
64545)
(SETA SpellingArray.CharTable (IPLUS i 8)
64418)
(SETA SpellingArray.CharTable (IPLUS i 9)
1278)
(SETA SpellingArray.CharTable (IPLUS i 10)
1433)
(SETA SpellingArray.CharTable (IPLUS i 11)
63968)
(SETA SpellingArray.CharTable (IPLUS i 12)
63827)
(SETA SpellingArray.CharTable (IPLUS i 13)
1874)
(SETA SpellingArray.CharTable (IPLUS i 14)
2027)
(SETA SpellingArray.CharTable (IPLUS i 15)
2180)
(SETA SpellingArray.CharTable (IPLUS i 16)
63195)
(SETA SpellingArray.CharTable (IPLUS i 17)
63058)
(SETA SpellingArray.CharTable (IPLUS i 18)
62865)
(SETA SpellingArray.CharTable (IPLUS i 19)
2798)
(SETA SpellingArray.CharTable (IPLUS i 20)
2963)
(SETA SpellingArray.CharTable (IPLUS i 21)
62372)
(SETA SpellingArray.CharTable (IPLUS i 22)
62216)
(SETA SpellingArray.CharTable (IPLUS i 23)
62067)
(SETA SpellingArray.CharTable (IPLUS i 24)
3624)
(SETA SpellingArray.CharTable (IPLUS i 25)
3793)
(SETA SpellingArray.CharTable (IPLUS i 26)
3944))
(RETURN SpellingArray.CharTable])
(Proofreader.LookupBit
[LAMBDA (row column SpellingArray) (* jtm: " 1-Apr-86 17:43")
(* * There are 4096 bits per row, but only 4093 of them are used.)
(PROG (byte (startByte 0))
(SETQ row (IMOD row 199))
(SETQ column (IMOD column 4093))
(SETQ byte (IPLUS (LLSH row 9)
(LRSH column 3)))
(for block in SpellingArray do (COND
((ILESSP byte (CAR block))
(SETQ byte (\GETBASEBYTE (CDR block)
(IDIFFERENCE byte startByte)))
(RETURN)))
(SETQ startByte (CAR block)))
(RETURN (BITTEST byte (MASK.1'S (IDIFFERENCE 7 (LOGAND column 7))
1])
(Proofreader.SetBit
[LAMBDA (row column SpellingArray) (* jtm: "24-Oct-85 15:28")
(* * There are 4096 bits per row, but only 4093 of them are used.)
(PROG (address (startByte 0))
(SETQ row (IMOD row 199))
(SETQ column (IMOD column 4093))
(SETQ address (IPLUS (LLSH row 9)
(LRSH column 3)))
(for block byte in SpellingArray
do (COND
((ILESSP address (CAR block))
(SETQ byte (\GETBASEBYTE (CDR block)
(IDIFFERENCE address startByte)))
(SETQ byte (BITSET byte (MASK.1%'S (IDIFFERENCE 7 (LOGAND column 7))
1)))
(\PUTBASEBYTE (CDR block)
(IDIFFERENCE address startByte)
byte)
(RETURN)))
(SETQ startByte (CAR block])
)
(DEFINEQ
(Proofreader.Correct
[LAMBDA (analyzer stream start length) (* jtm: "27-Nov-85 12:32")
(* * returns a list of possible spelling corrections for the given word.)
(PROG (form word wordList caps periods)
[COND
((NOT (LISTP stream))
(SETFILEPTR stream start)
(SETQ word (for i from 1 to length collect (READC stream]
(SETQ caps (Analyzer.Capitalization word))
(SETQ periods (FMEMB '%.
word))
(* * first try transpositions)
(for tail temp on word while (CDR tail)
do (SETQ temp (CAR tail))
(RPLACA tail (CADR tail))
(RPLACA (CDR tail)
temp)
(COND
((AND (EQ caps 'FIRST)
(EQ tail word)) (* don't transpose the first letters of a capitalized
word.)
NIL)
(T (\Proofreader.TestCorruption analyzer word wordList)))
(RPLACA (CDR tail)
(CAR tail))
(RPLACA tail temp))
(* * next try deletions)
(COND
((CDR word)
(\Proofreader.TestCorruption analyzer (CDR word)
wordList)))
(for tail temp on word while (CDR tail)
do (SETQ temp (CDR tail))
(RPLACD tail (CDDR tail))
(\Proofreader.TestCorruption analyzer word wordList)
(RPLACD tail temp))
(* * prepend a character.)
(SETQ word (CONS 'A
word))
(SELECTQ caps
(FIRST (* don't prepend a character before a capitalized
word.)
NIL)
(ALL (* prepend a capital letter.)
(for c from (CHARCODE A) to (CHARCODE Z)
do (RPLACA word (CHARACTER c))
(\Proofreader.TestCorruption analyzer word wordList)))
(for c from (CHARCODE a) to (CHARCODE z)
do (RPLACA word (CHARACTER c))
(\Proofreader.TestCorruption analyzer word wordList)))
(SETQ word (CDR word))
(* * insert characters.)
(for tail on word
do (RPLACD tail (CONS 'A
(CDR tail)))
[COND
((EQ caps 'ALL)
(for c from (CHARCODE A) to (CHARCODE Z)
do (RPLACA (CDR tail)
(CHARACTER c))
(\Proofreader.TestCorruption analyzer word wordList)))
(T (for c from (CHARCODE a) to (CHARCODE z)
do (RPLACA (CDR tail)
(CHARACTER c))
(\Proofreader.TestCorruption analyzer word wordList]
(COND
(periods (RPLACA (CDR tail)
'%.)
(\Proofreader.TestCorruption analyzer word wordList)))
(RPLACD tail (CDDR tail)))
(* * replace characters)
(for tail temp on word
do (SETQ temp (CAR tail))
[COND
((OR (EQ caps 'ALL)
(AND (EQ caps 'FIRST)
(EQ tail word)))
(for c from (CHARCODE A) to (CHARCODE Z)
do (COND
((NEQ temp (CHARACTER c))
(RPLACA tail (CHARACTER c))
(\Proofreader.TestCorruption analyzer word wordList]
[COND
((OR (EQ caps NIL)
(NOT (ALPHACHARP (CHCON1 temp)))
(AND (EQ caps 'FIRST)
(NEQ tail word)))
(for c from (CHARCODE a) to (CHARCODE z)
do (COND
((NEQ temp (CHARACTER c))
(RPLACA tail (CHARACTER c))
(\Proofreader.TestCorruption analyzer word wordList]
(COND
(periods (RPLACA tail '%.)
(\Proofreader.TestCorruption analyzer word wordList)))
(RPLACA tail temp))
(SETQ wordList (SORT wordList))
[for i on wordList do (while (STREQUAL (CAR i)
(CADR i))
do (RPLACD i (CDDR i]
(RETURN wordList])
(Proofreader.NextWord
[LAMBDA (analyzer stream startPtr searchLength NWFn) (* jtm: "22-Oct-85 15:27")
(* * Scans the stream looking for a word, i.e. a sequence of alphabetic charqacters. If the file ptr is already in
the middle of such a sequence, it backs up to the beginning of that sequence. The function applies NWFn to
(stream start stop) for each such word.)
(SETFILEPTR stream (OR startPtr (SETQ startPtr 0)))
(bind char end endPtr word length start value quote period number (filePtr ←(GETFILEPTR stream))
(EOFPtr ←(GETEOFPTR stream)) first (SETQ endPtr (COND
(searchLength (IMIN EOFPtr (IPLUS startPtr
searchLength)))
(T EOFPtr)))
do (SETQ char (AND (ILESSP (GETFILEPTR stream)
endPtr)
(BIN stream)))
(COND
[(AND char (AND (NUMBERP char)
(ILESSP char 128)
(Analyzer.AlphaCharP char)))
[OR start (SETQ start (SUB1 (GETFILEPTR stream]
(COND
(number (* we have a number followed by some characters.
(e.g. 7th, 21st, etc.) Take in the last digit of the
number.)
(add start -1)
(SETQ number NIL)))
(COND
(quote (COND
((EQ quote T) (* don%'t make a list until you need to.)
(SETQ quote NIL)))
(push quote char)))
(COND
(period (COND
((EQ period T)
(SETQ period NIL)))
(push period char]
((AND start char (EQUAL char (CHARCODE %'))) (* if the quote is in the middle of a word, leave it
in.)
(SETQ quote T))
((AND start char (EQUAL char (CHARCODE %.))) (* look for e.g., i.e.)
(OR period (SETQ period T)))
(start (SETQ end (GETFILEPTR stream))
(SETQ length (IDIFFERENCE end start))
(AND char (add length -1)) (* back up to the last legal char.)
(COND
((EQ quote T) (* delete final quotes)
(add length -1))
([OR (EQUAL quote '(115))
(EQUAL quote '(83)] (* delete %'s)
(add length -2)))
(SETQ quote NIL)
(COND
((EQ period T) (* delete final periods)
(add length -1)))
(SETQ period NIL)
(COND
((AND (EQ length 1)
(EQ char (CHARCODE %)))) (* letters used for outlines.)
(add length 1)))
[COND
[NWFn (SETQ value (APPLY* NWFn analyzer stream start length))
(COND
((EQ value T)
(RETURN (CONS start length)))
(value (RETURN value]
(T (RETURN (CONS start length]
(SETFILEPTR stream end)
(SETQ start NIL))
((AND char (NUMBERP char)
(IGEQ char 48)
(ILEQ char 57)) (* a number)
(SETQ number char))
(T (SETQ number NIL)))
(OR char (RETURN])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS Proofreader.Hash1 MACRO ((X)
(IPLUS (LLSH (LOGAND X 2047)
5)
(LRSH X 11]
[PUTPROPS Proofreader.Hash2 MACRO ((X)
(IPLUS (LLSH (LOGAND X 8191)
3)
(LRSH X 13]
[PUTPROPS \Proofreader.TestCorruption MACRO ((analyzer word wordList)
(COND ((Proofreader.Lookup analyzer word NIL NIL)
(push wordList (CONCATLIST word]
)
(RPAQ? Proofreader NIL)
(RPAQ? Proofreader.AutoLoad NIL)
(RPAQ? Proofreader.Lisp NIL)
(* Proofreader.AutoLoad is a file or list of files to be loaded whenever a proofreader is
opened.)
[Analyzer.Establish (SETQ Proofreader (Proofreader.New 'Hash-English]
(PUTPROPS PROOFREADER COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1217 10022 (Proofreader.New 1227 . 1577) (Proofreader.Open 1579 . 3203) (
Proofreader.AddEntry 3205 . 6209) (Proofreader.Lookup 6211 . 9040) (Proofreader.AllForms 9042 . 10020)
) (10023 16175 (Proofreader.BuildSpellingArray 10033 . 12208) (Proofreader.CharTable 12210 . 14299) (
Proofreader.LookupBit 14301 . 15265) (Proofreader.SetBit 15267 . 16173)) (16176 23724 (
Proofreader.Correct 16186 . 20420) (Proofreader.NextWord 20422 . 23722)))))
STOP