فهرست منبع

generics inc3: constraint model - T : TYPE (ORDINAL|INTEGER|REAL)

A type formal may carry an explicit constraint; at instantiation the
actual type must satisfy it (Ordinal -> IsOrdinal, INTEGER -> ClInt,
REAL -> ClReal), otherwise 233. Verified OrdBox(INTEGER) runs and
OrdBox(REAL) is rejected. Suite 213/213 (OrdProg, g_realbox); fixpoint
OK; corpus unchanged.
Eric Streit 1 روز پیش
والد
کامیت
77e8010940

+ 3 - 0
compiler/run_tests.sh

@@ -287,6 +287,8 @@ expect_run_files BufProg 42 \
   g_buf.def g_buf.mod g_buf10.def g_buf10.mod g_bufprog.mod
 expect_run_files SortProg 3 \
   g_cmp.def g_cmp.mod g_sort.def g_sort.mod g_isort.def g_isort.mod g_sortprog.mod
+expect_run_files OrdProg 42 \
+  g_ordbox.def g_ordbox.mod g_intbox.def g_intbox.mod g_ordprog.mod
 expect_run_files WrapProg 42 \
   ../runtime/syslib/SysShim.def ../runtime/syslib/SysShim.mod \
   ../stdlib/iochan.def ../stdlib/iochan.mod \
@@ -471,6 +473,7 @@ expect_fail_files() {
 expect_fail_files d_badimp_prog "undeclared identifier" d_basic.def d_basic.mod d_badimp_prog.mod
 expect_fail_files sig "implementation does not match definition" sig.def sig.mod sig_prog.mod
 expect_fail_files g_badbuf "invalid call" g_buf.def g_buf.mod g_badbuf.def
+expect_fail_files g_realbox "invalid call" g_ordbox.def g_ordbox.mod g_realbox.def
 
 # --- two-phase parse gate.  Deferral is now the DEFAULT (procedure
 #     bodies are parsed after the unit's declarations); -notwophase

+ 28 - 1
compiler/src/M2.atg

@@ -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

تفاوت فایلی نمایش داده نمی شود زیرا این فایل بسیار بزرگ است
+ 3504 - 3477
compiler/src/M2.lst


+ 2 - 0
compiler/tests/g_intbox.def

@@ -0,0 +1,2 @@
+DEFINITION MODULE IntBox = OrdBox(INTEGER);
+END IntBox.

+ 2 - 0
compiler/tests/g_intbox.mod

@@ -0,0 +1,2 @@
+IMPLEMENTATION MODULE IntBox = OrdBox(INTEGER);
+END IntBox.

+ 3 - 0
compiler/tests/g_ordbox.def

@@ -0,0 +1,3 @@
+GENERIC DEFINITION MODULE OrdBox (T : TYPE (ORDINAL));
+TYPE Box = ARRAY [0..3] OF T;
+END OrdBox.

+ 2 - 0
compiler/tests/g_ordbox.mod

@@ -0,0 +1,2 @@
+GENERIC IMPLEMENTATION MODULE OrdBox;
+END OrdBox.

+ 4 - 0
compiler/tests/g_ordprog.mod

@@ -0,0 +1,4 @@
+MODULE OrdProg;
+FROM IntBox IMPORT Box;
+VAR b : Box; ExitCode : INTEGER;
+BEGIN b[0] := 5; b[3] := 37; ExitCode := b[0] + b[3] END OrdProg.

+ 2 - 0
compiler/tests/g_realbox.def

@@ -0,0 +1,2 @@
+DEFINITION MODULE RealBox = OrdBox(REAL);
+END RealBox.

+ 10 - 1
docs/analysis_generics.md

@@ -44,7 +44,16 @@
 > Suite **210/210**, fixpoint OK, corpus unchanged.
 >
 > **Still open for inc3+:** a **constraint model** beyond kind-matching
-> (e.g. "`T` must be ordinal"), and `GENERIC CLASS`.
+>
+> **Done (Increment 3 — 2026-10-16, constraint model):** a type formal
+> may carry an explicit constraint: `T : TYPE (ORDINAL)` (also
+> `INTEGER`, `REAL`).  At instantiation the actual type must satisfy it
+> (`ConsOk`: ORDINAL → `IsOrdinal`, INTEGER → `ClInt`, REAL →
+> `ClReal`), else `233`.  Verified: `OrdBox(INTEGER)` compiles and runs;
+> `OrdBox(REAL)` is rejected.  Suite `OrdProg` / `g_realbox`.
+>
+> **Still open:** `GENERIC CLASS`; instance dedup; nested generics as
+> actuals; further constraint names (e.g. `POINTER`, `SCALAR`).
 >
 > **Done (Increment 3 — 2026-10-16, continued): procedure parameters.**
 > A formal may be a procedure:

برخی فایل ها در این مقایسه diff نمایش داده نمی شوند زیرا تعداد فایل ها بسیار زیاد است