VAR
FreeGroup,
GlobalGroup : Group ; (* The global group of all sets. *)
+ ErrorDepList, (* The set of symbols with dependency errors. *)
VisitedList,
ChainedList : Set ;
HaveInitDefaultTypes: BOOLEAN ; (* Have we initialized them yet? *)
enumDeps : BOOLEAN ;
-PROCEDURE mystop ; BEGIN END mystop ;
-
-
(* *************************************************** *)
(*
PrintNum -
(*
- EmitCircularDependancyError - issue a dependancy error.
+ EmitCircularDependencyError - issue a dependency error.
*)
-PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ;
+PROCEDURE EmitCircularDependencyError (sym: CARDINAL) ;
BEGIN
- MetaError1('circular dependancy error found when trying to resolve {%1Uad}',
- sym)
-END EmitCircularDependancyError ;
+ (* Ensure we only issue one dependency message per symbol for this
+ error classification. *)
+ IF NOT IsElementInSet (ErrorDepList, sym)
+ THEN
+ IncludeElementIntoSet (ErrorDepList, sym) ;
+ IF IsVar (sym) OR IsParameter (sym)
+ THEN
+ MetaError1 ('circular dependency error found when trying to resolve {%1Had}',
+ sym)
+ ELSE
+ MetaError1 ('circular dependency error found when trying to resolve {%1Dad}',
+ sym)
+ END
+ END
+END EmitCircularDependencyError ;
TYPE
IF ForeachTryDeclare (todolist,
circulartodo,
NotAllDependantsFullyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
ELSIF ForeachTryDeclare (partiallydeclared,
circularpartial,
NotAllDependantsPartiallyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
ELSIF ForeachTryDeclare (niltypedarrays,
circularniltyped,
NotAllDependantsPartiallyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
END
END ;
n := 1 ;
Var := GetNth(scope, n) ;
WHILE Var#NulSym DO
- IF NOT AllDependantsFullyDeclared(GetSType(Var))
- THEN
- mystop
- END ;
- IF NOT AllDependantsFullyDeclared(GetSType(Var))
+ IF NOT TypeDependentsDeclared (Var, TRUE)
THEN
- EmitCircularDependancyError(GetSType(Var)) ;
failed := TRUE
END ;
INC(n) ;
isImported, isExported,
isTemporary, isGlobal: BOOLEAN;
scope: tree) ;
+BEGIN
+ IF NOT (IsComponent (var) OR IsVarHeap (var))
+ THEN
+ IF TypeDependentsDeclared (var, TRUE)
+ THEN
+ PrepareGCCVarDeclaration (var, name, isImported, isExported,
+ isTemporary, isGlobal, scope)
+ END
+ END
+END DoVariableDeclaration ;
+
+
+(*
+ TypeDependentsDeclared - return TRUE if all type dependents of variable
+ have been declared.
+*)
+
+PROCEDURE TypeDependentsDeclared (variable: CARDINAL; errorMessage: BOOLEAN) : BOOLEAN ;
+VAR
+ type: CARDINAL ;
+BEGIN
+ type := GetSType (variable) ;
+ IF AllDependantsFullyDeclared (type)
+ THEN
+ RETURN TRUE
+ ELSE
+ IF errorMessage
+ THEN
+ EmitCircularDependencyError (variable) ;
+ ForeachElementInSetDo (GlobalGroup^.ToDoList, EmitCircularDependencyError)
+ END
+ END ;
+ RETURN FALSE
+END TypeDependentsDeclared ;
+
+
+(*
+ PrepareGCCVarDeclaration -
+*)
+
+PROCEDURE PrepareGCCVarDeclaration (var: CARDINAL; name: ADDRESS;
+ isImported, isExported,
+ isTemporary, isGlobal: BOOLEAN;
+ scope: tree) ;
VAR
type : tree ;
varType : CARDINAL ;
location: location_t ;
BEGIN
- IF IsComponent (var) OR IsVarHeap (var)
- THEN
- RETURN
- END ;
IF GetMode (var) = LeftValue
THEN
(*
isGlobal, scope, NIL)) ;
WatchRemoveList (var, todolist) ;
WatchIncludeList (var, fullydeclared)
-END DoVariableDeclaration ;
+END PrepareGCCVarDeclaration ;
(*
THEN
scope := FindContext (ModSym) ;
decl := FindOuterModule (variable) ;
- Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
PushBinding (ModSym) ;
DoVariableDeclaration (variable,
KeyToCharStar (GetFullSymName (variable)),
THEN
scope := FindContext (mainModule) ;
decl := FindOuterModule (variable) ;
- Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
PushBinding (mainModule) ;
DoVariableDeclaration (variable,
KeyToCharStar (GetFullSymName (variable)),
PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
BEGIN
- Assert (AllDependantsFullyDeclared (var)) ;
DoVariableDeclaration (var,
KeyToCharStar (GetFullSymName (var)),
FALSE, (* local variables cannot be imported *)
scope := Mod2Gcc (GetProcedureScope (sym)) ;
Var := GetNth (sym, i) ;
WHILE Var # NulSym DO
- Assert (AllDependantsFullyDeclared (GetSType (Var))) ;
DoVariableDeclaration (Var,
KeyToCharStar (GetFullSymName (Var)),
FALSE, (* inner module variables cannot be imported *)
BEGIN
FreeGroup := NIL ;
GlobalGroup := InitGroup () ;
+ ErrorDepList := InitSet (1) ;
ChainedList := InitSet(1) ;
WatchList := InitSet(1) ;
VisitedList := NIL ;
doError (eb, GetDeclaredDef (sym))
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
- IF IsProcedure (scope)
+ IF IsVar (sym) OR IsParameter (sym)
THEN
- IF IsVar (sym) OR IsParameter (sym)
- THEN
- doError (eb, GetVarParamTok (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetVarParamTok (sym))
+ ELSIF IsProcedure (scope)
+ THEN
+ doError (eb, GetDeclaredDef (sym))
+ ELSIF IsModule (scope)
+ THEN
+ doError (eb, GetDeclaredMod (sym))
ELSE
- IF IsModule (scope)
+ Assert (IsDefImp (scope)) ;
+ IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
- IF IsInnerModule (scope)
- THEN
- doError (eb, GetDeclaredDef (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetDeclaredMod (sym))
ELSE
- Assert (IsDefImp (scope)) ;
- (* if this fails then we need to skip to the outer scope.
- REPEAT
- OuterModule := GetScope(OuterModule)
- UNTIL GetScope(OuterModule)=NulSym ; *)
- IF GetDeclaredDefinition (sym) = UnknownTokenNo
- THEN
- doError (eb, GetDeclaredMod (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetDeclaredDef (sym))
END
END
END ;
Sym,
Type : CARDINAL ;
name : Name ;
- tokno : CARDINAL ;
+ nametokno,
+ typetokno: CARDINAL ;
BEGIN
(*
Two cases
- when type with a name that is different to Name. In which case
we create a new type.
*)
- PopTtok(Type, tokno) ;
- PopT(name) ;
+ PopTtok (Type, typetokno) ;
+ PopTtok (name, nametokno) ;
IF Debugging
THEN
n1 := GetSymName(GetCurrentModule()) ;
*)
(* WriteString('Blank name type') ; WriteLn ; *)
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
ELSIF IsError(Type)
THEN
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||error type|error type name|token no")
ELSIF GetSymName(Type)=name
THEN
IF isunknown OR
(NOT IsDeclaredIn(GetCurrentScope(), Type))
THEN
- Sym := MakeType(tokno, name) ;
+ Sym := MakeType (typetokno, name) ;
IF NOT IsError(Sym)
THEN
IF Sym=Type
CheckForEnumerationInCurrentModule(Type)
END
END ;
- PushTFtok(Sym, name, tokno) ;
+ PushTFtok(Sym, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
ELSE
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
END
ELSE
(* example TYPE a = CARDINAL *)
- Sym := MakeType(tokno, name) ;
- PutType(Sym, Type) ;
- CheckForExportedImplementation(Sym) ; (* May be an exported hidden type *)
- PushTFtok(Sym, name, tokno) ;
- Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+ Sym := MakeType (nametokno, name) ;
+ PutType (Sym, Type) ;
+ CheckForExportedImplementation (Sym) ; (* May be an exported hidden type *)
+ PushTFtok (Sym, name, nametokno) ;
+ Annotate ("%1s(%1d)|%2n|%3d||type|type name|token no") ;
+ IF Debugging
+ THEN
+ MetaErrorT1 (nametokno, 'type pos {%1Wa}', Sym)
+ END
END
END BuildType ;