administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(types): named integer subrange as an array index type

Browse source 
`type TIdx = lo..hi; TBuf = array[TIdx] of T;` now resolves to
`array[lo..hi] of T`, parallel to the existing `array[TEnum] of T`
ordinal-index folding.  Previously a named subrange used as an array
index was rejected with "'TIdx' is not an enumeration type", because a
subrange was stored as a transparent alias to its narrowest standard
integer type with its bounds discarded, and the array-index resolver
only accepted enum index types.

A named subrange now keeps its lo..hi bounds as compile-time metadata on
a DISTINCT TTypeDesc (IsSubrange/SubrangeLow/SubrangeHigh).  Its storage
and ABI are unchanged — it is still its underlying narrowest int, values
behave as ordinary unchecked integers (Blaise does no range checking) —
only the array-index resolver consults the retained bounds, folding
array[TIdx] to array[lo..hi].  Low/High on such an array then work via
the folded static-array bounds.

The bounds round-trip through the .bif META 'alias' record (three
trailing fields after TypeName), so a subrange exported from a unit and
used as `array[OtherUnit.TIdx]` resolves correctly across separate
compilation.  IFACE_VERSION 7 -> 8 (the alias record grew; v7 readers
must reject and recompile).  CloneTypeDef copies the new fields so the
export/clone path does not drop IsSubrange.

Tests: two e2e cases (0-based and 2..4 non-zero base, asserting element
reads + Length/Low/High on every backend), two IR/semantic cases
(the index folds to the right static-array bounds), and a .bif
round-trip case (IsSubrange + bounds survive write->read); the
magic/version assertion updated to v8.
This commit is contained in:
Graeme Geldenhuys 2026-06-30 20:19:01 +01:00
parent 61bb86f896
commit 1035dcc1c9
8 changed files with 265 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
compiler/src/main/pascal/uAST.pas
View file

@ -751,6 +751,14 @@ type
TTypeAliasDef = class(TASTTypeDef)
public
TypeName: string;
{ When the RHS was a named integer subrange (type TIdx = lo..hi;) the alias
target is the narrowest fitting standard integer type (in TypeName), but
the original lo..hi bounds are retained here as compile-time metadata so
the array-index resolver can fold array[TIdx] -> array[lo..hi]. The value
still behaves as its underlying int (unchecked); only the bounds are kept. }
IsSubrange: Boolean;
SubrangeLow: Int64;
SubrangeHigh: Int64;
end;
{ Set type definition: type TOptions = set of TEnum; }
@ -2542,6 +2550,9 @@ begin
begin
TA := TTypeAliasDef.Create();
TA.TypeName := TTypeAliasDef(ASrc).TypeName;
TA.IsSubrange := TTypeAliasDef(ASrc).IsSubrange;
TA.SubrangeLow := TTypeAliasDef(ASrc).SubrangeLow;
TA.SubrangeHigh := TTypeAliasDef(ASrc).SubrangeHigh;
Result := TA;
end
else if ASrc is TSetTypeDef then

13
compiler/src/main/pascal/uParser.pas
View file

@ -83,7 +83,7 @@ type
function CheckUnitNamePart: Boolean;
function ParseTypeName: string; { reads Ident optionally followed by '<' ArgList '>' }
function SubrangeAhead: Boolean; { current token starts an integer-literal subrange: IntLit.. or -IntLit.. }
function ParseIntegerSubrangeBaseType: string; { parse lo..hi, return narrowest fitting standard integer type }
function ParseIntegerSubrangeBaseType(out ALo, AHi: Int64): string; { parse lo..hi, return narrowest fitting standard integer type and the bounds }
function ReadConstBoundText: string; { read an array bound: literal, ident, or expr }
function ParseAnonEnumName: string; { parse '(a,b,c)' → encoded member-list string }
@ -656,7 +656,7 @@ begin
Result := False;
end;
function TParser.ParseIntegerSubrangeBaseType: string;
function TParser.ParseIntegerSubrangeBaseType(out ALo, AHi: Int64): string;
var
Lo, Hi: Int64;
Neg: Boolean;
@ -689,6 +689,8 @@ begin
raise EParseError.Create(Format(
'Subrange %d..%d is descending at line %d col %d in %s',
[Lo, Hi, FCurrent.Line, FCurrent.Col, FLexer.Filename]));
ALo := Lo;
AHi := Hi;
{ Pick the narrowest standard type covering [Lo, Hi]. }
if Lo >= 0 then
begin
@ -929,6 +931,8 @@ var
IsGeneric: Boolean;
Constraint: string;
ClassAttrs: TStringList;
SubLo: Int64;
SubHi: Int64;
begin
ClassAttrs := TStringList.Create();
try
@ -1099,7 +1103,10 @@ begin
record/array layout correct (TByte is byte-sized) while the value
behaves as an ordinary integer. }
AD := TTypeAliasDef.Create();
AD.TypeName := Self.ParseIntegerSubrangeBaseType();
AD.TypeName := Self.ParseIntegerSubrangeBaseType(SubLo, SubHi);
AD.IsSubrange := True;
AD.SubrangeLow := SubLo;
AD.SubrangeHigh := SubHi;
TD.Def := AD;
end
else if Check(tkArray) or Check(tkCaret) or Check(tkIdent) then

39
compiler/src/main/pascal/uSemantic.pas
View file

@ -3288,9 +3288,26 @@ begin
Result := SAT;
end;
end
else if (IdxTD <> nil) and IdxTD.IsSubrange and (BaseType <> nil) then
begin
{ Named integer subrange index (type TIdx = lo..hi; array[TIdx] of T):
the subrange supplies the index range; fold to array[lo..hi] of T,
exactly parallel to the enum branch's array[0..N-1]. }
LVal := IdxTD.SubrangeLow;
HVal := IdxTD.SubrangeHigh;
CanonName := Format('array[%d..%d] of %s', [LVal, HVal, BaseType.Name]);
Result := FTable.FindType(CanonName);
if Result = nil then
begin
SAT := FTable.NewStaticArrayType(BaseType, LVal, HVal);
Sym := TSymbol.Create(CanonName, skType, SAT);
FTable.DefineGlobal(Sym);
Result := SAT;
end;
end
else if IdxTD = nil then
SemanticError(Format('Unknown index type ''%s''', [IdxName]), 0, 0)
else if IdxTD.Kind <> tyEnum then
else if (IdxTD.Kind <> tyEnum) and (not IdxTD.IsSubrange) then
SemanticError(Format('''%s'' is not an enumeration type', [IdxName]), 0, 0);
Exit;
end;
@ -5860,6 +5877,26 @@ begin
Continue;
end;
end
else if AliasDef.IsSubrange then
begin
{ Named integer subrange: type TIdx = lo..hi; AliasName is the
narrowest fitting standard integer type (e.g. 'Byte'). Create a
DISTINCT descriptor that copies the underlying int's Kind (so layout,
QBE type, IsNumeric/IsOrdinal and assignment all treat it as that
int), but carries IsSubrange + the lo..hi bounds so the array-index
resolver can fold array[TIdx] -> array[lo..hi]. }
BaseSym := FTable.Lookup(AliasName);
if (BaseSym = nil) or (BaseSym.Kind <> skType) or (BaseSym.TypeDesc = nil) then
begin
SemanticError(Format('Unknown base type ''%s'' for subrange', [AliasName]),
TD.Line, TD.Col);
Continue;
end;
AliasDesc := FTable.NewType(BaseSym.TypeDesc.Kind, TD.Name);
AliasDesc.IsSubrange := True;
AliasDesc.SubrangeLow := AliasDef.SubrangeLow;
AliasDesc.SubrangeHigh := AliasDef.SubrangeHigh;
end
else
begin
{ Simple alias or constructed alias (array[L..H] of T, etc.).

9
compiler/src/main/pascal/uSymbolTable.pas
View file

@ -79,6 +79,15 @@ type
vtable, _FieldCleanup, itab) with this owner so two used units exporting a
same-named type emit distinct, non-colliding symbols. }
OwningUnit: string;
{ True when this descriptor was created for a NAMED integer subrange
(type TIdx = lo..hi;). Layout/Kind/RawSize remain those of the narrowest
fitting standard integer type — the value behaves as an ordinary unchecked
int — but the lo..hi bounds are retained as compile-time metadata so the
array-index resolver can fold array[TIdx] -> array[lo..hi]. No other path
(codegen, IsNumeric/IsOrdinal, assignment compatibility) consults these. }
IsSubrange: Boolean;
SubrangeLow: Int64;
SubrangeHigh: Int64;
function IsNumeric: Boolean;
function IsFloat: Boolean;
function IsString: Boolean;

18
compiler/src/main/pascal/uUnitInterfaceIO.pas
View file

@ -53,7 +53,15 @@ uses
const
IFACE_MAGIC = 'BLAISE-IFACE';
IFACE_VERSION = 7; { v7 (this cycle): external-library link dependencies now
IFACE_VERSION = 8; { v8 (this cycle): named integer subranges now round-trip.
A `type TIdx = lo..hi;` alias carries IsSubrange + the
lo..hi bounds so `array[TIdx] of T` folds to
`array[lo..hi] of T` across separate compilation. The
'alias' TYPE entry grew three trailing fields
(IsSubrange bool + SubrangeLow + SubrangeHigh, each an
lpstr) after TypeName, so v7 readers must reject these
.bif and recompile.
v7: external-library link dependencies now
round-trip. TUnitInterface.LinkLibs is serialised in
the META block (one EncodeStringList after
ImplUsedUnits, before HasInitialization) so a unit's
@ -632,7 +640,10 @@ begin
else if Kind = 'alias' then
SB.AppendLine(EncodeLpstr('alias') +
EncodeLpstr(E.Name) +
EncodeLpstr(TTypeAliasDef(E.Def).TypeName))
EncodeLpstr(TTypeAliasDef(E.Def).TypeName) +
EncodeBool(TTypeAliasDef(E.Def).IsSubrange) +
EncodeLpstr(IntToStr(TTypeAliasDef(E.Def).SubrangeLow)) +
EncodeLpstr(IntToStr(TTypeAliasDef(E.Def).SubrangeHigh)))
else if Kind = 'record' then
SB.AppendLine(EncodeLpstr('record') +
EncodeLpstr(E.Name) +
@ -2318,6 +2329,9 @@ begin
Payload := ReadLpstrAt(AText, APos);
AliasDef := TTypeAliasDef.Create();
AliasDef.TypeName := Payload;
AliasDef.IsSubrange := ReadLpstrAt(AText, APos) = '1';
AliasDef.SubrangeLow := ReadInt64At(AText, APos);
AliasDef.SubrangeHigh := ReadInt64At(AText, APos);
Entry.Def := AliasDef;
end
else if Kind = 'record' then

74
compiler/src/test/pascal/cp.test.e2e.staticarray.pas
View file

@ -35,6 +35,10 @@ type
procedure TestRun_TypeAlias_AsParam_Length;
procedure TestRun_TypeAlias_MultipleVarsShareType;
procedure TestRun_TypeAlias_GlobalAndLocal;
{ A named integer subrange (TIdx = 0..2) used as an array index type:
array[TIdx] of T resolves to array[0..2] of T (ordinal-indexed). }
procedure TestRun_NamedSubrange_AsArrayIndex;
procedure TestRun_NamedSubrange_NonZeroBase_AsArrayIndex;
{ Range-indexed const array: const X: array[L..H] of T = (...) }
procedure TestRun_ConstArray_RangeIndexed_Strings;
@ -204,6 +208,42 @@ const
end.
''';
{ A named integer subrange used as an array index type. array[TIdx] of T,
where TIdx = 0..2, must resolve to array[0..2] of T (ordinal-indexed,
like array[TEnum]). FPC compiles this; Blaise must too. }
SrcSubrangeIndex =
'''
program P;
type
TIdx = 0..2;
TBuf = array[TIdx] of Integer;
var A: TBuf;
begin
A[0] := 11; A[1] := 22; A[2] := 33;
WriteLn(A[0]);
WriteLn(A[1]);
WriteLn(A[2]);
WriteLn(Length(A))
end.
''';
{ Non-zero-based named subrange index: array[2..4] via a named subrange. }
SrcSubrangeIndexNonZero =
'''
program P;
type
TIdx = 2..4;
TBuf = array[TIdx] of Integer;
var A: TBuf;
begin
A[2] := 100; A[3] := 200; A[4] := 300;
WriteLn(A[2]);
WriteLn(A[4]);
WriteLn(Low(A));
WriteLn(High(A))
end.
''';
{ ------------------------------------------------------------------ }
{ Setup }
{ ------------------------------------------------------------------ }
@ -339,6 +379,40 @@ begin
finally Lines.Free() end
end;
procedure TE2EStaticArrayTests.TestRun_NamedSubrange_AsArrayIndex;
var Output: string; RCode: Integer;
Lines: TStringList;
begin
if not ToolchainAvailable() then begin Fail('<toolchain-missing>'); Exit end;
AssertTrue('compile+run', CompileAndRun(SrcSubrangeIndex, Output, RCode));
AssertEquals('exit 0', 0, RCode);
Lines := TStringList.Create();
try
Lines.Text := Trim(Output);
AssertEquals('A[0]=11', '11', Lines.Strings[0]);
AssertEquals('A[1]=22', '22', Lines.Strings[1]);
AssertEquals('A[2]=33', '33', Lines.Strings[2]);
AssertEquals('Length(A)=3', '3', Lines.Strings[3]);
finally Lines.Free() end
end;
procedure TE2EStaticArrayTests.TestRun_NamedSubrange_NonZeroBase_AsArrayIndex;
var Output: string; RCode: Integer;
Lines: TStringList;
begin
if not ToolchainAvailable() then begin Fail('<toolchain-missing>'); Exit end;
AssertTrue('compile+run', CompileAndRun(SrcSubrangeIndexNonZero, Output, RCode));
AssertEquals('exit 0', 0, RCode);
Lines := TStringList.Create();
try
Lines.Text := Trim(Output);
AssertEquals('A[2]=100', '100', Lines.Strings[0]);
AssertEquals('A[4]=300', '300', Lines.Strings[1]);
AssertEquals('Low(A)=2', '2', Lines.Strings[2]);
AssertEquals('High(A)=4', '4', Lines.Strings[3]);
finally Lines.Free() end
end;
procedure TE2EStaticArrayTests.TestRun_ConstArray_RangeIndexed_Strings;
const
Src =

64
compiler/src/test/pascal/cp.test.staticarray.pas
View file

@ -83,6 +83,12 @@ type
procedure TestCodegen_TypeAlias_AllocEmitted;
procedure TestCodegen_TypeAlias_ElementSizeInAlloc;
{ ------------------------------------------------------------------ }
{ Named integer subrange as an array index type }
{ ------------------------------------------------------------------ }
procedure TestSemantic_NamedSubrange_IndexFoldsToBounds;
procedure TestSemantic_NamedSubrange_NonZeroBase_IndexFoldsToBounds;
{ ------------------------------------------------------------------ }
{ Multi-dimensional arrays (comma form desugars to nested arrays) }
{ ------------------------------------------------------------------ }
@ -613,6 +619,33 @@ const
end.
''';
{ Named integer subrange (0-based) used as the array index type.
array[TIdx] of Integer must fold to array[0..2] of Integer. }
SrcNamedSubrangeIndex =
'''
program SA;
type
TIdx = 0..2;
TBuf = array[TIdx] of Integer;
var A: TBuf;
begin
A[0] := 11
end.
''';
{ Non-zero-based named integer subrange index: array[2..4]. }
SrcNamedSubrangeIndexNonZero =
'''
program SA;
type
TIdx = 2..4;
TBuf = array[TIdx] of Integer;
var A: TBuf;
begin
A[2] := 11
end.
''';
{ ------------------------------------------------------------------ }
{ Named array type alias — tests }
{ ------------------------------------------------------------------ }
@ -716,6 +749,37 @@ begin
AssertTrue('size 8 appears in IR', Pos('8', IR) >= 0);
end;
procedure TStaticArrayTests.TestSemantic_NamedSubrange_IndexFoldsToBounds;
var P: TProgram; Sym: TSymbol; SAT: TStaticArrayTypeDesc;
begin
{ type TIdx = 0..2; TBuf = array[TIdx] of Integer; must resolve to a static
array with bounds 0..2, exactly as if written array[0..2]. }
P := AnalyseSrc(SrcNamedSubrangeIndex);
try
Sym := P.SymbolTable.Lookup('TBuf');
AssertTrue('TBuf found', Sym <> nil);
AssertEquals('TBuf is static array',
Ord(tyStaticArray), Ord(Sym.TypeDesc.Kind));
SAT := TStaticArrayTypeDesc(Sym.TypeDesc);
AssertEquals('low=0', 0, SAT.LowBound);
AssertEquals('high=2', 2, SAT.HighBound);
finally P.Free(); end;
end;
procedure TStaticArrayTests.TestSemantic_NamedSubrange_NonZeroBase_IndexFoldsToBounds;
var P: TProgram; Sym: TSymbol; SAT: TStaticArrayTypeDesc;
begin
{ type TIdx = 2..4; TBuf = array[TIdx] of Integer; folds to array[2..4]. }
P := AnalyseSrc(SrcNamedSubrangeIndexNonZero);
try
Sym := P.SymbolTable.Lookup('TBuf');
AssertTrue('TBuf found', Sym <> nil);
SAT := TStaticArrayTypeDesc(Sym.TypeDesc);
AssertEquals('low=2', 2, SAT.LowBound);
AssertEquals('high=4', 4, SAT.HighBound);
finally P.Free(); end;
end;
{ ------------------------------------------------------------------ }
{ Multi-dimensional arrays }
{ ------------------------------------------------------------------ }

48
compiler/src/test/pascal/cp.test.unitinterface.pas
View file

@ -234,6 +234,9 @@ type
procedure TestRoundTrip_LinkLibsPreserved;
{ Int const round-trips. }
procedure TestRoundTrip_IntConstPreserved;
{ Named integer subrange alias round-trips its IsSubrange + lo..hi bounds,
so array[OtherUnit.TSub] still folds across separate compilation. }
procedure TestRoundTrip_NamedSubrangeAlias_BoundsPreserved;
{ String const round-trips, even with newlines + colons in the value. }
procedure TestRoundTrip_StringConstWithAwkwardChars;
{ Empty interface round-trips (zero consts). }
@ -2695,12 +2698,13 @@ begin
Iface := TUnitInterface.Create('U');
try
Buf := WriteUnitInterface(Iface);
{ Blaise Pos is 0-based; match-at-start returns 0. Version is 7 since
TUnitInterface.LinkLibs (external-library link deps) was added to the
META block (on top of v6's `overload` directive, v5's member Visibility,
v4's TRoutineSig.IsStatic, and v3's static-member facts). }
{ Blaise Pos is 0-based; match-at-start returns 0. Version is 8 since
named integer subranges (IsSubrange + lo..hi bounds on the 'alias' TYPE
entry) were added (on top of v7's LinkLibs, v6's `overload` directive,
v5's member Visibility, v4's TRoutineSig.IsStatic, and v3's static-member
facts). }
AssertTrue('starts with magic',
Pos('BLAISE-IFACE 7', Buf) = 0);
Pos('BLAISE-IFACE 8', Buf) = 0);
finally
Iface.Free();
end;
@ -2772,6 +2776,40 @@ begin
end;
end;
procedure TIfaceIOTests.TestRoundTrip_NamedSubrangeAlias_BoundsPreserved;
const
SRC =
'unit TestU;' + #10 +
'interface' + #10 +
'type TIdx = 2..4;' + #10 +
'implementation' + #10 +
'end.' + #10;
var
SrcIface, Dst: TUnitInterface;
E: TTypeEntry;
AD: TTypeAliasDef;
Buf: string;
begin
SrcIface := ParseAndExport(SRC);
try
Buf := WriteUnitInterface(SrcIface);
Dst := ReadUnitInterface(Buf);
try
E := Dst.FindType('TIdx');
AssertTrue('TIdx present', E <> nil);
AssertTrue('is alias def', E.Def is TTypeAliasDef);
AD := TTypeAliasDef(E.Def);
AssertEquals('IsSubrange', True, AD.IsSubrange);
AssertEquals('SubrangeLow', Int64(2), AD.SubrangeLow);
AssertEquals('SubrangeHigh', Int64(4), AD.SubrangeHigh);
finally
Dst.Free();
end;
finally
SrcIface.Free();
end;
end;
procedure TIfaceIOTests.TestRoundTrip_StringConstWithAwkwardChars;
const
WEIRD = 'multi' + #10 + 'line: with ":" inside';