|
|
@@ -442,6 +442,27 @@ PROCEDURE Adv;
|
|
|
INC(errDist)
|
|
|
END Adv;
|
|
|
|
|
|
+PROCEDURE ConsCode (nm: ARRAY OF CHAR): INTEGER;
|
|
|
+(* Constraint name -> code: 0 none, 1 ORDINAL, 2 INTEGER, 3 REAL. *)
|
|
|
+ BEGIN
|
|
|
+ IF SymTab.Equal(nm, "ORDINAL") THEN RETURN 1
|
|
|
+ ELSIF SymTab.Equal(nm, "INTEGER") THEN RETURN 2
|
|
|
+ ELSIF SymTab.Equal(nm, "REAL") THEN RETURN 3
|
|
|
+ END;
|
|
|
+ RETURN 0
|
|
|
+ END ConsCode;
|
|
|
+
|
|
|
+PROCEDURE ConsOk (cons: INTEGER; t: SymTab.TypeIndex): BOOLEAN;
|
|
|
+(* TRUE when t satisfies the constraint code. *)
|
|
|
+ BEGIN
|
|
|
+ IF cons = 0 THEN RETURN TRUE
|
|
|
+ ELSIF cons = 1 THEN RETURN SymTab.IsOrdinal(t)
|
|
|
+ ELSIF cons = 2 THEN RETURN SymTab.ClassOf(t) = SymTab.ClInt
|
|
|
+ ELSIF cons = 3 THEN RETURN SymTab.ClassOf(t) = SymTab.ClReal
|
|
|
+ END;
|
|
|
+ RETURN TRUE
|
|
|
+ END ConsOk;
|
|
|
+
|
|
|
PROCEDURE OrdClass (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
(* TRUE for scalar ordinal classes (int/char/bool/enum/uchar); a
|
|
|
conversion between two of these is representation-preserving, so its
|
|
|
@@ -581,6 +602,8 @@ PRODUCTIONS
|
|
|
quid, qdep: CARDINAL;
|
|
|
qres: SymTab.TypeIndex;
|
|
|
qext: BOOLEAN;
|
|
|
+ cons: INTEGER;
|
|
|
+ cn: SymTab.Name;
|
|
|
isTypeFormal: BOOLEAN; .)
|
|
|
= (. nn := 0; .)
|
|
|
GetIdent<nm> (. k := 0;
|
|
|
@@ -593,6 +616,7 @@ PRODUCTIONS
|
|
|
names[nn][k] := CHR(0); INC(nn); .) }
|
|
|
":" (. vt := SymTab.InvalidType; isTypeFormal := FALSE; .)
|
|
|
( "TYPE" (. isTypeFormal := TRUE; .)
|
|
|
+ [ "(" GetIdent<cn> ")" (. cons := ConsCode(cn); .) ]
|
|
|
| ProcType<vt> (. isTypeFormal := FALSE; .)
|
|
|
| TypeIdent<vt> ) (. k := 0;
|
|
|
WHILE k < nn DO
|
|
|
@@ -600,9 +624,12 @@ PRODUCTIONS
|
|
|
IF instActive THEN
|
|
|
(* constraint: a type
|
|
|
formal needs a type
|
|
|
- actual *)
|
|
|
+ actual that satisfies
|
|
|
+ the declared constraint *)
|
|
|
IF InstActualKind(instFk) # 0 THEN
|
|
|
SemError(233)
|
|
|
+ ELSIF NOT ConsOk(cons, InstActualGet(instFk)) THEN
|
|
|
+ SemError(233)
|
|
|
ELSIF NOT SymTab.EnterTypeParamBound(names[k], InstActualGet(instFk)) THEN
|
|
|
SemError(200) END
|
|
|
ELSIF NOT SymTab.EnterTypeParam(names[k]) THEN
|