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

feat(properties): default array property — Obj[I] sugar

Browse source 
Adds the `default` directive on an indexed property, enabling subscript
sugar on the object itself:

    property Items[I: Integer]: T read Get write Put; default;
    ...
    V[0] := 10;        // lowers to V.Put(0, 10)
    WriteLn(V[0]);     // lowers to V.Get(0)

This is the mechanism behind the familiar List[i] syntax and was a real
foundational gap (the directive did not even parse — "Expected ':'").

Implementation:
- Parser: accept the trailing `default;` directive after a property
  declaration; set TPropertyDecl.IsDefault.
- AST / symbol table: IsDefault on TPropertyDecl and TPropertyInfo;
  TRecordTypeDesc.FindDefaultProperty walks the inheritance chain.
- Semantic: Obj[I] read (AnalyseStringSubscriptExpr) synthesises the
  default property's field access and reuses the indexed-property read
  path; Obj[I] := V write (AnalyseStaticSubscriptAssign) records the
  setter on the TStaticSubscriptAssign node.
- Codegen (both backends): the write path emits the setter call via the
  existing PropAccessorTarget / EmitPropAccessorCallNative helpers, so it
  honours virtual/override on the accessor; the read path delegates the
  TStringSubscriptExpr to its folded property-read field access.
- Cross-unit: IsDefault is serialised in the .bif interface so a default
  property declared in one unit keeps its subscript sugar elsewhere.

Verified read, write, string-element, inherited, and cross-unit cases on
both backends. Adds IR tests (TPropertyTests.TestCodegen_DefaultProperty_
{Read,Write}) and dual-backend e2e tests (TE2EPropertyTests.TestRun_
DefaultProperty_{ReadWrite,StringElement,Inherited}). Grammar and
language-rationale updated; the two new TStaticSubscriptAssign fields are
marked safe in bif-coverage.status.
This commit is contained in:
Graeme Geldenhuys 2026-06-16 14:48:38 +01:00
parent 0f707d20ac
commit 798df8eb15
12 changed files with 321 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -6155,6 +6155,17 @@ begin
{ Open-array element read: A[I] where A is an open-array parameter.
The data pointer lives in the _var_A slot (not _var_A_high). }
{ Indexed/default property read: Obj.Items[I] or Obj[I] (default property) —
semantic has folded the index into StrExpr (a TFieldAccessExpr with PropRead
+ PropIndexExpr), leaving AExpr.IndexExpr nil. Delegate to the StrExpr. }
if (AExpr is TStringSubscriptExpr) and
(TStringSubscriptExpr(AExpr).StrExpr is TFieldAccessExpr) and
(TFieldAccessExpr(TStringSubscriptExpr(AExpr).StrExpr).PropRead <> nil) then
begin
Self.EmitExprToEax(TStringSubscriptExpr(AExpr).StrExpr);
Exit;
end;
if (AExpr is TStringSubscriptExpr) and
(TStringSubscriptExpr(AExpr).StrExpr is TIdentExpr) and
(TStringSubscriptExpr(AExpr).StrExpr.ResolvedType <> nil) and
@ -10967,6 +10978,28 @@ begin
if AStmt is TStaticSubscriptAssign then
begin
SSA := TStaticSubscriptAssign(AStmt);
{ Default array property write: Obj[I] := V lowered to a setter call.
Args: receiver %rdi, index %rsi, value %rdx (System V). Evaluate value
and index first (they clobber registers), stash on the stack, then load
the receiver and reload the args. }
if SSA.PropWriteInfo <> nil then
begin
Self.EmitExprToEax(SSA.ValueExpr); { value }
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(SSA.IndexExpr); { index }
Self.Emit(#9'pushq %rax');
if Self.IsLocal(SSA.ArrayName) then
Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(SSA.ArrayName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rdi', [SSA.ArrayName]));
if SSA.IsVarParam then
Self.Emit(#9'movq (%rdi), %rdi'); { var-param: slot -> instance }
Self.Emit(#9'popq %rsi'); { index }
Self.Emit(#9'popq %rdx'); { value }
Self.EmitPropAccessorCallNative(SSA.PropOwnerType,
TPropertyInfo(SSA.PropWriteInfo).WriteMethod, SSA.PropAccessorVSlot);
Exit;
end;
if (SSA.ResolvedArrayType <> nil) and
(SSA.ResolvedArrayType.Kind = tyPChar) then
begin

31
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -13976,7 +13976,38 @@ var
ItabTemp: string; { interface RHS itab slot or itab name literal }
ItabPtr: string; { ElemPtr + 8, target of itab store }
IntfDesc: TInterfaceTypeDesc;
DefProp: TPropertyInfo;
RecvTemp: string;
IdxQType: string;
ValQType: string;
PropTgt: string;
begin
{ Default array property write: Obj[I] := V lowered to a setter call.
Semantic set PropWriteInfo; ArrayName is the receiver, IndexExpr/ValueExpr
are the setter args. Dispatch through the vtable when the setter is
virtual (PropAccessorVSlot >= 0), else a static call. }
if AStmt.PropWriteInfo <> nil then
begin
DefProp := TPropertyInfo(AStmt.PropWriteInfo);
RecvTemp := AllocTemp();
EmitLine(Format(' %s =l loadl %s',
[RecvTemp, VarRef(AStmt.ArrayName, AStmt.IsGlobal)]));
if AStmt.IsVarParam then
begin
ElemPtr := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [ElemPtr, RecvTemp]));
RecvTemp := ElemPtr;
end;
IdxW := EmitExpr(AStmt.IndexExpr);
IdxQType := QbeTypeOf(DefProp.IndexTypeDesc);
ElemVal := EmitExpr(AStmt.ValueExpr);
ValQType := QbeTypeOf(DefProp.TypeDesc);
PropTgt := PropAccessorTarget(AStmt.PropOwnerType, DefProp.WriteMethod,
AStmt.PropAccessorVSlot, RecvTemp);
EmitLine(Format(' call %s(l %s, %s %s, %s %s)',
[PropTgt, RecvTemp, IdxQType, IdxW, ValQType, ElemVal]));
Exit;
end;
{ PChar subscript write: P[I] := Integer — storeb at ptr + I.
EmitByteRhs short-circuits Chr(N) so we store N directly instead of
truncating the low byte of a _Chr-allocated string pointer. }

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

@ -430,6 +430,13 @@ type
[Unretained] ResolvedArrayType: TTypeDesc; { set by uSemantic; not owned }
IsImplicitSelf: Boolean; { set by uSemantic — ArrayName is an array-typed field of Self }
[Unretained] ImplicitFieldInfo: TFieldInfo; { non-owned — the Self field; set with IsImplicitSelf }
{ Default array property write: Obj[I] := V where Obj's class has a
`default` indexed property — lowered to a setter call. When
PropWriteInfo is non-nil, ArrayName is the receiver variable, IndexExpr
is the index arg, ValueExpr is the value arg. }
[Unretained] PropWriteInfo: TObject; { TPropertyInfo — non-owned; nil = plain array write }
PropOwnerType: string; { declaring class of the setter }
PropAccessorVSlot: Integer; { setter vtable slot, -1 = static call }
destructor Destroy; override;
end;
@ -846,6 +853,7 @@ type
WriteName: string; { backing field or setter method; '' = read-only }
IndexParamName: string; { '' = non-indexed property }
IndexTypeName: string; { type name of the index parameter; '' when non-indexed }
IsDefault: Boolean; { declared with the `default` directive (Obj[I] sugar) }
end;
TClassTypeDef = class(TASTTypeDef)

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

@ -1992,6 +1992,16 @@ begin
Advance();
end;
Expect(tkSemicolon);
{ Optional `default` directive on an indexed property — marks it as the
class's default array property, enabling Obj[I] sugar. It appears as a
separate directive after the property's own semicolon:
property Items[I: Integer]: T read Get write Put; default; }
if Check(tkIdent) and SameText(FCurrent.Value, 'default') then
begin
Result.IsDefault := True;
Advance();
Expect(tkSemicolon);
end;
except
Result.Free();
raise;

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

@ -2537,6 +2537,7 @@ begin
PropInfo.IndexParamName := NewPDecl.IndexParamName;
if NewPDecl.IndexTypeName <> '' then
PropInfo.IndexTypeDesc := FindTypeOrInstantiate(NewPDecl.IndexTypeName);
PropInfo.IsDefault := NewPDecl.IsDefault;
RT.AddProperty(PropInfo);
end;
@ -4264,6 +4265,7 @@ begin
PropInfo.IndexParamName := PropDecl.IndexParamName;
if PropDecl.IndexTypeName <> '' then
PropInfo.IndexTypeDesc := FTable.FindType(PropDecl.IndexTypeName);
PropInfo.IsDefault := PropDecl.IsDefault;
RT.AddProperty(PropInfo);
end;
@ -10165,6 +10167,8 @@ function TSemanticAnalyser.AnalyseStringSubscriptExpr(AExpr: TStringSubscriptExp
var
StrType, IdxType: TTypeDesc;
FldAccess: TFieldAccessExpr;
DefProp: TPropertyInfo;
DefFA: TFieldAccessExpr;
begin
StrType := AnalyseExpr(AExpr.StrExpr);
{ Indexed property read: Obj.Prop[I] where Prop is a method-backed indexed property }
@ -10229,6 +10233,31 @@ begin
AExpr.ResolvedType := Result;
Exit;
end;
{ Default array property: Obj[I] on a class/record with a `default` indexed
property is sugar for Obj.<DefaultProp>[I]. Synthesise the field-access for
the default property's getter, analyse it (which sets PropRead / owner /
vtable slot), and reuse the indexed-property-read path above. }
if (StrType.Kind in [tyClass, tyRecord]) then
begin
DefProp := TRecordTypeDesc(StrType).FindDefaultProperty();
if (DefProp <> nil) and (DefProp.ReadMethod <> '') then
begin
DefFA := TFieldAccessExpr.Create();
DefFA.Line := AExpr.Line;
DefFA.Col := AExpr.Col;
DefFA.Base := AExpr.StrExpr; { transfer ownership of the receiver expr }
DefFA.FieldName := DefProp.Name;
{ Attach the index BEFORE analysis — the indexed-property field-access
path expects PropIndexExpr to be present. }
DefFA.PropIndexExpr := AExpr.IndexExpr;
AExpr.IndexExpr := nil;
AExpr.StrExpr := DefFA; { StrExpr now owns DefFA }
AnalyseExpr(DefFA); { sets DefFA.PropRead / PropOwnerType / VSlot }
Result := DefProp.TypeDesc;
AExpr.ResolvedType := Result;
Exit;
end;
end;
if not StrType.IsString() then
SemanticError(
Format('String subscript ''[]'' requires a string expression, got ''%s''',
@ -10335,6 +10364,7 @@ var
ValType: TTypeDesc;
BaseInfo: TFieldInfo;
ElemT: TTypeDesc;
DefProp: TPropertyInfo;
begin
{ Chained / multi-dimensional element write: BaseExpr yields the inner
array (A[I][J] := V, lowered from A[I, J] := V or written directly).
@ -10393,6 +10423,30 @@ begin
AStmt.Line, AStmt.Col);
end;
AStmt.ArrayName := Sym.Name; { normalise to declared casing }
{ Default array property write: Obj[I] := V where Obj's class/record has a
`default` indexed property with a setter — lower to a setter call. }
if Sym.TypeDesc.Kind in [tyClass, tyRecord] then
begin
DefProp := TRecordTypeDesc(Sym.TypeDesc).FindDefaultProperty();
if (DefProp <> nil) and (DefProp.WriteMethod <> '') then
begin
AStmt.IsGlobal := Sym.IsGlobal;
AStmt.IsVarParam := Sym.Kind = skVarParameter;
AStmt.PropWriteInfo := DefProp;
AStmt.PropOwnerType :=
PropAccessorOwner(TRecordTypeDesc(Sym.TypeDesc).Name, DefProp.WriteMethod);
AStmt.PropAccessorVSlot :=
PropAccessorVSlot(TRecordTypeDesc(Sym.TypeDesc).Name, DefProp.WriteMethod);
IdxType := AnalyseExpr(AStmt.IndexExpr);
if (DefProp.IndexTypeDesc <> nil) then
CheckTypesMatch(DefProp.IndexTypeDesc, IdxType, 'default property index',
AStmt.Line, AStmt.Col);
ValType := AnalyseExpr(AStmt.ValueExpr);
CheckTypesMatch(DefProp.TypeDesc, ValType, 'default property assignment',
AStmt.Line, AStmt.Col);
Exit;
end;
end;
{ PChar subscript write: P[I] := Integer — storeb at ptr + I }
if Sym.TypeDesc.Kind = tyPChar then
begin

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

@ -218,6 +218,7 @@ type
WriteMethod: string; { '' if field-backed write or read-only }
IndexParamName: string; { '' = non-indexed property }
[Unretained] IndexTypeDesc: TTypeDesc; { not owned; non-nil when IndexParamName <> '' }
IsDefault: Boolean; { declared with the `default` directive (Obj[I] sugar) }
end;
{ Type descriptor for zero-GUID interface types (Phase 3). }
@ -294,6 +295,7 @@ type
procedure AddProperty(AProp: TPropertyInfo);
function FindProperty(const AName: string): TPropertyInfo;
function FindIndexedProperty: TPropertyInfo;
function FindDefaultProperty: TPropertyInfo;
{ Custom attribute tracking }
procedure AddClassAttribute(const AName: string);
@ -1007,6 +1009,27 @@ begin
Result := nil;
end;
function TRecordTypeDesc.FindDefaultProperty: TPropertyInfo;
{ Returns the property marked `default` (Obj[I] sugar), walking the inheritance
chain; nil if the class has no default property. }
var
I: Integer;
P: TPropertyInfo;
Walk: TRecordTypeDesc;
begin
Walk := Self;
while Walk <> nil do
begin
for I := 0 to Walk.FProperties.Count - 1 do
begin
P := TPropertyInfo(Walk.FProperties.Items[I]);
if P.IsDefault then Exit(P);
end;
Walk := Walk.Parent;
end;
Result := nil;
end;
procedure TRecordTypeDesc.AddClassAttribute(const AName: string);
begin
FClassAttributes.Add(AName);

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

@ -311,7 +311,8 @@ begin
EncodeLpstr(P.ReadName) +
EncodeLpstr(P.WriteName) +
EncodeLpstr(P.IndexParamName) +
EncodeLpstr(P.IndexTypeName);
EncodeLpstr(P.IndexTypeName) +
EncodeBool(P.IsDefault);
end;
end;
@ -1807,6 +1808,7 @@ begin
P.WriteName := ReadLpstrAt(AText, APos);
P.IndexParamName := ReadLpstrAt(AText, APos);
P.IndexTypeName := ReadLpstrAt(AText, APos);
P.IsDefault := DecodeBool(AText, APos);
ATarget.Add(P);
end;
end;

79
compiler/src/test/pascal/cp.test.e2e.properties.pas
View file

@ -30,6 +30,11 @@ type
procedure TestRun_DefaultValueIsZero;
procedure TestRun_InheritedProperty;
procedure TestRun_IndexedProperty;
{ Default array property: Obj[I] sugar (read + write), string element, and
inheritance of the default property from a base class. }
procedure TestRun_DefaultProperty_ReadWrite;
procedure TestRun_DefaultProperty_StringElement;
procedure TestRun_DefaultProperty_Inherited;
{ Static-array field accessed from inside a method (implicit Self). }
procedure TestRun_StaticArrayField_ReadInMethod;
procedure TestRun_StaticArrayField_WriteInMethod;
@ -215,6 +220,80 @@ begin
AssertRunsOnAll(SrcArrOfRecord, '77' + LE, 0);
end;
const
SrcDefaultRW = '''
program P;
type
TVec = class
FData: array[0..4] of Integer;
function Get(i: Integer): Integer; begin Result := FData[i] end;
procedure Put(i: Integer; v: Integer); begin FData[i] := v end;
property Items[i: Integer]: Integer read Get write Put; default;
end;
var v: TVec;
begin
v := TVec.Create;
v[0] := 10; v[1] := 20;
WriteLn(v[0] + v[1]);
v := nil
end.
''';
SrcDefaultStr = '''
program P;
type
TBag = class
FData: array[0..2] of string;
function Get(i: Integer): string; begin Result := FData[i] end;
procedure Put(i: Integer; v: string); begin FData[i] := v end;
property Items[i: Integer]: string read Get write Put; default;
end;
var b: TBag;
begin
b := TBag.Create;
b[0] := 'foo'; b[1] := 'bar';
WriteLn(b[0] + b[1]);
b := nil
end.
''';
SrcDefaultInherited = '''
program P;
type
TBase = class
FData: array[0..2] of Integer;
function Get(i: Integer): Integer; begin Result := FData[i] end;
procedure Put(i: Integer; v: Integer); begin FData[i] := v end;
property Items[i: Integer]: Integer read Get write Put; default;
end;
TDerived = class(TBase) end;
var d: TDerived;
begin
d := TDerived.Create;
d[0] := 5; d[1] := 7;
WriteLn(d[0] + d[1]);
d := nil
end.
''';
procedure TE2EPropertyTests.TestRun_DefaultProperty_ReadWrite;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcDefaultRW, '30' + LE, 0);
end;
procedure TE2EPropertyTests.TestRun_DefaultProperty_StringElement;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcDefaultStr, 'foobar' + LE, 0);
end;
procedure TE2EPropertyTests.TestRun_DefaultProperty_Inherited;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcDefaultInherited, '12' + LE, 0);
end;
initialization
RegisterTest(TE2EPropertyTests);

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

@ -70,6 +70,10 @@ type
procedure TestCodegen_IndexedProperty_Read_EmitsGetterWithIndex;
procedure TestCodegen_IndexedProperty_Write_EmitsSetterWithIndex;
{ Default array property: Obj[I] lowers to the getter/setter call. }
procedure TestCodegen_DefaultProperty_Read_EmitsGetter;
procedure TestCodegen_DefaultProperty_Write_EmitsSetter;
{ Regression: 'Outer.Inner.Indexed[Variable]' — chained base + indexed
property read with a variable index. Previously crashed the codegen
because the analyser skipped AnalyseExpr on PropIndexExpr in the
@ -588,6 +592,50 @@ begin
AssertTrue('indexed write emits setter call', Pos('call $TList_Put', IR) > 0);
end;
procedure TPropertyTests.TestCodegen_DefaultProperty_Read_EmitsGetter;
var
IR: string;
begin
IR := GenIR(
'''
program P;
type
TVec = class
FD: array[0..3] of Integer;
function Get(i: Integer): Integer; begin Result := FD[i] end;
procedure Put(i: Integer; v: Integer); begin FD[i] := v end;
property Items[i: Integer]: Integer read Get write Put; default;
end;
var v: TVec; x: Integer;
begin v := TVec.Create(); x := v[2]; WriteLn(x) end.
'''
);
AssertTrue('default-property read emits getter call',
Pos('call $TVec_Get', IR) > 0);
end;
procedure TPropertyTests.TestCodegen_DefaultProperty_Write_EmitsSetter;
var
IR: string;
begin
IR := GenIR(
'''
program P;
type
TVec = class
FD: array[0..3] of Integer;
function Get(i: Integer): Integer; begin Result := FD[i] end;
procedure Put(i: Integer; v: Integer); begin FD[i] := v end;
property Items[i: Integer]: Integer read Get write Put; default;
end;
var v: TVec;
begin v := TVec.Create(); v[2] := 9 end.
'''
);
AssertTrue('default-property write emits setter call',
Pos('call $TVec_Put', IR) > 0);
end;
procedure TPropertyTests.TestCodegen_IndexedProperty_ChainedBase_VarIndex_Compiles;
const
Src =

8
docs/grammar.ebnf
View file

@ -405,6 +405,7 @@ PropertyDecl
[ "read" IDENT ]
[ "write" IDENT ]
SEMICOLON
[ "default" SEMICOLON ] (* default array property *)
;
(* If the index parameter is present, the property is indexed:
@ -412,7 +413,12 @@ PropertyDecl
* Indexed reads emit a getter call with one extra argument (the index).
* Indexed writes emit a setter call with two extra arguments (index, value).
* Only a single index parameter is supported; multiple-index properties
* (as in Delphi) are not. *)
* (as in Delphi) are not.
*
* The optional "default" directive (only meaningful on an indexed property)
* marks it as the class's default array property, enabling the Obj[I] sugar:
* property Items[I: Integer]: T read Get write Put; default;
* Obj[I] then lowers to Obj.Items[I] (getter on read, setter on write). *)
(* "property", "read", "write" are contextual soft keywords; they may be used
* as identifiers outside a class body. *)

23
docs/language-rationale.adoc
View file

@ -755,6 +755,29 @@ the idiomatic subscript syntax the compiler source already uses.
names in the declaration are more transparent and consistent with the
existing non-indexed property design.
==== Default array property
An indexed property may carry the `default` directive, marking it as the
class's default array property:
----
property Items[I: Integer]: T read Get write Put; default;
----
A subscript applied directly to an object of that class — `Obj[I]` — is then
sugar for `Obj.Items[I]`: it lowers to the getter on read and the setter on
write, exactly as the named form does. This is the mechanism behind the
familiar `List[i]` syntax. Resolution walks the inheritance chain, so a
default property declared on a base class is usable through a derived class.
The `default` flag is carried across units in the `.bif` interface so a
default property declared in one unit keeps its subscript sugar when the unit
is used elsewhere.
Only one default property per class is meaningful (the first one found wins);
the directive is only valid on an indexed property. The accessor dispatch
honours `virtual`/`override` on the getter/setter, the same as a named indexed
property access.
---
=== Constructor and Destructor Keywords

2
tools/bif-coverage/bif-coverage.status
View file

@ -194,6 +194,8 @@ TStaticSubscriptAssign.BaseExpr serialise
TStaticSubscriptAssign.IsGlobal safe
TStaticSubscriptAssign.IsVarParam safe
TStaticSubscriptAssign.IsImplicitSelf safe
TStaticSubscriptAssign.PropOwnerType safe
TStaticSubscriptAssign.PropAccessorVSlot safe
# TPointerWriteStmt (uAST.pas:420)
TPointerWriteStmt.PtrExpr serialise