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