Parcourir la source

showcase18: VIRTUAL dispatch (polymorphic Shape hierarchy)

- Showcase18 (exit 42): Circle/Square shapes with a virtual Area();
  an array of POINTER TO Shape holds objects of both kinds and each
  area is resolved at run time; the sum (139) is asserted and printed
  ('showcase18 areas sum=139').
- docs/summary_showcase18.md: session summary (VIRTUAL dispatch +
  showcase).
- Suite 144/144; fixpoint OK (2,310,300 bytes).
Eric Streit il y a 1 semaine
Parent
commit
f584e620b7
4 fichiers modifiés avec 169 ajouts et 1 suppressions
  1. 5 0
      compiler/run_tests.sh
  2. 80 0
      compiler/tests/showcase18.mod
  3. 1 1
      docs/features.md
  4. 83 0
      docs/summary_showcase18.md

+ 5 - 0
compiler/run_tests.sh

@@ -287,6 +287,11 @@ rm -f gen_ssa/_showcase11.txt
 # statements, 1-char strings, qualified type names.
 expect_run_files Showcase12 42 showcase12lib.def showcase12lib.mod showcase12.mod
 expect_run_files_out Showcase13 42 "Even(8)=T Odd(7)=T total=42" ../stdlib/sysio.def ../stdlib/sysio.mod showcase13.mod
+expect_run_files_out Showcase18 42 "showcase18 areas sum=139" \
+  ../runtime/syslib/Utf8.def ../runtime/syslib/Utf8.mod \
+  ../stdlib/textio.def ../stdlib/textio.mod \
+  ../stdlib/conversions.def ../stdlib/conversions.mod \
+  showcase18.mod
 expect_run_files_out Showcase17 42 "showcase17 total=42" \
   ../runtime/syslib/Utf8.def ../runtime/syslib/Utf8.mod \
   ../stdlib/textio.def ../stdlib/textio.mod \

+ 80 - 0
compiler/tests/showcase18.mod

@@ -0,0 +1,80 @@
+MODULE Showcase18;
+// Session showcase: VIRTUAL dispatch through vtables.
+//
+// A Shape hierarchy (Circle, Square) with a virtual Area(); an array
+// of base-class pointers holds objects of both kinds, and each Area()
+// is resolved at run time. The sum is asserted and printed.
+// Expected ExitCode: 42.
+IMPORT TextIO, Conversions;
+
+TYPE
+  CLASS Shape;
+    VIRTUAL PROCEDURE Area() : INTEGER;
+  END Shape;
+
+  CLASS Circle (Shape);
+    r : INTEGER;
+    PROCEDURE SetR(v : INTEGER);
+    VIRTUAL PROCEDURE Area() : INTEGER;
+  END Circle;
+
+  CLASS Square (Shape);
+    s : INTEGER;
+    PROCEDURE SetS(v : INTEGER);
+    VIRTUAL PROCEDURE Area() : INTEGER;
+  END Square;
+
+CLASS IMPLEMENTATION Shape;
+  PROCEDURE Area() : INTEGER;
+  BEGIN RETURN 0 END Area;
+END Shape;
+
+CLASS IMPLEMENTATION Circle;
+  PROCEDURE SetR(v : INTEGER);
+  BEGIN r := v END SetR;
+  PROCEDURE Area() : INTEGER;
+  BEGIN RETURN r * r END Area;
+END Circle;
+
+CLASS IMPLEMENTATION Square;
+  PROCEDURE SetS(v : INTEGER);
+  BEGIN s := v END SetS;
+  PROCEDURE Area() : INTEGER;
+  BEGIN RETURN s * s END Area;
+END Square;
+
+VAR ExitCode : INTEGER;
+VAR shapes : ARRAY [0 .. 5] OF POINTER TO Shape;
+VAR a, b : POINTER TO Circle;
+VAR c, d : POINTER TO Square;
+VAR e : POINTER TO Circle;
+VAR f : POINTER TO Square;
+VAR line, num : ARRAY [0 .. 63] OF CHAR;
+VAR i, total : INTEGER;
+
+BEGIN
+  ExitCode := 0;
+  NEW(a); a^.SetR(3);          (* 9  *)
+  NEW(b); b^.SetR(5);          (* 25 *)
+  NEW(c); c^.SetS(4);          (* 16 *)
+  NEW(d); d^.SetS(6);          (* 36 *)
+  NEW(e); e^.SetR(2);          (* 4  *)
+  NEW(f); f^.SetS(7);          (* 49 *)
+
+  shapes[0] := a; shapes[1] := b; shapes[2] := c;
+  shapes[3] := d; shapes[4] := e; shapes[5] := f;
+
+  total := 0;
+  i := 0;
+  WHILE i <= 5 DO
+    total := total + shapes[i]^.Area();   (* virtual dispatch *)
+    INC(i)
+  END;
+
+  Conversions.IntToStr(total, num);
+  line := "showcase18 areas sum=" + num;
+  TextIO.WriteString(line);
+  TextIO.WriteLn;
+
+  IF total = 139 THEN ExitCode := 42 ELSE ExitCode := 1 END
+END Showcase18.

+ 1 - 1
docs/features.md

@@ -1,4 +1,4 @@
-# m2compiler-V3 — feature status (at `v3-virtual-dispatch`, 143/143 green)
+# m2compiler-V3 — feature status (at `v3-showcase18`, 144/144 green)
 
 Pipeline: Coco/R `M2.atg` (1748 lines, 73 productions) → `gm2`-built
 `M2` → QBE `.ssa` → `qbe` → `cc` → run. `SymTab.mod` 1623 lines,

+ 83 - 0
docs/summary_showcase18.md

@@ -0,0 +1,83 @@
+# Session summary — 2026-09-29 (b): VIRTUAL dispatch + showcase18
+
+Suite **144/144**; self-hosting fixpoint **OK**
+(image **2,310,300 bytes**). `master`, tree clean except the user's
+uncommitted `compiler/toto.mod`.
+
+This session completed the Clarion OOP story by adding **dynamic
+dispatch**, then showcased it.
+
+## Steps, tags and headline commits
+
+| Step | Tag | Commit | What |
+| --- | --- | --- | --- |
+| VIRTUAL dispatch | `v3-virtual-dispatch` | `98d3067` | per-class vtables + subtype pointer assignment |
+| Showcase | `v3-showcase18` | (this commit) | polymorphic Shape hierarchy |
+
+## 1. VIRTUAL dispatch (vtables)
+
+`VIRTUAL` methods now resolve at run time. A base-class pointer
+holding a derived object calls the derived override:
+
+```modula-2
+TYPE
+  CLASS Shape;  VIRTUAL PROCEDURE Area() : INTEGER; END Shape;
+  CLASS Circle (Shape); VIRTUAL PROCEDURE Area() : INTEGER; END Circle;
+...
+VAR b : POINTER TO Shape; c : POINTER TO Circle;
+BEGIN
+  NEW(c); b := c;            (* subtype pointer assignment *)
+  ExitCode := b^.Area()      (* Circle.Area, decided at run time *)
+END
+```
+
+- **vtable** — each class with virtuals owns a slice of a shared
+  pool: the parent's slots are inherited first; a same-named virtual
+  method overrides in place; new ones append. Each method node
+  records its `vslot`.
+- **vptr** — the class introducing virtuals gets an 8-byte vtable
+  pointer (offset 0 with no parent, else after the parent's fields);
+  subclasses share it, so an object's vptr identifies its dynamic
+  class.
+- **emission** — `data $vt_<typeindex> = { l $Method_uid, … }`;
+  a declared-but-unimplemented method is `l 0`.
+- **init** — static class variables and `NEW` store the vptr.
+- **dispatch** — a virtual call loads the vptr, fetches the slot, and
+  calls indirectly; the receiver is the hidden first argument.
+- **subtyping** — `POINTER TO Derived` assigns to `POINTER TO Base`
+  (`IsSubclass`), which lets a base pointer hold a derived object.
+
+Docs: `docs/summary_virtual-dispatch.md`.
+
+## 2. Showcase
+
+`compiler/tests/showcase18.mod` (`Showcase18`, exit 42): a `Shape`
+hierarchy (`Circle`, `Square`) with a virtual `Area()`; an array of
+`POINTER TO Shape` holds objects of both kinds and each area is
+resolved at run time; the sum is asserted and printed:
+
+```
+showcase18 areas sum=139
+```
+
+(The number is built with `Conversions.IntToStr` + CHAR-array `+`,
+tying in the earlier stdlib/string work.)
+
+## Tests (144, was 143)
+
+New: `t_virtual` (3) and `Showcase18` (42).
+
+## Resume
+
+```sh
+cd .../m2compiler-V3
+./bootstrap/fixpoint.sh                       # FIXPOINT OK
+cd compiler && ./build.sh && ./run_tests.sh   # 144/144
+```
+
+## Remaining polish
+
+- CLASS: bare sibling-method calls inside a method body, a class
+  `BEGIN … END` init body, multiple parents.
+- `VAL(LONGINT|REAL, x)` and long→int narrowing.
+- More stdlib (`SysClock`, richer `Strings`/`Math`).