DIRECTORY IO USING [PutFR, rope], PasPrivate, PasPrivateVars, Rope USING [Equal, Fetch, Length]; PasIdent: CEDAR PROGRAM IMPORTS IO, PasPrivate, PasPrivateVars, Rope EXPORTS PasPrivate = BEGIN OPEN PasPrivate, PasPrivateVars; pascalMinMatchLen: CARDINAL _ 8; complainAboutIdMismatch: BOOLEAN _ TRUE; DefaultSet: PROCEDURE [p: IdentifierSetPtr] RETURNS [IdentifierSetPtr] = INLINE { IF p = NIL THEN RETURN[display[lexLevel].locals] ELSE RETURN[p]}; CreateIdentifierSet: PUBLIC PROCEDURE RETURNS [pset: IdentifierSetPtr] = BEGIN pset _ Z.NEW[IdentifierSet]; pset^ _ NIL; END; -- of CreateIdentifierSet InitIdentifierSet: PUBLIC PROCEDURE [pset: IdentifierSetPtr] = BEGIN pset^ _ NIL END; -- of InitIdentifierSet EmptyIdentifierSet: PUBLIC PROCEDURE [pset: IdentifierSetPtr] RETURNS [BOOL]= BEGIN RETURN[pset^ = NIL] END; -- of EmptyIdentifierSet EnumerateIdentifierSet: PUBLIC PROCEDURE [ pset: IdentifierSetPtr, p: PROCEDURE [IdentifierPtr]] = BEGIN set: IdentifierSet; FOR set _ pset^, set.rest WHILE set # NIL DO p[set.first] ENDLOOP; END; -- of EnumerateIdentifierSet MergeIdentifierSets: PUBLIC PROCEDURE [ into: IdentifierSetPtr _ NIL, from: IdentifierSetPtr] = BEGIN into _ DefaultSet[into]; IF into^ = NIL THEN into^ _ from^ ELSE BEGIN set: IdentifierSet; FOR set _ into^, set.rest WHILE set.rest # NIL DO ENDLOOP; set.rest _ from^; END; from^ _ NIL; END; -- of MergeIdentifierSets AssignTypeToIdSet: PUBLIC PROCEDURE [ pset: IdentifierSetPtr, type: GeneralTypePtr] = BEGIN lastSet, set: IdentifierSet; FOR lastSet _ pset^, lastSet.rest WHILE lastSet.rest # NIL DO ENDLOOP; FOR set _ pset^, set.rest WHILE set # lastSet DO set.first.type _ lastSet.first; ENDLOOP; lastSet.first.type _ type; END; -- of AssignTypeToSet DisposeIdentifierSet: PUBLIC PROCEDURE [pset: IdentifierSetPtr] = BEGIN pset^ _ NIL; END; -- of DisposeIdentifierSet NewIdent: PUBLIC PROCEDURE [ name: Name _ NIL, pset: IdentifierSetPtr _ NIL] RETURNS [IdentifierPtr] = BEGIN set: IdentifierSet; lastSet: IdentifierSet _ NIL; id: IdentifierPtr; pset _ DefaultSet[pset]; IF name = NIL THEN name _ ident; FOR set _ pset^, set.rest UNTIL set = NIL DO lastSet _ set; IF Rope.Equal[set.first.name, name] THEN Error[MultipleDefinition]; ENDLOOP; id _ Z.NEW[Identifier_ [name: name, hash: GetHash[name], type: NIL, class: NIL]]; IF lastSet = NIL THEN pset^ _ CONS[id,NIL] ELSE lastSet.rest _ CONS[id,NIL]; RETURN[id]; END; -- of NewIdent GetHash: PROC [name: Name] RETURNS [hash: INTEGER] = TRUSTED BEGIN len: NAT _ name.Length[]; hash _ 0; FOR i:NAT IN [0..MIN[len, PascalIdentLength]) DO hash _ 2*hash + LOOPHOLE[name.Fetch[i], INTEGER]; ENDLOOP; RETURN[hash]; END; -- of GetHash InsertOldIdent: PUBLIC PROC [id: IdentifierPtr, pset: IdentifierSetPtr] = BEGIN set: IdentifierSet; lastSet: IdentifierSet _ NIL; FOR set _ pset^, set.rest UNTIL set = NIL DO lastSet _ set; IF id = set.first THEN Error[Confusion]; ENDLOOP; IF lastSet = NIL THEN pset^ _ CONS[id,NIL] ELSE lastSet.rest _ CONS[id,NIL]; END; -- of InsertOldIdent IdentLookup: PUBLIC PROCEDURE [ name: Name _ NIL, pset: IdentifierSetPtr _ NIL, pfl: FieldListPtr _ NIL, couldFail: BOOLEAN _ FALSE] RETURNS [IdentifierPtr] = BEGIN complete: CARDINAL = LAST[CARDINAL]; hash: INTEGER; MatchRec: TYPE = RECORD [ bid: IdentifierPtr, -- one identifier w/ best match bml: CARDINAL, -- length of best match count: CARDINAL -- # identifiers that match this length ]; initMatchRec: MatchRec = [bid: NIL, bml: 0, count: 0]; Match: PROCEDURE [id: IdentifierPtr, m: MatchRec _ initMatchRec] RETURNS [MatchRec] = BEGIN matchLen: CARDINAL; s: Name _ id.name; FOR matchLen IN [0..MIN[NAT[s.Length[]], NAT[name.Length[]]]) DO IF s.Fetch[matchLen] # name.Fetch[matchLen] THEN EXIT; REPEAT FINISHED => matchLen _ IF s.Length[] = name.Length[] THEN complete ELSE matchLen + 1; ENDLOOP; SELECT m.bml FROM < matchLen => {m.bid _ id; m.bml _ matchLen; m.count _ 1}; = matchLen => m.count _ m.count + 1; ENDCASE => NULL; RETURN[m]; END; -- of Match SearchIdSet: PROCEDURE [pset: IdentifierSetPtr, m: MatchRec _ initMatchRec] RETURNS [MatchRec] = BEGIN set: IdentifierSet; FOR set _ pset^, set.rest UNTIL set = NIL DO IF set.first.hash = hash THEN m _ Match[set.first, m]; ENDLOOP; RETURN[m]; END; -- of SearchIdSet SearchFieldList: PROCEDURE [pfl: FieldListPtr, m: MatchRec _ initMatchRec] RETURNS [MatchRec] = BEGIN v: VariantPtr; ids: IdentifierSetPtr _ NIL; m _ SearchIdSet[pfl.fieldSet, m]; FOR v _ pfl.firstVariant, v.nextVariant UNTIL v = NIL DO IF v.fieldList.fieldSet # ids THEN BEGIN m _ SearchFieldList[v.fieldList, m]; ids _ v.fieldList.fieldSet; END; ENDLOOP; RETURN[m]; END; -- of SearchFieldList m: MatchRec; IF name = NIL THEN name _ ident; hash _ GetHash[name]; SELECT TRUE FROM pset # NIL => m _ SearchIdSet[pset]; pfl # NIL => m _ SearchFieldList[pfl]; ENDCASE => BEGIN -- use normal display lookup tLexLevel: LexLevel; mTemp: MatchRec; m _ initMatchRec; FOR tLexLevel DECREASING IN [FIRST[LexLevel]..lexLevel] DO mTemp _ SearchIdSet[display[tLexLevel].locals]; IF mTemp.bml > m.bml THEN BEGIN m _ mTemp; IF m.bml = complete THEN EXIT; END; WITH display[tLexLevel] SELECT FROM de: REF call DisplayEntry => mTemp _ SearchIdSet[de.isp]; de: REF with DisplayEntry => mTemp _ SearchFieldList[de.flp]; ENDCASE; IF mTemp.bml > m.bml THEN BEGIN m _ mTemp; IF m.bml = complete THEN EXIT; END; ENDLOOP; END; SELECT TRUE FROM m.bml # complete AND couldFail => NULL; m.bml < pascalMinMatchLen => Error[Undefined]; m.count > 1 => Error[MultipleDefinition]; m.bml # complete => BEGIN msg: ROPE; msg _ IO.PutFR["Used as \"%g\" but defined as \"%g\".\n", IO.rope[name], IO.rope[m.bid.name]]; Warning[IdentifierMismatch, msg]; RETURN[m.bid]; END; ENDCASE => RETURN[m.bid]; RETURN[NIL]; END; -- of IdentLookup END. -- of PasIdent -- œfile: PasIdent.mesa modified by Ramshaw, January 20, 1984 2:41 pm written by McCreight, October 31, 1980 4:32 PM Pavel, May 29, 1985 6:39:13 pm PDT ΚΖ˜Jšœ™Jšœ-™-šœ/™/Icode™"—J˜šΟk ˜ Jšœœ˜J˜ J˜Jšœœ˜"J˜—šœ œ˜Jšœœ#œ ˜AJ˜Jš˜J˜Jšœ˜ J˜Jšœœ˜ Jšœœœ˜(J˜šΟn œ œœœ˜QJš œœœœœœ˜AJ˜—šžœœ œœ˜HJš œœœœœΟc˜NJ˜—šžœœ œ˜>Jšœ œœŸ˜.J˜—š žœœ œœœ˜MJš œœ œœŸ˜7J˜J˜—šžœœ œ˜*Jšœ œ˜7Jš˜J˜Jš œœœœœ˜BJšœŸ˜!J˜J˜—šžœœ œ˜'Jšœœ˜7Jš˜J˜Jšœ œœ˜!š˜Jš˜J˜Jš œœ œœœ˜:J˜Jšœ˜—Jšœœ˜ JšœŸ˜J˜J˜—šžœœ œ˜%J˜/Jš˜J˜Jš œœœœœ˜Fšœœ˜0Jšœ œ˜(—J˜JšœŸ˜J˜J˜—šžœœ œ˜AJš˜Jšœœ˜ JšœŸ˜J˜J˜—šžœœ œ˜Jšœ œœœ˜IJš˜J˜Jšœœ˜J˜J˜Jšœœœ˜ šœœœ˜,J˜Jšœ"œ˜CJšœ˜—Jš œœœ5œ œ˜QJšœ œœ œœœœœ˜LJšœ˜ JšœŸ˜J˜—šžœœœœ˜4Jšœ˜ Jšœœ˜J˜ š œœœœ˜0Jšœœœ˜1Jšœ˜—Jšœ˜ JšœŸ ˜J˜—šžœœœ.˜IJš˜J˜Jšœœ˜šœœœ˜,J˜Jšœœ˜(Jšœ˜—Jšœ œœ œœœœœ˜LJšœŸ˜J˜—šž œœ œ˜Jšœ œœœ˜HJšœ œœœ˜5Jš˜Jšœ œœœ˜$Jšœœ˜šœ œœ˜JšœŸ˜3JšœœŸ˜&JšœœŸ'˜7J˜—Jšœœ˜6J˜šžœ œ0˜@Jšœ ˜Jš˜Jšœ œ˜J˜š œ œœœœ˜@Jšœ*œœ˜6š˜šœ˜ Jšœ œœ œ˜I——Jšœ˜—šœ˜J˜:J˜$Jšœœ˜—Jšœ˜ JšœŸ ˜J˜—šž œ œ5˜KJšœ ˜Jš˜J˜šœœœœ˜-Jšœœœ˜?—Jšœ˜ JšœŸ˜J˜—šžœ œ0˜JJšœ ˜Jš˜J˜Jšœœ˜J˜!šœ%œœ˜8šœ˜"Jš˜J˜$J˜Jšœ˜—Jšœ˜—Jšœ˜ JšœŸ˜J˜—J˜ J˜J˜J˜Jšœœœ˜ J˜šœœ˜Jšœœ˜$Jšœœ˜&šœ˜ JšœŸ˜"J˜J˜J˜š œ  œœœ˜:J˜/šœ˜Jš œ œœœœ˜4—šœœ˜#Jšœœ2˜9Jšœœ6˜=Jšœ˜—šœ˜Jš œ œœœœ˜4—Jšœ˜—Jšœ˜J˜J˜J˜—Jšœœ˜Jšœœœ˜'J˜.J˜)˜Jš˜Jšœœ˜ šœœ1˜9Jšœ œ˜$—J˜!Jšœ˜Jšœ˜—Jšœœ˜J˜—Jšœœ˜ JšœŸ˜J˜—JšœŸ˜J˜J˜J˜——…—”φ