00050 .PR POINT .PR
00100 .COMMENT SISTERS, COUSINS AND AUNTS - MODEL SOLUTION .COMMENT 
00120 ( .MODE .PERSON = .STRUCT(.STRING NAME, .BOOL SEX, .INT COUNT, .BITS UP 
00130     , .REF .PERSON PA, MA, NEXTHASH)
00140 ; .REF .PERSON NOBODY = .NIL
00150 ; .INT HASHSIZE = 43
00152 ; .INT BITSWIDTH = (MAXINT=32767!16!32)
00160 ; .LOC [0:HASHSIZE-1] .REF .PERSON HASHTABLE
00170     # PERSONS HASHING TO THE SAME HASHTABLE ELEMENT WILL BE CHAINED 
00180       USING THE 'NEXTHASH' FIELD #
00190 ; .FOR I .FROM 0 .TO HASHSIZE-1 
00200   .DO HASHTABLE[I] := NOBODY .OD
00210 ; .BOOL MALE = .TRUE, FEMALE = .FALSE, CHECK = .TRUE, NOCHECK = .FALSE
00220 ; .PROC HASHIN = (.STRING NAME, .BOOL SEX, CHECK).REF .PERSON:  
00230     # RETURNS EXISTING .REF .PERSON FROM HASHTABLE (CHECKING EXISTING SEX IF 'CHECK'),
00240       OR CREATES A NEW ONE AS REQUIRED. 
00250       AN EMPTY 'NAME' RETURNS 'NOBODY' #
00260     .IF NAME="" 
00270     .THEN NOBODY
00280     .ELSE .LOC .INT HASHNO := 0 
00290       ; .FOR I .TO .UPB NAME
00300         .DO HASHNO +:= .ABS NAME[I] .OD 
00310       ; .LOC .REF .REF .PERSON PTR := HASHTABLE[HASHNO .MOD HASHSIZE] 
00320           # NOTE USE OF THE "3 REF TRICK" # 
00330       ; .WHILE (PTR .IS NOBODY ! .FALSE ! NAME .OF PTR /= NAME) 
00340         .DO PTR := NEXTHASH .OF PTR .OD 
00350       ; .IF PTR .IS NOBODY
00360         .THEN .REF .REF .PERSON (PTR) := .HEAP .PERSON := 
00370               ( NAME, SEX, 0, .SKIP, NOBODY, NOBODY, NOBODY)
00380         .ELIF SEX .OF PTR = SEX .OR .NOT CHECK
00390         .THEN PTR 
00400         .ELSE PRINT((NAME, " SEEMS TO HAVE CHANGED SEX", NEWLINE))
00410           ; NOBODY
00420         .FI 
00430     .FI 
00440 ; .BEGIN # INPUT OF FAMILIES #
00450       .LOC .STRING FATHER, MOTHER, CHILD
00460     ; .LOC .REF .PERSON PA, MA, INFANT
00470     ; .LOC .CHAR SD # TO HOLD "S" FOR SON, OR "D" FOR DAUGHTER #
00480     ; .LOC .BOOL SEX # .TRUE FOR MALE # 
00482     ; CLOSE(STANDIN)
00484     ; OPEN(STANDIN, "sisters", STAND IN CHANNEL)
00490     ; ON PAGE END(STAND IN, (.REF .FILE F).BOOL: (NEWPAGE(F); .GOTO RELATIONSHIP))
00500     ; MAKE TERM(STAND IN, ",;.")
00510     ; RESTART:  
00520         ( .PROC COMPLAIN = (.STRING MESSAGE).VOID:  
00530             # IGNORES REMAINDER OF CURRENT LINE, AND RESTARTS INPUT LOOP #
00540             ( PRINT((MESSAGE, NEWLINE)) 
00550             ; READ(NEWLINE) 
00560             ; .GOTO RESTART 
00570             ) 
00580         ; .PROC EXPECT = (.CHAR E).VOID:  
00590             # ABSORBS NEXT CHARACTER, COMPLAINING IF IT IS NOT AS EXPECTED #
00600             ( .LOC .CHAR C
00610             ; READ(C) 
00620             ; .IF C/=E
00630               .THEN COMPLAIN(C+" FOUND INSTEAD OF "+E)
00640               .FI 
00650             ) 
00660         ; READ(FATHER); EXPECT(",") 
00670         ; PA := HASHIN(FATHER, MALE, CHECK) 
00680         ; READ(MOTHER); EXPECT(";") 
00690         ; MA := HASHIN(MOTHER, FEMALE, CHECK) 
00700             # IF FATHER(MOTHER) IS NOT SPECIFIED, 'NOBODY' GETS ASSIGNED TO PA(MA) #
00710         ; .IF (PA .IS NOBODY) .AND (MA .IS NOBODY)
00720           .THEN COMPLAIN("BOTH PARENTS MISSING")
00730           .FI 
00740         ; .WHILE READ(SD) 
00750             ; SEX := (SD="S" ! MALE !: SD="D" ! FEMALE ! COMPLAIN(SD+" FOUND INSTEAD OF S OR D"); .SKIP)
00760             ; EXPECT("=") 
00770             ; READ(CHILD) 
00780             ; INFANT := HASHIN(CHILD, SEX, CHECK) 
00790             ; .IF INFANT .ISNT NOBODY 
00800               .THEN .IF PA .OF INFANT .ISNT NOBODY
00810                   .THEN COMPLAIN(CHILD+" ALREADY HAS A FATHER") 
00820                   .ELSE PA .OF INFANT := PA 
00830                   .FI 
00840                 ; .IF MA .OF INFANT .ISNT NOBODY
00850                   .THEN COMPLAIN(CHILD+" ALREADY HAS A MOTHER") 
00860                   .ELSE MA .OF INFANT := MA 
00870                   .FI 
00880               .ELSE COMPLAIN("CHILD'S NAME NOT GIVEN")
00890               .FI 
00900             ; READ(SD)
00910             ; SD/="." 
00920           .DO .SKIP .OD 
00930         ; READ(NEWLINE) 
00940         ; .GOTO RESTART 
00950         ) 
00960   .END # INPUT OF FAMILIES #
00970 ; RELATIONSHIP: 
00980     .BEGIN # CHECKING OF RELATIONSHIPS #
00990         .LOC .STRING FIRST, SECOND
01000       ; .LOC .REF .PERSON THIS, THAT
01010       ; .MODE .CHAIN = .STRUCT(.INT UP, DOWN, .REF .CHAIN NEXT) 
01020       ; .REF .CHAIN NOCHAIN = .NIL
01030       ; .LOC .REF .CHAIN START CHAIN
01040       ; .PROC INSERT CHAIN = (.INT UP, DOWN).VOID:  
01050           ( .LOC .REF .CHAIN PTR := START CHAIN 
01060           ; .WHILE (PTR :/=: NOCHAIN ! UP .OF PTR /= UP .OR DOWN .OF PTR /= DOWN ! .FALSE)
01070             .DO PTR := NEXT .OF PTR .OD 
01080           ; .IF PTR :=: NOCHAIN .THEN START CHAIN := .HEAP .CHAIN := (UP, DOWN, START CHAIN) .FI
01090           ) 
01100       ; .PROC RELATIONS = (.INT UP, DOWN).VOID: 
01110           # PRINTS THE RELATIONSHIP BETWEEN 'THIS' AND 'THAT', ACCORDING TO 
01120             'UP' AND 'DOWN' # 
01130           PRINT((NAME .OF THIS
01140               ,   ( .PROC GREATS = (.INT N).STRING: N*"GREAT-"
01150                 ; " IS THE " +
01160                     .CASE UP+1
01170                     .IN .CASE DOWN+1
01180                         .IN "SAME AS "
01190                           , (SEX .OF THIS ! "FATHER" ! "MOTHER") + " OF " 
01200                         .OUT GREATS(DOWN-UP-2) + "GRAND" + (SEX .OF THIS ! "FATHER" ! "MOTHER") + " OF "
01210                         .ESAC 
01220                       , .CASE DOWN+1
01230                         .IN (SEX .OF THIS ! "SON" ! "DAUGHTER") + " OF "
01240                           , (SEX .OF THIS ! "BROTHER" ! "SISTER") + " OF "
01250                         .OUT GREATS(DOWN-UP-1) + (SEX .OF THIS ! "UNCLE" ! "AUNT") + " OF " 
01260                         .ESAC 
01270                     .OUT .CASE DOWN+1 
01280                         .IN GREATS(UP-DOWN-2) + "GRAND" + (SEX .OF THIS ! "SON" ! "DAUGHTER") + " OF "
01290                           , GREATS(UP-DOWN-1) + (SEX .OF THIS ! "NEPHEW" ! "NIECE") + " OF "
01300                         .OUT .INT COUS = (UP<DOWN ! UP ! DOWN)-1
01310                           ; .INT REM = .ABS(UP-DOWN)
01320                           ; WHOLE(COUS, 0) + (COUS ! "ST", "ND", "RD" ! "TH") + " COUSIN "
01330                               + (REM/=0 ! WHOLE(REM, 0) + " TIMES REMOVED " ! "") + "OF " 
01340                         .ESAC 
01350                     .ESAC 
01360                 ) 
01370               , NAME .OF THAT, NEWLINE
01380               ))
01390       ; .LOC .INT COUNT := 1 # USED TO MARK .PERSONS WHICH HAVE BEEN SCANNED #
01400       ; .PROC MARK = (.REF .PERSON P, .BITS UP).VOID: 
01410           # MARK ALL ANCESTORS OF 'P' WITH 'COUNT'. 
01420             'UP' IS NUMBER OF GENERATIONS FROM START #
01430           .IF P .ISNT NOBODY
01440           .THEN .IF COUNT .OF P = COUNT 
01442               .THEN UP .OF P := UP .OF P .OR UP 
01450               .ELSE COUNT .OF P := COUNT
01460                 ; UP .OF P := UP
01462               .FI 
01470             ; MARK(PA .OF P, UP .SHR 1) 
01480             ; MARK(MA .OF P, UP .SHR 1) 
01500           .FI 
01510       ; .PROC SEARCH = (.REF .PERSON P, .INT DOWN, .BOOL FIRSTIME).BOOL:  
01520           # SEARCHES ALL ANCESTORS OF 'P' FOR MARKED ANCESTOR.
01530             'DOWN' IS NUMBER OF GENERATIONS FROM START. 
01540             RETURNS .FALSE IF NO RELATION FOUND # 
01550           .IF P .ISNT NOBODY
01560           .THEN .IF COUNT .OF P = COUNT 
01562               .THEN .BITS UP = UP .OF P 
01564                 ; .FOR I .TO BITSWIDTH-1
01565                   .DO .IF I .ELEM UP
01566                       .THEN .IF FIRSTIME
01567                            .THEN INSERT CHAIN(I-1, DOWN)
01568                            .ELSE INSERT CHAIN(DOWN, I-1)
01569                            .FI
01570                        .FI
01571                    .OD
01572                 ; .TRUE 
01573               .ELSE SEARCH(PA .OF P, DOWN+1, FIRSTIME)
01580                     .OR SEARCH(MA .OF P, DOWN+1, FIRSTIME)
01590               .FI 
01600           .ELSE .FALSE
01610           .FI 
01620       ; ON LOGICAL FILE END(STANDIN, (.REF .FILE F).BOOL: .GOTO STOP) 
01630       ; MAKE TERM(STANDIN, ",;.") 
01640       ; RESTART:  
01650           ( .PROC COMPLAIN = (.STRING MESSAGE).VOID:  
01660               ( PRINT((MESSAGE, NEWLINE)) 
01670               ; READ(NEWLINE) 
01680               ; .GOTO RESTART 
01690               ) 
01700           ; .PROC EXPECT = (.CHAR E).VOID:  
01710               ( .LOC .CHAR C
01720               ; READ(C) 
01730               ; .IF C/=E .THEN COMPLAIN(C+" FOUND INSTEAD OF "+E) .FI 
01740               ) 
01750           ; READ(FIRST); EXPECT(",")
01760           ; THIS := HASHIN(FIRST, .SKIP, NOCHECK) 
01770           ; READ(SECOND); EXPECT(".") 
01780           ; THAT := HASHIN(SECOND, .SKIP, NOCHECK)
01790           ; .IF (THIS .IS NOBODY) .OR (THAT .IS NOBODY) .THEN COMPLAIN("TWO NAMES NOT GIVEN") .FI 
01800           ; MARK(THIS, 2R1 .SHL (BITSWIDTH-1))
01810           ; START CHAIN := NOCHAIN
01820           ; .IF SEARCH(THAT, 0, .TRUE)
01822             .THEN COUNT +:= 1 
01823               ; MARK(THAT, 2R1 .SHL (BITSWIDTH-1))
01824               ; SEARCH(THIS, 0, .FALSE) 
01830               ; .LOC .REF .CHAIN PTR := START CHAIN 
01840               ; .WHILE PTR :/=: NOCHAIN 
01850                 .DO RELATIONS(UP .OF PTR, DOWN .OF PTR) 
01860                   ; PTR := NEXT .OF PTR 
01870                 .OD 
01880             .ELSE PRINT((NAME .OF THIS, " IS NOT RELATED TO ", NAME .OF THAT, NEWLINE)) 
01890             .FI 
01900           ; COUNT +:= 1 
01910           ; READ(NEWLINE) 
01920           ; .GOTO RESTART 
01930           ) 
01940     .END # CHECKING OF RELATIONSHIPS #
01950 )