From 2dcfe8e196fd2ba7bf39ccc4ae866494dc44f881 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 17 Jun 2026 19:07:26 +0100 Subject: [PATCH] feat(arrays): accept named constants and expressions as static-array bounds (#109) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Static-array bounds now accept named integer constants and compile-time integer expressions, not only integer literals. All of these are valid: const N = 10; type TBuf = array[0..N-1] of Byte; var A: array[0..N] of Integer; const Days: array[0..N-1] of string = (...); Parser: ReadConstBoundText collects tokens forming a bound expression (integers, identifiers, arithmetic operators, parentheses) into a string embedded in the type name. Semantic: ResolveArrayBound resolves the bound text — plain integers via StrToInt, named constants via symbol-table lookup, expressions via mini-parse + EvalConstIntExpr. The canonical type name always uses resolved integer values for cache consistency. Both the var/type declaration path (FindTypeOrInstantiate) and the const-array path (BuildConstArrayType / ReadConstArrayDim) are updated. Tests: 5 unit tests + 3 E2E tests (both backends). Grammar and language rationale updated. --- compiler/src/main/pascal/uParser.pas | 145 ++++++++++++------ compiler/src/main/pascal/uSemantic.pas | 89 +++++++++-- .../test/pascal/cp.test.e2e.staticarray.pas | 54 +++++++ .../src/test/pascal/cp.test.staticarray.pas | 104 +++++++++++++ docs/grammar.ebnf | 16 +- docs/language-rationale.adoc | 43 ++++++ 6 files changed, 395 insertions(+), 56 deletions(-) diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index cea4467..d5e9be7 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -58,6 +58,7 @@ type function Check(AKind: TTokenKind): Boolean; function CheckUnitNamePart: Boolean; function ParseTypeName: string; { reads Ident optionally followed by '<' ArgList '>' } + function ReadConstBoundText: string; { read an array bound: literal, ident, or expr } function ParseAnonEnumName: string; { parse '(a,b,c)' → encoded member-list string } function ParseProgram: TProgram; @@ -153,6 +154,85 @@ begin Result := FLookahead2.Kind; end; +function TParser.ReadConstBoundText: string; +var + Depth: Integer; +begin + Result := ''; + Depth := 0; + while True do + begin + if (Depth = 0) and ((Check(tkDotDot)) or (Check(tkRBracket)) + or (Check(tkComma))) then + Break; + if Check(tkLParen) then + begin + Depth := Depth + 1; + Result := Result + '('; + Advance(); + end + else if Check(tkRParen) then + begin + Depth := Depth - 1; + Result := Result + ')'; + Advance(); + end + else if Check(tkIntLit) then + begin + Result := Result + FCurrent.Value; + Advance(); + end + else if Check(tkIdent) then + begin + Result := Result + FCurrent.Value; + Advance(); + end + else if Check(tkMinus) then + begin + Result := Result + '-'; + Advance(); + end + else if Check(tkPlus) then + begin + Result := Result + '+'; + Advance(); + end + else if Check(tkStar) then + begin + Result := Result + '*'; + Advance(); + end + else if Check(tkDiv) then + begin + Result := Result + ' div '; + Advance(); + end + else if Check(tkMod) then + begin + Result := Result + ' mod '; + Advance(); + end + else if Check(tkShl) then + begin + Result := Result + ' shl '; + Advance(); + end + else if Check(tkShr) then + begin + Result := Result + ' shr '; + Advance(); + end + else + raise EParseError.Create(Format( + 'Expected constant bound expression at line %d col %d in %s', + [FCurrent.Line, FCurrent.Col, FLexer.Filename])); + end; + if Result = '' then + raise EParseError.Create(Format( + 'Expected constant bound expression at line %d col %d in %s', + [FCurrent.Line, FCurrent.Col, FLexer.Filename])); +end; + { Parse a type name, including generic instantiations. Returns 'Integer', 'TBox', 'TPair', etc. Spaces around commas are stripped for a canonical representation. } @@ -178,17 +258,9 @@ begin Highs := TStringList.Create(); try repeat - if not Check(tkIntLit) then - raise EParseError.Create(Format('Expected integer bound at line %d col %d in %s', - [FCurrent.Line, FCurrent.Col, FLexer.Filename])); - Lows.Add(FCurrent.Value); - Advance(); + Lows.Add(Self.ReadConstBoundText()); Expect(tkDotDot); - if not Check(tkIntLit) then - raise EParseError.Create(Format('Expected integer bound at line %d col %d in %s', - [FCurrent.Line, FCurrent.Col, FLexer.Filename])); - Highs.Add(FCurrent.Value); - Advance(); + Highs.Add(Self.ReadConstBoundText()); if not Check(tkComma) then Break; Advance(); { consume ',' — next dimension } @@ -946,19 +1018,13 @@ end; it cannot be mixed with multi-dimensional ranges. } procedure TParser.ReadConstArrayDim(CD: TConstDecl); var - Lo, Hi: Integer; + LoText, HiText: string; begin - Lo := ParseIntLiteral(FCurrent.Value); - Advance(); + LoText := Self.ReadConstBoundText(); Expect(tkDotDot); - if not Check(tkIntLit) then - raise EParseError.Create(Format( - 'Expected integer high bound in array const at line %d col %d in %s', - [FCurrent.Line, FCurrent.Col, FLexer.Filename])); - Hi := ParseIntLiteral(FCurrent.Value); - Advance(); - CD.ArrayDimLows.Add(IntToStr(Lo)); - CD.ArrayDimHighs.Add(IntToStr(Hi)); + HiText := Self.ReadConstBoundText(); + CD.ArrayDimLows.Add(LoText); + CD.ArrayDimHighs.Add(HiText); CD.ArrayIsRangeIndexed := True; end; @@ -974,22 +1040,9 @@ begin begin Expect(tkArray); Expect(tkLBracket); - if Check(tkIntLit) then + if Check(tkIdent) and (PeekKind() = tkRBracket) then begin - Self.ReadConstArrayDim(CD); - while Check(tkComma) do - begin - Advance(); - if not Check(tkIntLit) then - raise EParseError.Create(Format( - 'Expected integer low bound in array const at line %d col %d in %s', - [FCurrent.Line, FCurrent.Col, FLexer.Filename])); - Self.ReadConstArrayDim(CD); - end; - end - else if Check(tkIdent) then - begin - { Enum-indexed: only valid as a lone single dimension. } + { Enum-indexed: 'array[TEnum]' — ident alone followed by ']'. } if (CD.ArrayDimLows.Count > 0) or (CD.ArrayIndexType <> '') then raise EParseError.Create(Format( 'Enum-indexed dimension cannot be combined with other dimensions ' + @@ -998,6 +1051,16 @@ begin CD.ArrayIndexType := FCurrent.Value; Advance(); end + else if Check(tkIntLit) or Check(tkIdent) or Check(tkMinus) + or Check(tkLParen) then + begin + Self.ReadConstArrayDim(CD); + while Check(tkComma) do + begin + Advance(); + Self.ReadConstArrayDim(CD); + end; + end else raise EParseError.Create(Format( 'Expected index type or range in array const at line %d col %d in %s', @@ -1016,13 +1079,9 @@ begin Advance(); Break; end; - { Mirror dim-0 bounds onto the legacy single-dim fields so the existing - range-indexed semantic/codegen path is unchanged for 1-D constants. } - if CD.ArrayDimLows.Count > 0 then - begin - CD.ArrayLowBound := StrToInt(CD.ArrayDimLows.Strings[0]); - CD.ArrayHighBound := StrToInt(CD.ArrayDimHighs.Strings[0]); - end; + { Legacy single-dim fields (ArrayLowBound / ArrayHighBound) are resolved + from ArrayDimLows/ArrayDimHighs by the semantic pass, which can evaluate + named constants and constant expressions. } end; { Parse a constant value (everything after '=', up to but excluding the diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 5e2eef4..1c9846f 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -22,7 +22,7 @@ interface uses SysUtils, Classes, contnrs, uAST, uSymbolTable, uStrCompat, - uUnitInterface; + uUnitInterface, uLexer, uParser; type ESemanticError = class(Exception); @@ -165,6 +165,7 @@ type function EvalConstIntExpr(AExpr: TASTExpr; ALine, ACol: Integer): Int64; function EvalConstFloatExpr(AExpr: TASTExpr; ALine, ACol: Integer): string; function IsFloatConstExpr(AExpr: TASTExpr): Boolean; + function ResolveArrayBound(const ABoundText: string): Integer; procedure AnalyseTypeDecls(ABlock: TBlock); procedure LinkClassMethodImpls(ABlock: TBlock); procedure LinkGenericClassMethodImpls(ABlock: TBlock); @@ -2270,6 +2271,7 @@ var DDotPos, RBrPos, OfPos: Integer; LStr, HStr, ElemName: string; CanonName: string; + LVal, HVal: Integer; SAT: TStaticArrayTypeDesc; DAT: TDynArrayTypeDesc; begin @@ -2296,7 +2298,9 @@ begin end; Exit; end; - { Static array: 'array[L..H] of TypeName' — create on demand. } + { Static array: 'array[L..H] of TypeName' — create on demand. + L and H may be integer literals, named constants, or constant + expressions (e.g. N-1). ResolveArrayBound folds them to integers. } if (Length(AName) > 6) and (StrHead(AName, 6) = 'array[') then begin DDotPos := StrPos('..', AName); @@ -2308,11 +2312,13 @@ begin BaseType := FindTypeOrInstantiate(ElemName); if BaseType <> nil then begin - CanonName := 'array[' + LStr + '..' + HStr + '] of ' + BaseType.Name; + LVal := ResolveArrayBound(LStr); + HVal := ResolveArrayBound(HStr); + CanonName := Format('array[%d..%d] of %s', [LVal, HVal, BaseType.Name]); Result := FTable.FindType(CanonName); if Result = nil then begin - SAT := FTable.NewStaticArrayType(BaseType, StrToInt(LStr), StrToInt(HStr)); + SAT := FTable.NewStaticArrayType(BaseType, LVal, HVal); Sym := TSymbol.Create(CanonName, skType, SAT); FTable.DefineGlobal(Sym); Result := SAT; @@ -3775,6 +3781,66 @@ begin 'Constant expression is not a compile-time float', ALine, ACol); end; +function IsPlainInt(const S: string): Boolean; +var + I, Start: Integer; +begin + Result := False; + if Length(S) = 0 then Exit; + if S[0] = '-' then + Start := 1 + else + Start := 0; + if Start >= Length(S) then Exit; + for I := Start to Length(S) - 1 do + if (S[I] < '0') or (S[I] > '9') then Exit; + Result := True; +end; + +function TSemanticAnalyser.ResolveArrayBound(const ABoundText: string): Integer; +var + Src: string; + Lx: TLexer; + Px: TParser; + Prog: TProgram; + CD: TConstDecl; + Expr: TASTExpr; + Sym: TSymbol; +begin + if IsPlainInt(ABoundText) then + Exit(Integer(StrToInt(ABoundText))); + Sym := FTable.Lookup(ABoundText); + if (Sym <> nil) and (Sym.Kind = skConstant) then + Exit(Integer(Sym.ConstValue)); + Src := 'program _ab; const _ab_val = ' + ABoundText + '; begin end.'; + Lx := TLexer.Create(Src); + Px := TParser.Create(Lx); + try + Prog := Px.Parse(); + try + if Prog.Block.ConstDecls.Count = 0 then + raise ESemanticError.Create( + Format('Cannot resolve array bound ''%s''', [ABoundText])); + CD := TConstDecl(Prog.Block.ConstDecls.Items[0]); + if CD.IntValueExpr <> nil then + begin + Expr := CD.IntValueExpr; + Result := Integer(EvalConstIntExpr(Expr, 0, 0)); + end + else if CD.IntExprTokens <> nil then + Result := Integer(FoldConstBitOpExpr(CD.IntExprTokens, 0, 0)) + else + raise ESemanticError.Create( + Format('Cannot resolve array bound ''%s''', [ABoundText])); + finally + Prog.Free(); + end; + finally + Px.Free(); + Lx.Free(); + end; +end; + procedure TSemanticAnalyser.AnalyseSetConstDecl(ACD: TConstDecl); var I: Integer; @@ -4026,8 +4092,8 @@ begin Expected := 1; for D := 0 to ACD.ArrayDimLows.Count - 1 do begin - Lo := StrToInt(ACD.ArrayDimLows.Strings[D]); - Hi := StrToInt(ACD.ArrayDimHighs.Strings[D]); + Lo := ResolveArrayBound(ACD.ArrayDimLows.Strings[D]); + Hi := ResolveArrayBound(ACD.ArrayDimHighs.Strings[D]); Expected := Expected * (Hi - Lo + 1); end; if ACD.ArrayElements.Count <> Expected then @@ -4038,14 +4104,19 @@ begin Inner := AElemTD; for D := ACD.ArrayDimLows.Count - 1 downto 0 do begin - Lo := StrToInt(ACD.ArrayDimLows.Strings[D]); - Hi := StrToInt(ACD.ArrayDimHighs.Strings[D]); + Lo := ResolveArrayBound(ACD.ArrayDimLows.Strings[D]); + Hi := ResolveArrayBound(ACD.ArrayDimHighs.Strings[D]); Inner := FTable.NewStaticArrayType(Inner, Lo, Hi); end; Result := TStaticArrayTypeDesc(Inner); Exit; end; - { Single dimension. } + { Single dimension — resolve from dim lists (parser stores raw text). } + if (ACD.ArrayDimLows <> nil) and (ACD.ArrayDimLows.Count = 1) then + begin + ACD.ArrayLowBound := ResolveArrayBound(ACD.ArrayDimLows.Strings[0]); + ACD.ArrayHighBound := ResolveArrayBound(ACD.ArrayDimHighs.Strings[0]); + end; Expected := ACD.ArrayHighBound - ACD.ArrayLowBound + 1; if ACD.ArrayElements.Count <> Expected then SemanticError(Format( diff --git a/compiler/src/test/pascal/cp.test.e2e.staticarray.pas b/compiler/src/test/pascal/cp.test.e2e.staticarray.pas index 5ef5bbe..56b24b6 100644 --- a/compiler/src/test/pascal/cp.test.e2e.staticarray.pas +++ b/compiler/src/test/pascal/cp.test.e2e.staticarray.pas @@ -72,6 +72,11 @@ type procedure TestRun_MultiDimConst_CommaForm_ReadsValues; procedure TestRun_MultiDimConst_NestedForm_ReadsValues; procedure TestRun_MultiDimConst_ThreeDimensions; + + { Named constant array bounds (issue #109) } + procedure TestRun_NamedConstBound_Simple; + procedure TestRun_NamedConstBound_Expression; + procedure TestRun_NamedConstBound_TypeAlias; end; implementation @@ -787,6 +792,55 @@ begin AssertRunsOnAll(Src, '1' + LE + '6' + LE + '8' + LE, 0); end; +procedure TE2EStaticArrayTests.TestRun_NamedConstBound_Simple; +var LE: string; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end; + LE := LineEnding; + AssertRunsOnAll(''' + program P; + const N = 3; + var A: array[0..N] of Integer; + begin + A[0] := 10; A[1] := 20; A[2] := 30; A[3] := 40; + WriteLn(A[0]); WriteLn(A[3]) + end. + ''', '10' + LE + '40' + LE, 0); +end; + +procedure TE2EStaticArrayTests.TestRun_NamedConstBound_Expression; +var LE: string; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end; + LE := LineEnding; + AssertRunsOnAll(''' + program P; + const N = 10; + var A: array[0..N-1] of Integer; + begin + A[0] := 1; A[9] := 99; + WriteLn(A[0]); WriteLn(A[9]) + end. + ''', '1' + LE + '99' + LE, 0); +end; + +procedure TE2EStaticArrayTests.TestRun_NamedConstBound_TypeAlias; +var LE: string; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end; + LE := LineEnding; + AssertRunsOnAll(''' + program P; + const MaxItems = 5; + type TBuf = array[0..MaxItems-1] of Integer; + var B: TBuf; + begin + B[0] := 100; B[4] := 500; + WriteLn(B[0]); WriteLn(B[4]) + end. + ''', '100' + LE + '500' + LE, 0); +end; + initialization RegisterTest(TE2EStaticArrayTests); diff --git a/compiler/src/test/pascal/cp.test.staticarray.pas b/compiler/src/test/pascal/cp.test.staticarray.pas index 9cd0a6f..b84ff8e 100644 --- a/compiler/src/test/pascal/cp.test.staticarray.pas +++ b/compiler/src/test/pascal/cp.test.staticarray.pas @@ -101,6 +101,15 @@ type { ------------------------------------------------------------------ } procedure TestCodegen_ReturnStaticArray_SretParam; procedure TestCodegen_ReturnStaticArray_VoidReturn; + + { ------------------------------------------------------------------ } + { Named constant array bounds (issue #109) } + { ------------------------------------------------------------------ } + procedure TestSemantic_NamedConstBound_Simple; + procedure TestSemantic_NamedConstBound_BothBounds; + procedure TestSemantic_NamedConstBound_Expression; + procedure TestSemantic_NamedConstBound_TypeDecl; + procedure TestCodegen_NamedConstBound_CorrectSize; end; implementation @@ -884,6 +893,101 @@ begin AssertTrue('void return', Pos('ret', IR) >= 0); end; +{ ------------------------------------------------------------------ } +{ Named constant array bounds (issue #109) } +{ ------------------------------------------------------------------ } + +procedure TStaticArrayTests.TestSemantic_NamedConstBound_Simple; +var P: TProgram; VD: TVarDecl; SAT: TStaticArrayTypeDesc; +begin + P := AnalyseSrc(''' + program P; + const N = 5; + var A: array[0..N] of Integer; + begin end. + '''); + try + VD := TVarDecl(P.Block.Decls.Items[0]); + AssertTrue('resolved type', VD.ResolvedType <> nil); + AssertTrue('is static array', VD.ResolvedType.Kind = tyStaticArray); + SAT := TStaticArrayTypeDesc(VD.ResolvedType); + AssertEquals('low', 0, SAT.LowBound); + AssertEquals('high', 5, SAT.HighBound); + finally + P.Free(); + end; +end; + +procedure TStaticArrayTests.TestSemantic_NamedConstBound_BothBounds; +var P: TProgram; VD: TVarDecl; SAT: TStaticArrayTypeDesc; +begin + P := AnalyseSrc(''' + program P; + const Lo = 1; Hi = 10; + var A: array[Lo..Hi] of Integer; + begin end. + '''); + try + VD := TVarDecl(P.Block.Decls.Items[0]); + SAT := TStaticArrayTypeDesc(VD.ResolvedType); + AssertEquals('low', 1, SAT.LowBound); + AssertEquals('high', 10, SAT.HighBound); + finally + P.Free(); + end; +end; + +procedure TStaticArrayTests.TestSemantic_NamedConstBound_Expression; +var P: TProgram; VD: TVarDecl; SAT: TStaticArrayTypeDesc; +begin + P := AnalyseSrc(''' + program P; + const N = 10; + var A: array[0..N-1] of Integer; + begin end. + '''); + try + VD := TVarDecl(P.Block.Decls.Items[0]); + SAT := TStaticArrayTypeDesc(VD.ResolvedType); + AssertEquals('low', 0, SAT.LowBound); + AssertEquals('high', 9, SAT.HighBound); + finally + P.Free(); + end; +end; + +procedure TStaticArrayTests.TestSemantic_NamedConstBound_TypeDecl; +var P: TProgram; VD: TVarDecl; SAT: TStaticArrayTypeDesc; +begin + P := AnalyseSrc(''' + program P; + const MaxItems = 8; + type TBuf = array[0..MaxItems-1] of Byte; + var Buf: TBuf; + begin end. + '''); + try + VD := TVarDecl(P.Block.Decls.Items[0]); + SAT := TStaticArrayTypeDesc(VD.ResolvedType); + AssertEquals('low', 0, SAT.LowBound); + AssertEquals('high', 7, SAT.HighBound); + finally + P.Free(); + end; +end; + +procedure TStaticArrayTests.TestCodegen_NamedConstBound_CorrectSize; +var IR: string; +begin + IR := GenIR(''' + program P; + const N = 4; + var A: array[0..N] of Integer; + begin A[0] := 42 end. + '''); + AssertTrue('alloc for 5 ints (20 bytes)', Pos('20', IR) >= 0); +end; + initialization RegisterTest(TStaticArrayTests); diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index 313cca4..8334bf6 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -499,7 +499,7 @@ ConstArrayType ; ConstArrayRange - = IntLit DOTDOT IntLit + = ArrayBound DOTDOT ArrayBound ; ConstRhs @@ -632,10 +632,18 @@ TypeName * index list (ARRAY [L1..H1, L2..H2] OF T) or, equivalently, as nested * single-dimension arrays (ARRAY [L1..H1] OF ARRAY [L2..H2] OF T). The * comma form is desugared by the parser into the nested form, so the two - * are interchangeable. *) + * are interchangeable. + * + * Each bound is a ConstArithExpr — an integer literal, a named integer + * constant, or a compile-time integer expression (e.g. N-1, 2*K). The + * semantic pass resolves the bound text to an integer value. *) ArrayType - = ARRAY LBRACKET IntLit DOTDOT IntLit - { COMMA IntLit DOTDOT IntLit } RBRACKET OF TypeName + = ARRAY LBRACKET ArrayBound DOTDOT ArrayBound + { COMMA ArrayBound DOTDOT ArrayBound } RBRACKET OF TypeName + ; + +ArrayBound + = ConstArithExpr ; DynArrayType diff --git a/docs/language-rationale.adoc b/docs/language-rationale.adoc index 62cb3d1..8610a0d 100644 --- a/docs/language-rationale.adoc +++ b/docs/language-rationale.adoc @@ -4723,3 +4723,46 @@ exactly as bare float literals are stored. (`and`, `or`, `xor`, `shl`, `shr`) have no meaningful float semantics. The `mod` operator could theoretically map to `fmod`, but there is no demonstrated need. Integer-only operators remain available in integer constant expressions. + +== Named Constants as Static-Array Bounds + +=== Decision + +Static-array bounds accept named constants and compile-time integer expressions, +not only integer literals. The following forms are all valid: + +[source,pascal] +---- +const N = 10; +const Lo = 1; +const Hi = 100; +type + TBuf = array[0..N-1] of Byte; { expression as bound } + TArr = array[Lo..Hi] of Integer; { named constants as both bounds } +var + A: array[0..N] of Integer; { named constant as upper bound } +const + Days: array[0..N-1] of string = (...); { const-array declarations too } +---- + +=== Rationale + +Before this change, all array bounds had to be integer literals. This forced +users to duplicate magic numbers and prevented writing self-sizing array types +based on named constants — a fundamental use case in systems programming. + +The parser now reads a constant expression (integer literals, named identifiers, +and the arithmetic operators `+`, `-`, `*`, `div`, `mod`, `shl`, `shr` with +parentheses) as each array bound, embedding the text in the type-name string. +The semantic pass resolves each bound to a concrete integer: plain integers are +converted directly, named constants are looked up in the symbol table, and +expressions are parsed and folded via the existing `EvalConstIntExpr` machinery. + +=== Alternatives considered + +* *Accept only bare named constants, not expressions.* Rejected. `array[0..N-1]` + is the most common idiom; supporting `array[0..N]` but not `array[0..N-1]` + would be a constant source of frustration. +* *Resolve bounds at parse time.* Rejected. The parser runs before the semantic + pass, so named constants are not yet resolved. Deferring to the semantic pass + is the natural point where all constant values are available.