diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index 9cd97f0..9748215 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -293,8 +293,17 @@ type destructor Destroy; override; end; - { 'exit' statement — returns from the current procedure/function. } - TExitStmt = class(TASTStmt); + { 'exit' statement — returns from the current procedure/function. + Value is the Exit(X) function-result shorthand: the parser stores the raw + X here. The semantic pass validates it and builds ResultAssign (a + synthesised 'Result := X'); codegen emits ResultAssign before the exit + jump. Both nil = bare Exit. } + TExitStmt = class(TASTStmt) + public + Value: TASTExpr; { owned; nil = bare exit; raw parsed expr } + ResultAssign: TASTStmt; { owned; synthesised 'Result := Value' (TAssignment) } + destructor Destroy; override; + end; { 'break' statement — exits the innermost loop. } TBreakStmt = class(TASTStmt); @@ -958,6 +967,12 @@ begin inherited Destroy; end; +destructor TExitStmt.Destroy; +begin + { Owned class fields released by ARC field cleanup. } + inherited Destroy; +end; + { TFieldAccessExpr } destructor TFieldAccessExpr.Destroy; @@ -1705,6 +1720,7 @@ var TFS_: TTryFinallyStmt; TES_: TTryExceptStmt; RaS_: TRaiseStmt; + ExS_: TExitStmt; CSS_: TCaseStmt; FAS_: TFieldAssignment; SSA_: TStaticSubscriptAssign; @@ -1797,7 +1813,11 @@ begin Result := RaS_; end else if AStmt is TExitStmt then - Result := TExitStmt.Create + begin + ExS_ := TExitStmt.Create; + ExS_.Value := CloneExpr(TExitStmt(AStmt).Value); + Result := ExS_; + end else if AStmt is TBreakStmt then Result := TBreakStmt.Create else if AStmt is TContinueStmt then diff --git a/compiler/src/main/pascal/uCodeGenQBE.pas b/compiler/src/main/pascal/uCodeGenQBE.pas index 2fed5a5..63afa7c 100644 --- a/compiler/src/main/pascal/uCodeGenQBE.pas +++ b/compiler/src/main/pascal/uCodeGenQBE.pas @@ -1506,8 +1506,11 @@ begin SSubA := TStaticSubscriptAssign(AStmt); CollectAddressTakenExpr(SSubA.IndexExpr, ASet); CollectAddressTakenExpr(SSubA.ValueExpr, ASet); - end; - { TExitStmt, TBreakStmt, TContinueStmt — no expressions to walk } + end + else if (AStmt is TExitStmt) and (TExitStmt(AStmt).ResultAssign <> nil) then + { Exit(X) carries a synthesised 'Result := X' — walk it. } + CollectAddressTakenStmt(TExitStmt(AStmt).ResultAssign, ASet); + { TBreakStmt, TContinueStmt, bare TExitStmt — no expressions to walk } end; function TCodeGenQBE.StmtHasTry(AStmt: TASTStmt): Boolean; @@ -2235,6 +2238,11 @@ begin EmitProcCall(TProcCall(AStmt)) else if AStmt is TExitStmt then begin + { Exit(X) shorthand: emit the synthesised 'Result := X' (built by the + semantic pass) before the return, so the value flows through the normal + assignment path (widening, ARC for string/class returns, etc.). } + if TExitStmt(AStmt).ResultAssign <> nil then + EmitAssignment(TAssignment(TExitStmt(AStmt).ResultAssign)); { Inline frame: Exit jumps to the per-call-site end label, not the caller's exit. No exception unwinding needed because the analyser rejects bodies that contain try frames. } diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index 3ff1db4..7932d2c 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -1851,6 +1851,7 @@ var CastRcv: TASTExpr; FCallNode: TFuncCallExpr; SubAssign: TStaticSubscriptAssign; + ExitS: TExitStmt; begin Result := nil; @@ -1895,10 +1896,20 @@ begin if Check(tkExit) then begin - Result := TExitStmt.Create; - Result.Line := FCurrent.Line; - Result.Col := FCurrent.Col; + ExitS := TExitStmt.Create; + ExitS.Line := FCurrent.Line; + ExitS.Col := FCurrent.Col; Advance; + { Exit(X) shorthand: assign X to Result before returning. Semantic checks + X is assignment-compatible with the return type and that the enclosing + routine is a function (not a procedure). } + if Check(tkLParen) then + begin + Advance; + ExitS.Value := Self.ParseExpr; + Expect(tkRParen); + end; + Result := ExitS; Exit; end; diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 1f7c317..d524d24 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -4077,6 +4077,8 @@ var VarSym: TSymbol; StartType: TTypeDesc; EndType: TTypeDesc; + ResultSym: TSymbol; + ExitAssign: TAssignment; CollType: TTypeDesc; CollRT: TRecordTypeDesc; GetEnumDecl: TMethodDecl; @@ -4416,8 +4418,28 @@ begin end else if AStmt is TExitStmt then begin - { No semantic checks needed — a bare 'exit' is valid in any method or - the main program block. } + { A bare 'exit' is valid in any method or the main program block. The + Exit(X) shorthand assigns X to Result, so it is only valid inside a + function (where Result is in scope). Rewrite it into a synthesised + 'Result := X' (analysed like any assignment, so it inherits all the + type-check / widening / ARC handling) that codegen emits before the + exit jump. } + if TExitStmt(AStmt).Value <> nil then + begin + ResultSym := FTable.Lookup('Result'); + if (ResultSym = nil) or (ResultSym.Kind <> skVariable) then + SemanticError( + '''Exit(Value)'' is only valid inside a function', + AStmt.Line, AStmt.Col); + ExitAssign := TAssignment.Create; + ExitAssign.Line := AStmt.Line; + ExitAssign.Col := AStmt.Col; + ExitAssign.Name := 'Result'; + ExitAssign.Expr := TExitStmt(AStmt).Value; + TExitStmt(AStmt).Value := nil; { ownership moves into the assignment } + AnalyseStmt(ExitAssign); { fills ResolvedLhsType + checks types } + TExitStmt(AStmt).ResultAssign := ExitAssign; + end; end else if AStmt is TBreakStmt then begin diff --git a/compiler/src/test/pascal/cp.test.e2e.controlflow.pas b/compiler/src/test/pascal/cp.test.e2e.controlflow.pas index c29065e..7438556 100644 --- a/compiler/src/test/pascal/cp.test.e2e.controlflow.pas +++ b/compiler/src/test/pascal/cp.test.e2e.controlflow.pas @@ -28,6 +28,7 @@ type procedure TestRun_For_BreakExitsEarly; procedure TestRun_For_ContinueSkipsIteration; procedure TestRun_Nested_For_Loops; + procedure TestRun_ExitValue_ReturnsEarly; end; implementation @@ -50,6 +51,31 @@ const end. '''; + { Exit(X) function-result shorthand — early returns with a value, including + a string return (exercises ARC on the returned value), and a fall-through + case where no Exit(X) fires. } + SrcExitValue = ''' + program P; + function Classify(n: Integer): Integer; + begin + if n < 0 then Exit(-1); + if n = 0 then Exit(0); + Exit(1) + end; + function Pick(b: Boolean): string; + begin + if b then Exit('yes'); + Result := 'no' + end; + begin + WriteLn(Classify(-9)); + WriteLn(Classify(0)); + WriteLn(Classify(42)); + WriteLn(Pick(True)); + WriteLn(Pick(False)) + end. + '''; + SrcForDown = ''' program P; var I: Integer; @@ -181,6 +207,17 @@ begin AssertEquals('nested 2x2', '11' + LE + '12' + LE + '21' + LE + '22' + LE, Output); end; +procedure TE2EControlFlowTests.TestRun_ExitValue_ReturnsEarly; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRun(SrcExitValue, Output, RCode)); + AssertEquals('exit code 0', 0, RCode); + { Classify: -1, 0, 1; Pick: yes (Exit), no (fall-through). } + AssertEquals('exit-value returns', + '-1' + LE + '0' + LE + '1' + LE + 'yes' + LE + 'no' + LE, Output); +end; + initialization RegisterTest(TE2EControlFlowTests); diff --git a/compiler/src/test/pascal/cp.test.flowjumps.pas b/compiler/src/test/pascal/cp.test.flowjumps.pas index e968f7f..34e6047 100644 --- a/compiler/src/test/pascal/cp.test.flowjumps.pas +++ b/compiler/src/test/pascal/cp.test.flowjumps.pas @@ -35,6 +35,13 @@ type procedure TestCodegen_Break_InFor_EmitsJmpToLoopEnd; procedure TestCodegen_Break_InWhile_EmitsJmpToLoopEnd; procedure TestCodegen_Exit_FromFunction_JumpsToFuncExit; + + { Exit(Value) function-result shorthand } + procedure TestParse_ExitValue_AttachesValue; + procedure TestSemantic_ExitValue_InFunction_OK; + procedure TestSemantic_ExitValue_InProcedure_RaisesError; + procedure TestSemantic_ExitValue_TypeMismatch_RaisesError; + procedure TestCodegen_ExitValue_StoresResultThenJumps; end; implementation @@ -140,6 +147,48 @@ const end. '''; + { Exit(X) inside a function — assigns X to Result, then returns. } + SrcExitValueFunc = + ''' + program P; + function Classify(N: Integer): Integer; + begin + if N < 0 then Exit(-1); + Result := 1 + end; + var R: Integer; + begin + R := Classify(-3) + end. + '''; + + { Exit(X) in a procedure — illegal (no Result). } + SrcExitValueProc = + ''' + program P; + procedure DoIt; + begin + Exit(5) + end; + begin + DoIt + end. + '''; + + { Exit(X) where X is not assignment-compatible with the return type. } + SrcExitValueMismatch = + ''' + program P; + function F: Integer; + begin + Exit('text') + end; + var R: Integer; + begin + R := F + end. + '''; + procedure TFlowJumpsTests.TestLexer_Exit_Keyword; var L: TLexer; T: TToken; begin @@ -228,6 +277,60 @@ begin AssertTrue('emits func_exit label', Pos('@func_exit', IR) > 0); end; +{ -------------------------------------------------------------------- } +{ Exit(Value) function-result shorthand } +{ -------------------------------------------------------------------- } + +procedure TFlowJumpsTests.TestParse_ExitValue_AttachesValue; +var Prog: TProgram; MDecl: TMethodDecl; IfS: TIfStmt; ExitS: TExitStmt; +begin + { function Classify: first body statement is the 'if N < 0 then Exit(-1)'. } + Prog := ParseSrc(SrcExitValueFunc); + try + MDecl := TMethodDecl(Prog.Block.ProcDecls[0]); + IfS := TIfStmt(MDecl.Body.Stmts[0]); + AssertTrue('then body is TExitStmt', IfS.ThenStmt is TExitStmt); + ExitS := TExitStmt(IfS.ThenStmt); + AssertNotNull('Exit value attached', ExitS.Value); + finally Prog.Free; end; +end; + +procedure TFlowJumpsTests.TestSemantic_ExitValue_InFunction_OK; +var Prog: TProgram; +begin + { Analyses cleanly and rewrites into a synthesised Result assignment. } + Prog := AnalyseSrc(SrcExitValueFunc); + try + { After analysis, the parsed Value moved into ResultAssign. } + { (Navigation kept light — TestParse covers the shape; here we just + confirm analysis does not raise.) } + finally Prog.Free; end; +end; + +procedure TFlowJumpsTests.TestSemantic_ExitValue_InProcedure_RaisesError; +begin + AnalyseExpectError(SrcExitValueProc); +end; + +procedure TFlowJumpsTests.TestSemantic_ExitValue_TypeMismatch_RaisesError; +begin + AnalyseExpectError(SrcExitValueMismatch); +end; + +procedure TFlowJumpsTests.TestCodegen_ExitValue_StoresResultThenJumps; +var IR: string; StorePos, JmpPos: Integer; +begin + { Exit(-1) lowers to 'Result := -1' (a store into %_var_Result) followed by + the exit jump to @func_exit. } + IR := GenIR(SrcExitValueFunc); + AssertTrue('stores into Result slot', Pos('%_var_Result', IR) > 0); + AssertTrue('jumps to func_exit', Pos('@func_exit', IR) > 0); + { The Result store must precede the exit jump in the first Exit path. } + StorePos := Pos('storew', IR); + JmpPos := Pos('jmp @func_exit', IR); + AssertTrue('store precedes exit jump', (StorePos > 0) and (StorePos < JmpPos)); +end; + initialization RegisterTest(TFlowJumpsTests); diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index c8a0414..62eca1b 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -103,6 +103,7 @@ TRY = "try" ; EXCEPT = "except" ; FINALLY = "finally" ; RAISE = "raise" ; +EXIT = "exit" ; NIL = "nil" ; IS = "is" ; AS = "as" ; @@ -599,6 +600,7 @@ Stmt | TryFinallyStmt | TryExceptStmt | RaiseStmt + | ExitStmt | CompoundStmt | PointerWriteStmt | StaticSubscriptAssign @@ -659,6 +661,14 @@ RaiseStmt = RAISE [ Expr ] ; +(* Exit returns from the current routine. The optional Exit(X) form is the + * function-result shorthand: it assigns X to Result, then returns. X must be + * assignment-compatible with the return type; Exit(X) is only valid inside a + * function (a procedure has no Result). *) +ExitStmt + = EXIT [ LPAREN Expr RPAREN ] + ; + CompoundStmt = BEGIN StmtList END ; diff --git a/docs/language-rationale.adoc b/docs/language-rationale.adoc index 5c6ab1b..cd412bc 100644 --- a/docs/language-rationale.adoc +++ b/docs/language-rationale.adoc @@ -2582,6 +2582,32 @@ for simplicity and ABI predictability. Set types also use `w` for sets with Blaise currently follows FPC's `Result` convention inside functions. No change is planned, but this should be formally documented. +==== `Exit(Value)` function-result shorthand + +Inside a function, `Exit(X)` is shorthand for `Result := X; Exit;` — it assigns +`X` to `Result` and returns immediately. This matches Delphi/FPC and makes +early returns with a value concise: + +[source,pascal] +---- +function Classify(N: Integer): Integer; +begin + if N < 0 then Exit(-1); + if N = 0 then Exit(0); + Result := 1 +end; +---- + +`Exit(X)` is only valid inside a function (a procedure has no `Result`); using +it in a procedure is a semantic error. `X` must be assignment-compatible with +the return type — the same check (and the same widening / ARC handling for +string and class returns) as a direct `Result := X`. + +Implementation: the parser attaches the parsed `X` to the `TExitStmt`; the +semantic pass rewrites it into a synthesised `Result := X` assignment (so it +reuses the full assignment-analysis path) which codegen emits immediately +before the normal exit jump. A bare `Exit` is unchanged. + == Typed Constants === Decision