resolve-check step 4c: propagate resolved types up the expression tree

An expression containing a forward designator (e.g. arr[0] + arr[1]) was
typed InvalidType at parse time.  Check now walks the unit post-order
(PropNode) and re-types any expression node still unknown, combining its
operands' now-resolved types by the operator rules (EvalExpr), reusing
SymTab.ArithCheck/RelCheck/InCheck/BoolCheck.  Leaf kinds are skipped:
their child 0 is a text index, not a node (descending into it segfaulted).

Also the first half of the Lower split: for string and set literals Lower
now reads the type the parser stored (AST.Ty) instead of constructing a
second one, removing a duplicate type descriptor per literal; it falls
back to construction when the slot is unset.

Verified with the temporary differential instrument (AST-stored type vs
Lower's, compared by class): clean across the suite except four
pre-existing proc-value designators (ClProc vs ClInvalid, unrelated to
forwards), and it fires for a forward compound expression when the
propagation is deliberately broken.  Instrument removed again.

Suite 191/191; fixpoint OK (3,487,473 bytes).

compiler/src/Check.mod

@@ -49,6 +49,84 @@ PROCEDURE SelType (n: AST.Node; VAR t: SymTab.TypeIndex);
     END
   END SelType;
 
+PROCEDURE RelOp (op: INTEGER; VAR sop: INTEGER): BOOLEAN;
+(* AST relation operator -> SymTab relation operator. *)
+BEGIN
+  IF op = AST.OpEq THEN sop := SymTab.OpEq; RETURN TRUE
+  ELSIF op = AST.OpNe THEN sop := SymTab.OpNeq1; RETURN TRUE
+  ELSIF op = AST.OpLt THEN sop := SymTab.OpLt; RETURN TRUE
+  ELSIF op = AST.OpLe THEN sop := SymTab.OpLe; RETURN TRUE
+  ELSIF op = AST.OpGt THEN sop := SymTab.OpGt; RETURN TRUE
+  ELSIF op = AST.OpGe THEN sop := SymTab.OpGe; RETURN TRUE
+  END;
+  RETURN FALSE
+END RelOp;
+
+PROCEDURE EvalExpr (n: AST.Node): SymTab.TypeIndex;
+(* The type of an expression node: its stored type when known, else the
+   result of combining its (now typed) operands by the operator rules.
+   Mirrors the grammar's typing; set operators are left unknown. *)
+  VAR t, t2, res: SymTab.TypeIndex; op, k, sop: INTEGER;
+BEGIN
+  IF n < 0 THEN RETURN SymTab.InvalidType END;
+  t := AST.Ty(n);
+  IF t # -1 THEN RETURN t END;
+  k := AST.Kind(n);
+  op := AST.Op(n);
+  IF k = AST.NkBinExpr THEN
+    IF AST.Child(n, 0) < 0 THEN RETURN SymTab.InvalidType END;
+    t := EvalExpr(AST.Child(n, 0));
+    t2 := EvalExpr(AST.Child(n, 1));
+    IF (t = SymTab.InvalidType) OR (t2 = SymTab.InvalidType) THEN
+      RETURN SymTab.InvalidType
+    END;
+    IF (op = AST.OpAnd) OR (op = AST.OpOr) THEN
+      IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
+        RETURN SymTab.BoolType()
+      END
+    ELSIF op = AST.OpIn THEN
+      IF SymTab.InCheck(t, t2) THEN RETURN SymTab.BoolType() END
+    ELSIF RelOp(op, sop) THEN
+      IF SymTab.RelCheck(t, t2, sop) THEN RETURN SymTab.BoolType() END
+    ELSIF SymTab.ArithCheck(t, t2, (op = AST.OpDiv) OR (op = AST.OpMod),
+                            res) THEN
+      RETURN res
+    END;
+    RETURN SymTab.InvalidType
+  ELSIF k = AST.NkUnary THEN
+    IF AST.Child(n, 0) < 0 THEN RETURN SymTab.InvalidType END;
+    t := EvalExpr(AST.Child(n, 0));
+    IF t = SymTab.InvalidType THEN RETURN t END;
+    IF op = AST.OpNot THEN
+      IF SymTab.BoolCheck(t) THEN RETURN SymTab.BoolType() END;
+      RETURN SymTab.InvalidType
+    END;
+    RETURN t
+  END;
+  RETURN t
+END EvalExpr;
+
+PROCEDURE PropNode (n: AST.Node);
+(* Post-order: re-type any expression node whose type is still unknown
+   (i.e. one whose operands included a forward reference). *)
+  VAR i: CARDINAL; k: INTEGER; t: SymTab.TypeIndex;
+BEGIN
+  IF n < 0 THEN RETURN END;
+  k := AST.Kind(n);
+  IF (k >= AST.NkIdent) AND (k <= AST.NkCharLit) THEN
+    RETURN   (* a leaf: child 0 is a text index, not a node *)
+  END;
+  i := 0;
+  WHILE i < AST.NChild(n) DO
+    PropNode(AST.Child(n, i)); INC(i)
+  END;
+  IF (k >= AST.NkBinExpr) AND (k <= AST.NkSetLit)
+     AND (AST.Ty(n) = -1) THEN
+    t := EvalExpr(n);
+    IF t # -1 THEN AST.SetTy(n, t) END
+  END
+END PropNode;
+
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
 BEGIN
   nFwd := 0
@@ -93,7 +171,8 @@ END FlushForward;
 
 PROCEDURE Resolve (unit: AST.Node);
 BEGIN
-  FlushForward
+  FlushForward;
+  PropNode(unit)
 END Resolve;
 
 PROCEDURE EndSession;

compiler/src/Lower.mod

@@ -1551,15 +1551,15 @@ PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
         ELSIF isU THEN
           t := SymTab.UCharType(); QbeGen.IntStr(ucp, q)
         ELSE
-          t := SymTab.NewUStr(); QbeGen.NoteAddr(q, q)
+          t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewUStr() END; QbeGen.NoteAddr(q, q)
         END
       ELSIF SymTab.StrLen(qn) = 3 THEN
         t := SymTab.CharType(); QbeGen.IntStr(QbeGen.CharVal(qn), q)
       ELSE
-        t := SymTab.NewStr(); QbeGen.DeclStr(qn, q); QbeGen.NoteAddr(q, q)
+        t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewStr() END; QbeGen.DeclStr(qn, q); QbeGen.NoteAddr(q, q)
       END
     ELSIF AST.Kind(n) = AST.NkSetLit THEN
-      t := SymTab.NewSet(SymTab.NewSubR(0, 255));
+      t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewSet(SymTab.NewSubR(0, 255)) END;
       QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8);
       i := 0;
       WHILE i < AST.NChild(n) DO