DEFINITION MODULE SymTab;
(* Symbol table with static type checking for SimpleMod2
   (simplified Modula-2 without procedures).

   - flat scopes with levels: globals at level 0, WITH statement
     bodies push the record's fields as an inner scope (shadowing
     allowed, duplicates within one level rejected)
   - every symbol carries a type descriptor index (InvalidType if
     unknown, e.g. imported names); unknown types suppress follow-on
     errors to avoid cascades
   - type descriptors: aliases (one per TYPE declaration, so
     self-references such as POINTER TO Person resolve), subranges,
     enumerations, arrays, records (with field lists), sets,
     pointers, predefined types, string literals
   - INTEGER, CARDINAL and subranges thereof form one lenient
     "integer family"; mixed INTEGER/REAL arithmetic is rejected *)

CONST
  InvalidType = -1;

  (* symbol kinds *)
  KindConst  = 0;
  KindType   = 1;
  KindVar    = 2;
  KindImport = 3;
  KindModule = 4;
  KindPredef = 5;
  KindField  = 6;
  KindProc   = 7;
  KindParam  = 8;

  (* type classes returned by ClassOf *)
  ClInvalid = 0;
  ClInt     = 1;
  ClReal    = 2;
  ClChar    = 3;
  ClBool    = 4;
  ClEnum    = 5;
  ClArray   = 6;
  ClRecord  = 7;
  ClSet     = 8;
  ClPtr     = 9;
  ClStr     = 10;
  ClClass   = 11;
  ClNil     = 12;
  ClLong    = 13;

  (* operator codes for RelCheck *)
  OpEq = 0; OpNeq1 = 1; OpNeq2 = 2;
  OpLt = 3; OpLe  = 4; OpGt   = 5; OpGe = 6;
  OpIn = 7;
  (* operator codes for AddOp / MulOp *)
  OpAdd = 0; OpSub = 1; OpOr = 2;
  OpTimes = 0; OpSlash = 1; OpDiv = 2; OpMod = 3; OpAnd = 4;

TYPE
  Name = ARRAY [0 .. 63] OF CHAR;
  TypeIndex = INTEGER;
  BoundsArr = ARRAY [0 .. 7] OF INTEGER;
(* Per-dimension bounds for array index lists (grammar locals). *)

(* ---------------- symbols and scopes ---------------- *)

PROCEDURE Init;
(* Clears the table and enters predefined identifiers
   (INTEGER, CARDINAL, SHORTINT, LONGINT, SHORTCARD, REAL, LONGREAL,
   CHAR, BOOLEAN, TRUE, FALSE, NIL). *)

PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
(* Enters name at the current scope level (type InvalidType).
   Returns FALSE on duplicate within the same level. *)

PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
(* Like Enter, but remembers the entry for a later FixPending call
   (used for VAR identifier lists whose type is parsed afterwards).
   Returns FALSE on duplicate (entry not recorded). *)

PROCEDURE FixPending (t: TypeIndex);
(* Assigns type t to all pending entries, clears the buffer. *)

PROCEDURE PendCount (): CARDINAL;
(* Number of entries currently waiting for FixPending. *)

PROCEDURE PendName (i: CARDINAL; VAR n: Name);
(* Name of the i-th pending entry (empty string if out of range).
   Used by the QBE backend to emit storage for VAR lists whose
   type is parsed after the identifiers. *)

PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
(* Records a field name for record descriptor rec (type fixed later
   with FixPendingF). Returns FALSE on duplicate field. *)

PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
(* Assigns type t to pending fields owned by rec. *)

PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
(* TRUE if name is visible (innermost scope wins). *)

PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
(* Type of innermost visible entry, InvalidType if absent. *)

PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
(* Sets type of innermost visible entry. *)

PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
(* Kind of innermost visible entry, -1 if absent. *)

PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;

PROCEDURE PushScope;
PROCEDURE PopScope;
(* WITH statement support: PushRecord pushes a record's fields. *)

PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
(* Pushes a scope containing t's fields (as KindField). FALSE if t
   is not a record type (or invalid). Caller must PopScope after. *)

PROCEDURE PrintTable;

(* ---------------- procedures (headings now, bodies step 4) ---------------- *)

PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
(* Enters a KindProc heading and pushes its parameter scope.
   FALSE on duplicate (no scope pushed). Resets result to
   InvalidType (proper procedure), clears fwd, empties param chain. *)

PROCEDURE ResumeProc (name: ARRAY OF CHAR): BOOLEAN;
(* Resumes a DEFINITION's procedure heading for its
   IMPLEMENTATION body: pushes a fresh body scope, clears the
   formal chain (the implementation re-enters its own). Only valid
   while an IMPLEMENTATION unit is open. *)

PROCEDURE ReenterProc (name: ARRAY OF CHAR): BOOLEAN;
(* Resumes a FORWARD-marked procedure of this scope for its body
   heading: clears fwd, pushes a fresh parameter scope. FALSE
   when no such forward heading exists (then 200 applies). *)

PROCEDURE EnterParam (name: ARRAY OF CHAR; isVar: BOOLEAN): BOOLEAN;
(* Enters a KindParam in the heading scope and chains it into the
   current procedure's positional param list. FALSE on duplicate. *)

PROCEDURE SetProcRes (t: TypeIndex);
(* Sets the current procedure's result type (InvalidType = none). *)

PROCEDURE ProcRes (name: ARRAY OF CHAR): TypeIndex;
(* Result type of the named procedure, InvalidType if absent/none. *)

PROCEDURE MarkFwd;
(* Marks the current procedure FORWARD (body must follow). *)

PROCEDURE MarkVirtual;
(* Marks the current procedure VIRTUAL (dynamically dispatched;
   dispatch tables arrive with class lowering). *)

PROCEDURE MarkExternal (link: ARRAY OF CHAR);
(* Marks the current procedure EXTERNAL (no body emitted; calls bind
   to the C symbol `link`, or to the procedure's own name if ''). *)

PROCEDURE IsExternal (name: ARRAY OF CHAR): BOOLEAN;
PROCEDURE ProcLink (name: ARRAY OF CHAR; VAR link: Name): BOOLEAN;
(* External-procedure query/link lookup (link name of the named
   visible procedure). *)

PROCEDURE CloseProc;
(* Pops the current procedure's scope and its proc-stack entry.
   Replaces bare PopScope at the end of headings (DefUnit),
   FORWARD clauses and bodies. *)

PROCEDURE InProc (): BOOLEAN;
(* TRUE inside a procedure heading/body (RETURN legal). *)

PROCEDURE CurRes (): TypeIndex;
(* Result type of the innermost open procedure,
   InvalidType outside procedures or for proper procedures. *)

PROCEDURE ProcDepth (): CARDINAL;
(* Number of open procedure headings/bodies (nesting depth). *)

PROCEDURE ProcDepthOf (name: ARRAY OF CHAR): CARDINAL;
(* Lexical function-nesting depth of the named procedure
   (enclosing procedures; 0 = module level). Drives the static-
   link walk count at call sites. *)

PROCEDURE ProcUid (name: ARRAY OF CHAR): CARDINAL;
(* Unique id of the named procedure (0 if absent); drives QBE
   name mangling so same-named methods never collide. *)

PROCEDURE ProcNPar (name: ARRAY OF CHAR): CARDINAL;
PROCEDURE ParamType (name: ARRAY OF CHAR; i: CARDINAL): TypeIndex;
PROCEDURE ParamIsVar (name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
(* Positional formal access for call checking (233 on mismatch). *)

PROCEDURE VarParamOk (actual, formal: TypeIndex): BOOLEAN;
(* VAR-formal compatibility: same type, fixed array into open
   array with same element, or string literal into open CHAR. *)

(* ---------------- modules / separate compilation (step 4.3) ---------------- *)
(* One compiler session compiles several units into one image:
   DEFINITION, its IMPLEMENTATION, and one program (last). Each
   unit gets its own scope; imports materialize names. *)

CONST
  UnitProg = 0; UnitDef = 1; UnitImpl = 2;

PROCEDURE BeginDef (name: ARRAY OF CHAR): BOOLEAN;
(* Opens a DEFINITION module scope. FALSE on duplicate module. *)

PROCEDURE BeginImpl (name: ARRAY OF CHAR): BOOLEAN;
(* Resumes a DEFINITION's scope for its IMPLEMENTATION.
   FALSE when the module is undefined or already implemented. *)

PROCEDURE BeginProg (name: ARRAY OF CHAR): BOOLEAN;
(* Opens the program module's scope. *)

PROCEDURE EndUnit;
(* Returns to the global scope. *)

PROCEDURE CurUnit (): INTEGER;
(* Unit kind currently open (UnitProg/Def/Impl); -1 between units. *)

PROCEDURE CurModule (VAR name: Name);
(* Name of the module currently open ('' between units). *)

PROCEDURE HaveProgram (): BOOLEAN;
(* TRUE once a program module has been opened (a session without
   one is an error: nothing to link). *)

PROCEDURE ModKnown (name: ARRAY OF CHAR): BOOLEAN;
PROCEDURE ModDefined (name: ARRAY OF CHAR): BOOLEAN;
PROCEDURE ModImplemented (name: ARRAY OF CHAR): BOOLEAN;

PROCEDURE ImportFrom (mod, name: ARRAY OF CHAR): BOOLEAN;
(* Materializes an exported name from mod into the current scope
   (FROM mod IMPORT name). FALSE when mod/name is unknown. *)

PROCEDURE OpaqueBase (name: ARRAY OF CHAR): TypeIndex;
(* If name is an opaque alias (its target still InvalidType),
   returns that alias descriptor so the implementation can complete
   it via SetTarget; InvalidType otherwise. *)

PROCEDURE QualFind (mod, name: ARRAY OF CHAR): BOOLEAN;
(* TRUE when mod exports name. *)

PROCEDURE QualKind (mod, name: ARRAY OF CHAR): INTEGER;
PROCEDURE QualType (mod, name: ARRAY OF CHAR): TypeIndex;
PROCEDURE QualProcUid (mod, name: ARRAY OF CHAR): CARDINAL;
PROCEDURE QualProcNPar (mod, name: ARRAY OF CHAR): CARDINAL;
PROCEDURE QualParamType (mod, name: ARRAY OF CHAR; i: CARDINAL): TypeIndex;
PROCEDURE QualParamIsVar (mod, name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
PROCEDURE QualProcRes (mod, name: ARRAY OF CHAR): TypeIndex;

PROCEDURE Materialize (mod, name: ARRAY OF CHAR): BOOLEAN;
(* FROM-import: clones mod's export into the current scope under
   its plain name. FALSE when mod/name is unknown. *)

PROCEDURE MaterializeAlias (mod, name: ARRAY OF CHAR;
                             VAR alias: Name): BOOLEAN;
(* Qualified access: clones mod's export under a per-module alias
   key, so same-named exports of different modules never collide.
   The alias key is used for all subsequent lookups (types, uids,
   params); the node remembers its base name and module for QBE
   symbol emission. *)

PROCEDURE SymBase (name: ARRAY OF CHAR; VAR base: Name): BOOLEAN;
(* Base symbol name of the visible entry (drops any alias prefix). *)

PROCEDURE GlobalRef (name: ARRAY OF CHAR; VAR g: Name): BOOLEAN;
(* "<mod>_<sym>" QBE global-symbol name for a module-level entry;
   FALSE when name is not a module-level symbol. *)

(* ---------------- classes (Clarion form, lowering deferred) ---------------- *)

PROCEDURE SetParent (t, p: TypeIndex);
(* Records p as the (single) parent class of t. Multiple parents
   are rejected in the grammar with 230. *)

PROCEDURE PushClassScope (t: TypeIndex);
(* Pushes the body scope of class t and records it on t. *)

PROCEDURE MethodExists (t: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
(* TRUE if the class scope of t declares name as a procedure. *)

PROCEDURE PushClassMembers (t: TypeIndex): BOOLEAN;
(* Pushes a scope with t's fields (KindField) for method bodies in
   CLASS IMPLEMENTATION. FALSE if t is not a class. Method names
   are re-entered fresh by each body (copying them would collide);
   sibling-method references report 201 until step 4 calls. *)

(* ---------------- type descriptors ---------------- *)

PROCEDURE NewAlias (): TypeIndex;
PROCEDURE NewSub (base: TypeIndex): TypeIndex;
PROCEDURE NewSubR (lo, hi: INTEGER): TypeIndex;
(* Integer subrange [lo..hi] (no base descriptor needed). Bounds
   accessors arrive with step 3; the backend cannot lower them yet. *)
PROCEDURE NewEnum (): TypeIndex;
PROCEDURE NewArrayB (elem: TypeIndex; lo, hi: INTEGER): TypeIndex;
(* Bounded array (one dimension; nest for multi-dim). InvalidType
   when the table is full. *)
PROCEDURE NewOpenArray (elem: TypeIndex): TypeIndex;
(* Open ARRAY OF formal: 0-based, runtime count in the header.
   Only legal for formal parameters (grammar enforces). *)

PROCEDURE BoundBegin;
PROCEDURE BoundAdd (lo, hi: INTEGER): BOOLEAN;
(* Accumulates one index bound pair for the enclosing ArrayType
   (max 8 dimensions, FALSE past that). *)
PROCEDURE NestArray (elem: TypeIndex): TypeIndex;
(* Nests the accumulated bounds inside-out around elem. *)
PROCEDURE NewRecord (): TypeIndex;
PROCEDURE NewSet (base: TypeIndex): TypeIndex;
PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
PROCEDURE NewStr (): TypeIndex;
PROCEDURE NewClass (): TypeIndex;
(* Fresh class descriptor (holds fields like a record; methods live
   in the class scope). Parent and scope via SetParent/PushClassScope. *)
(* Fresh descriptors; base/elem may be InvalidType. InvalidType is
   returned when the table is full. *)

PROCEDURE SetTarget (t, base: TypeIndex);
(* Sets an alias target (TYPE declaration completion). *)

PROCEDURE IntType (): TypeIndex;
PROCEDURE RealType (): TypeIndex;
PROCEDURE CharType (): TypeIndex;
PROCEDURE BoolType (): TypeIndex;
PROCEDURE LongType (): TypeIndex;
(* LONGINT/LONGCARD: 64-bit integer (QBE l). *)
PROCEDURE AddrType (): TypeIndex;
(* ADDRESS: the pointer-sized opaque type (interchangeable with any
   pointer for assignment and VAR parameters). *)

PROCEDURE ObjectSize (t: TypeIndex): CARDINAL;
(* Full allocation footprint (arrays 8 + count*element); drives
   SYSTEM.SIZE/TSIZE. *)

PROCEDURE ClassOf (t: TypeIndex): INTEGER;
(* Resolves aliases; InvalidType maps to ClInvalid. *)

PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
(* INTEGER, CARDINAL or subrange thereof (Invalid suppresses). *)

PROCEDURE IsLongFamily (t: TypeIndex): BOOLEAN;
(* LONGINT/LONGCARD (QBE l). *)

PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
(* Same resolved descriptor (Invalid suppresses). *)

PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
PROCEDURE IsOpenArray (t: TypeIndex): BOOLEAN;
PROCEDURE ArrayLo (t: TypeIndex): INTEGER;
PROCEDURE ArrayHi (t: TypeIndex): INTEGER;
(* Static bounds (open arrays: lo 0, hi undefined — backend reads
   the header instead). InvalidType maps to 0. *)
PROCEDURE ArrayLen (t: TypeIndex): CARDINAL;
(* Static element count, 0 for open/invalid. *)
PROCEDURE ArrayDepth (t: TypeIndex): CARDINAL;
(* Nesting depth (open/fixed levels); 0 for non-arrays. *)

PROCEDURE TypeSize (t: TypeIndex): CARDINAL;
(* Inline footprint in bytes: scalars 4/8, sets words*4, pointers,
   open and fixed arrays 8 (descriptor address), records sum of
   members. *)

PROCEDURE FieldOffset (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
(* Declaration-order byte offset (-1 if absent). Computed lazily. *)

PROCEDURE FieldOwner (name: ARRAY OF CHAR): TypeIndex;
(* Owning record/class of the visible field (InvalidType if none). *)

PROCEDURE FieldCount (rec: TypeIndex): CARDINAL;
PROCEDURE FieldName (rec: TypeIndex; i: CARDINAL; VAR name: Name);
(* Field enumeration for whole-record lowering (order irrelevant). *)

PROCEDURE SubBounds (t: TypeIndex; VAR lo, hi: INTEGER): BOOLEAN;
(* TRUE with the bounds when t resolves to a subrange. *)
PROCEDURE SetBase (t: TypeIndex): TypeIndex;
(* Base type of a set descriptor (InvalidType if none). *)
PROCEDURE SetWords (t: TypeIndex): CARDINAL;
(* Mask words for a set type from its base span (bool 1, char 8,
   subrange by bounds); 0 when the base is unsuitable. *)
PROCEDURE SetBaseLo (t: TypeIndex): INTEGER;
(* Base minimum (bool/char 0, subrange lo); 0 when unsuitable. *)
PROCEDURE SetCount (t: TypeIndex): CARDINAL;
(* Base span in values (0 when unsuitable). *)
PROCEDURE PtrBase (t: TypeIndex): TypeIndex;

(* ---------------- predicates used by grammar checks ---------------- *)
(* All return TRUE if either operand is InvalidType (no cascades). *)

PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
(* Assignment compatibility (210). *)

PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
                      VAR res: TypeIndex): BOOLEAN;
(* + - * / (divmod FALSE) or DIV MOD (TRUE); res is result type (211). *)

PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
(* Unary + - (part of 211). *)

PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
(* BOOLEAN required: NOT/AND/OR operands (212), conditions (214). *)

PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
(* = # <> < <= > >= IN (213/222 chosen by caller via op). *)

PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
(* = # compatibility, also reused for CASE label matching. *)

PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
(* Fresh SET OF elem descriptor for set literals. *)

PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;

PROCEDURE ConstInt (q: ARRAY OF CHAR; VAR v: INTEGER): BOOLEAN;
(* Parses a folded integer immediate ("42", "-5", "16") as produced
   by NormInt/NegFold. FALSE for temporaries and non-numerics. *)

END SymTab.