
<<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>>

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 --