Compare commits
422 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 6b41c0c418 | |||
| c73668643f | |||
| cb8fd44d6f | |||
| dc46a2dd2d | |||
| 19cdb2f004 | |||
| 76c3ad9835 | |||
| 4daa05efda | |||
| ca1d9b95f7 | |||
| b90d29f2bc | |||
| ef4583c2ae | |||
| ceb6f13833 | |||
| b3ca67428d | |||
| 2cc5e53394 | |||
| 1258f79347 | |||
| 758e4eaa0e | |||
| 629dbc97ca | |||
| 1c6a6fe5a0 | |||
| 1429278765 | |||
| 717a648ad4 | |||
| c58da94128 | |||
| 3c5d51f6a8 | |||
| 1387131f57 | |||
| f35dafeac2 | |||
| 0efce47972 | |||
| a62ba89bca | |||
| a25fec38f8 | |||
| 108b47e059 | |||
| 0d3ccd1c63 | |||
| 8a29cf7f74 | |||
| 4618573d6c | |||
| 60952494c1 | |||
| 51d0b8d9b7 | |||
| 74a5c30ae0 | |||
| 7313848538 | |||
| 3b3966b2f7 | |||
| fb2fc8f6f9 | |||
| da59fbdf3f | |||
| 40ed51aef8 | |||
| 264314cd93 | |||
| 242ec9a56e | |||
| 2a7e6626ad | |||
| 991b998cb1 | |||
| a4afae6f39 | |||
| 8914d59607 | |||
| 700088b5c5 | |||
| 0a7a6ea2d0 | |||
| f1733c41a0 | |||
| 22674b962b | |||
| db74b83e11 | |||
| 2e0db2682f | |||
| 13d8a21de7 | |||
| 2395cb1e70 | |||
| b7d0222ec2 | |||
| d5d71afdaa | |||
| 185f8273dd | |||
| 8b765487ae | |||
| ac96a105a5 | |||
| e7fdbc3312 | |||
| 8960a5683e | |||
| 34b4466a15 | |||
| 8bde31a478 | |||
| 0b015fe4e7 | |||
| 363c9596fc | |||
| 3c7723f3d2 | |||
| f0567a32a1 | |||
| f88fe9f5ef | |||
| 8beb5d95b2 | |||
| e84ecfa2d2 | |||
| 8c60949ec9 | |||
| 18dde168fd | |||
| 3ed5a4011f | |||
| a3f6f4af26 | |||
| 235de7a7c5 | |||
| 5376f8924a | |||
| 76c92fa355 | |||
| f8dc5b945c | |||
| 43afbd6050 | |||
| e56bf7ee7d | |||
| 9a4f477cfd | |||
| 59692bc211 | |||
| d5ec91d9b3 | |||
| 7aa0056799 | |||
| 95de9a155e | |||
| 1d13d0cdaa | |||
| 91c4d57aaf | |||
| f03d250d2b | |||
| e0ceeeb7b0 | |||
| 872c15ac51 | |||
| e40f56eaeb | |||
| 9ed563bcc1 | |||
| a7290550e7 | |||
| 656375de99 | |||
| 68a97e6985 | |||
| 5c738c95bc | |||
| 438baa3609 | |||
| cd0f2ffde3 | |||
| 851f56c63f | |||
| 250f950a68 | |||
| 521d0ac28f | |||
| 0b4201fe9b | |||
| 833ce8aada | |||
| 13b2ef3bf0 | |||
| 65342c99aa | |||
| 874c0d9adf | |||
| aff4cec7d5 | |||
| 0b7a60e338 | |||
| 85ef043b04 | |||
| 0a1df4e9fe | |||
| 4e508d90a5 | |||
| d84509c034 | |||
| 29c36c7ae0 | |||
| c8e0c78e3f | |||
| 2f87444827 | |||
| bcd20df29e | |||
| d334ffdc73 | |||
| 7c761e86e5 | |||
| 738e595f95 | |||
| 30933072a4 | |||
| a052dfb20f | |||
| c5167b8550 | |||
| 240f794211 | |||
| 61b6a1742b | |||
| 58c44079f7 | |||
| ae10f4eee0 | |||
| d0d1053faf | |||
| 3ae1ed8f48 | |||
| 138e7ac454 | |||
| c129c1a3ae | |||
| 8a6c866a9c | |||
| 7aa406f27b | |||
| d849f65f2d | |||
| be5f36e04a | |||
| 93dc19497c | |||
| c16f47c6d5 | |||
| c0f871ce02 | |||
| 4ccf3bb5fd | |||
| 6851f745d4 | |||
| 5003cfd899 | |||
| 1f0eef7698 | |||
| 0915d6d90d | |||
| b98e7d98e6 | |||
| 25984fe61a | |||
| 218bd9f506 | |||
| c0a689d2bc | |||
| 9bd2d6f7ab | |||
| 60358365cd | |||
| edd3e83377 | |||
| 980919525b | |||
| f73c0c67b8 | |||
| d82a75aba6 | |||
| 48ccb23060 | |||
| 2b8a3effed | |||
| 2fd85be923 | |||
| ec76b78b39 | |||
| eb42a4ef3b | |||
| 92cfe94463 | |||
| ea39a57b77 | |||
| 8f29212cba | |||
| 915deb4dc0 | |||
| 734b7b1d5e | |||
| 6826b75c19 | |||
| 4687ecb9ca | |||
| 6ab51816d1 | |||
| 3869c98652 | |||
| df12db2595 | |||
| 957171f089 | |||
| 689dede600 | |||
| 8abec8e98f | |||
| 0526ec8a24 | |||
| 798aa08f02 | |||
| dfe1f04333 | |||
| 1394314a57 | |||
| b0d87fdc69 | |||
| f1735e2678 | |||
| a47cd3f1f4 | |||
| e95a920dc7 | |||
| e379e6694c | |||
| 85f2e02893 | |||
| 5a289492a3 | |||
| 28e4d94b97 | |||
| a706483f28 | |||
| f2d9e1d9b0 | |||
| dd72401ab5 | |||
| 03465e21d2 | |||
| b4a3595ae4 | |||
| e0c4cf7ee4 | |||
| 51265ce945 | |||
| 039a7c4b3e | |||
| 0edb9b800b | |||
| 0d73a13051 | |||
| 54bf350c70 | |||
| 7c48e9e203 | |||
| d9219474e0 | |||
| bb0ecda6be | |||
| fd97799b7b | |||
| d47c1417f5 | |||
| ecbe39abac | |||
| 1fd7fb9da9 | |||
| 1c1bd4cdca | |||
| 1ac605ee57 | |||
| 9010bb1890 | |||
| 4de6bf9bcd | |||
| 18904f17d1 | |||
| 2b34046efc | |||
| 823ea0e8f1 | |||
| e1a46da6f8 | |||
| 624af31243 | |||
| 5a1919ec07 | |||
| 411fd0a3ce | |||
| 46d40cfbca | |||
| 2f2c93d56e | |||
| c573628fe5 | |||
| 8041f7355f | |||
| 36fe827b00 | |||
| 00f5861148 | |||
| 09bd25b318 | |||
| 7621849bfb | |||
| 81dd69bf49 | |||
| e03155179a | |||
| 28558614f0 | |||
| c31985935c | |||
| abbce15362 | |||
| 9be22dea3a | |||
| ef16003971 | |||
| 565742275c | |||
| d12c6c966c | |||
| 5f110e4408 | |||
| 1be9591a61 | |||
| 2c55a120f1 | |||
| 4d380c8f98 | |||
| 0cb6f6e85e | |||
| ea5879520a | |||
| b972b05a07 | |||
| 230c4b51bf | |||
| 5796f88da4 | |||
| 469f2dc1f2 | |||
| f5c7121e26 | |||
| a83d3bf9fc | |||
| 101dbec760 | |||
| 3ad004a895 | |||
| e78ef0a3ea | |||
| c913f9dbc5 | |||
| d731048b41 | |||
| 0f9eb36ab8 | |||
| bdc8886057 | |||
| be6665ad6e | |||
| a36ca2c7e3 | |||
| 17c5b90ecf | |||
| 3c8be92b4a | |||
| d37862186c | |||
| 646ffe92bb | |||
| 695e854cc3 | |||
| 9b359eb75b | |||
| a9cc9633a2 | |||
| 7e4ecb2ff9 | |||
| 6b77391e91 | |||
| f2357a543e | |||
| 100646c7d8 | |||
| edf8329b28 | |||
| 82a7b349b7 | |||
| aa3c218f44 | |||
| 4a8075fecf | |||
| bb74d408da | |||
| c6a71aa8be | |||
| faa447fd91 | |||
| 9c90a92b04 | |||
| de052cab64 | |||
| a5fd079875 | |||
| 48bc763e41 | |||
| 696fb2f9a0 | |||
| 6b9dcee417 | |||
| 3e4ca283c9 | |||
| eb7902d9e8 | |||
| a83bbf4f54 | |||
| 375e64411b | |||
| 3b3d94291d | |||
| d5f2763aa2 | |||
| 7c531c1207 | |||
| d033bd9405 | |||
| f00676a935 | |||
| 59e71b6d7b | |||
| c7a865d12e | |||
| d2c00c6033 | |||
| fa9328a183 | |||
| 5593761551 | |||
| 5451f4fed9 | |||
| 9a5f2c1b1d | |||
| 9419f5cd03 | |||
| 6fcf8c26c8 | |||
| 77d2cb3f92 | |||
| f4b5882080 | |||
| bb0e2fd5af | |||
| 3268748c03 | |||
| afb8f459c6 | |||
| dc4066097c | |||
| 284fb95985 | |||
| 644b3fa8fd | |||
| 3daf55a355 | |||
| 54d470b2f8 | |||
| e9608a746a | |||
| 8e8f139785 | |||
| 769497887f | |||
| 267aef65d8 | |||
| 1ff603bd10 | |||
| c434a151dd | |||
| 262ee8ff69 | |||
| d2f7b01911 | |||
| 5adbe67d0b | |||
| e4681e2bf7 | |||
| b4a5e30b45 | |||
| c0fd594008 | |||
| e329cbe598 | |||
| 947060566d | |||
| 42110e8471 | |||
| c9e28a946d | |||
| ce653c83b1 | |||
| 27f1cc5486 | |||
| 75675b8dc1 | |||
| 1ddc295c9d | |||
| 78e89f345e | |||
| 7842c3bd87 | |||
| ecee8b37bc | |||
| 791f629a10 | |||
| 86001b654f | |||
| 468adcf203 | |||
| aa53a88953 | |||
| 6b18d95570 | |||
| e20e359919 | |||
| b217be6f01 | |||
| ff5b379fde | |||
| 4859c49738 | |||
| 6a114f77c5 | |||
| 7b2446b220 | |||
| b623be13fa | |||
| d1d3393392 | |||
| e6d41260f9 | |||
| c530f2fc0b | |||
| 5b8b475da7 | |||
| bf4ef71cba | |||
| dd50049b06 | |||
| 6010f61953 | |||
| 57319a55c1 | |||
| c203871c9f | |||
| d2c47843a7 | |||
| a896b7fcf0 | |||
| 208006c896 | |||
| 0b891c6def | |||
| b3359a4d73 | |||
| abad66ae52 | |||
| 120c62083e | |||
| 342eb07c42 | |||
| bc75f08477 | |||
| 8ebcd81561 | |||
| 1a07468ad8 | |||
| ce0cba720a | |||
| 3e0628ad57 | |||
| 1a2b6cf8a0 | |||
| 4247fde7cd | |||
| d9a82365d3 | |||
| 6f0b927a05 | |||
| d0ad547aa3 | |||
| 661faba75c | |||
| 87a3a505b1 | |||
| 4d67d9acbe | |||
| 840904e42d | |||
| 6e5c0de876 | |||
| f6fff24f10 | |||
| 9ce608ba09 | |||
| e75cb2ecb3 | |||
| 956c47ba36 | |||
| a06640665a | |||
| 45ff69fd92 | |||
| ce915e503a | |||
| 1b0f93c633 | |||
| 4727db1a01 | |||
| cf17e06e32 | |||
| 021ff61774 | |||
| 487169afe0 | |||
| 644b6074d6 | |||
| 58ce84e567 | |||
| b453236b1e | |||
| 9802c8c924 | |||
| 10b653e16f | |||
| e2a262bc5a | |||
| dce0d83e18 | |||
| e1159e883b | |||
| f791667264 | |||
| 13c41d01b5 | |||
| a65a5f2b0a | |||
| 3797507d95 | |||
| 35413f5966 | |||
| 3048c28fe3 | |||
| 6077d094f7 | |||
| 9022f60376 | |||
| ed8619650c | |||
| fdea3cf26a | |||
| 6ea0f94e36 | |||
| a3da63ad6a | |||
| 6c7cc2569b | |||
| a9aff8c41a | |||
| f81337c98d | |||
| 2c56f6e750 | |||
| bbd9d1752a | |||
| ba8dd7b464 | |||
| 4d67e587ba | |||
| 8ca85473d7 | |||
| 7f6672db24 | |||
| d282d2c40d | |||
| 3cfca1f167 | |||
| b8a530254d | |||
| 7516bd3d9d | |||
| 0e598d595e | |||
| 312be15cc8 | |||
| 776067d0a8 | |||
| 590e98d614 | |||
| 1f02733071 | |||
| 2cdae3d3f6 | |||
| 031b99acc8 | |||
| a6c0c3d6b3 | |||
| e7f381bc46 | |||
| 98de7176c3 | |||
| f70cfe0ec1 |
@@ -81,3 +81,4 @@ __recovery/
|
|||||||
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
|
# Boss dependency manager vendor folder https://github.com/HashLoad/boss
|
||||||
modules/
|
modules/
|
||||||
|
|
||||||
|
.vscode
|
||||||
|
|||||||
File diff suppressed because one or more lines are too long
@@ -0,0 +1,58 @@
|
|||||||
|
program ASTPlayground;
|
||||||
|
|
||||||
|
uses
|
||||||
|
FastMM5,
|
||||||
|
System.StartUpCopy,
|
||||||
|
FMX.Forms,
|
||||||
|
MainForm in 'MainForm.pas' {Form1},
|
||||||
|
Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas',
|
||||||
|
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
|
||||||
|
Myc.Data.Value in 'Myc.Data.Value.pas',
|
||||||
|
Myc.Ast.Visitor in '..\Src\AST\Myc.Ast.Visitor.pas',
|
||||||
|
Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas',
|
||||||
|
Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas',
|
||||||
|
Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.pas',
|
||||||
|
Myc.Utils in '..\Src\Myc.Utils.pas',
|
||||||
|
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
|
||||||
|
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
|
||||||
|
Myc.Data.Keyword in '..\Src\Data\Myc.Data.Keyword.pas',
|
||||||
|
Myc.Ast.Compiler.TCO in '..\Src\AST\Myc.Ast.Compiler.TCO.pas',
|
||||||
|
Myc.Ast.Compiler.Binder in '..\Src\AST\Myc.Ast.Compiler.Binder.pas',
|
||||||
|
Myc.Ast.Compiler.Lowering in '..\Src\AST\Myc.Ast.Compiler.Lowering.pas',
|
||||||
|
Myc.Ast.Compiler.TypeChecker in '..\Src\AST\Myc.Ast.Compiler.TypeChecker.pas',
|
||||||
|
Myc.Ast.Compiler.Macros in '..\Src\AST\Myc.Ast.Compiler.Macros.pas',
|
||||||
|
Myc.Ast.Compiler.Specializer in '..\Src\AST\Myc.Ast.Compiler.Specializer.pas',
|
||||||
|
Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas',
|
||||||
|
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
|
||||||
|
Myc.Ast.Analysis.Purity in '..\Src\AST\Myc.Ast.Analysis.Purity.pas',
|
||||||
|
Myc.Ast.Identities in '..\Src\AST\Myc.Ast.Identities.pas',
|
||||||
|
Myc.Fmx.AstEditor.Visualizer in '..\Src\AST\Myc.Fmx.AstEditor.Visualizer.pas',
|
||||||
|
Myc.Fmx.AstEditor.Workspace in '..\Src\AST\Myc.Fmx.AstEditor.Workspace.pas',
|
||||||
|
Myc.Fmx.AstEditor.Layout in '..\Src\AST\Myc.Fmx.AstEditor.Layout.pas',
|
||||||
|
Myc.Fmx.AstEditor.Node in '..\Src\AST\Myc.Fmx.AstEditor.Node.pas',
|
||||||
|
Myc.Ast.Refactoring.Remove in '..\Src\AST\Myc.Ast.Refactoring.Remove.pas',
|
||||||
|
Myc.Fmx.AstEditor.Render in '..\Src\AST\Myc.Fmx.AstEditor.Render.pas',
|
||||||
|
Myc.Fmx.AstEditor.Handlers.Lists in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Lists.pas',
|
||||||
|
Myc.Fmx.AstEditor.Handlers.Primitives in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Primitives.pas',
|
||||||
|
Myc.Fmx.AstEditor.Handlers.Control in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Control.pas',
|
||||||
|
Myc.Fmx.AstEditor.Handlers.Data in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Data.pas',
|
||||||
|
Myc.Ast.RTL.TypeRegistry in '..\Src\AST\Myc.Ast.RTL.TypeRegistry.pas',
|
||||||
|
Myc.Trade.Broker in '..\Src\Myc.Trade.Broker.pas',
|
||||||
|
Myc.Data.Stream in '..\Src\Data\Myc.Data.Stream.pas',
|
||||||
|
Myc.Fmx.AstEditor.Handlers.Pipes in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas',
|
||||||
|
Demo.Finance in '..\Test\Demo.Finance.pas',
|
||||||
|
Myc.Ast.Script.Print in '..\Src\AST\Myc.Ast.Script.Print.pas',
|
||||||
|
Myc.Ast.Json.Schema.Old in '..\Src\AST\Myc.Ast.Json.Schema.Old.pas',
|
||||||
|
Myc.Ast.Attributes in 'Myc.Ast.Attributes.pas',
|
||||||
|
Myc.Ast.Json.Schema in '..\Src\AST\Myc.Ast.Json.Schema.pas',
|
||||||
|
Myc.Ast.RTL.Math in '..\Src\AST\Myc.Ast.RTL.Math.pas',
|
||||||
|
Myc.Ast.RTL.DateTime in '..\Src\AST\Myc.Ast.RTL.DateTime.pas',
|
||||||
|
Myc.Ast.RTL.Series in '..\Src\AST\Myc.Ast.RTL.Series.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,306 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 883
|
||||||
|
ClientWidth = 1394
|
||||||
|
FormFactor.Width = 320
|
||||||
|
FormFactor.Height = 480
|
||||||
|
FormFactor.Devices = [Desktop]
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
DesignerMasterStyle = 0
|
||||||
|
object Panel1: TPanel
|
||||||
|
Align = MostLeft
|
||||||
|
Size.Width = 129.000000000000000000
|
||||||
|
Size.Height = 883.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 1
|
||||||
|
object Test1Button: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 32.000000000000000000
|
||||||
|
TabOrder = 1
|
||||||
|
Text = 'Test 1'
|
||||||
|
OnClick = Test1ButtonClick
|
||||||
|
end
|
||||||
|
object Test2Button: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 62.000000000000000000
|
||||||
|
TabOrder = 2
|
||||||
|
Text = 'Test 2'
|
||||||
|
OnClick = Test2ButtonClick
|
||||||
|
end
|
||||||
|
object RecursionButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 92.000000000000000000
|
||||||
|
Size.Width = 80.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 3
|
||||||
|
Text = 'Recursion'
|
||||||
|
OnClick = RecursionButtonClick
|
||||||
|
end
|
||||||
|
object ShowScopeBox: TCheckBox
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 452.000000000000000000
|
||||||
|
TabOrder = 4
|
||||||
|
Text = 'Scope'
|
||||||
|
end
|
||||||
|
object FibonacciButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 122.000000000000000000
|
||||||
|
TabOrder = 6
|
||||||
|
Text = 'Fibonacci'
|
||||||
|
OnClick = FibonacciButtonClick
|
||||||
|
end
|
||||||
|
object CrerateTriggerExampleButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 168.000000000000000000
|
||||||
|
TabOrder = 7
|
||||||
|
Text = 'TriggerTest'
|
||||||
|
OnClick = CreateTriggerExampleButtonClick
|
||||||
|
end
|
||||||
|
object DoTriggerButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 198.000000000000000000
|
||||||
|
TabOrder = 8
|
||||||
|
Text = 'Trigger!'
|
||||||
|
OnClick = DoTriggerButtonClick
|
||||||
|
object DoTrigger2Button: TButton
|
||||||
|
Position.Y = 30.000000000000000000
|
||||||
|
TabOrder = 5
|
||||||
|
Text = 'Trigger2'
|
||||||
|
OnClick = DoTrigger2ButtonClick
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object ClearButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 539.000000000000000000
|
||||||
|
Size.Width = 80.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 9
|
||||||
|
Text = 'Clear'
|
||||||
|
OnClick = ClearButtonClick
|
||||||
|
end
|
||||||
|
object SeriesTestButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 258.000000000000000000
|
||||||
|
Size.Width = 80.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 11
|
||||||
|
Text = 'Series'
|
||||||
|
OnClick = SeriesTestButtonClick
|
||||||
|
end
|
||||||
|
object OHLCButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 288.000000000000000000
|
||||||
|
TabOrder = 12
|
||||||
|
Text = 'OHLC'
|
||||||
|
OnClick = OHLCButtonClick
|
||||||
|
end
|
||||||
|
object DebugBox: TCheckBox
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 436.000000000000000000
|
||||||
|
TabOrder = 13
|
||||||
|
Text = 'Debug'
|
||||||
|
OnChange = DebugBoxChange
|
||||||
|
end
|
||||||
|
object FromJSONButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 569.000000000000000000
|
||||||
|
TabOrder = 14
|
||||||
|
Text = 'From JSON'
|
||||||
|
OnClick = FromJSONButtonClick
|
||||||
|
end
|
||||||
|
object ToJSONButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 599.000000000000000000
|
||||||
|
TabOrder = 15
|
||||||
|
Text = 'To JSON'
|
||||||
|
OnClick = ToJSONButtonClick
|
||||||
|
end
|
||||||
|
object ExternalFuncButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 318.000000000000000000
|
||||||
|
TabOrder = 16
|
||||||
|
Text = 'External Func'
|
||||||
|
OnClick = ExternalFuncButtonClick
|
||||||
|
end
|
||||||
|
object InnerLambdaButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 348.000000000000000000
|
||||||
|
TabOrder = 17
|
||||||
|
Text = 'Inner Lambda'
|
||||||
|
OnClick = InnerLambdaButtonClick
|
||||||
|
end
|
||||||
|
object DumpButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 509.000000000000000000
|
||||||
|
TabOrder = 18
|
||||||
|
Text = 'Dump'
|
||||||
|
OnClick = DumpButtonClick
|
||||||
|
end
|
||||||
|
object FailingUpvalueButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 378.000000000000000000
|
||||||
|
TabOrder = 20
|
||||||
|
Text = 'Upvalue'
|
||||||
|
OnClick = FailingUpvalueButtonClick
|
||||||
|
end
|
||||||
|
object TailCallButten: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 406.000000000000000000
|
||||||
|
TabOrder = 21
|
||||||
|
Text = 'Tail calls'
|
||||||
|
OnClick = TailCallButtenClick
|
||||||
|
end
|
||||||
|
object SaveUserLibButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 629.000000000000000000
|
||||||
|
TabOrder = 22
|
||||||
|
Text = 'Save Lib'
|
||||||
|
OnClick = SaveUserLibButtonClick
|
||||||
|
end
|
||||||
|
object LoadUserLibButton: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 659.000000000000000000
|
||||||
|
TabOrder = 23
|
||||||
|
Text = 'LoadLib'
|
||||||
|
OnClick = LoadUserLibButtonClick
|
||||||
|
end
|
||||||
|
object RTLListView: TListView
|
||||||
|
ItemAppearanceClassName = 'TListItemAppearance'
|
||||||
|
ItemEditAppearanceClassName = 'TListItemShowCheckAppearance'
|
||||||
|
HeaderAppearanceClassName = 'TListHeaderObjects'
|
||||||
|
FooterAppearanceClassName = 'TListHeaderObjects'
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
Position.X = 8.000000000000000000
|
||||||
|
Position.Y = 689.000000000000000000
|
||||||
|
Size.Width = 113.000000000000000000
|
||||||
|
Size.Height = 184.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 24
|
||||||
|
OnChange = RTLListViewChange
|
||||||
|
end
|
||||||
|
object SaveTestBtn: TButton
|
||||||
|
Position.X = 24.000000000000000000
|
||||||
|
Position.Y = 479.000000000000000000
|
||||||
|
TabOrder = 26
|
||||||
|
Text = 'Save test'
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Panel2: TPanel
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 784.000000000000000000
|
||||||
|
Size.Height = 609.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 3
|
||||||
|
object CompilerStageBox: TComboBox
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Items.Strings = (
|
||||||
|
'Unbound'
|
||||||
|
'Expanded'
|
||||||
|
'Bound'
|
||||||
|
'Specialized')
|
||||||
|
ItemIndex = 3
|
||||||
|
Position.X = 672.000000000000000000
|
||||||
|
Position.Y = 576.000000000000000000
|
||||||
|
Size.Width = 104.000000000000000000
|
||||||
|
Size.Height = 25.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 0
|
||||||
|
OnChange = CompilerStageBoxChange
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Memo1: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
StyledSettings = [Size, Style, FontColor]
|
||||||
|
TextSettings.Font.Family = 'Consolas'
|
||||||
|
Align = Bottom
|
||||||
|
Position.X = 129.000000000000000000
|
||||||
|
Position.Y = 616.000000000000000000
|
||||||
|
Size.Width = 1265.000000000000000000
|
||||||
|
Size.Height = 267.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 2
|
||||||
|
Viewport.Width = 1261.000000000000000000
|
||||||
|
Viewport.Height = 263.000000000000000000
|
||||||
|
end
|
||||||
|
object Splitter1: TSplitter
|
||||||
|
Align = Bottom
|
||||||
|
Cursor = crVSplit
|
||||||
|
MinSize = 20.000000000000000000
|
||||||
|
Position.X = 129.000000000000000000
|
||||||
|
Position.Y = 609.000000000000000000
|
||||||
|
Size.Width = 1265.000000000000000000
|
||||||
|
Size.Height = 7.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
end
|
||||||
|
object Splitter2: TSplitter
|
||||||
|
Align = Right
|
||||||
|
Cursor = crHSplit
|
||||||
|
MinSize = 20.000000000000000000
|
||||||
|
Position.X = 913.000000000000000000
|
||||||
|
Size.Width = 7.000000000000000000
|
||||||
|
Size.Height = 609.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
end
|
||||||
|
object ScriptMemo: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
Lines.Strings = (
|
||||||
|
'(do'
|
||||||
|
' ;; Broker mit 10.000 Startkapital erstellen'
|
||||||
|
' (def broker (create-broker 10000.0))'
|
||||||
|
' '
|
||||||
|
' ;; Aktien kaufen: 10 St'#252'ck von "AAPL" zu 150.0'
|
||||||
|
' ((.Buy broker) "AAPL" 10 150.0)'
|
||||||
|
' ((.Buy broker) "MSFT" 5 50.0)'
|
||||||
|
' '
|
||||||
|
' ((.ListPositions broker) '
|
||||||
|
' (fn [symbol amount] (print symbol ": " amount)))'
|
||||||
|
')')
|
||||||
|
StyledSettings = [Size, Style, FontColor]
|
||||||
|
TextSettings.Font.Family = 'Consolas'
|
||||||
|
OnChange = ScriptMemoChange
|
||||||
|
OnChangeTracking = ScriptMemoChange
|
||||||
|
Align = Right
|
||||||
|
Position.X = 920.000000000000000000
|
||||||
|
Size.Width = 474.000000000000000000
|
||||||
|
Size.Height = 609.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 6
|
||||||
|
Viewport.Width = 470.000000000000000000
|
||||||
|
Viewport.Height = 605.000000000000000000
|
||||||
|
end
|
||||||
|
object SaveScriptButton: TButton
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
Position.X = 1330.000000000000000000
|
||||||
|
Position.Y = 8.000000000000000000
|
||||||
|
Size.Width = 56.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Save'
|
||||||
|
OnClick = SaveScriptButtonClick
|
||||||
|
end
|
||||||
|
object Timer1: TTimer
|
||||||
|
Interval = 250
|
||||||
|
OnTimer = Timer1Timer
|
||||||
|
Left = 992
|
||||||
|
Top = 216
|
||||||
|
end
|
||||||
|
object WatchLabel: TLabel
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Position.X = 1097.000000000000000000
|
||||||
|
Position.Y = 856.000000000000000000
|
||||||
|
Size.Width = 289.000000000000000000
|
||||||
|
Size.Height = 17.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'watcher: ..............'
|
||||||
|
TabOrder = 9
|
||||||
|
end
|
||||||
|
end
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,32 @@
|
|||||||
|
(do
|
||||||
|
(def med (pipe [[dax [:Close :Open]]]
|
||||||
|
(fn [cs os]
|
||||||
|
(do
|
||||||
|
(def o (get os 0))
|
||||||
|
(def c (get cs 0))
|
||||||
|
(def mm (* 0.5 (+ o c)))
|
||||||
|
{:m mm}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
))
|
||||||
|
|
||||||
|
(def v 0)
|
||||||
|
|
||||||
|
(def xxx (pipe [[dax [:High :Low]] [med [:m]]]
|
||||||
|
(fn [hs ls ms]
|
||||||
|
(do
|
||||||
|
(def h (round (get hs 0)))
|
||||||
|
(def l (round (get ls 0)))
|
||||||
|
(def m (get ms 0))
|
||||||
|
(watch "h=" h " l=" l " m=" m)
|
||||||
|
(assign v (+ v h))
|
||||||
|
{:ah v}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
))
|
||||||
|
|
||||||
|
(pipe [[xxx [:ah]]]
|
||||||
|
(fn [a] (do (print (get a 0)) ...))
|
||||||
|
)
|
||||||
|
|
||||||
|
)
|
||||||
@@ -0,0 +1,578 @@
|
|||||||
|
{
|
||||||
|
"repeat": {
|
||||||
|
"NodeType": "MacroDef",
|
||||||
|
"Name": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "repeat"
|
||||||
|
},
|
||||||
|
"Parameters": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "body"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"Body": {
|
||||||
|
"NodeType": "Quasiquote",
|
||||||
|
"Expression": {
|
||||||
|
"NodeType": "Block",
|
||||||
|
"Expressions": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "VarDecl",
|
||||||
|
"Identifier": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "loop"
|
||||||
|
},
|
||||||
|
"Initializer": {
|
||||||
|
"NodeType": "LambdaExpr",
|
||||||
|
"Parameters": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "counter"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"Body": {
|
||||||
|
"NodeType": "IfExpr",
|
||||||
|
"Condition": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": ">"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "counter"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"ThenBranch": {
|
||||||
|
"NodeType": "Block",
|
||||||
|
"Expressions": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Unquote",
|
||||||
|
"Expression": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "body"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Recur",
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "-"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "counter"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"ElseBranch": {
|
||||||
|
"NodeType": "Block",
|
||||||
|
"Expressions": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "loop"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Unquote",
|
||||||
|
"Expression": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"factorial": {
|
||||||
|
"NodeType": "LambdaExpr",
|
||||||
|
"Parameters": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"Body": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "LambdaExpr",
|
||||||
|
"Parameters": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "acc"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"Body": {
|
||||||
|
"NodeType": "TernaryExpr",
|
||||||
|
"Condition": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "<="
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"ThenBranch": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "acc"
|
||||||
|
},
|
||||||
|
"ElseBranch": {
|
||||||
|
"NodeType": "Recur",
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "-"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "*"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "acc"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "n"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"CreateSMA": {
|
||||||
|
"NodeType": "LambdaExpr",
|
||||||
|
"Parameters": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "len"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"Body": {
|
||||||
|
"NodeType": "Block",
|
||||||
|
"Expressions": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "VarDecl",
|
||||||
|
"Identifier": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
},
|
||||||
|
"Initializer": {
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "VarDecl",
|
||||||
|
"Identifier": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
"Initializer": {
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "LambdaExpr",
|
||||||
|
"Parameters": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "series"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "val"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
},
|
||||||
|
"Body": {
|
||||||
|
"NodeType": "Block",
|
||||||
|
"Expressions": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Assignment",
|
||||||
|
"Identifier": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
},
|
||||||
|
"Value": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "+"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "val"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Assignment",
|
||||||
|
"Identifier": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
"Value": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "+"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Ordinal",
|
||||||
|
"Value": 1
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Assignment",
|
||||||
|
"Identifier": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
},
|
||||||
|
"Value": {
|
||||||
|
"NodeType": "TernaryExpr",
|
||||||
|
"Condition": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": ">"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "len"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"ThenBranch": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "-"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Indexer",
|
||||||
|
"Base": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "series"
|
||||||
|
},
|
||||||
|
"Index": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "-"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "len"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"ElseBranch": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "/"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "sum"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "TernaryExpr",
|
||||||
|
"Condition": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "<"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "len"
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"ThenBranch": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "count"
|
||||||
|
},
|
||||||
|
"ElseBranch": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "len"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"broker": {
|
||||||
|
"NodeType": "FunctionCall",
|
||||||
|
"Callee": {
|
||||||
|
"NodeType": "Identifier",
|
||||||
|
"Name": "create-broker"
|
||||||
|
},
|
||||||
|
"Arguments": {
|
||||||
|
"NodeType": "Tuple",
|
||||||
|
"Elements": [
|
||||||
|
{
|
||||||
|
"NodeType": "Constant",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Scalar",
|
||||||
|
"Value": {
|
||||||
|
"Kind": "Float",
|
||||||
|
"Value": 10000.0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,20 @@
|
|||||||
|
program AuraTrader;
|
||||||
|
|
||||||
|
uses
|
||||||
|
FastMM5,
|
||||||
|
System.StartUpCopy,
|
||||||
|
FMX.Forms,
|
||||||
|
MainForm in 'MainForm.pas' {Form1},
|
||||||
|
TestModule in 'TestModule.pas',
|
||||||
|
DynamicFMXControl in 'DynamicFMXControl.pas',
|
||||||
|
Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas',
|
||||||
|
Myc.Trade.Indicators_v2 in '..\Src\Myc.Trade.Indicators_v2.pas',
|
||||||
|
Strategy2 in 'Strategy2.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,224 @@
|
|||||||
|
<map version="freeplane 1.12.1">
|
||||||
|
<!--To view this file, download free mind mapping software Freeplane from https://www.freeplane.org -->
|
||||||
|
<node TEXT="AuraTrader" LOCALIZED_STYLE_REF="AutomaticLayout.level.root" FOLDED="false" ID="ID_1090958577" CREATED="1409300609620" MODIFIED="1749137964610" VGAP_QUANTITY="3 pt"><hook NAME="MapStyle" background="#d6e8e8ff" zoom="0.826">
|
||||||
|
<properties show_icon_for_attributes="true" edgeColorConfiguration="#808080ff,#ff0000ff,#0000ffff,#00ff00ff,#ff00ffff,#00ffffff,#7c0000ff,#00007cff,#007c00ff,#7c007cff,#007c7cff,#7c7c00ff" show_tags="UNDER_NODES" show_note_icons="true" associatedTemplateLocation="template:/light_sky_element_template.mm" fit_to_viewport="false" show_icons="BESIDE_NODES" showTagCategories="false"/>
|
||||||
|
<tags category_separator="::"/>
|
||||||
|
|
||||||
|
<map_styles>
|
||||||
|
<stylenode LOCALIZED_TEXT="styles.root_node" STYLE="oval" UNIFORM_SHAPE="true" VGAP_QUANTITY="24 pt">
|
||||||
|
<font SIZE="24"/>
|
||||||
|
<stylenode LOCALIZED_TEXT="styles.predefined" POSITION="bottom_or_right" STYLE="bubble">
|
||||||
|
<stylenode LOCALIZED_TEXT="default" ID="ID_4172522" ICON_SIZE="12 pt" FORMAT_AS_HYPERLINK="false" COLOR="#051552" BACKGROUND_COLOR="#5cd5e8" STYLE="bubble" SHAPE_HORIZONTAL_MARGIN="8 pt" SHAPE_VERTICAL_MARGIN="5 pt" BORDER_WIDTH_LIKE_EDGE="false" BORDER_WIDTH="1.7 px" BORDER_COLOR_LIKE_EDGE="false" BORDER_COLOR="#1164b0" BORDER_DASH_LIKE_EDGE="true" BORDER_DASH="SOLID" VGAP_QUANTITY="3 pt">
|
||||||
|
<arrowlink SHAPE="CUBIC_CURVE" COLOR="#000000" WIDTH="2" TRANSPARENCY="200" DASH="" FONT_SIZE="9" FONT_FAMILY="SansSerif" DESTINATION="ID_4172522" STARTINCLINATION="116.25 pt;0 pt;" ENDINCLINATION="116.25 pt;28.5 pt;" STARTARROW="NONE" ENDARROW="DEFAULT"/>
|
||||||
|
<font NAME="SansSerif" SIZE="10" BOLD="false" STRIKETHROUGH="false" ITALIC="false"/>
|
||||||
|
<edge STYLE="bezier" COLOR="#051552" WIDTH="2" DASH="SOLID"/>
|
||||||
|
<richcontent TYPE="DETAILS" CONTENT-TYPE="plain/auto"/>
|
||||||
|
<richcontent TYPE="NOTE" CONTENT-TYPE="plain/auto"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="defaultstyle.details" COLOR="#fff024" BACKGROUND_COLOR="#000000"/>
|
||||||
|
<stylenode LOCALIZED_TEXT="defaultstyle.tags">
|
||||||
|
<font SIZE="10"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="defaultstyle.attributes">
|
||||||
|
<font SIZE="9"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="defaultstyle.note" COLOR="#000000" BACKGROUND_COLOR="#f6f9a1" TEXT_ALIGN="LEFT">
|
||||||
|
<icon BUILTIN="clock2"/>
|
||||||
|
<font SIZE="10" ITALIC="true"/>
|
||||||
|
<edge COLOR="#000000"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="defaultstyle.floating">
|
||||||
|
<edge STYLE="hide_edge"/>
|
||||||
|
<cloud COLOR="#f0f0f0" SHAPE="ROUND_RECT"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="defaultstyle.selection" COLOR="#ffffff" BACKGROUND_COLOR="#cc7212" BORDER_COLOR_LIKE_EDGE="false" BORDER_COLOR="#1164b0"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="styles.user-defined" POSITION="bottom_or_right" STYLE="bubble">
|
||||||
|
<stylenode LOCALIZED_TEXT="styles.important" ID="ID_1823054225" COLOR="#fff024" BORDER_COLOR_LIKE_EDGE="false" BORDER_COLOR="#9d5e19">
|
||||||
|
<icon BUILTIN="yes"/>
|
||||||
|
<arrowlink COLOR="#9d5e19" TRANSPARENCY="255" DESTINATION="ID_1823054225"/>
|
||||||
|
<font SIZE="11" BOLD="true"/>
|
||||||
|
<edge COLOR="#9d5e19"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="styles.flower" COLOR="#ffffff" BACKGROUND_COLOR="#255aba" STYLE="oval" TEXT_ALIGN="CENTER" BORDER_WIDTH_LIKE_EDGE="false" BORDER_WIDTH="22 pt" BORDER_COLOR_LIKE_EDGE="false" BORDER_COLOR="#f9d71c" BORDER_DASH_LIKE_EDGE="false" BORDER_DASH="CLOSE_DOTS" MAX_WIDTH="6 cm" MIN_WIDTH="3 cm"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="styles.AutomaticLayout" POSITION="bottom_or_right" STYLE="bubble">
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level.root" COLOR="#ffffff" BACKGROUND_COLOR="#053d8b" STYLE="bubble" SHAPE_HORIZONTAL_MARGIN="10 pt" SHAPE_VERTICAL_MARGIN="10 pt" BORDER_COLOR_LIKE_EDGE="false" BORDER_COLOR="#2c2b29" BORDER_DASH_LIKE_EDGE="true">
|
||||||
|
<font SIZE="18"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,1" COLOR="#ffffff" BACKGROUND_COLOR="#1164b0" STYLE="bubble" SHAPE_HORIZONTAL_MARGIN="8 pt" SHAPE_VERTICAL_MARGIN="5 pt" BORDER_COLOR="#2c2b29">
|
||||||
|
<font SIZE="16"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,2" COLOR="#ffffff" BACKGROUND_COLOR="#298bc8" STYLE="bubble" SHAPE_HORIZONTAL_MARGIN="8 pt" SHAPE_VERTICAL_MARGIN="5 pt" BORDER_COLOR_LIKE_EDGE="true" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="14"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,3" COLOR="#ffffff" BACKGROUND_COLOR="#3fb7db" STYLE="bubble" SHAPE_HORIZONTAL_MARGIN="8 pt" SHAPE_VERTICAL_MARGIN="5 pt" BORDER_COLOR_LIKE_EDGE="true" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="12"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,4" COLOR="#051552" BACKGROUND_COLOR="#5cd5e8" BORDER_COLOR_LIKE_EDGE="true" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="11"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,5" BORDER_COLOR_LIKE_EDGE="true" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="11"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,6" BORDER_COLOR_LIKE_EDGE="true" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="10"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,7" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="10"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,8" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="10"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,9" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="10"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,10" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="9"/>
|
||||||
|
</stylenode>
|
||||||
|
<stylenode LOCALIZED_TEXT="AutomaticLayout.level,11" BORDER_COLOR="#f0f0f0">
|
||||||
|
<font SIZE="9"/>
|
||||||
|
</stylenode>
|
||||||
|
</stylenode>
|
||||||
|
</stylenode>
|
||||||
|
</map_styles>
|
||||||
|
</hook>
|
||||||
|
<hook NAME="accessories/plugins/AutomaticLayout.properties" VALUE="ALL"/>
|
||||||
|
<font BOLD="true"/>
|
||||||
|
<node TEXT="Konzept" POSITION="bottom_or_right" ID="ID_351347589" CREATED="1749138140790" MODIFIED="1749138143372">
|
||||||
|
<node TEXT="Graph" ID="ID_1387256995" CREATED="1749138153896" MODIFIED="1749138171293">
|
||||||
|
<node TEXT="Node" ID="ID_259083893" CREATED="1749197003119" MODIFIED="1749197028434">
|
||||||
|
<node TEXT="Hat eine Signatur" POSITION="bottom_or_right" ID="ID_1518342419" CREATED="1749138332065" MODIFIED="1749198016791">
|
||||||
|
<node TEXT="Eingänge" ID="ID_225862940" CREATED="1749198017375" MODIFIED="1749198021478">
|
||||||
|
<node TEXT="Lazy<T>" ID="ID_1288547800" CREATED="1749198026579" MODIFIED="1749198040009"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Ausgänge" ID="ID_661812861" CREATED="1749198022539" MODIFIED="1749198024513">
|
||||||
|
<node TEXT="Mutable<T>" ID="ID_1005406898" CREATED="1749198042405" MODIFIED="1749198082198"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Caption" POSITION="bottom_or_right" ID="ID_1196798317" CREATED="1749197994222" MODIFIED="1749197997264"/>
|
||||||
|
<node TEXT="Grafische Repräsentation" POSITION="bottom_or_right" ID="ID_1686858497" CREATED="1749198609593" MODIFIED="1749198635728"/>
|
||||||
|
<node TEXT="Jeder Node ist eine Factory" POSITION="bottom_or_right" ID="ID_1175294085" CREATED="1749199661343" MODIFIED="1749199751197">
|
||||||
|
<node TEXT="Die eigentliche Komponente wird erst beim Init der Strategie erzeugt" ID="ID_691361700" CREATED="1749199752043" MODIFIED="1749199765349"/>
|
||||||
|
<node TEXT="So ist es möglich, dass z.B. ein Chart mit mehreren Eingängen verknüpft wird" ID="ID_1680171724" CREATED="1749199770731" MODIFIED="1749199814332"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="abstract templates" ID="ID_1144603697" CREATED="1749197934224" MODIFIED="1749197953583">
|
||||||
|
<node TEXT="DataServer" POSITION="bottom_or_right" ID="ID_291421820" CREATED="1749138179173" MODIFIED="1749202649741">
|
||||||
|
<node TEXT="Können Preisdaten aus beliebigen Quellen sammeln und stellen sie als Stream zur verfügung" ID="ID_827558062" CREATED="1749138204738" MODIFIED="1749138284430"/>
|
||||||
|
<node TEXT="Können sowohl Live- als auch historische Daten liefern" ID="ID_896603589" CREATED="1749193159987" MODIFIED="1749193216833">
|
||||||
|
<node TEXT="Für den Consumer darf das (eigentlich) nicht transparent sein" ID="ID_554512865" CREATED="1749193217206" MODIFIED="1749196862117"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Signatur" ID="ID_1267368219" CREATED="1749195431793" MODIFIED="1749195436151">
|
||||||
|
<node TEXT="Keine Eingänge!" POSITION="bottom_or_right" ID="ID_65784960" CREATED="1749200853295" MODIFIED="1749200862455">
|
||||||
|
<node TEXT="Registriert sich als IDataProvider und publiziert so seine Fetch-Routine" POSITION="bottom_or_right" ID="ID_351312947" CREATED="1749200902001" MODIFIED="1749200934037"/>
|
||||||
|
<node TEXT="Fetch - signalisiert, dass neue Daten abgerufen werden können" POSITION="bottom_or_right" ID="ID_1521536523" CREATED="1749193885863" MODIFIED="1749194845452">
|
||||||
|
<node TEXT="Live" ID="ID_1178415156" CREATED="1749196109094" MODIFIED="1749196123441">
|
||||||
|
<node TEXT="Asynchron Daten von der externen Quelle abrufen" ID="ID_26813979" CREATED="1749196129271" MODIFIED="1749201012068"/>
|
||||||
|
<node TEXT="Es werden nach einem Fetch immer alle bis dahin enfangenen Daten verarbeitet" ID="ID_1279384359" CREATED="1749196364669" MODIFIED="1749196388802"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Backtest" ID="ID_1462183661" CREATED="1749196123907" MODIFIED="1749196127688">
|
||||||
|
<node TEXT="Einlesen der historischen Daten aus lokaler Quelle" ID="ID_766072914" CREATED="1749196215155" MODIFIED="1749196299263"/>
|
||||||
|
<node TEXT="Wie viele Daten sollen hier gelesen werden?" ID="ID_955008466" CREATED="1749196316474" MODIFIED="1749196340955">
|
||||||
|
<node TEXT="Der Backtest könnte theoretisch alle Daten in einem Fetch liefern" ID="ID_783811796" CREATED="1749196423022" MODIFIED="1749196468608"/>
|
||||||
|
<node TEXT="Stattdessen sollen "sinnvolle" Häppchen geliefert werden" ID="ID_1420632589" CREATED="1749196470465" MODIFIED="1749196493915"/>
|
||||||
|
<node TEXT="Z.B. in dem die Timestamps der Daten analysiert werden." ID="ID_994363528" CREATED="1749196495078" MODIFIED="1749196523145">
|
||||||
|
<node TEXT="Ticks die sehr schnell nacheinender kommen, könnten zusammengefasst werden." ID="ID_262920625" CREATED="1749196523651" MODIFIED="1749196546182"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Ausgang" POSITION="bottom_or_right" ID="ID_354621746" CREATED="1749193952447" MODIFIED="1749193957977">
|
||||||
|
<node TEXT="Array" ID="ID_1992679898" CREATED="1749196558592" MODIFIED="1749196561177">
|
||||||
|
<node TEXT="Enthält alle Datenpunkte, die seit dem letzten Durchlauf empfangen wurden" POSITION="bottom_or_right" ID="ID_1560263964" CREATED="1749194019659" MODIFIED="1749196612914"/>
|
||||||
|
<node TEXT="Datenpunkt" ID="ID_1319987980" CREATED="1749196616408" MODIFIED="1749196620117">
|
||||||
|
<node TEXT="Index seit Start der Strategy" POSITION="bottom_or_right" ID="ID_1416903711" CREATED="1749194191668" MODIFIED="1749194208147"/>
|
||||||
|
<node TEXT="Index seit dem letzten Session Break (wenn die Datenquelle das unterstützt)" POSITION="bottom_or_right" ID="ID_1894209537" CREATED="1749194208989" MODIFIED="1749194250436"/>
|
||||||
|
<node TEXT="Daten" ID="ID_508077608" CREATED="1749196736643" MODIFIED="1749196745736">
|
||||||
|
<node TEXT="Timestamp" POSITION="bottom_or_right" ID="ID_1600370587" CREATED="1749195711666" MODIFIED="1749195717838"/>
|
||||||
|
<node TEXT="Volume" POSITION="bottom_or_right" ID="ID_719731480" CREATED="1749196709681" MODIFIED="1749196711684"/>
|
||||||
|
<node TEXT="abstrakt" POSITION="bottom_or_right" ID="ID_1867165552" CREATED="1749196643858" MODIFIED="1749196675549">
|
||||||
|
<node TEXT="OHLC" POSITION="bottom_or_right" ID="ID_400927533" CREATED="1749195379156" MODIFIED="1749196820207"/>
|
||||||
|
<node TEXT="Tick" POSITION="bottom_or_right" ID="ID_1133389846" CREATED="1749195375327" MODIFIED="1749196821669">
|
||||||
|
<node TEXT="Ask-Bid" POSITION="bottom_or_right" ID="ID_127401459" CREATED="1749194269527" MODIFIED="1749196722182"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="IsLiveData" ID="ID_1043765011" CREATED="1749196881074" MODIFIED="1749196892932"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Trader" POSITION="bottom_or_right" ID="ID_1544725450" CREATED="1749197183355" MODIFIED="1749197191427">
|
||||||
|
<node TEXT="Implementiert, wie mit Signalen umgegangen wird" ID="ID_102160159" CREATED="1749197357878" MODIFIED="1749197388131"/>
|
||||||
|
<node TEXT="Signatur" ID="ID_1668381928" CREATED="1749198186867" MODIFIED="1749198190179">
|
||||||
|
<node TEXT="Eingang" POSITION="bottom_or_right" ID="ID_967519634" CREATED="1749197096963" MODIFIED="1749197103083">
|
||||||
|
<node TEXT="Buy-Signal" ID="ID_1120078634" CREATED="1749197103978" MODIFIED="1749197398085"/>
|
||||||
|
<node TEXT="Sell-Signal" ID="ID_1074440473" CREATED="1749197140015" MODIFIED="1749197402441"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Ausgang" POSITION="bottom_or_right" ID="ID_1984669993" CREATED="1749197229378" MODIFIED="1749197231751">
|
||||||
|
<node TEXT="Orders" ID="ID_84017955" CREATED="1749197256250" MODIFIED="1749197267082"/>
|
||||||
|
<node TEXT="Positions" ID="ID_106757702" CREATED="1749197270413" MODIFIED="1749197273907">
|
||||||
|
<node TEXT="Deals" ID="ID_1873504915" CREATED="1749197303336" MODIFIED="1749197305157"/>
|
||||||
|
<node TEXT="IsOpen" ID="ID_111000501" CREATED="1749197318276" MODIFIED="1749197322652"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Indicator" ID="ID_1041206949" CREATED="1749198254012" MODIFIED="1749198258932">
|
||||||
|
<node TEXT="Frei programmierbare Module" ID="ID_1046851781" CREATED="1749198260161" MODIFIED="1749198292019"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Diagramme" ID="ID_1728273110" CREATED="1749198882498" MODIFIED="1749199486967">
|
||||||
|
<node TEXT="abstract" POSITION="bottom_or_right" ID="ID_1648724212" CREATED="1749198794903" MODIFIED="1749198800455">
|
||||||
|
<node TEXT="Tick-Chart" ID="ID_1017072631" CREATED="1749198800457" MODIFIED="1749198831938"/>
|
||||||
|
<node TEXT="OHLC-Chart" ID="ID_629656972" CREATED="1749198805040" MODIFIED="1749198837689"/>
|
||||||
|
<node TEXT="Histogram" ID="ID_34977684" CREATED="1749198841247" MODIFIED="1749199015989"/>
|
||||||
|
<node TEXT="Diagram" ID="ID_840651195" CREATED="1749199016656" MODIFIED="1749199108308"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Draw-Plane mit X/Y Achse" ID="ID_587693864" CREATED="1749198904253" MODIFIED="1749199081316"/>
|
||||||
|
<node TEXT="Charts" ID="ID_382545852" CREATED="1749199466839" MODIFIED="1749199491297">
|
||||||
|
<node TEXT="Eingang" POSITION="bottom_or_right" ID="ID_1587680882" CREATED="1749199129247" MODIFIED="1749199394732">
|
||||||
|
<node TEXT="Klar definierte Dateneingänge" ID="ID_548619408" CREATED="1749199135233" MODIFIED="1749199152222">
|
||||||
|
<node TEXT="z.B. TickData für Tick-Chart" ID="ID_383484888" CREATED="1749199152224" MODIFIED="1749199163416"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Eingänge dynamisch erzeugen." ID="ID_710689831" CREATED="1749199168396" MODIFIED="1749199223960">
|
||||||
|
<node TEXT="z.B. ein EMA auf einem OHLC-Chart" ID="ID_288893788" CREATED="1749199223961" MODIFIED="1749199254594">
|
||||||
|
<node TEXT="Ausgang des EMA liefert nur einen Wert" ID="ID_1879052051" CREATED="1749199255287" MODIFIED="1749199283462"/>
|
||||||
|
<node TEXT="Muss über einen im Chart-Node definierbaren Eingang verknüpft werden" ID="ID_1048634781" CREATED="1749199285281" MODIFIED="1749199324815">
|
||||||
|
<node TEXT="Definiert den Style des EMA" ID="ID_1401266298" CREATED="1749199343035" MODIFIED="1749199359978"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="AddChartInput()" ID="ID_851859706" CREATED="1749199909158" MODIFIED="1749200050028">
|
||||||
|
<node TEXT="Liefert einen neuen Eingang mit eigenen Style-Parametern" ID="ID_1326484717" CREATED="1749200057661" MODIFIED="1749200088602"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Ausgang" POSITION="bottom_or_right" ID="ID_1838167422" CREATED="1749199387596" MODIFIED="1749199390976">
|
||||||
|
<node TEXT="Sichtbarer Datenbereich" ID="ID_149531054" CREATED="1749199425386" MODIFIED="1749199530548">
|
||||||
|
<node TEXT="Damit können andere Diagramme ihren Sichtbereich an den Chart anpassen." ID="ID_21321688" CREATED="1749199531020" MODIFIED="1749199559573"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Last Value" ID="ID_179046743" CREATED="1749199567850" MODIFIED="1749199578133"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Histogram" ID="ID_1926471247" CREATED="1749199595197" MODIFIED="1749199599389"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Chart" ID="ID_1485297910" CREATED="1749198734818" MODIFIED="1749198738034">
|
||||||
|
<node TEXT="Tick" ID="ID_1989326003" CREATED="1749198752908" MODIFIED="1749198768413">
|
||||||
|
<node TEXT="" ID="ID_276822419" CREATED="1749198770321" MODIFIED="1749198770321"/>
|
||||||
|
</node>
|
||||||
|
<node TEXT="OHLC" ID="ID_1040780755" CREATED="1749198757224" MODIFIED="1749198762424"/>
|
||||||
|
<node TEXT="Eingang" ID="ID_1311557583" CREATED="1749198785094" MODIFIED="1749198793621"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
<node TEXT="Broker" POSITION="bottom_or_right" ID="ID_1666096793" CREATED="1749138364769" MODIFIED="1749138404806">
|
||||||
|
<node TEXT="Order- und Positionsmanagement" ID="ID_982862918" CREATED="1749138407782" MODIFIED="1749138443566"/>
|
||||||
|
<node TEXT="Reduziert auf das absolute Minimum" ID="ID_620096980" CREATED="1749138462663" MODIFIED="1749138472587"/>
|
||||||
|
<node TEXT="Plazieren von Limit- und Market-Orders" ID="ID_325256813" CREATED="1749138473278" MODIFIED="1749138498552"/>
|
||||||
|
<node TEXT="Verschiedene Ausführungsmodelle" ID="ID_1368393579" CREATED="1749138525992" MODIFIED="1749138537994"/>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</node>
|
||||||
|
</map>
|
||||||
Binary file not shown.
@@ -0,0 +1,387 @@
|
|||||||
|
unit DynamicFMXControl;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Types,
|
||||||
|
System.UITypes,
|
||||||
|
System.Classes,
|
||||||
|
FMX.Controls,
|
||||||
|
FMX.Graphics,
|
||||||
|
FMX.Forms,
|
||||||
|
FMX.StdCtrls,
|
||||||
|
FMX.Types;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Dezidierte Event-Typen für virtuelle Methoden von TControl
|
||||||
|
TControlPaintEvent = reference to procedure;
|
||||||
|
TControlMouseEvent = reference to procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||||
|
TControlMouseMoveEvent = reference to procedure(Shift: TShiftState; X, Y: Single);
|
||||||
|
TControlMouseWheelEvent = reference to procedure(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||||
|
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||||
|
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
|
||||||
|
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||||
|
TControlNotifyEvent = reference to procedure;
|
||||||
|
TControlCanFocusEvent = reference to function: Boolean;
|
||||||
|
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
|
||||||
|
TControlSetHintEvent = reference to procedure(const AHint: string);
|
||||||
|
TControlGetHintStringEvent = reference to function: string;
|
||||||
|
TControlHasHintEvent = reference to function: Boolean;
|
||||||
|
TControlCanShowHintEvent = reference to function: Boolean;
|
||||||
|
TControlGetDefaultSizeEvent = reference to function: TSizeF;
|
||||||
|
TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
|
||||||
|
TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
|
||||||
|
TControlDoAbsoluteChangedEvent = reference to procedure;
|
||||||
|
|
||||||
|
TDynamicControl = class(TControl)
|
||||||
|
private
|
||||||
|
// Private Felder für die Event-Handler
|
||||||
|
FPaintEvent: TControlPaintEvent;
|
||||||
|
FMouseDownEvent: TControlMouseEvent;
|
||||||
|
FMouseUpEvent: TControlMouseEvent;
|
||||||
|
FMouseMoveEvent: TControlMouseMoveEvent;
|
||||||
|
FMouseWheelEvent: TControlMouseWheelEvent;
|
||||||
|
FKeyDownEvent: TControlKeyEvent;
|
||||||
|
FKeyUpEvent: TControlKeyEvent;
|
||||||
|
FClickEvent: TControlNotifyEvent;
|
||||||
|
FDblClickEvent: TControlNotifyEvent;
|
||||||
|
FDragEnterEvent: TControlDragEvent;
|
||||||
|
FDragOverEvent: TControlDragOverEvent;
|
||||||
|
FDragDropEvent: TControlDragEvent;
|
||||||
|
FDragLeaveEvent: TControlNotifyEvent;
|
||||||
|
FDragEndEvent: TControlNotifyEvent;
|
||||||
|
FEnterEvent: TControlNotifyEvent;
|
||||||
|
FExitEvent: TControlNotifyEvent;
|
||||||
|
FMouseEnterEvent: TControlNotifyEvent;
|
||||||
|
FMouseLeaveEvent: TControlNotifyEvent;
|
||||||
|
FResizeEvent: TControlNotifyEvent;
|
||||||
|
FResizedEvent: TControlNotifyEvent;
|
||||||
|
FCanFocusEvent: TControlCanFocusEvent;
|
||||||
|
FShowContextMenuEvent: TControlShowContextMenuEvent;
|
||||||
|
FSetHintEvent: TControlSetHintEvent;
|
||||||
|
FGetHintStringEvent: TControlGetHintStringEvent;
|
||||||
|
FHasHintEvent: TControlHasHintEvent;
|
||||||
|
FCanShowHintEvent: TControlCanShowHintEvent;
|
||||||
|
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
|
||||||
|
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
|
||||||
|
FSetVisibleEvent: TControlSetVisibleEvent;
|
||||||
|
FSetEnabledEvent: TControlSetEnabledEvent;
|
||||||
|
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
|
||||||
|
|
||||||
|
protected
|
||||||
|
// Überschriebene virtuelle Methoden, die die Events auslösen
|
||||||
|
procedure Paint; override;
|
||||||
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||||
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||||
|
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
||||||
|
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||||
|
procedure Click; override;
|
||||||
|
procedure DblClick; override;
|
||||||
|
procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||||
|
procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||||
|
procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
|
||||||
|
procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
|
||||||
|
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
|
||||||
|
procedure DragLeave; override;
|
||||||
|
procedure DragEnd; override;
|
||||||
|
procedure DoEnter; override;
|
||||||
|
procedure DoExit; override;
|
||||||
|
procedure DoMouseEnter; override;
|
||||||
|
procedure DoMouseLeave; override;
|
||||||
|
procedure Resize; override;
|
||||||
|
procedure DoResized; override;
|
||||||
|
function GetCanFocus: Boolean; override;
|
||||||
|
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
|
||||||
|
procedure SetHint(const AHint: string); override;
|
||||||
|
function GetHintString: string; override;
|
||||||
|
function HasHint: Boolean; override;
|
||||||
|
function CanShowHint: Boolean; override;
|
||||||
|
function GetDefaultSize: TSizeF; override;
|
||||||
|
procedure RecalculateAbsoluteMatrices; override;
|
||||||
|
procedure SetVisible(const Value: Boolean); override;
|
||||||
|
procedure SetEnabled(const Value: Boolean); override;
|
||||||
|
procedure DoAbsoluteChanged; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
|
||||||
|
// Public Properties, die die Events exponieren
|
||||||
|
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
|
||||||
|
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
|
||||||
|
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
|
||||||
|
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
|
||||||
|
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
|
||||||
|
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
|
||||||
|
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
|
||||||
|
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
|
||||||
|
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
|
||||||
|
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
|
||||||
|
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
|
||||||
|
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
|
||||||
|
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
|
||||||
|
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
|
||||||
|
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
|
||||||
|
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
|
||||||
|
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
|
||||||
|
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
|
||||||
|
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
|
||||||
|
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
|
||||||
|
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
|
||||||
|
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
|
||||||
|
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
|
||||||
|
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
|
||||||
|
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
|
||||||
|
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
|
||||||
|
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
|
||||||
|
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent
|
||||||
|
read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
|
||||||
|
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
|
||||||
|
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
|
||||||
|
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TDynamicControl }
|
||||||
|
|
||||||
|
constructor TDynamicControl.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
Width := 150;
|
||||||
|
Height := 100;
|
||||||
|
HitTest := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDynamicControl.CanShowHint: Boolean;
|
||||||
|
begin
|
||||||
|
if Assigned(FCanShowHintEvent) then
|
||||||
|
Result := FCanShowHintEvent
|
||||||
|
else
|
||||||
|
Result := inherited CanShowHint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.Click;
|
||||||
|
begin
|
||||||
|
inherited Click;
|
||||||
|
if Assigned(FClickEvent) then
|
||||||
|
FClickEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DblClick;
|
||||||
|
begin
|
||||||
|
inherited DblClick;
|
||||||
|
if Assigned(FDblClickEvent) then
|
||||||
|
FDblClickEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DoAbsoluteChanged;
|
||||||
|
begin
|
||||||
|
inherited DoAbsoluteChanged;
|
||||||
|
if Assigned(FDoAbsoluteChangedEvent) then
|
||||||
|
FDoAbsoluteChangedEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DragDrop(const Data: TDragObject; const Point: TPointF);
|
||||||
|
begin
|
||||||
|
inherited DragDrop(Data, Point);
|
||||||
|
if Assigned(FDragDropEvent) then
|
||||||
|
FDragDropEvent(Data, Point);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DragEnd;
|
||||||
|
begin
|
||||||
|
inherited DragEnd;
|
||||||
|
if Assigned(FDragEndEvent) then
|
||||||
|
FDragEndEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DragEnter(const Data: TDragObject; const Point: TPointF);
|
||||||
|
begin
|
||||||
|
inherited DragEnter(Data, Point);
|
||||||
|
if Assigned(FDragEnterEvent) then
|
||||||
|
FDragEnterEvent(Data, Point);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DragLeave;
|
||||||
|
begin
|
||||||
|
inherited DragLeave;
|
||||||
|
if Assigned(FDragLeaveEvent) then
|
||||||
|
FDragLeaveEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||||
|
begin
|
||||||
|
inherited DragOver(Data, Point, Operation);
|
||||||
|
if Assigned(FDragOverEvent) then
|
||||||
|
FDragOverEvent(Data, Point, Operation);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DoEnter;
|
||||||
|
begin
|
||||||
|
inherited DoEnter;
|
||||||
|
if Assigned(FEnterEvent) then
|
||||||
|
FEnterEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DoExit;
|
||||||
|
begin
|
||||||
|
inherited DoExit;
|
||||||
|
if Assigned(FExitEvent) then
|
||||||
|
FExitEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DoMouseEnter;
|
||||||
|
begin
|
||||||
|
inherited DoMouseEnter;
|
||||||
|
if Assigned(FMouseEnterEvent) then
|
||||||
|
FMouseEnterEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DoMouseLeave;
|
||||||
|
begin
|
||||||
|
inherited DoMouseLeave;
|
||||||
|
if Assigned(FMouseLeaveEvent) then
|
||||||
|
FMouseLeaveEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.DoResized;
|
||||||
|
begin
|
||||||
|
inherited DoResized;
|
||||||
|
if Assigned(FResizedEvent) then
|
||||||
|
FResizedEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDynamicControl.GetCanFocus: Boolean;
|
||||||
|
begin
|
||||||
|
if Assigned(FCanFocusEvent) then
|
||||||
|
Result := FCanFocusEvent
|
||||||
|
else
|
||||||
|
Result := inherited GetCanFocus;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDynamicControl.GetDefaultSize: TSizeF;
|
||||||
|
begin
|
||||||
|
if Assigned(FGetDefaultSizeEvent) then
|
||||||
|
Result := FGetDefaultSizeEvent
|
||||||
|
else
|
||||||
|
Result := inherited GetDefaultSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDynamicControl.GetHintString: string;
|
||||||
|
begin
|
||||||
|
if Assigned(FGetHintStringEvent) then
|
||||||
|
Result := FGetHintStringEvent
|
||||||
|
else
|
||||||
|
Result := inherited GetHintString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDynamicControl.HasHint: Boolean;
|
||||||
|
begin
|
||||||
|
if Assigned(FHasHintEvent) then
|
||||||
|
Result := FHasHintEvent
|
||||||
|
else
|
||||||
|
Result := inherited HasHint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
inherited KeyDown(Key, KeyChar, Shift);
|
||||||
|
if Assigned(FKeyDownEvent) then
|
||||||
|
FKeyDownEvent(Key, KeyChar, Shift);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
inherited KeyUp(Key, KeyChar, Shift);
|
||||||
|
if Assigned(FKeyUpEvent) then
|
||||||
|
FKeyUpEvent(Key, KeyChar, Shift);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||||
|
begin
|
||||||
|
inherited MouseDown(Button, Shift, X, Y);
|
||||||
|
if Assigned(FMouseDownEvent) then
|
||||||
|
FMouseDownEvent(Button, Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||||
|
begin
|
||||||
|
inherited MouseMove(Shift, X, Y);
|
||||||
|
if Assigned(FMouseMoveEvent) then
|
||||||
|
FMouseMoveEvent(Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||||
|
begin
|
||||||
|
inherited MouseUp(Button, Shift, X, Y);
|
||||||
|
if Assigned(FMouseUpEvent) then
|
||||||
|
FMouseUpEvent(Button, Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||||
|
begin
|
||||||
|
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||||
|
if Assigned(FMouseWheelEvent) then
|
||||||
|
FMouseWheelEvent(Shift, WheelDelta, Handled);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.Paint;
|
||||||
|
begin
|
||||||
|
inherited Paint;
|
||||||
|
if Assigned(FPaintEvent) then
|
||||||
|
FPaintEvent
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
|
||||||
|
Canvas.FillRect(LocalRect, 0, 0, [], 1);
|
||||||
|
Canvas.Stroke.Color := TAlphaColors.Gray;
|
||||||
|
Canvas.Stroke.Thickness := 1;
|
||||||
|
Canvas.DrawRect(LocalRect, 0, 0, [], 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.RecalculateAbsoluteMatrices;
|
||||||
|
begin
|
||||||
|
inherited RecalculateAbsoluteMatrices;
|
||||||
|
if Assigned(FRecalculateAbsoluteMatricesEvent) then
|
||||||
|
FRecalculateAbsoluteMatricesEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.Resize;
|
||||||
|
begin
|
||||||
|
inherited Resize;
|
||||||
|
if Assigned(FResizeEvent) then
|
||||||
|
FResizeEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.SetEnabled(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
inherited SetEnabled(Value);
|
||||||
|
if Assigned(FSetEnabledEvent) then
|
||||||
|
FSetEnabledEvent(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.SetHint(const AHint: string);
|
||||||
|
begin
|
||||||
|
inherited SetHint(AHint);
|
||||||
|
if Assigned(FSetHintEvent) then
|
||||||
|
FSetHintEvent(AHint);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDynamicControl.SetVisible(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
inherited SetVisible(Value);
|
||||||
|
if Assigned(FSetVisibleEvent) then
|
||||||
|
FSetVisibleEvent(Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDynamicControl.ShowContextMenu(const ScreenPosition: TPointF): Boolean;
|
||||||
|
begin
|
||||||
|
if Assigned(FShowContextMenuEvent) then
|
||||||
|
Result := FShowContextMenuEvent(ScreenPosition)
|
||||||
|
else
|
||||||
|
Result := inherited ShowContextMenu(ScreenPosition);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,237 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 840
|
||||||
|
ClientWidth = 1017
|
||||||
|
FormFactor.Width = 320
|
||||||
|
FormFactor.Height = 480
|
||||||
|
FormFactor.Devices = [Desktop]
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
DesignerMasterStyle = 0
|
||||||
|
object MainPanel: TPanel
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 1017.000000000000000000
|
||||||
|
Size.Height = 406.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 2
|
||||||
|
object Splitter1: TSplitter
|
||||||
|
Align = Left
|
||||||
|
Cursor = crHSplit
|
||||||
|
MinSize = 20.000000000000000000
|
||||||
|
Position.X = 169.000000000000000000
|
||||||
|
Size.Width = 8.000000000000000000
|
||||||
|
Size.Height = 406.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
end
|
||||||
|
object WorkspacePanel: TPanel
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 840.000000000000000000
|
||||||
|
Size.Height = 406.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 3
|
||||||
|
object TabControl: TTabControl
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 840.000000000000000000
|
||||||
|
Size.Height = 372.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabIndex = 0
|
||||||
|
TabOrder = 10
|
||||||
|
TabPosition = PlatformDefault
|
||||||
|
end
|
||||||
|
object ToolBar: TToolBar
|
||||||
|
Size.Width = 840.000000000000000000
|
||||||
|
Size.Height = 34.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 3
|
||||||
|
object AddWorkspaceButton: TSpeedButton
|
||||||
|
Action = AddWorkspaceAction
|
||||||
|
Align = FitLeft
|
||||||
|
ImageIndex = -1
|
||||||
|
Size.Width = 123.636383056640600000
|
||||||
|
Size.Height = 34.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Add'
|
||||||
|
end
|
||||||
|
object TestButton: TSpeedButton
|
||||||
|
Action = TestAction
|
||||||
|
Align = FitLeft
|
||||||
|
ImageIndex = -1
|
||||||
|
Position.X = 123.636383056640600000
|
||||||
|
Size.Width = 123.636322021484400000
|
||||||
|
Size.Height = 34.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
object TestPopup: TPopup
|
||||||
|
PlacementTarget = TestButton
|
||||||
|
Size.Width = 400.000000000000000000
|
||||||
|
Size.Height = 400.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 7
|
||||||
|
object FlowLayout: TFlowLayout
|
||||||
|
Position.X = 224.000000000000000000
|
||||||
|
Position.Y = 167.000000000000000000
|
||||||
|
TabOrder = 4
|
||||||
|
Justify = Left
|
||||||
|
JustifyLastLine = Left
|
||||||
|
FlowDirection = LeftToRight
|
||||||
|
object RandomBox: TCheckBox
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
TabOrder = 1
|
||||||
|
Text = 'Random'
|
||||||
|
end
|
||||||
|
object LoadButton: TButton
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
Position.Y = 19.000000000000000000
|
||||||
|
Size.Width = 47.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 4
|
||||||
|
Text = 'Load'
|
||||||
|
end
|
||||||
|
object RandomButton: TButton
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
Position.Y = 41.000000000000000000
|
||||||
|
TabOrder = 2
|
||||||
|
Text = 'Random'
|
||||||
|
end
|
||||||
|
object ChartButton: TButton
|
||||||
|
Anchors = [akTop, akRight]
|
||||||
|
Position.Y = 63.000000000000000000
|
||||||
|
TabOrder = 6
|
||||||
|
Text = 'ChartButton'
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object StrategyButton: TSpeedButton
|
||||||
|
Align = FitLeft
|
||||||
|
Position.X = 247.272705078125000000
|
||||||
|
Size.Width = 123.250000000000000000
|
||||||
|
Size.Height = 34.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Strategy'
|
||||||
|
OnClick = StrategyButtonClick
|
||||||
|
end
|
||||||
|
object SymbolsComboBox: TComboBox
|
||||||
|
Align = FitLeft
|
||||||
|
Margins.Top = 4.000000000000000000
|
||||||
|
Margins.Bottom = 4.000000000000000000
|
||||||
|
Position.X = 370.522735595703100000
|
||||||
|
Position.Y = 4.000000000000000000
|
||||||
|
Size.Width = 141.192199707031300000
|
||||||
|
Size.Height = 26.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object StopButton: TButton
|
||||||
|
Align = FitLeft
|
||||||
|
Margins.Left = 8.000000000000000000
|
||||||
|
Margins.Top = 4.000000000000000000
|
||||||
|
Margins.Right = 8.000000000000000000
|
||||||
|
Margins.Bottom = 4.000000000000000000
|
||||||
|
Position.X = 519.714965820312500000
|
||||||
|
Position.Y = 4.000000000000000000
|
||||||
|
Size.Width = 111.404327392578100000
|
||||||
|
Size.Height = 26.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 7
|
||||||
|
Text = 'StopButton'
|
||||||
|
OnClick = StopButtonClick
|
||||||
|
end
|
||||||
|
object Strat2Button: TSpeedButton
|
||||||
|
Align = FitLeft
|
||||||
|
Position.X = 639.119262695312500000
|
||||||
|
Size.Width = 123.636352539062500000
|
||||||
|
Size.Height = 34.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Strat 2'
|
||||||
|
OnClick = Strat2ButtonClick
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object ObjectsPanel: TPanel
|
||||||
|
Align = Left
|
||||||
|
Size.Width = 169.000000000000000000
|
||||||
|
Size.Height = 406.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 4
|
||||||
|
object ObjectsTabControl: TTabControl
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 169.000000000000000000
|
||||||
|
Size.Height = 406.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabIndex = 0
|
||||||
|
TabOrder = 0
|
||||||
|
TabPosition = Bottom
|
||||||
|
Sizes = (
|
||||||
|
169s
|
||||||
|
380s)
|
||||||
|
object ModulesTabItem: TTabItem
|
||||||
|
CustomIcon = <
|
||||||
|
item
|
||||||
|
end>
|
||||||
|
IsSelected = True
|
||||||
|
Size.Width = 66.000000000000000000
|
||||||
|
Size.Height = 26.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
StyleLookup = ''
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Modules'
|
||||||
|
ExplicitSize.cx = 66.000000000000000000
|
||||||
|
ExplicitSize.cy = 26.000000000000000000
|
||||||
|
object TreeView: TTreeView
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 169.000000000000000000
|
||||||
|
Size.Height = 380.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 0
|
||||||
|
OnDblClick = TreeViewDblClick
|
||||||
|
AllowDrag = True
|
||||||
|
Viewport.Width = 165.000000000000000000
|
||||||
|
Viewport.Height = 376.000000000000000000
|
||||||
|
object Button1: TButton
|
||||||
|
Position.X = 56.000000000000000000
|
||||||
|
Position.Y = 72.000000000000000000
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Button1'
|
||||||
|
OnClick = Button1Click
|
||||||
|
end
|
||||||
|
object Button2: TButton
|
||||||
|
Position.X = 56.000000000000000000
|
||||||
|
Position.Y = 112.000000000000000000
|
||||||
|
TabOrder = 1
|
||||||
|
Text = 'Button2'
|
||||||
|
OnClick = Button2Click
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object LogMemo: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
Align = Bottom
|
||||||
|
Position.Y = 406.000000000000000000
|
||||||
|
Size.Width = 1017.000000000000000000
|
||||||
|
Size.Height = 434.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 1
|
||||||
|
Viewport.Width = 1013.000000000000000000
|
||||||
|
Viewport.Height = 430.000000000000000000
|
||||||
|
end
|
||||||
|
object ActionList: TActionList
|
||||||
|
Left = 209
|
||||||
|
Top = 32
|
||||||
|
object AddWorkspaceAction: TAction
|
||||||
|
Text = 'Add Workspace'
|
||||||
|
OnExecute = AddWorkspaceActionExecute
|
||||||
|
end
|
||||||
|
object TestAction: TAction
|
||||||
|
Text = 'Test...'
|
||||||
|
Checked = True
|
||||||
|
OnExecute = TestActionExecute
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -0,0 +1,746 @@
|
|||||||
|
unit MainForm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{.$define TICKDATA}
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Types,
|
||||||
|
System.UITypes,
|
||||||
|
System.Classes,
|
||||||
|
System.Variants,
|
||||||
|
System.DateUtils,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.Rtti,
|
||||||
|
System.Math,
|
||||||
|
FMX.Types,
|
||||||
|
FMX.Controls,
|
||||||
|
FMX.Forms,
|
||||||
|
FMX.Graphics,
|
||||||
|
FMX.Dialogs,
|
||||||
|
FMX.Controls.Presentation,
|
||||||
|
FMX.StdCtrls,
|
||||||
|
FMX.ListView.Types,
|
||||||
|
FMX.ListView.Appearances,
|
||||||
|
FMX.ListView.Adapters.Base,
|
||||||
|
FMX.ListView,
|
||||||
|
FMX.Memo.Types,
|
||||||
|
FMX.ScrollBox,
|
||||||
|
FMX.Memo,
|
||||||
|
FMX.Objects,
|
||||||
|
Myc.Futures,
|
||||||
|
Myc.Trade.Types,
|
||||||
|
Myc.Trade.DataStream,
|
||||||
|
Myc.Trade.Pipeline,
|
||||||
|
Myc.Data.Series,
|
||||||
|
Myc.Data.Pipeline,
|
||||||
|
Myc.Signals,
|
||||||
|
Myc.Mutable,
|
||||||
|
Myc.Signals.FMX,
|
||||||
|
Myc.TaskManager,
|
||||||
|
Myc.Aura.Module,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Data.Keyword,
|
||||||
|
FMX.ListBox,
|
||||||
|
FMX.Layouts,
|
||||||
|
FMX.TreeView,
|
||||||
|
FMX.TabControl,
|
||||||
|
FMX.Menus,
|
||||||
|
System.ImageList,
|
||||||
|
FMX.ImgList,
|
||||||
|
System.Actions,
|
||||||
|
FMX.ActnList,
|
||||||
|
DynamicFMXControl,
|
||||||
|
Myc.FMX.Chart,
|
||||||
|
Myc.Trade.Indicators,
|
||||||
|
Myc.Trade.Indicators.Common,
|
||||||
|
Myc.Core.FileCache,
|
||||||
|
StrategyTest,
|
||||||
|
TestMethodCallFromRecordParams;
|
||||||
|
|
||||||
|
type
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
LogMemo: TMemo;
|
||||||
|
MainPanel: TPanel;
|
||||||
|
SymbolsComboBox: TComboBox;
|
||||||
|
RandomBox: TCheckBox;
|
||||||
|
LoadButton: TButton;
|
||||||
|
RandomButton: TButton;
|
||||||
|
ChartButton: TButton;
|
||||||
|
StopButton: TButton;
|
||||||
|
Splitter1: TSplitter;
|
||||||
|
ActionList: TActionList;
|
||||||
|
AddWorkspaceAction: TAction;
|
||||||
|
WorkspacePanel: TPanel;
|
||||||
|
TabControl: TTabControl;
|
||||||
|
ToolBar: TToolBar;
|
||||||
|
AddWorkspaceButton: TSpeedButton;
|
||||||
|
ObjectsPanel: TPanel;
|
||||||
|
ObjectsTabControl: TTabControl;
|
||||||
|
ModulesTabItem: TTabItem;
|
||||||
|
TreeView: TTreeView;
|
||||||
|
TestButton: TSpeedButton;
|
||||||
|
TestAction: TAction;
|
||||||
|
TestPopup: TPopup;
|
||||||
|
FlowLayout: TFlowLayout;
|
||||||
|
StrategyButton: TSpeedButton;
|
||||||
|
Strat2Button: TSpeedButton;
|
||||||
|
Button1: TButton;
|
||||||
|
Button2: TButton;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure StopButtonClick(Sender: TObject);
|
||||||
|
procedure TreeViewDblClick(Sender: TObject);
|
||||||
|
procedure AddWorkspaceActionExecute(Sender: TObject);
|
||||||
|
procedure Button1Click(Sender: TObject);
|
||||||
|
procedure Button2Click(Sender: TObject);
|
||||||
|
procedure LogMemoChange(Sender: TObject);
|
||||||
|
procedure Strat2ButtonClick(Sender: TObject);
|
||||||
|
procedure TestActionExecute(Sender: TObject);
|
||||||
|
procedure StrategyButtonClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
FOnEvent: TNotifyEvent;
|
||||||
|
{ Private declarations }
|
||||||
|
FFileCache: IDataFileCache<TArray<TBytes>>;
|
||||||
|
FServer: IDataServer;
|
||||||
|
FSymbols: TFuture<TArray<String>>;
|
||||||
|
FTerminate: TEvent;
|
||||||
|
FProcessDone: TState;
|
||||||
|
FApplication: IAuraApplication;
|
||||||
|
FModulesItem: TTreeViewItem;
|
||||||
|
function SelectedSymbol: String;
|
||||||
|
procedure ExecuteStrategy(const Symbol: String; Timeframe: TTimeframe; const Consumer: IConsumer<TDataPoint<TOhlcItem>>);
|
||||||
|
|
||||||
|
public
|
||||||
|
procedure NewWorkspace;
|
||||||
|
function CurrLayout<T: TControl>: T;
|
||||||
|
procedure AlignControl(Control: TControl);
|
||||||
|
function CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>;
|
||||||
|
|
||||||
|
published
|
||||||
|
property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Myc.Data.Records,
|
||||||
|
TestModule,
|
||||||
|
Strategy2;
|
||||||
|
|
||||||
|
{$R *.fmx}
|
||||||
|
|
||||||
|
procedure TForm1.NewWorkspace;
|
||||||
|
var
|
||||||
|
tab: TTabItem;
|
||||||
|
begin
|
||||||
|
var ws: IAuraWorkspace := TMycAuraWorkspace.Create('New workspace', tmTesting);
|
||||||
|
FApplication.Workspaces.Insert(-1, ws);
|
||||||
|
|
||||||
|
tab := TabControl.Add;
|
||||||
|
tab.Text := ws.Caption;
|
||||||
|
tab.Tag := NativeInt(ws);
|
||||||
|
|
||||||
|
var scrollbox := TVertScrollBox.Create(Self);
|
||||||
|
scrollbox.Parent := tab;
|
||||||
|
scrollbox.Align := TAlignLayout.Client;
|
||||||
|
|
||||||
|
tab.ProcessSignal(ws.Name.Changed, procedure begin tab.Text := ws.Caption; end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StopButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FTerminate.Notify;
|
||||||
|
TaskManager.WaitFor(FProcessDone);
|
||||||
|
|
||||||
|
var Layout := CurrLayout<TVertScrollBox>;
|
||||||
|
if Layout <> nil then
|
||||||
|
begin
|
||||||
|
Layout.Content.DeleteChildren;
|
||||||
|
Layout.Repaint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.TreeViewDblClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
var sel := TreeView.Selected as TTreeViewItem;
|
||||||
|
|
||||||
|
var parent := sel.ParentItem;
|
||||||
|
if parent = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
if parent = FModulesItem then
|
||||||
|
begin
|
||||||
|
if (TabControl.ActiveTab <> nil) and (TabControl.ActiveTab.Tag <> 0) then
|
||||||
|
begin
|
||||||
|
var ws := IAuraWorkspace(TabControl.ActiveTab.Tag);
|
||||||
|
var module := FApplication.Modules[sel.TagString];
|
||||||
|
if (ws <> nil) and (module <> nil) then
|
||||||
|
module.SetupWorkspace(ws);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FApplication := TMycAuraApplication.Create;
|
||||||
|
|
||||||
|
FModulesItem := TTreeViewItem.Create(Self);
|
||||||
|
FModulesItem.Text := 'Modules';
|
||||||
|
|
||||||
|
const modName = 'Test_Module';
|
||||||
|
|
||||||
|
FApplication.RegisterModule(modName, TTestModule.Create('Test-Module', 1));
|
||||||
|
|
||||||
|
TreeView.AddObject(FModulesItem);
|
||||||
|
FModulesItem.ProcessSignal(
|
||||||
|
FApplication.ModuleNames.Changed,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
FModulesItem.BeginUpdate;
|
||||||
|
try
|
||||||
|
while FModulesItem.Count > 0 do
|
||||||
|
FModulesItem[0].Free;
|
||||||
|
var mods := FApplication.ModuleNames.Value;
|
||||||
|
for var i := 0 to High(mods) do
|
||||||
|
begin
|
||||||
|
var ModItem := TTreeViewItem.Create(Self);
|
||||||
|
ModItem.Text := mods[i];
|
||||||
|
ModItem.DragMode := TDragMode.dmAutomatic;
|
||||||
|
ModItem.Text := 'Module-' + mods[i];
|
||||||
|
ModItem.TagString := mods[i];
|
||||||
|
FModulesItem.AddObject(ModItem);
|
||||||
|
end;
|
||||||
|
FModulesItem.ExpandAll;
|
||||||
|
finally
|
||||||
|
FModulesItem.EndUpdate;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
FTerminate := TEvent.CreateEvent;
|
||||||
|
|
||||||
|
// Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364]
|
||||||
|
FFileCache := TDataFileCache<TArray<TBytes>>.Create;
|
||||||
|
{$ifdef TICKDATA}
|
||||||
|
FServer := TTickFileServer.Create(FFileCache, '\\COFFEE\TickData\Pepperstone');
|
||||||
|
{$else}
|
||||||
|
FServer := TM1FileServer.Create(FFileCache, '\\COFFEE\TickData\Pepperstone');
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
SymbolsComboBox.Enabled := false;
|
||||||
|
ChartButton.Enabled := false;
|
||||||
|
LoadButton.Enabled := false;
|
||||||
|
|
||||||
|
FSymbols := FServer.EnumerateSymbols;
|
||||||
|
|
||||||
|
SymbolsComboBox.ProcessSignal(
|
||||||
|
FSymbols.Done.Signal,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
SymbolsComboBox.BeginUpdate;
|
||||||
|
try
|
||||||
|
SymbolsComboBox.Items.Clear;
|
||||||
|
SymbolsComboBox.Items.AddStrings(FSymbols.WaitFor);
|
||||||
|
if SymbolsComboBox.Items.Count > 0 then
|
||||||
|
begin
|
||||||
|
if SymbolsComboBox.ItemIndex < 0 then
|
||||||
|
SymbolsComboBox.ItemIndex := SymbolsComboBox.Items.IndexOf('GER40');
|
||||||
|
SymbolsComboBox.Enabled := true;
|
||||||
|
ChartButton.Enabled := true;
|
||||||
|
LoadButton.Enabled := true;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SymbolsComboBox.EndUpdate;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
NewWorkspace;
|
||||||
|
|
||||||
|
IndicatorRegistry.LogRegistry(LogMemo.Lines);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FSymbols.WaitFor;
|
||||||
|
FTerminate.Notify;
|
||||||
|
TaskManager.WaitFor(FProcessDone);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.TestActionExecute(Sender: TObject);
|
||||||
|
begin
|
||||||
|
TestPopup.IsOpen := TestAction.Checked;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.AddWorkspaceActionExecute(Sender: TObject);
|
||||||
|
begin
|
||||||
|
NewWorkspace;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.AlignControl(Control: TControl);
|
||||||
|
begin
|
||||||
|
var Layout := CurrLayout<TVertScrollBox>;
|
||||||
|
if Layout = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
Control.Parent := Layout;
|
||||||
|
Control.Width := Layout.Width;
|
||||||
|
Control.Position.Y := Layout.ChildrenRect.Bottom + 1;
|
||||||
|
Control.Anchors := [TAnchorKind.akLeft, TAnchorKind.akRight];
|
||||||
|
Control.Align := TAlignLayout.Top;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Test1(LogMemo.Lines);
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button2Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
var Symbol := SelectedSymbol;
|
||||||
|
if Symbol = '' then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
|
||||||
|
|
||||||
|
var ticker := TConverter.CreateTicker<TDataPoint<TOhlcItem>>;
|
||||||
|
|
||||||
|
var Layout := CurrLayout<TVertScrollBox>;
|
||||||
|
if Layout = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var chart1 := TMycChart.Create(Self);
|
||||||
|
AlignControl(chart1);
|
||||||
|
chart1.Height := Layout.ChildrenRect.Width * 9 / 20;
|
||||||
|
chart1.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
var chart2 := TMycChart.Create(Self);
|
||||||
|
AlignControl(chart2);
|
||||||
|
chart2.Height := Layout.ChildrenRect.Width * 9 / 20;
|
||||||
|
chart2.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
var equity := Strategy2.CreateStrategy2(ticker.Producer, LogMemo.Lines, chart1, chart2);
|
||||||
|
|
||||||
|
var pnlChart := TMycChart.Create(Self);
|
||||||
|
AlignControl(pnlChart);
|
||||||
|
pnlChart.Height := Layout.ChildrenRect.Width * 9 / 24;
|
||||||
|
pnlChart.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
pnlChart.SetXAxisCounter<Double>(equity);
|
||||||
|
|
||||||
|
var panel := pnlChart.AddPanel;
|
||||||
|
panel.AddDoubleSeries(equity, TAlphaColors.Blue, 3);
|
||||||
|
|
||||||
|
FProcessDone := FProcessDone + (FServer as IM1DataServer).ProcessData(Symbol, terminated, ticker.Consumer);
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>;
|
||||||
|
type
|
||||||
|
TSignal = record
|
||||||
|
Sig: Double;
|
||||||
|
SL: Double;
|
||||||
|
Entry: Double;
|
||||||
|
pnl: Double;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
panel: TMycChart.TPanel;
|
||||||
|
begin
|
||||||
|
var ticker := TConverter.CreateIdentity<TDataPoint<TOhlcItem>>;
|
||||||
|
Result := ticker.Consumer;
|
||||||
|
|
||||||
|
var OhlcPoint := ticker.Producer.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(Timeframe));
|
||||||
|
|
||||||
|
var Ohlc := OhlcPoint.Field<TOhlcItem>('Data');
|
||||||
|
|
||||||
|
var Closes := Ohlc.Field<Double>('Close');
|
||||||
|
|
||||||
|
var Hull := Closes.Chain<Double>(THMA.CreateHMA(250)).MakeParallel;
|
||||||
|
var Sma := Closes.Chain<Double>(TSMA.CreateSMA(200)).MakeParallel;
|
||||||
|
|
||||||
|
var Lowest: Double := Double.MaxValue;
|
||||||
|
var Highest: Double := Double.MinValue;
|
||||||
|
|
||||||
|
var ATR := Ohlc.Chain<Double>(TATR.CreateATR(50)).MakeParallel;
|
||||||
|
|
||||||
|
// next stage
|
||||||
|
|
||||||
|
var curr: TSignal;
|
||||||
|
curr.SL := Double.NaN;
|
||||||
|
curr.Entry := Double.NaN;
|
||||||
|
|
||||||
|
var lastHull, lastSma: Double;
|
||||||
|
|
||||||
|
var conv := TConverter.Join<Double>(jmAll, [Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]);
|
||||||
|
|
||||||
|
var Signal :=
|
||||||
|
TConverter<TArray<Double>, TSignal>.CreateConverter(
|
||||||
|
function(const Values: TArray<Double>): TSignal
|
||||||
|
begin
|
||||||
|
var low := Values[0];
|
||||||
|
var high := Values[1];
|
||||||
|
var close := Values[2];
|
||||||
|
var atr := Values[3];
|
||||||
|
var hull := Values[4];
|
||||||
|
var sma := Values[5];
|
||||||
|
|
||||||
|
if low < Lowest then
|
||||||
|
Lowest := low;
|
||||||
|
if high > Highest then
|
||||||
|
Highest := high;
|
||||||
|
|
||||||
|
Result := curr;
|
||||||
|
Result.Sig := 0;
|
||||||
|
var pnl: double := NaN;
|
||||||
|
|
||||||
|
if (hull < sma) and (lastHull >= lastSma) then
|
||||||
|
begin
|
||||||
|
if curr.Sig > 0 then
|
||||||
|
pnl := close - curr.Entry;
|
||||||
|
|
||||||
|
curr.Sig := -1;
|
||||||
|
curr.SL := Highest;
|
||||||
|
curr.Entry := close;
|
||||||
|
Result := curr;
|
||||||
|
end
|
||||||
|
else if (hull > sma) and (lastHull <= lastSma) then
|
||||||
|
begin
|
||||||
|
if curr.Sig < 0 then
|
||||||
|
pnl := curr.Entry - close;
|
||||||
|
|
||||||
|
curr.Sig := 1;
|
||||||
|
curr.SL := Lowest;
|
||||||
|
curr.Entry := close;
|
||||||
|
Result := curr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
atr := 15 * atr;
|
||||||
|
if curr.Sig > 0 then
|
||||||
|
begin
|
||||||
|
if close > curr.SL then
|
||||||
|
begin
|
||||||
|
if curr.SL < close - atr then
|
||||||
|
curr.SL := close - atr;
|
||||||
|
Result.SL := curr.SL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if low <= curr.SL then
|
||||||
|
begin
|
||||||
|
pnl := curr.SL - curr.Entry;
|
||||||
|
curr.Sig := 0;
|
||||||
|
Result.Sig := 0;
|
||||||
|
curr.SL := NaN;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if curr.Sig < 0 then
|
||||||
|
begin
|
||||||
|
if close < curr.SL then
|
||||||
|
begin
|
||||||
|
if curr.SL > close + atr then
|
||||||
|
curr.SL := close + atr;
|
||||||
|
Result.SL := curr.SL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if high >= curr.SL then
|
||||||
|
begin
|
||||||
|
pnl := curr.Entry - curr.SL;
|
||||||
|
curr.Sig := 0;
|
||||||
|
Result.Sig := 0;
|
||||||
|
curr.SL := NaN;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Result.Sig <> 0 then
|
||||||
|
begin
|
||||||
|
Lowest := Double.MaxValue;
|
||||||
|
Highest := Double.MinValue;
|
||||||
|
Result.SL := Double.NaN;
|
||||||
|
Result.Entry := Double.NaN;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result.pnl := pnl;
|
||||||
|
|
||||||
|
lastHull := hull;
|
||||||
|
lastSma := sma;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
conv.Chain<TSignal>(Signal);
|
||||||
|
|
||||||
|
var pnl := Signal.Producer.Field<Double>('pnl');
|
||||||
|
|
||||||
|
var FEquity: Double := 10000;
|
||||||
|
var FInit: Boolean := false;
|
||||||
|
|
||||||
|
var equity :=
|
||||||
|
TConverter<Double, Double>.CreateAggregation(
|
||||||
|
function(const Value: Double; const Broadcast: TBroadcastFunc<Double>): TState
|
||||||
|
begin
|
||||||
|
if not FInit then
|
||||||
|
begin
|
||||||
|
FInit := true;
|
||||||
|
Broadcast(FEquity);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not IsNan(Value) then
|
||||||
|
begin
|
||||||
|
FEquity := FEquity + Value;
|
||||||
|
Result := Broadcast(FEquity);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
pnl.Chain<Double>(equity);
|
||||||
|
|
||||||
|
var Layout := CurrLayout<TVertScrollBox>;
|
||||||
|
if Layout = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var Symbol := SelectedSymbol;
|
||||||
|
if Symbol = '' then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var chart := TMycChart.Create(Self);
|
||||||
|
AlignControl(chart);
|
||||||
|
chart.Height := Layout.ChildrenRect.Width * 9 / 16;
|
||||||
|
chart.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
chart.SetXAxisSeries(M15, OhlcPoint.Field<TDateTime>('Time'));
|
||||||
|
|
||||||
|
panel := chart.AddPanel;
|
||||||
|
panel.AddOhlcSeries(Ohlc);
|
||||||
|
panel.AddDoubleSeries(Hull, TAlphaColors.Cornflowerblue, 2);
|
||||||
|
panel.AddDoubleSeries(Sma, TAlphaColors.Brown, 1.5);
|
||||||
|
panel.AddDoubleSeries(Signal.Producer.Field<Double>('Entry'), TAlphaColors.Green, 1);
|
||||||
|
panel.AddDoubleSeries(Signal.Producer.Field<Double>('SL'), TAlphaColors.Red, 2);
|
||||||
|
|
||||||
|
var mean := TConverter<TArray<Double>, Double>.CreateConverter(TMean.CreateMean());
|
||||||
|
|
||||||
|
TConverter.Join<Double>(jmAll, [Hull, Sma]).Chain<Double>(mean);
|
||||||
|
|
||||||
|
panel.AddDoubleSeries(mean.Producer, TAlphaColors.Blue, 5);
|
||||||
|
|
||||||
|
var pnlChart := TMycChart.Create(Self);
|
||||||
|
AlignControl(pnlChart);
|
||||||
|
pnlChart.Height := Layout.ChildrenRect.Width * 9 / 24;
|
||||||
|
pnlChart.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
pnlChart.SetXAxisCounter<Double>(equity.Producer);
|
||||||
|
|
||||||
|
////////////
|
||||||
|
|
||||||
|
(*
|
||||||
|
var Params: TEMA.TParam;
|
||||||
|
Params.Period := 20;
|
||||||
|
|
||||||
|
var indi := TEMA.CreateEMA(Params);
|
||||||
|
|
||||||
|
var EMAConv := TConverter<TEMA.TInput, TEMA.TResult>.CreateConverter(indi);
|
||||||
|
|
||||||
|
var equityEMA :=
|
||||||
|
equity
|
||||||
|
.Producer
|
||||||
|
.Chain<TEMA.TInput>(function(const Value: Double): TEMA.TInput begin Result.Price := Value end)
|
||||||
|
.Chain<TEMA.TResult>(EMAConv)
|
||||||
|
.Chain<Double>(function(const Value: TEMA.TResult): Double begin Result := Value.MA end);
|
||||||
|
*)
|
||||||
|
//////////////
|
||||||
|
|
||||||
|
panel := pnlChart.AddPanel;
|
||||||
|
panel.AddDoubleSeries(equity.Producer, TAlphaColors.Blue, 3);
|
||||||
|
// panel.AddDoubleSeries(equityEMA, TAlphaColors.Gray, 2);
|
||||||
|
|
||||||
|
/////
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TForm1.CurrLayout<T>: T;
|
||||||
|
begin
|
||||||
|
if TabControl.ActiveTab = nil then
|
||||||
|
exit(nil);
|
||||||
|
|
||||||
|
var Res: T := nil;
|
||||||
|
TabControl.ActiveTab.EnumControls(
|
||||||
|
function(Control: TControl): TEnumControlsResult
|
||||||
|
begin
|
||||||
|
Result := TEnumControlsResult.Continue;
|
||||||
|
if Control is T then
|
||||||
|
begin
|
||||||
|
Res := Control as T;
|
||||||
|
Result := TEnumControlsResult.Stop;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
Result := Res;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ExecuteStrategy(const Symbol: String; Timeframe: TTimeframe; const Consumer: IConsumer<TDataPoint<TOhlcItem>>);
|
||||||
|
begin
|
||||||
|
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
|
||||||
|
|
||||||
|
{$ifdef TICKDATA}
|
||||||
|
var ticker := TConverter.CreateTicker<TDataPoint<TTickRecord>>;
|
||||||
|
|
||||||
|
var lastPrice :=
|
||||||
|
ticker.Producer.Chain<TDataPoint<Double>>(
|
||||||
|
function(const Tick: TDataPoint<TTickRecord>): TDataPoint<Double>
|
||||||
|
begin
|
||||||
|
Result.Time := Tick.Time;
|
||||||
|
Result.Data := 0.5 * (Tick.Data.Ask + Tick.Data.Bid);
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
var OhlcPoint := lastPrice.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateTickAggregation(Timeframe));
|
||||||
|
OhlcPoint.CreateLink(Consumer);
|
||||||
|
|
||||||
|
FProcessDone := FProcessDone + (FServer as ITickDataServer).ProcessData(Symbol, terminated, ticker.Consumer);
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
var ticker := TConverter.CreateTicker<TDataPoint<TOhlcItem>>;
|
||||||
|
|
||||||
|
ticker.Producer.Chain(Consumer);
|
||||||
|
|
||||||
|
FProcessDone := FProcessDone + (FServer as IM1DataServer).ProcessData(Symbol, terminated, ticker.Consumer);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.LogMemoChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if LogMemo.Lines.Count > 1000 then
|
||||||
|
LogMemo.Lines.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TForm1.SelectedSymbol: String;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
if RandomBox.IsChecked then
|
||||||
|
Result := FSymbols.WaitFor[Random(Length(FSymbols.WaitFor))]
|
||||||
|
else if SymbolsComboBox.ItemIndex >= 0 then
|
||||||
|
Result := FSymbols.WaitFor[SymbolsComboBox.ItemIndex];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StrategyButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
var Layout := CurrLayout<TVertScrollBox>;
|
||||||
|
if Layout = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var Symbol := SelectedSymbol;
|
||||||
|
if Symbol = '' then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var chart := TMycChart.Create(Self);
|
||||||
|
AlignControl(chart);
|
||||||
|
chart.Height := Layout.ChildrenRect.Width * 9 / 16;
|
||||||
|
chart.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
/////
|
||||||
|
|
||||||
|
var timeframe := TTimeframe.H;
|
||||||
|
|
||||||
|
var ticker := TConverter.CreateIdentity<TDataPoint<TOhlcItem>>;
|
||||||
|
|
||||||
|
var OhlcPoint := ticker.Producer.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(timeframe));
|
||||||
|
|
||||||
|
// var OhlcTicker := TConverter.CreateIdentity<TDataPoint<TOhlcItem>>;
|
||||||
|
// var OhlcPoint := OhlcTicker.Sender;
|
||||||
|
|
||||||
|
var Timestamps := OhlcPoint.Field<TDateTime>('Time');
|
||||||
|
var Ohlc := OhlcPoint.Field<TOhlcItem>('Data');
|
||||||
|
var Closes := Ohlc.Field<Double>('Close');
|
||||||
|
|
||||||
|
var Hull := Closes.Chain<Double>(THMA.CreateHMA(150));
|
||||||
|
var Sma := Closes.Chain<Double>(TSMA.CreateSMA(50));
|
||||||
|
var Ema := Closes.Chain<Double>(TEMA.CreateEMA(21));
|
||||||
|
var Boli := Closes.MakeParallel.Chain<TBollingerBands.TResult>(TBollingerBands.CreateBollingerBands(20, 2.0));
|
||||||
|
var Rsi := Closes.Chain<Double>(TRSI.CreateRSI(14));
|
||||||
|
var Macd := Closes.MakeParallel.Chain<TMacd.TResult>(TMACD.CreateMACD(12, 26, 9));
|
||||||
|
|
||||||
|
var Stoch := Ohlc.Chain<TStochastic.TResult>(TStochastic.CreateStochastic(14, 3));
|
||||||
|
|
||||||
|
chart.SetXAxisSeries(timeframe, Timestamps);
|
||||||
|
|
||||||
|
var Panel := chart.AddPanel;
|
||||||
|
Panel.AddOhlcSeries(Ohlc);
|
||||||
|
Panel.AddDoubleSeries(Hull, TAlphaColors.Aliceblue);
|
||||||
|
Panel.AddDoubleSeries(Sma, TAlphaColors.Yellow);
|
||||||
|
Panel.AddDoubleSeries(Ema, TAlphaColors.Aqua);
|
||||||
|
Panel.AddDoubleSeries(Boli.Field<Double>('UpperBand'), TAlphaColors.Gray);
|
||||||
|
Panel.AddDoubleSeries(Boli.Field<Double>('MiddleBand'), TAlphaColors.Darkgray, 1.0);
|
||||||
|
Panel.AddDoubleSeries(Boli.Field<Double>('LowerBand'), TAlphaColors.Gray);
|
||||||
|
|
||||||
|
Panel := chart.AddPanel;
|
||||||
|
Panel.AddDoubleSeries(Rsi, TAlphaColors.Fuchsia);
|
||||||
|
|
||||||
|
Panel := chart.AddPanel;
|
||||||
|
Panel.AddDoubleSeries(Macd.Field<Double>('MacdLine'), TAlphaColors.Orange);
|
||||||
|
Panel.AddDoubleSeries(Macd.Field<Double>('SignalLine'), TAlphaColors.Dodgerblue);
|
||||||
|
Panel.AddDoubleSeries(Macd.Field<Double>('Histogram'), TAlphaColors.Lightgreen);
|
||||||
|
|
||||||
|
Panel := chart.AddPanel;
|
||||||
|
Panel.AddDoubleSeries(Stoch.Field<Double>('K'), TAlphaColors.Green);
|
||||||
|
Panel.AddDoubleSeries(Stoch.Field<Double>('D'), TAlphaColors.Red);
|
||||||
|
|
||||||
|
/////
|
||||||
|
{
|
||||||
|
var tickChart := TMycChart.Create(Self);
|
||||||
|
tickChart.Height := Layout.ChildrenRect.Width * 9 / 16;
|
||||||
|
AlignControl(tickChart);
|
||||||
|
tickChart.Lookback.Value := 1000000;
|
||||||
|
|
||||||
|
var TickTime := ticker.Field<TDateTime>('Time');
|
||||||
|
|
||||||
|
var TickData := ticker.Field<TAskBidItem>('Data');
|
||||||
|
var TickAsk := TickData.Field<Double>('Ask');
|
||||||
|
var TickBid := TickData.Field<Double>('Bid');
|
||||||
|
|
||||||
|
var TickSpread := TickData.Chain<Double>(function(const Tick: TAskBidItem): Double begin Result := Tick.Bid - Tick.Ask; end);
|
||||||
|
|
||||||
|
tickChart.SetXAxisSeries(TTimeframe.S, TickTime.Sender);
|
||||||
|
panel := tickChart.AddPanel;
|
||||||
|
panel.AddDoubleSeries(TickAsk.Sender, TAlphaColors.Blue);
|
||||||
|
panel.AddDoubleSeries(TickBid.Sender, TAlphaColors.Red);
|
||||||
|
|
||||||
|
panel := tickChart.AddPanel;
|
||||||
|
panel.AddDoubleSeries(TickSpread.Sender);
|
||||||
|
}
|
||||||
|
/////
|
||||||
|
|
||||||
|
ExecuteStrategy(Symbol, timeframe, ticker.Consumer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Strat2ButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
var Symbol := SelectedSymbol;
|
||||||
|
if Symbol = '' then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var timeframe := TTimeframe.M15;
|
||||||
|
// ExecuteStrategy(Symbol, timeframe, CreateStrategy2(timeframe));
|
||||||
|
|
||||||
|
var tstStrat := StrategyTest.CreateStrategy1(timeframe);
|
||||||
|
|
||||||
|
ExecuteStrategy(Symbol, timeframe, tstStrat.Consumer);
|
||||||
|
|
||||||
|
var Layout := CurrLayout<TVertScrollBox>;
|
||||||
|
if Layout = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var pnlChart := TMycChart.Create(Self);
|
||||||
|
AlignControl(pnlChart);
|
||||||
|
pnlChart.Height := Layout.ChildrenRect.Width * 9 / 24;
|
||||||
|
pnlChart.Lookback.Value := 50000;
|
||||||
|
|
||||||
|
pnlChart.SetXAxisCounter<Double>(tstStrat.Producer);
|
||||||
|
|
||||||
|
var panel := pnlChart.AddPanel;
|
||||||
|
panel.AddDoubleSeries(tstStrat.Producer, TAlphaColors.Blue, 3);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,74 @@
|
|||||||
|
# Projektplan: Meilenstein Daten-Infrastruktur
|
||||||
|
|
||||||
|
*Datum: 13. Juni 2025*
|
||||||
|
|
||||||
|
## Status: Design-Phase abgeschlossen, Basis-Implementierung erfolgt
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## Stufe 1: Asynchrone Datenstrom-Schnittstelle (`IDataStream<T>`) - **ABGESCHLOSSEN**
|
||||||
|
|
||||||
|
* **Motivation**: Das ursprüngliche, zustandsbehaftete Design war für die Verarbeitung asynchron eintreffender Daten (z.B. von `TFuture`-Objekten) zu komplex und fehleranfällig.
|
||||||
|
|
||||||
|
* **Ziel**: Die Schaffung eines robusten, ereignisgesteuerten und non-blocking Modells, das den Datenproduzenten sauber vom Konsumenten entkoppelt.
|
||||||
|
|
||||||
|
* **Ergebnis**:
|
||||||
|
* Die `IDataStream<T>`-Schnittstelle wurde überarbeitet. Die `HasData`-Eigenschaft liefert nun ein `TSignal`, das Konsumenten aktiv über potenziell neue Daten informiert.
|
||||||
|
* Die Referenzimplementierung `TAuraFileStream<T>` wurde erfolgreich angepasst und nutzt eine saubere Ereignis-Kopplung (`Subscribe`) für eine robuste und wartungsarme Logik.
|
||||||
|
* Die korrekte Funktionalität wurde durch eine angepasste DUnitX-Test-Suite verifiziert.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## Stufe 2: Abstraktion für Handelssysteme (`IDataSeriesProvider`) - **ENTWORFEN**
|
||||||
|
|
||||||
|
* **Motivation**: Ein Handelssystem benötigt einen stets validen und kontinuierlichen Daten-Lookback. Ein roher `IDataStream<T>` kann dies nicht garantieren, da Lücken in den Daten auftreten können (z.B. beim Übergang von Historie zu Live).
|
||||||
|
|
||||||
|
* **Ziel**: Die Konzeption einer übergeordneten Abstraktionsschicht, die diese komplexe Anforderung kapselt, die Datenintegrität sicherstellt und dem Handelssystem eine einfache, sichere Schnittstelle bietet.
|
||||||
|
|
||||||
|
* **Ergebnis**:
|
||||||
|
Entworfen wurde der `IDataSeriesProvider`, der als "Black Box" für das Handelssystem fungiert und die Komplexität der Datenbeschaffung vollständig verbirgt. Er wurde mit zwei unterschiedlichen, vom Anwender wählbaren Betriebsmodi konzipiert:
|
||||||
|
|
||||||
|
### Modus 1: "Live-Handel"
|
||||||
|
* **Motivation**: Um einen echten **"Sofort-Start"** im Live-Handel zu ermöglichen, muss die Lücke zwischen den statischen, lokalen Historiendaten und dem aktuellen Zeitpunkt geschlossen werden.
|
||||||
|
* **Ziel**: Ein lückenloser, tagesaktueller Start des Handelssystems ohne manuelles Eingreifen oder lange Wartezeiten für den Nutzer.
|
||||||
|
* **Ergebnis**: Das Design einer **Drei-Phasen-Synchronisation**: (1) Lokale History laden, (2) "Catch-up"-Daten vom Broker holen, (3) auf den Live-Stream umschalten.
|
||||||
|
|
||||||
|
### Modus 2: "Simulation & Backtest"
|
||||||
|
* **Motivation**: Für Entwicklung, Test und Analyse muss die Software **völlig autonom** und ohne Abhängigkeit von einer externen, potenziell nicht verfügbaren Broker-API lauffähig sein.
|
||||||
|
* **Ziel**: Einen "Sofort-Start" für Backtests zu jedem beliebigen Zeitpunkt in der Vergangenheit zu ermöglichen, der rein auf lokalen Dateien basiert.
|
||||||
|
* **Ergebnis**: Ein Design, bei dem der relevante Datenkontext in den Speicher geladen wird, um von dort aus einen schnellen Start und ein "Playback" der Daten zu ermöglichen.
|
||||||
|
|
||||||
|
# TODO-Einträge: Dateninfrastruktur
|
||||||
|
|
||||||
|
## Stufe 2: `IDataSeriesProvider`
|
||||||
|
|
||||||
|
- [ ] **Interface und Basis-Implementierung erstellen**
|
||||||
|
* Definiere das `IDataSeriesProvider<T>`-Interface.
|
||||||
|
* Definiere die `TProviderStatus`-Enumeration (`psInitializing`, `psReadyContinuous`, `psReadyWithGap`, `psFaulted`).
|
||||||
|
* Implementiere eine abstrakte Basisklasse `TDataSeriesProvider<T>`, die die grundlegenden Felder (z.B. für die interne `TDataSeries`) und Methoden bereitstellt.
|
||||||
|
|
||||||
|
- [ ] **Simulations-Modus implementieren**
|
||||||
|
* Erstelle eine konkrete Implementierung (z.B. `TSimulationSeriesProvider<T>`).
|
||||||
|
* Implementiere die Start-Logik:
|
||||||
|
* Laden des gesamten relevanten Datenkontexts via `TAuraDataServer.LoadDataSeries`.
|
||||||
|
* Positionierung auf einen wählbaren Startzeitpunkt via `TDataSeries.IndexOf`.
|
||||||
|
* Extrahieren des initialen Lookback-Puffers.
|
||||||
|
* Implementiere das "Playback" der nachfolgenden Datenpunkte aus der im Speicher gehaltenen Serie.
|
||||||
|
* Setze den `Status` korrekt auf `psReadyContinuous`, da im Simulationsmodus per Definition keine Lücke zur "Gegenwart" existiert.
|
||||||
|
|
||||||
|
- [ ] **Live-Handel Modus implementieren**
|
||||||
|
* **Voraussetzung**: Definiere eine Schnittstelle für Live-Datenquellen (z.B. `ILiveDataSource<T>`), die eine Methode zur Abfrage rezenter historischer Daten (`GetCatchUpData`) enthält.
|
||||||
|
* **Start-Logik (Drei-Phasen-Synchronisation)**:
|
||||||
|
* Implementiere den parallelen Start der asynchronen Operationen:
|
||||||
|
1. Laden der lokalen Historie.
|
||||||
|
2. Herstellen der Broker-Verbindung und Abrufen der "Catch-up"-Daten.
|
||||||
|
* Implementiere die "Splicing"-Logik, die beide Datenquellen zu einem nahtlosen Lookback-Puffer verbindet.
|
||||||
|
* Implementiere die Prüfung auf ein "Markt-Gap" beim Übergang, um den initialen Status korrekt auf `psReadyContinuous` oder `psReadyWithGap` zu setzen.
|
||||||
|
* **Laufzeit-Logik**:
|
||||||
|
* Implementiere das kontinuierliche Verarbeiten des Live-Streams.
|
||||||
|
* Implementiere die Fehlerbehandlung für Laufzeit-Unterbrechungen (Verbindungsverlust), inklusive des Wechsels in den `psFaulted`-Status und des sicheren "Re-Priming".
|
||||||
|
|
||||||
|
- [ ] **Session-Kalender entwerfen und implementieren**
|
||||||
|
* **Motivation**: Notwendig für die Unterscheidung zwischen "Markt-Gaps" (natürlich) und "Daten-Lücken" (Fehler) im Live-Betrieb.
|
||||||
|
* **Anforderung**: Muss pro Asset konfigurierbar sein (Handelszeiten, Feiertage).
|
||||||
|
* **Implementierung**: Erstelle eine Klasse, die für ein gegebenes Zeitintervall prüfen kann, ob der Markt geöffnet oder geschlossen war. Integriere diese Prüfung in die Laufzeit-Logik des `TDataSeriesProvider` im Live-Modus.
|
||||||
@@ -0,0 +1,503 @@
|
|||||||
|
unit Strategy2;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Classes,
|
||||||
|
Myc.Signals,
|
||||||
|
Myc.Data.Pipeline,
|
||||||
|
Myc.Trade.Types,
|
||||||
|
Myc.FMX.Chart,
|
||||||
|
Myc.Trade.Pipeline;
|
||||||
|
|
||||||
|
function CreateStrategy2(
|
||||||
|
const Ticker: TProducer<TDataPoint<TOhlcItem>>;
|
||||||
|
const Log: TStrings;
|
||||||
|
const Chart1H, Chart24H: TMycChart
|
||||||
|
): TProducer<Double>;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Rtti,
|
||||||
|
System.Math,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.Types,
|
||||||
|
System.UITypes,
|
||||||
|
FMX.Types,
|
||||||
|
Myc.Trade.Indicators.Common,
|
||||||
|
Myc.Data.Records;
|
||||||
|
|
||||||
|
// Calculates the difference between the current value and the value N periods ago.
|
||||||
|
// (Value[0] - Value[N])
|
||||||
|
function Delta(N: Integer): TConverter<Double, Double>;
|
||||||
|
var
|
||||||
|
history: TQueue<Double>; // Captured state for the history of values
|
||||||
|
begin
|
||||||
|
if N <= 0 then
|
||||||
|
raise EArgumentException.Create('Delta period N must be positive.');
|
||||||
|
|
||||||
|
history := TQueue<Double>.Create;
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
TConverter<Double, Double>.CreateAggregation(
|
||||||
|
// This function is the core of the aggregator. It is called for each value.
|
||||||
|
function(const Value: Double; const Broadcast: TBroadcastFunc<Double>): TState
|
||||||
|
var
|
||||||
|
deltaValue, oldestValue: Double;
|
||||||
|
begin
|
||||||
|
// Add current value to the history
|
||||||
|
history.Enqueue(Value);
|
||||||
|
|
||||||
|
// If the history is larger than needed, remove the oldest element.
|
||||||
|
// We need N+1 elements to have the current and the Nth previous value.
|
||||||
|
if history.Count > (N + 1) then
|
||||||
|
history.Dequeue;
|
||||||
|
|
||||||
|
// Calculate delta if we have enough data
|
||||||
|
if history.Count = (N + 1) then
|
||||||
|
begin
|
||||||
|
oldestValue := history.Peek; // Oldest value is at the front
|
||||||
|
deltaValue := Value - oldestValue;
|
||||||
|
Broadcast(deltaValue);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Not enough data yet, broadcast a neutral value.
|
||||||
|
Broadcast(0.0);
|
||||||
|
end;
|
||||||
|
Result := TState.Null;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Defines the direction of the slope between two points
|
||||||
|
TSlope = (sFalling, sFlat, sRising);
|
||||||
|
|
||||||
|
// Represents the last found high and low point in a series.
|
||||||
|
TExtrema = record
|
||||||
|
High: Double;
|
||||||
|
Low: Double;
|
||||||
|
constructor Create(AHigh, ALow: Double);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TExtrema.Create(AHigh, ALow: Double);
|
||||||
|
begin
|
||||||
|
High := AHigh;
|
||||||
|
Low := ALow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Finds the last peak/trough. A peak is a value surrounded by N lower values on both sides.
|
||||||
|
// This introduces a signal lag of N periods.
|
||||||
|
function ExtremaFinder(N: Integer): TConverter<Double, TExtrema>;
|
||||||
|
var
|
||||||
|
// Captured state for the aggregator
|
||||||
|
history: TQueue<Double>;
|
||||||
|
lastHigh, lastLow: Double;
|
||||||
|
initialized: Boolean;
|
||||||
|
begin
|
||||||
|
if N <= 0 then
|
||||||
|
raise EArgumentException.Create('ExtremaFinder period N must be positive.');
|
||||||
|
|
||||||
|
initialized := False;
|
||||||
|
history := TQueue<Double>.Create;
|
||||||
|
lastHigh := 0;
|
||||||
|
lastLow := 0;
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
TConverter<Double, TExtrema>.CreateAggregation(
|
||||||
|
function(const Value: Double; const Broadcast: TBroadcastFunc<TExtrema>): TState
|
||||||
|
var
|
||||||
|
data: TArray<Double>;
|
||||||
|
centerValue: Double;
|
||||||
|
isPeak, isTrough: Boolean;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
history.Enqueue(Value);
|
||||||
|
// Keep the history buffer at the required size for the sliding window
|
||||||
|
if history.Count > (2 * N + 1) then
|
||||||
|
history.Dequeue;
|
||||||
|
|
||||||
|
// Initialize extrema with the first value once the buffer is full
|
||||||
|
if not initialized and (history.Count = (2 * N + 1)) then
|
||||||
|
begin
|
||||||
|
lastHigh := history.Peek;
|
||||||
|
lastLow := history.Peek;
|
||||||
|
initialized := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Only proceed if the window is full
|
||||||
|
if history.Count = (2 * N + 1) then
|
||||||
|
begin
|
||||||
|
data := history.ToArray;
|
||||||
|
centerValue := data[N]; // The value to be tested is in the middle of the window
|
||||||
|
|
||||||
|
// Test for a peak (center value is highest in the window)
|
||||||
|
isPeak := True;
|
||||||
|
for i := 0 to High(data) do
|
||||||
|
begin
|
||||||
|
if i <> N then
|
||||||
|
begin
|
||||||
|
if centerValue <= data[i] then
|
||||||
|
begin
|
||||||
|
isPeak := False;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if isPeak then
|
||||||
|
lastHigh := centerValue;
|
||||||
|
|
||||||
|
// Test for a trough (center value is lowest in the window)
|
||||||
|
isTrough := True;
|
||||||
|
if not isPeak then // Small optimization
|
||||||
|
begin
|
||||||
|
for i := 0 to High(data) do
|
||||||
|
begin
|
||||||
|
if i <> N then
|
||||||
|
begin
|
||||||
|
if centerValue >= data[i] then
|
||||||
|
begin
|
||||||
|
isTrough := False;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
isTrough := False;
|
||||||
|
|
||||||
|
if isTrough then
|
||||||
|
lastLow := centerValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Broadcast the latest known extrema.
|
||||||
|
if initialized then
|
||||||
|
Broadcast(TExtrema.Create(lastHigh, lastLow));
|
||||||
|
|
||||||
|
Result := TState.Null;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TValueHelper = record helper for TValue
|
||||||
|
class function AsValue<T>(const P: TProducer<T>): TProducer<TValue>; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Helper to convert a producer of any type T into a producer of TValue.
|
||||||
|
class function TValueHelper.AsValue<T>(const P: TProducer<T>): TProducer<TValue>;
|
||||||
|
begin
|
||||||
|
Result := P.Chain<TValue>(function(const V: T): TValue begin Result := TValue.From<T>(V); end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateStrategy2(
|
||||||
|
const Ticker: TProducer<TDataPoint<TOhlcItem>>;
|
||||||
|
const Log: TStrings;
|
||||||
|
const Chart1H, Chart24H: TMycChart
|
||||||
|
): TProducer<Double>;
|
||||||
|
const
|
||||||
|
// Timeframe independent constants
|
||||||
|
HMA_BIAS_PERIOD = 250;
|
||||||
|
SMA_BIAS_PERIOD = 200;
|
||||||
|
ATR_PERIOD = 50;
|
||||||
|
ATR_FILTER_MULTIPLIER = 3.0;
|
||||||
|
ATR_SL_MULTIPLIER = 4.0;
|
||||||
|
|
||||||
|
// 1H specific constants
|
||||||
|
HMA_ENTRY_PERIOD = 20;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Represents the current state of the trading logic
|
||||||
|
TTradeStatus = (tsFlat, tsLong, tsShort);
|
||||||
|
|
||||||
|
// Holds all necessary data for the stateful trade management aggregator
|
||||||
|
TTradeState = record
|
||||||
|
Status: TTradeStatus;
|
||||||
|
EntryPrice: Double;
|
||||||
|
StopLoss: Double;
|
||||||
|
TakeProfit: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
{$region 'Producers for Indicators and Logic Signals'}
|
||||||
|
// Timeframe specific producers
|
||||||
|
Ohlc1H, Ohlc24H: TProducer<TDataPoint<TOhlcItem>>;
|
||||||
|
Close1H, Close24H: TProducer<Double>;
|
||||||
|
Time1H, Time24H: TProducer<TDateTime>;
|
||||||
|
|
||||||
|
// 24H Indicators
|
||||||
|
Hma250_24H, Sma200_24H, Atr50_24H: TProducer<Double>;
|
||||||
|
// 1H Indicators
|
||||||
|
Hma250_1H, Sma200_1H, Atr50_1H, Hma20_1H: TProducer<Double>;
|
||||||
|
|
||||||
|
// Bias producers
|
||||||
|
Bias24H_Bullish, Bias24H_Bearish: TProducer<Boolean>;
|
||||||
|
Bias1H_Bullish, Bias1H_Bearish: TProducer<Boolean>;
|
||||||
|
OverallBias_Bullish, OverallBias_Bearish: TProducer<Boolean>;
|
||||||
|
|
||||||
|
// Filter producers
|
||||||
|
Filter24H, Filter1H, TradeAllowed: TProducer<Boolean>;
|
||||||
|
|
||||||
|
// Entry producers
|
||||||
|
Hma20_Extrema: TProducer<TExtrema>;
|
||||||
|
LastLow_HMA20, LastHigh_HMA20: TProducer<Double>;
|
||||||
|
TriggerBuy, TriggerShort: TProducer<Boolean>;
|
||||||
|
GoLong, GoShort: TProducer<Boolean>;
|
||||||
|
{$endregion}
|
||||||
|
begin
|
||||||
|
{$region 'Helper function implementations'}
|
||||||
|
var All :=
|
||||||
|
function(const Prods: TArray<TProducer<Boolean>>): TProducer<Boolean>
|
||||||
|
begin
|
||||||
|
// TConverter.Join combines multiple producers of the same type into a producer of an array of that type.
|
||||||
|
Result :=
|
||||||
|
TConverter
|
||||||
|
.Join<Boolean>(TConverter.TJoinMode.jmAll, Prods)
|
||||||
|
.Chain<Boolean>(
|
||||||
|
function(const V: TArray<Boolean>): Boolean
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
// The output is true only if all input booleans are true.
|
||||||
|
Result := True;
|
||||||
|
for i := 0 to High(V) do
|
||||||
|
begin
|
||||||
|
if not V[i] then
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var IsRising :=
|
||||||
|
function(const P: TProducer<Double>): TProducer<Boolean>
|
||||||
|
begin
|
||||||
|
// A series is rising if the difference to its previous value is positive.
|
||||||
|
// Assumes the existence of a Delta(1) converter.
|
||||||
|
Result := P.Chain<Double>(Delta(1)).Chain<Boolean>(function(const D: Double): Boolean begin Result := D > 0; end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var IsFalling :=
|
||||||
|
function(const P: TProducer<Double>): TProducer<Boolean>
|
||||||
|
begin
|
||||||
|
// A series is falling if the difference to its previous value is negative.
|
||||||
|
Result := P.Chain<Double>(Delta(1)).Chain<Boolean>(function(const D: Double): Boolean begin Result := D < 0; end);
|
||||||
|
end;
|
||||||
|
{$endregion}
|
||||||
|
|
||||||
|
{$region '1. Timeframe Aggregation & Chart Setup'}
|
||||||
|
// Aggregate Ticker data to 1H and 24H timeframes using a trade-specific converter.
|
||||||
|
Ohlc1H := Ticker.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(TTimeframe.H));
|
||||||
|
Ohlc24H := Ticker.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(TTimeframe.D));
|
||||||
|
|
||||||
|
var Ohlc1HData := Ohlc1H.Field<TOhlcItem>('Data');
|
||||||
|
var Ohlc24HData := Ohlc24H.Field<TOhlcItem>('Data');
|
||||||
|
|
||||||
|
// Extract relevant data fields (Close price and Time) from the aggregated data points.
|
||||||
|
// The Field helper uses RTTI to access nested record fields.
|
||||||
|
Close1H := Ohlc1HData.Field<Double>('Close');
|
||||||
|
Time1H := Ohlc1H.Field<TDateTime>('Time');
|
||||||
|
Close24H := Ohlc24HData.Field<Double>('Close');
|
||||||
|
Time24H := Ohlc24H.Field<TDateTime>('Time');
|
||||||
|
|
||||||
|
// Setup the 1H chart
|
||||||
|
Chart1H.SetXAxisSeries(TTimeframe.H, Time1H);
|
||||||
|
var Panel1H_Main := Chart1H.AddPanel;
|
||||||
|
Panel1H_Main.AddOhlcSeries(Ohlc1HData);
|
||||||
|
var Panel1H_ATR := Chart1H.AddPanel;
|
||||||
|
Panel1H_ATR.Weight := 0.25;
|
||||||
|
|
||||||
|
// Setup the 24H chart
|
||||||
|
Chart24H.SetXAxisSeries(TTimeframe.D, Time24H);
|
||||||
|
var Panel24H_Main := Chart24H.AddPanel;
|
||||||
|
Panel24H_Main.AddOhlcSeries(Ohlc24HData);
|
||||||
|
var Panel24H_ATR := Chart24H.AddPanel;
|
||||||
|
Panel24H_ATR.Weight := 0.25;
|
||||||
|
{$endregion}
|
||||||
|
|
||||||
|
{$region '2. Indicator Calculation'}
|
||||||
|
// Calculate indicators for the 24H timeframe and add them to the chart.
|
||||||
|
Hma250_24H := Close24H.Chain<Double>(THMA.CreateHMA(HMA_BIAS_PERIOD));
|
||||||
|
Sma200_24H := Close24H.Chain<Double>(TSMA.CreateSMA(SMA_BIAS_PERIOD));
|
||||||
|
// ATR is calculated from OHLC data, not just the close price.
|
||||||
|
Atr50_24H := Ohlc24H.Field<TOhlcItem>('Data').Chain<Double>(TATR.CreateATR(ATR_PERIOD));
|
||||||
|
|
||||||
|
Panel24H_Main.AddDoubleSeries(Hma250_24H, TAlphaColors.Aqua);
|
||||||
|
Panel24H_Main.AddDoubleSeries(Sma200_24H, TAlphaColors.Orange);
|
||||||
|
Panel24H_ATR.AddDoubleSeries(Atr50_24H, TAlphaColors.Magenta);
|
||||||
|
|
||||||
|
// Calculate indicators for the 1H timeframe and add them to the chart.
|
||||||
|
Hma250_1H := Close1H.Chain<Double>(THMA.CreateHMA(HMA_BIAS_PERIOD));
|
||||||
|
Sma200_1H := Close1H.Chain<Double>(TSMA.CreateSMA(SMA_BIAS_PERIOD));
|
||||||
|
Atr50_1H := Ohlc1H.Field<TOhlcItem>('Data').Chain<Double>(TATR.CreateATR(ATR_PERIOD));
|
||||||
|
Hma20_1H := Close1H.Chain<Double>(THMA.CreateHMA(HMA_ENTRY_PERIOD));
|
||||||
|
|
||||||
|
Panel1H_Main.AddDoubleSeries(Hma250_1H, TAlphaColors.Aqua);
|
||||||
|
Panel1H_Main.AddDoubleSeries(Sma200_1H, TAlphaColors.Orange);
|
||||||
|
Panel1H_ATR.AddDoubleSeries(Atr50_1H, TAlphaColors.Magenta);
|
||||||
|
Panel1H_Main.AddDoubleSeries(Hma20_1H, TAlphaColors.Yellow, 2.0);
|
||||||
|
{$endregion}
|
||||||
|
|
||||||
|
{$region '3. Bias and Filter Logic'}
|
||||||
|
// Determine bullish/bearish bias for each timeframe based on moving average slopes.
|
||||||
|
Bias24H_Bullish := All([IsRising(Hma250_24H), IsRising(Sma200_24H)]);
|
||||||
|
Bias24H_Bearish := All([IsFalling(Hma250_24H), IsFalling(Sma200_24H)]);
|
||||||
|
|
||||||
|
Bias1H_Bullish := All([IsRising(Hma250_1H), IsRising(Sma200_1H)]);
|
||||||
|
Bias1H_Bearish := All([IsFalling(Hma250_1H), IsFalling(Sma200_1H)]);
|
||||||
|
|
||||||
|
// Determine overall bias: both timeframes must agree.
|
||||||
|
OverallBias_Bullish := All([Bias24H_Bullish, Bias1H_Bullish]);
|
||||||
|
OverallBias_Bearish := All([Bias24H_Bearish, Bias1H_Bearish]);
|
||||||
|
|
||||||
|
// Define the ATR filter logic.
|
||||||
|
var GetFilter :=
|
||||||
|
function(const Hma, Sma, Atr: TProducer<Double>): TProducer<Boolean>
|
||||||
|
begin
|
||||||
|
var Dist :=
|
||||||
|
TConverter
|
||||||
|
.Join<Double>(jmAll, [Hma, Sma])
|
||||||
|
.Chain<Double>(function(const V: TArray<Double>): Double begin Result := Abs(V[0] - V[1]); end);
|
||||||
|
|
||||||
|
var Threshold := Atr.Chain<Double>(function(const V: Double): Double begin Result := V * ATR_FILTER_MULTIPLIER; end);
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
TConverter
|
||||||
|
.Join<Double>(jmAll, [Dist, Threshold])
|
||||||
|
.Chain<Boolean>(function(const V: TArray<Double>): Boolean begin Result := V[0] > V[1]; end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// A trade is only allowed if the HMA/SMA distance is wide enough on both timeframes.
|
||||||
|
Filter24H := GetFilter(Hma250_24H, Sma200_24H, Atr50_24H);
|
||||||
|
Filter1H := GetFilter(Hma250_1H, Sma200_1H, Atr50_1H);
|
||||||
|
TradeAllowed := All([Filter1H, Filter24H]);
|
||||||
|
{$endregion}
|
||||||
|
|
||||||
|
{$region '4. Entry Logic'}
|
||||||
|
// Find the last high and low points of the 20-period HMA on the 1H chart.
|
||||||
|
// Assumes an ExtremaFinder converter that returns a TExtrema record.
|
||||||
|
Hma20_Extrema := Hma20_1H.Chain<TExtrema>(ExtremaFinder(1));
|
||||||
|
LastLow_HMA20 := Hma20_Extrema.Field<Double>('Low');
|
||||||
|
LastHigh_HMA20 := Hma20_Extrema.Field<Double>('High');
|
||||||
|
|
||||||
|
// Define entry triggers: price crossing below the last low (for longs) or above the last high (for shorts).
|
||||||
|
TriggerBuy :=
|
||||||
|
TConverter
|
||||||
|
.Join<Double>(jmAll, [Close1H, LastLow_HMA20])
|
||||||
|
.Chain<Boolean>(function(const V: TArray<Double>): Boolean begin Result := V[0] < V[1]; end);
|
||||||
|
|
||||||
|
TriggerShort :=
|
||||||
|
TConverter
|
||||||
|
.Join<Double>(jmAll, [Close1H, LastHigh_HMA20])
|
||||||
|
.Chain<Boolean>(function(const V: TArray<Double>): Boolean begin Result := V[0] > V[1]; end);
|
||||||
|
|
||||||
|
// Combine all conditions for the final entry signals.
|
||||||
|
GoLong := All([OverallBias_Bullish, TradeAllowed, TriggerBuy]);
|
||||||
|
GoShort := All([OverallBias_Bearish, TradeAllowed, TriggerShort]);
|
||||||
|
{$endregion}
|
||||||
|
|
||||||
|
{$region '5. Trade Management via Aggregation'}
|
||||||
|
// The core state machine of the strategy. It's implemented as an aggregate function
|
||||||
|
// that captures a state record and processes a stream of combined input data.
|
||||||
|
var tradeState: TTradeState;
|
||||||
|
tradeState.Status := tsFlat;
|
||||||
|
tradeState.EntryPrice := 0;
|
||||||
|
tradeState.StopLoss := 0;
|
||||||
|
tradeState.TakeProfit := 0;
|
||||||
|
|
||||||
|
// The aggregator function processes an array of TValue, where each element
|
||||||
|
// corresponds to an input producer in a defined order.
|
||||||
|
var aggregatorFunc: TAggregateFunc<TArray<TValue>, Double> :=
|
||||||
|
function(const Value: TArray<TValue>; const Broadcast: TBroadcastFunc<Double>): TState
|
||||||
|
var
|
||||||
|
goLong, goShort: Boolean;
|
||||||
|
close, atr, lastHigh, lastLow: Double;
|
||||||
|
begin
|
||||||
|
// Not enough data, or data types are incorrect -> do nothing.
|
||||||
|
if (Length(Value) <> 6) or not Value[0].IsType<Boolean> then
|
||||||
|
begin
|
||||||
|
Result := TState.Null;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Extract current values from the TValue array by index.
|
||||||
|
// This order must match the order in the 'producers' array below.
|
||||||
|
goLong := Value[0].AsBoolean;
|
||||||
|
goShort := Value[1].AsBoolean;
|
||||||
|
close := Value[2].AsExtended;
|
||||||
|
atr := Value[3].AsExtended;
|
||||||
|
lastHigh := Value[4].AsExtended;
|
||||||
|
lastLow := Value[5].AsExtended;
|
||||||
|
|
||||||
|
// The state machine logic for trade management remains identical.
|
||||||
|
case tradeState.Status of
|
||||||
|
tsFlat:
|
||||||
|
begin
|
||||||
|
if goLong then
|
||||||
|
begin
|
||||||
|
tradeState.Status := tsLong;
|
||||||
|
tradeState.EntryPrice := close;
|
||||||
|
tradeState.TakeProfit := lastHigh;
|
||||||
|
tradeState.StopLoss := close - atr * ATR_SL_MULTIPLIER;
|
||||||
|
end
|
||||||
|
else if goShort then
|
||||||
|
begin
|
||||||
|
tradeState.Status := tsShort;
|
||||||
|
tradeState.EntryPrice := close;
|
||||||
|
tradeState.TakeProfit := lastLow;
|
||||||
|
tradeState.StopLoss := close + atr * ATR_SL_MULTIPLIER;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
tsLong:
|
||||||
|
begin
|
||||||
|
var newSL := close - atr * ATR_SL_MULTIPLIER;
|
||||||
|
if (newSL > tradeState.StopLoss) then
|
||||||
|
tradeState.StopLoss := newSL;
|
||||||
|
|
||||||
|
if (close >= tradeState.TakeProfit) or (close <= tradeState.StopLoss) then
|
||||||
|
tradeState.Status := tsFlat;
|
||||||
|
end;
|
||||||
|
tsShort:
|
||||||
|
begin
|
||||||
|
var newSL := close + atr * ATR_SL_MULTIPLIER;
|
||||||
|
if (newSL < tradeState.StopLoss) then
|
||||||
|
tradeState.StopLoss := newSL;
|
||||||
|
|
||||||
|
if (close <= tradeState.TakeProfit) or (close >= tradeState.StopLoss) then
|
||||||
|
tradeState.Status := tsFlat;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Broadcast the current position status.
|
||||||
|
Broadcast(Integer(tradeState.Status) - Integer(tsLong));
|
||||||
|
Result := TState.Null;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// To feed the aggregator, combine all required data streams into one.
|
||||||
|
// 1. Convert each producer to TProducer<TValue>.
|
||||||
|
var producers: TArray<TProducer<TValue>> :=
|
||||||
|
[
|
||||||
|
TValue.AsValue<Boolean>(GoLong),
|
||||||
|
TValue.AsValue<Boolean>(GoShort),
|
||||||
|
TValue.AsValue<Double>(Close1H),
|
||||||
|
TValue.AsValue<Double>(Atr50_1H),
|
||||||
|
TValue.AsValue<Double>(LastHigh_HMA20),
|
||||||
|
TValue.AsValue<Double>(LastLow_HMA20)
|
||||||
|
];
|
||||||
|
|
||||||
|
// 2. Join them into a single producer of an array of TValue.
|
||||||
|
var combinedProducer := TConverter.Join<TValue>(jmAll, producers);
|
||||||
|
|
||||||
|
// 3. Create the aggregator converter and chain it to the combined producer.
|
||||||
|
var strategyAggregator := TConverter<TArray<TValue>, Double>.CreateAggregation(aggregatorFunc);
|
||||||
|
Result := combinedProducer.Chain<Double>(strategyAggregator);
|
||||||
|
{$endregion}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,189 @@
|
|||||||
|
unit StrategyTest;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Myc.Signals,
|
||||||
|
Myc.Data.Pipeline,
|
||||||
|
Myc.Trade.Types,
|
||||||
|
Myc.Trade.Pipeline,
|
||||||
|
Myc.Trade.Indicators.Common;
|
||||||
|
|
||||||
|
function CreateStrategy1(Timeframe: TTimeframe): TConverter<TDataPoint<TOhlcItem>, Double>; overload;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Math;
|
||||||
|
|
||||||
|
function CreateStrategy1(Timeframe: TTimeframe): TConverter<TDataPoint<TOhlcItem>, Double>;
|
||||||
|
type
|
||||||
|
// A record to transfer a detected signal event and the required price data to the next stage.
|
||||||
|
TSignalEvent = record
|
||||||
|
Signal: Integer; // -1 for short, 1 for long, 0 for no new signal
|
||||||
|
Close, Low, High, ATR: Double;
|
||||||
|
InitialSL: Double; // The calculated SL (Highest/Lowest) at the time of the signal
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
var ticker := TConverter.CreateIdentity<TDataPoint<TOhlcItem>>;
|
||||||
|
|
||||||
|
var OhlcPoint := ticker.Producer.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(Timeframe));
|
||||||
|
|
||||||
|
var Ohlc := OhlcPoint.Field<TOhlcItem>('Data');
|
||||||
|
|
||||||
|
var Closes := Ohlc.Field<Double>('Close');
|
||||||
|
|
||||||
|
var Hull := Closes.Chain<Double>(THMA.CreateHMA(250)).MakeParallel;
|
||||||
|
var Sma := Closes.Chain<Double>(TSMA.CreateSMA(200)).MakeParallel;
|
||||||
|
|
||||||
|
var ATR := Ohlc.Chain<Double>(TATR.CreateATR(50));
|
||||||
|
|
||||||
|
var conv := TConverter.Join<Double>(jmAll, [Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]);
|
||||||
|
|
||||||
|
// STAGE 1: Signal Generation. This converter is stateless regarding the trade itself.
|
||||||
|
// It only detects the crossover event and prepares the data for the next stage.
|
||||||
|
var Lowest: Double := Double.MaxValue;
|
||||||
|
var Highest: Double := Double.MinValue;
|
||||||
|
var lastHull, lastSma: Double;
|
||||||
|
|
||||||
|
var signalGenerator :=
|
||||||
|
conv.Chain<TSignalEvent>(
|
||||||
|
TConverter<TArray<Double>, TSignalEvent>.CreateConverter(
|
||||||
|
function(const Values: TArray<Double>): TSignalEvent
|
||||||
|
begin
|
||||||
|
Result.Low := Values[0];
|
||||||
|
Result.High := Values[1];
|
||||||
|
Result.Close := Values[2];
|
||||||
|
Result.ATR := Values[3];
|
||||||
|
var hull := Values[4];
|
||||||
|
var sma := Values[5];
|
||||||
|
|
||||||
|
if Result.Low < Lowest then
|
||||||
|
Lowest := Result.Low;
|
||||||
|
if Result.High > Highest then
|
||||||
|
Highest := Result.High;
|
||||||
|
|
||||||
|
Result.Signal := 0;
|
||||||
|
Result.InitialSL := Double.NaN;
|
||||||
|
|
||||||
|
if (hull < sma) and (lastHull >= lastSma) then
|
||||||
|
begin
|
||||||
|
Result.Signal := -1;
|
||||||
|
Result.InitialSL := Highest;
|
||||||
|
Highest := Double.MinValue; // Reset for next trend
|
||||||
|
Lowest := Double.MaxValue;
|
||||||
|
end
|
||||||
|
else if (hull > sma) and (lastHull <= lastSma) then
|
||||||
|
begin
|
||||||
|
Result.Signal := 1;
|
||||||
|
Result.InitialSL := Lowest;
|
||||||
|
Highest := Double.MinValue; // Reset for next trend
|
||||||
|
Lowest := Double.MaxValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
lastHull := hull;
|
||||||
|
lastSma := sma;
|
||||||
|
end
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
// STAGE 2: Position Management. This stateful converter manages the lifecycle
|
||||||
|
// of a single trade (entry, trailing stop, exit) and outputs the PnL.
|
||||||
|
// State variables for the position manager
|
||||||
|
var currSig: Integer := 0;
|
||||||
|
var currSL := Double.NaN;
|
||||||
|
var currEntry := Double.NaN;
|
||||||
|
|
||||||
|
var positionManager :=
|
||||||
|
signalGenerator.Chain<Double>(
|
||||||
|
TConverter<TSignalEvent, Double>.CreateAggregation(
|
||||||
|
function(const Value: TSignalEvent; const Broadcast: TBroadcastFunc<Double>): TState
|
||||||
|
var
|
||||||
|
pnl: Double;
|
||||||
|
begin
|
||||||
|
Result := TState.Null;
|
||||||
|
pnl := Double.NaN;
|
||||||
|
|
||||||
|
// 1. Check for a new signal to open or reverse a position
|
||||||
|
if Value.Signal <> 0 then
|
||||||
|
begin
|
||||||
|
// If a position is already open, close it first
|
||||||
|
if currSig > 0 then
|
||||||
|
pnl := Value.Close - currEntry
|
||||||
|
else if currSig < 0 then
|
||||||
|
pnl := currEntry - Value.Close;
|
||||||
|
|
||||||
|
// Open new position
|
||||||
|
currSig := Value.Signal;
|
||||||
|
currEntry := Value.Close;
|
||||||
|
currSL := Value.InitialSL;
|
||||||
|
end
|
||||||
|
// 2. If no new signal, manage the currently open position
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
var atrValue := 15 * Value.ATR;
|
||||||
|
if currSig > 0 then // Manage long position
|
||||||
|
begin
|
||||||
|
if Value.Close > currSL then
|
||||||
|
if currSL < Value.Close - atrValue then
|
||||||
|
currSL := Value.Close - atrValue;
|
||||||
|
|
||||||
|
if Value.Low <= currSL then
|
||||||
|
begin
|
||||||
|
pnl := currSL - currEntry;
|
||||||
|
currSig := 0; // Close position
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if currSig < 0 then // Manage short position
|
||||||
|
begin
|
||||||
|
if Value.Close < currSL then
|
||||||
|
if currSL > Value.Close + atrValue then
|
||||||
|
currSL := Value.Close + atrValue;
|
||||||
|
|
||||||
|
if Value.High >= currSL then
|
||||||
|
begin
|
||||||
|
pnl := currEntry - currSL;
|
||||||
|
currSig := 0; // Close position
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 3. If a PnL was generated (trade closed), broadcast it
|
||||||
|
if not IsNan(pnl) then
|
||||||
|
begin
|
||||||
|
currSL := Double.NaN;
|
||||||
|
Broadcast(pnl);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
// The final equity calculation remains the same, it just consumes the PnL from the position manager
|
||||||
|
var FEquity: Double := 10000;
|
||||||
|
var FInit: Boolean := false;
|
||||||
|
var equity :=
|
||||||
|
positionManager.Chain<Double>(
|
||||||
|
TConverter<Double, Double>.CreateAggregation(
|
||||||
|
function(const Value: Double; const Broadcast: TBroadcastFunc<Double>): TState
|
||||||
|
begin
|
||||||
|
if not FInit then
|
||||||
|
begin
|
||||||
|
FInit := true;
|
||||||
|
Broadcast(FEquity);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not IsNan(Value) then
|
||||||
|
begin
|
||||||
|
FEquity := FEquity + Value;
|
||||||
|
Result := Broadcast(FEquity);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
Result := TConverter<TDataPoint<TOhlcItem>, Double>.Construct(ticker.Consumer, equity);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,12 @@
|
|||||||
|
object TestChartForm: TTestChartForm
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Chart Test'
|
||||||
|
ClientHeight = 480
|
||||||
|
ClientWidth = 640
|
||||||
|
FormFactor.Width = 320
|
||||||
|
FormFactor.Height = 480
|
||||||
|
FormFactor.Devices = [Desktop]
|
||||||
|
OnCreate = FormCreate
|
||||||
|
DesignerMasterStyle = 0
|
||||||
|
end
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,147 @@
|
|||||||
|
unit TestMethodCallFromRecordParams;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Rtti,
|
||||||
|
Myc.Data.Records,
|
||||||
|
Myc.Data.Pipeline,
|
||||||
|
Myc.Trade.Indicators;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMyWorker = class
|
||||||
|
public
|
||||||
|
type
|
||||||
|
TParams = record
|
||||||
|
Log: Int64;
|
||||||
|
text: String;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TArgs = record
|
||||||
|
xyz: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TResult = record
|
||||||
|
val: Int64;
|
||||||
|
desc: String;
|
||||||
|
end;
|
||||||
|
|
||||||
|
[IndicatorFactory]
|
||||||
|
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// SMA indicator for demonstration purposes
|
||||||
|
TSmaIndicator = class
|
||||||
|
public
|
||||||
|
type
|
||||||
|
TParams = record
|
||||||
|
Period: Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TArgs = record
|
||||||
|
Value: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TResult = record
|
||||||
|
Sma: Double;
|
||||||
|
end;
|
||||||
|
|
||||||
|
[IndicatorFactory]
|
||||||
|
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Test1(const Log: TStrings);
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Math;
|
||||||
|
|
||||||
|
class function TMyWorker.CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>;
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
function(const Params: TParams): TConvertFunc<TArgs, TResult>
|
||||||
|
begin
|
||||||
|
var Log := TStrings(Params.Log);
|
||||||
|
var text := Params.text;
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
function(const Args: TArgs): TResult
|
||||||
|
begin
|
||||||
|
// Use Format to avoid locale issues with float conversion
|
||||||
|
Log.Add(Format('Val=%f (...%s)', [Args.xyz, text]));
|
||||||
|
Result.desc := 'done';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Test1(const Log: TStrings);
|
||||||
|
begin
|
||||||
|
var fact := TGenericIndicatorFactory.CreateFromTemplate<TMyWorker>;
|
||||||
|
|
||||||
|
var params: TMyWorker.TParams;
|
||||||
|
params.Log := Int64(Log);
|
||||||
|
params.text := 'The quick brown fox jumps...';
|
||||||
|
|
||||||
|
var indi := fact.CreateIndicator<TMyWorker.TParams, TMyWorker.TArgs, TMyWorker.TResult>(params);
|
||||||
|
|
||||||
|
var args: TMyWorker.TArgs;
|
||||||
|
args.xyz := 3.14159;
|
||||||
|
|
||||||
|
var res := indi(args);
|
||||||
|
|
||||||
|
Log.Add('Final result description: ' + res.desc);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TSmaIndicator }
|
||||||
|
|
||||||
|
class function TSmaIndicator.CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>;
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
function(const Params: TParams): TConvertFunc<TArgs, TResult>
|
||||||
|
var
|
||||||
|
// State for the indicator closure
|
||||||
|
period: Integer;
|
||||||
|
buffer: TArray<Double>;
|
||||||
|
sum: Double;
|
||||||
|
count: Integer;
|
||||||
|
idx: Integer;
|
||||||
|
begin
|
||||||
|
period := Params.Period;
|
||||||
|
if period <= 0 then
|
||||||
|
raise Exception.Create('Period must be positive');
|
||||||
|
|
||||||
|
SetLength(buffer, period);
|
||||||
|
sum := 0.0;
|
||||||
|
count := 0;
|
||||||
|
idx := 0;
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
function(const Args: TArgs): TResult
|
||||||
|
begin
|
||||||
|
// If the buffer is full, subtract the oldest value that is about to be overwritten.
|
||||||
|
if count >= period then
|
||||||
|
sum := sum - buffer[idx];
|
||||||
|
|
||||||
|
// Add the new value to the buffer and the sum.
|
||||||
|
buffer[idx] := Args.Value;
|
||||||
|
sum := sum + Args.Value;
|
||||||
|
|
||||||
|
// Advance the index for the circular buffer.
|
||||||
|
idx := (idx + 1) mod period;
|
||||||
|
|
||||||
|
// Increment the fill count until the buffer is full for the first time.
|
||||||
|
if count < period then
|
||||||
|
inc(count);
|
||||||
|
|
||||||
|
// Calculate the SMA. The result is the average of the values currently in the buffer.
|
||||||
|
if count > 0 then
|
||||||
|
Result.Sma := sum / count
|
||||||
|
else
|
||||||
|
Result.Sma := 0.0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,30 @@
|
|||||||
|
unit TestModule;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Myc.Aura.Module;
|
||||||
|
|
||||||
|
type
|
||||||
|
TTestModule = class(TMycAuraNode, IAuraModule)
|
||||||
|
private
|
||||||
|
FId: Integer;
|
||||||
|
public
|
||||||
|
constructor Create(const AName: string; AId: Integer);
|
||||||
|
procedure SetupWorkspace(const Workspace: IAuraWorkspace);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor TTestModule.Create(const AName: string; AId: Integer);
|
||||||
|
begin
|
||||||
|
inherited Create(AName);
|
||||||
|
FId := AId;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestModule.SetupWorkspace(const Workspace: IAuraWorkspace);
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,15 @@
|
|||||||
|
program BlocklyTest;
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.StartUpCopy,
|
||||||
|
FMX.Forms,
|
||||||
|
MainUnit in 'MainUnit.pas' {MainForm},
|
||||||
|
LLVM.Runner in 'LLVM.Runner.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TMainForm, MainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,95 @@
|
|||||||
|
unit LLVM.Runner;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
Winapi.Windows,
|
||||||
|
System.Classes;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Callback-Prozedur, die von der DLL aufgerufen wird
|
||||||
|
TLogIntegerCallback = procedure(AValue: Integer); stdcall;
|
||||||
|
|
||||||
|
// NEU: Typ für die Host-Additionsfunktion
|
||||||
|
THostAddIntegersCallback = function(ANum1: Integer; ANum2: Integer): Integer; stdcall;
|
||||||
|
|
||||||
|
// NEUE, VEREINFACHTE Signatur der exportierten DLL-Funktion
|
||||||
|
// Jetzt nur noch der Log-Callback und der neue Integer-Input-Parameter
|
||||||
|
TStarteLogikProc =
|
||||||
|
procedure(
|
||||||
|
ALogIntProc: TLogIntegerCallback;
|
||||||
|
AHostInputInteger: Integer;
|
||||||
|
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
|
||||||
|
); stdcall;
|
||||||
|
|
||||||
|
type
|
||||||
|
TLLVMRunner = class
|
||||||
|
private
|
||||||
|
FModule: HMODULE;
|
||||||
|
FStarteLogik: TStarteLogikProc;
|
||||||
|
class var
|
||||||
|
FLog: TStrings;
|
||||||
|
class procedure LogInteger(AValue: Integer); static; stdcall;
|
||||||
|
// NEU: Host-Unterprogramm-Implementierung
|
||||||
|
class function HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer; static; stdcall;
|
||||||
|
public
|
||||||
|
constructor Create(const ADLLPath: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Execute(AInputInteger: Integer);
|
||||||
|
class property Log: TStrings read FLog write FLog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TLLVMRunner }
|
||||||
|
|
||||||
|
constructor TLLVMRunner.Create(const ADLLPath: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FModule := LoadLibrary(PChar(ADLLPath));
|
||||||
|
if FModule = 0 then
|
||||||
|
raise Exception.Create('Failed to load DLL.');
|
||||||
|
|
||||||
|
FStarteLogik := GetProcAddress(FModule, 'StarteLogik');
|
||||||
|
if not Assigned(FStarteLogik) then
|
||||||
|
raise Exception.Create('Procedure "StarteLogik" not found in DLL.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TLLVMRunner.Destroy;
|
||||||
|
begin
|
||||||
|
if FModule <> 0 then
|
||||||
|
FreeLibrary(FModule);
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// NEUE Implementierung der Host-Funktion
|
||||||
|
class function TLLVMRunner.HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer;
|
||||||
|
begin
|
||||||
|
Result := ANum1 + ANum2; // Die eigentliche Logik
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.Add(Format('DLL hat Host-Addition angefordert: %d + %d = %d', [ANum1, ANum2, Result]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Die Execute-Methode muss angepasst werden, um den neuen Funktionszeiger zu übergeben
|
||||||
|
procedure TLLVMRunner.Execute(AInputInteger: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FStarteLogik) then
|
||||||
|
FStarteLogik(
|
||||||
|
LogInteger,
|
||||||
|
AInputInteger,
|
||||||
|
HostAddIntegers // <--- Adresse der Host-Funktion übergeben
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Dies ist die Methode, die die DLL für LogInteger aufruft.
|
||||||
|
class procedure TLLVMRunner.LogInteger(AValue: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.Add(Format('DLL logged integer: %d', [AValue]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Die Implementierungen von GetCurrentDateTimeUTCHost und GetComponentInZoneHost
|
||||||
|
// wurden hier entfernt, da sie nicht mehr benötigt werden.
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,90 @@
|
|||||||
|
object MainForm: TMainForm
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Blockly LLVM IR Generator'
|
||||||
|
ClientHeight = 872
|
||||||
|
ClientWidth = 1010
|
||||||
|
FormFactor.Width = 320
|
||||||
|
FormFactor.Height = 480
|
||||||
|
FormFactor.Devices = [Desktop]
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
DesignerMasterStyle = 0
|
||||||
|
object WebBrowser1: TWebBrowser
|
||||||
|
Align = Top
|
||||||
|
Anchors = [akLeft, akTop]
|
||||||
|
Size.Width = 1010.000000000000000000
|
||||||
|
Size.Height = 625.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
WindowsEngine = EdgeOnly
|
||||||
|
OnDidFinishLoad = WebBrowser1DidFinishLoad
|
||||||
|
object ToolBar1: TToolBar
|
||||||
|
Size.Width = 1010.000000000000000000
|
||||||
|
Size.Height = 40.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 0
|
||||||
|
object RefreshButton: TSpeedButton
|
||||||
|
Align = Left
|
||||||
|
Size.Width = 80.000000000000000000
|
||||||
|
Size.Height = 40.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Refresh'
|
||||||
|
TextSettings.Trimming = None
|
||||||
|
OnClick = RefreshButtonClick
|
||||||
|
end
|
||||||
|
object SaveWorkspaceButton: TSpeedButton
|
||||||
|
Align = Left
|
||||||
|
Position.X = 80.000000000000000000
|
||||||
|
Size.Width = 80.000000000000000000
|
||||||
|
Size.Height = 40.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Save'
|
||||||
|
TextSettings.Trimming = None
|
||||||
|
OnClick = SaveWorkspaceButtonClick
|
||||||
|
end
|
||||||
|
object GenerateCodeButton: TSpeedButton
|
||||||
|
Align = Left
|
||||||
|
Position.X = 160.000000000000000000
|
||||||
|
Size.Width = 80.000000000000000000
|
||||||
|
Size.Height = 40.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Generate'
|
||||||
|
TextSettings.Trimming = None
|
||||||
|
OnClick = GenerateCodeButtonClick
|
||||||
|
end
|
||||||
|
object InputEdit: TEdit
|
||||||
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
|
Align = Left
|
||||||
|
TabOrder = 3
|
||||||
|
Text = '1345'
|
||||||
|
Position.X = 240.000000000000000000
|
||||||
|
Position.Y = 10.000000000000000000
|
||||||
|
Margins.Top = 10.000000000000000000
|
||||||
|
Margins.Bottom = 10.000000000000000000
|
||||||
|
Size.Width = 73.000000000000000000
|
||||||
|
Size.Height = 20.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Memo: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 1010.000000000000000000
|
||||||
|
Size.Height = 239.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 1
|
||||||
|
Viewport.Width = 1006.000000000000000000
|
||||||
|
Viewport.Height = 235.000000000000000000
|
||||||
|
end
|
||||||
|
object Splitter1: TSplitter
|
||||||
|
Align = Top
|
||||||
|
Cursor = crVSplit
|
||||||
|
MinSize = 20.000000000000000000
|
||||||
|
Position.Y = 625.000000000000000000
|
||||||
|
Size.Width = 1010.000000000000000000
|
||||||
|
Size.Height = 8.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -0,0 +1,314 @@
|
|||||||
|
unit MainUnit;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Types,
|
||||||
|
System.UITypes,
|
||||||
|
System.Classes,
|
||||||
|
System.Variants,
|
||||||
|
FMX.Types,
|
||||||
|
FMX.Controls,
|
||||||
|
FMX.Forms,
|
||||||
|
FMX.Graphics,
|
||||||
|
FMX.Dialogs,
|
||||||
|
FMX.Controls.Presentation,
|
||||||
|
FMX.StdCtrls,
|
||||||
|
FMX.WebBrowser,
|
||||||
|
Winapi.WebView2,
|
||||||
|
FMX.Memo.Types,
|
||||||
|
FMX.ScrollBox,
|
||||||
|
FMX.Memo,
|
||||||
|
FMX.Edit,
|
||||||
|
FMX.StdActns,
|
||||||
|
// FMX.Edit für TEdit, FMX.StdActns oft für Standardaktionen
|
||||||
|
// Korrekte und vollständige Units
|
||||||
|
System.IOUtils,
|
||||||
|
System.Threading,
|
||||||
|
System.Diagnostics,
|
||||||
|
Winapi.Windows,
|
||||||
|
LLVM.Runner;
|
||||||
|
|
||||||
|
const
|
||||||
|
// Pfad zur HTML-Datei (BITTE HIER ANPASSEN!)
|
||||||
|
PATH_BLOCKLY = 'T:\Myc\Blockly\index.html'; // <--- PRÜFEN UND ANPASSEN!
|
||||||
|
|
||||||
|
// Pfade zu den LLVM-Werkzeugen (BITTE HIER ANPASSEN!)
|
||||||
|
CLANG_PATH = 'clang.exe'; // <--- PRÜFEN UND ANPASSEN!
|
||||||
|
LLD_PATH = 'lld-link.exe'; // <--- PRÜFEN UND ANPASSEN!
|
||||||
|
|
||||||
|
type
|
||||||
|
TMainForm = class(TForm)
|
||||||
|
WebBrowser1: TWebBrowser;
|
||||||
|
SaveWorkspaceButton: TSpeedButton;
|
||||||
|
GenerateCodeButton: TSpeedButton;
|
||||||
|
Memo: TMemo;
|
||||||
|
InputEdit: TEdit; // <--- Hinzugefügt (Optional für Beschriftung des InputEdit)
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure RefreshButtonClick(Sender: TObject);
|
||||||
|
procedure SaveWorkspaceButtonClick(Sender: TObject);
|
||||||
|
procedure GenerateCodeButtonClick(Sender: TObject);
|
||||||
|
procedure WebBrowser1DidFinishLoad(ASender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
FWebView: ICoreWebView2;
|
||||||
|
FWebMessageReceiver: ICoreWebView2WebMessageReceivedEventHandler;
|
||||||
|
FWebMessageReceivedToken: EventRegistrationToken;
|
||||||
|
procedure HandleWebMessage(const AMessage: string);
|
||||||
|
function ExecuteProcess(const ACommand: string; const AParameters: string): string;
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
MainForm: TMainForm;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.fmx}
|
||||||
|
|
||||||
|
type
|
||||||
|
TWebMessageReceiver = class(TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler)
|
||||||
|
private
|
||||||
|
FOwner: TMainForm;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TMainForm);
|
||||||
|
function Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult; stdcall;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TWebMessageReceiver.Create(AOwner: TMainForm);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FOwner := AOwner;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TWebMessageReceiver.Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult;
|
||||||
|
var
|
||||||
|
message: PWideChar;
|
||||||
|
begin
|
||||||
|
Result := args.TryGetWebMessageAsString(message);
|
||||||
|
if Succeeded(Result) then
|
||||||
|
begin
|
||||||
|
TThread.Queue(nil, procedure begin FOwner.HandleWebMessage(string(message)); end);
|
||||||
|
end;
|
||||||
|
Result := S_OK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
TLLVMRunner.Log := Memo.Lines;
|
||||||
|
// Optional: Standardwert für InputEdit
|
||||||
|
InputEdit.Text := '123';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
TLLVMRunner.Log := nil;
|
||||||
|
if (FWebView <> nil) and (FWebMessageReceivedToken.value <> 0) then
|
||||||
|
begin
|
||||||
|
FWebView.remove_WebMessageReceived(FWebMessageReceivedToken);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMainForm.ExecuteProcess(const ACommand: string; const AParameters: string): string;
|
||||||
|
var
|
||||||
|
sa: TSecurityAttributes;
|
||||||
|
si: TStartupInfo;
|
||||||
|
pi: TProcessInformation;
|
||||||
|
stdOutRead, stdOutWrite: THandle;
|
||||||
|
success: Boolean;
|
||||||
|
cmdLine: string;
|
||||||
|
buffer: TBytes;
|
||||||
|
bytesRead: Cardinal;
|
||||||
|
output, errors: string;
|
||||||
|
begin
|
||||||
|
// Pipe für StdOut und StdErr erstellen
|
||||||
|
sa.nLength := SizeOf(TSecurityAttributes);
|
||||||
|
sa.lpSecurityDescriptor := nil;
|
||||||
|
sa.bInheritHandle := True;
|
||||||
|
|
||||||
|
// Für stdout und stderr wird dieselbe Pipe verwendet, da clang Fehler auf stdout ausgibt
|
||||||
|
if not CreatePipe(stdOutRead, stdOutWrite, @sa, 0) then
|
||||||
|
Exit('Error creating pipe.');
|
||||||
|
|
||||||
|
try
|
||||||
|
// StartupInfo vorbereiten
|
||||||
|
FillChar(si, SizeOf(TStartupInfo), 0);
|
||||||
|
si.cb := SizeOf(TStartupInfo);
|
||||||
|
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
|
||||||
|
si.wShowWindow := SW_HIDE; // Fenster explizit verstecken
|
||||||
|
si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
|
||||||
|
si.hStdOutput := stdOutWrite;
|
||||||
|
si.hStdError := stdOutWrite; // Leite stderr auf dieselbe Pipe wie stdout
|
||||||
|
|
||||||
|
cmdLine := Format('"%s" %s', [ACommand, AParameters]);
|
||||||
|
|
||||||
|
success := CreateProcess(nil, PChar(cmdLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, si, pi);
|
||||||
|
|
||||||
|
// Schreib-Handle der Pipe sofort schließen
|
||||||
|
CloseHandle(stdOutWrite);
|
||||||
|
|
||||||
|
if not success then
|
||||||
|
Exit(Format('CreateProcess failed. Code: %d', [GetLastError]));
|
||||||
|
|
||||||
|
try
|
||||||
|
output := '';
|
||||||
|
// Warten, bis der Prozess fertig ist und alle Daten in die Pipe geschrieben hat
|
||||||
|
if WaitForSingleObject(pi.hProcess, 5000) = WAIT_TIMEOUT then // 5s Timeout
|
||||||
|
begin
|
||||||
|
TerminateProcess(pi.hProcess, 1);
|
||||||
|
Exit('Process timed out.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Bytes aus der Pipe lesen
|
||||||
|
repeat
|
||||||
|
SetLength(buffer, 1024);
|
||||||
|
bytesRead := 0;
|
||||||
|
if ReadFile(stdOutRead, buffer[0], Length(buffer), bytesRead, nil) and (bytesRead > 0) then
|
||||||
|
begin
|
||||||
|
SetLength(buffer, bytesRead);
|
||||||
|
// Gelesene Bytes mit dem Default-System-Encoding in einen String umwandeln
|
||||||
|
output := output + TEncoding.Default.GetString(buffer);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
break; // Pipe ist leer oder Fehler
|
||||||
|
end;
|
||||||
|
until False;
|
||||||
|
|
||||||
|
finally
|
||||||
|
CloseHandle(pi.hProcess);
|
||||||
|
CloseHandle(pi.hThread);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := output;
|
||||||
|
|
||||||
|
finally
|
||||||
|
CloseHandle(stdOutRead);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.RefreshButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
WebBrowser1.Navigate(PATH_BLOCKLY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.SaveWorkspaceButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
WebBrowser1.EvaluateJavaScript('saveWorkspace()');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.GenerateCodeButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
WebBrowser1.EvaluateJavaScript('generateAndPostCode()');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.HandleWebMessage(const AMessage: string);
|
||||||
|
var
|
||||||
|
llFile, objFile, dllFile: string;
|
||||||
|
compilerOutput: string;
|
||||||
|
success: Boolean;
|
||||||
|
InputInteger: Integer; // <--- Hinzugefügt
|
||||||
|
begin
|
||||||
|
Memo.Lines.Clear;
|
||||||
|
Memo.Lines.Add('LLVM-Code empfangen. Starte Kompilierung...');
|
||||||
|
Memo.Lines.Add(AMessage);
|
||||||
|
Memo.Lines.Add('--------------------');
|
||||||
|
|
||||||
|
// Wert aus dem InputEdit-Feld holen
|
||||||
|
try
|
||||||
|
InputInteger := StrToIntDef(InputEdit.Text, 0); // Standardwert 0, falls ungültig
|
||||||
|
except
|
||||||
|
InputInteger := 0;
|
||||||
|
Memo.Lines.Add('WARNUNG: Ungültige Eingabe im InputEdit-Feld. Verwende 0.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTask.Run(
|
||||||
|
procedure
|
||||||
|
var
|
||||||
|
llFileLocal, objFileLocal, dllFileLocal: string; // Lokale Variablen für den Task
|
||||||
|
compilerOutputLocal: string;
|
||||||
|
successLocal: Boolean;
|
||||||
|
begin
|
||||||
|
llFileLocal := TPath.Combine(TPath.GetTempPath, 'poc.ll');
|
||||||
|
objFileLocal := TPath.ChangeExtension(llFileLocal, '.obj');
|
||||||
|
dllFileLocal := TPath.ChangeExtension(llFileLocal, '.dll');
|
||||||
|
successLocal := False;
|
||||||
|
|
||||||
|
try
|
||||||
|
TFile.WriteAllText(llFileLocal, AMessage);
|
||||||
|
|
||||||
|
TThread.Queue(nil, procedure begin Memo.Lines.Add('Kompiliere zu Objektdatei...'); end);
|
||||||
|
compilerOutputLocal := ExecuteProcess(CLANG_PATH, Format('-c "%s" -o "%s"', [llFileLocal, objFileLocal]));
|
||||||
|
TThread.Queue(nil, procedure begin Memo.Lines.Add(compilerOutputLocal); end);
|
||||||
|
|
||||||
|
if not TFile.Exists(objFileLocal) then
|
||||||
|
begin
|
||||||
|
TThread
|
||||||
|
.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.'); end);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TThread.Queue(nil, procedure begin Memo.Lines.Add('Linke zu DLL...'); end);
|
||||||
|
compilerOutputLocal := ExecuteProcess(LLD_PATH, Format('/dll /noentry "%s" /out:"%s"', [objFileLocal, dllFileLocal]));
|
||||||
|
TThread.Queue(nil, procedure begin Memo.Lines.Add(compilerOutputLocal); end);
|
||||||
|
|
||||||
|
if TFile.Exists(dllFileLocal) then
|
||||||
|
begin
|
||||||
|
successLocal := True;
|
||||||
|
TThread.Queue(nil, procedure begin Memo.Lines.Add(Format('ERFOLG: DLL wurde erstellt: %s', [dllFileLocal])); end);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
TThread.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.'); end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
finally
|
||||||
|
if TFile.Exists(llFileLocal) then
|
||||||
|
TFile.Delete(llFileLocal);
|
||||||
|
if TFile.Exists(objFileLocal) then
|
||||||
|
TFile.Delete(objFileLocal);
|
||||||
|
if not successLocal and TFile.Exists(dllFileLocal) then
|
||||||
|
TFile.Delete(dllFileLocal);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TThread.Queue(
|
||||||
|
nil,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
Memo.Lines.Add('---------------------------------------------------------');
|
||||||
|
Memo.Lines.Add('DLL wird aufgerufen:');
|
||||||
|
|
||||||
|
if TFile.Exists(dllFileLocal) then
|
||||||
|
begin
|
||||||
|
var Runner := TLLVMRunner.Create(dllFileLocal);
|
||||||
|
try
|
||||||
|
Runner.Execute(InputInteger); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN
|
||||||
|
finally
|
||||||
|
Runner.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Memo.Lines.Add('DLL beendet.');
|
||||||
|
Memo.CaretPosition := TCaretPosition.Create(Memo.Lines.Count - 1, 1);
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.WebBrowser1DidFinishLoad(ASender: TObject);
|
||||||
|
begin
|
||||||
|
if Assigned(FWebMessageReceiver) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
if Supports(WebBrowser1, ICoreWebView2, FWebView) then
|
||||||
|
begin
|
||||||
|
FWebMessageReceiver := TWebMessageReceiver.Create(Self);
|
||||||
|
FWebView.add_WebMessageReceived(FWebMessageReceiver, FWebMessageReceivedToken);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,74 @@
|
|||||||
|
Technische Dokumentation: Integration von Blockly in eine Delphi FireMonkey Anwendung via WebView2
|
||||||
|
Datum: 10. Juni 2025
|
||||||
|
|
||||||
|
Autor: Gemini & ein sehr fähiger Delphi-Entwickler
|
||||||
|
|
||||||
|
1. Zielsetzung
|
||||||
|
Ziel dieser Architektur ist die Erstellung einer Hybrid-Anwendung. Eine in Delphi (FireMonkey) entwickelte, native Desktop-Anwendung hostet eine webbasierte, visuelle Programmierumgebung (Blockly). Dies ermöglicht es Endanwendern, komplexe Logik visuell zu erstellen, während die Hauptanwendung die generierten Ergebnisse (z.B. Quellcode in einer Zielsprache) entgegennehmen und weiterverarbeiten kann.
|
||||||
|
|
||||||
|
Diese Architektur ist ideal für die Erstellung von spezialisierten Entwicklungsumgebungen, Konfigurations-Tools oder Lernanwendungen.
|
||||||
|
|
||||||
|
2. Kernkomponenten
|
||||||
|
Native Host-Anwendung: Eine Delphi FireMonkey (FMX) Anwendung, erstellt in RAD Studio (getestet mit Version 12). Dient als Hauptcontainer und steuert die native UI.
|
||||||
|
Browser-Komponente: Die FMX TWebBrowser-Komponente. Entscheidend ist die Konfiguration der Engine-Eigenschaft, um auf Windows die moderne Microsoft Edge WebView2-Engine zu nutzen.
|
||||||
|
Browser-Laufzeitumgebung: Die Microsoft Edge WebView2 Runtime. Diese muss auf dem Zielsystem des Endanwenders installiert sein.
|
||||||
|
Web-Anwendung (Frontend): Eine lokale, in sich geschlossene HTML-Datei (index.html), die die Blockly-Bibliothek lädt und den visuellen Editor initialisiert.
|
||||||
|
Benutzerdefinierter Generator: Ein in JavaScript geschriebener, benutzerdefinierter Blockly-Generator (in unserem Fall Blockly.Delphi), der die visuellen Blöcke in eine textbasierte Zielsprache übersetzt.
|
||||||
|
3. Architektur-Übersicht
|
||||||
|
Die Delphi-Anwendung fungiert als nativer Container. Beim Start lädt die TWebBrowser-Komponente die lokale index.html-Datei. Diese Datei enthält die gesamte Logik für den Blockly-Editor und den Code-Generator. Die Kommunikation zwischen der Delphi-Anwendung (Host) und der JavaScript-Anwendung (Gast) erfolgt über eine spezielle Schnittstelle, die von der WebView2-Engine bereitgestellt wird.
|
||||||
|
|
||||||
|
+-------------------------------------------------+
|
||||||
|
| Delphi FireMonkey Anwendung (MainForm.pas) |
|
||||||
|
| +---------------------------------------------+ |
|
||||||
|
| | TWebBrowser (Engine: Edge WebView2) | |
|
||||||
|
| | +-----------------------------------------+ | |
|
||||||
|
| | | Lokale index.html geladen | | |
|
||||||
|
| | | +-----------------+ +---------------+ | | |
|
||||||
|
| | | | Blockly | | Generator | | | |
|
||||||
|
| | | | Arbeitsbereich | | (JavaScript) | | | |
|
||||||
|
| | | +-----------------+ +---------------+ | | |
|
||||||
|
| | +-----------------------------------------+ | |
|
||||||
|
| +---------------------------------------------+ |
|
||||||
|
| ^ | |
|
||||||
|
| | Delphi -> JS (EvaluateJavaScript) |
|
||||||
|
| | JS -> Delphi (OnWebMessageReceived) |
|
||||||
|
| v | |
|
||||||
|
| +---------------------------------------------+ |
|
||||||
|
| | Native UI-Elemente (Buttons, TMemo etc.) | |
|
||||||
|
| +---------------------------------------------+ |
|
||||||
|
+-------------------------------------------------+
|
||||||
|
4. Implementierungsschritte
|
||||||
|
4.1. Die Web-Anwendung (index.html)
|
||||||
|
Dies ist das Herzstück des Editors. Die Datei enthält die Blockly-Bibliotheken (von einem CDN oder lokal), den benutzerdefinierten Generator und den Initialisierungscode.
|
||||||
|
|
||||||
|
Wichtige JavaScript-Funktionen in der index.html:
|
||||||
|
|
||||||
|
Blockly.Delphi = new Blockly.Generator(...): Erstellt die Instanz unseres benutzerdefinierten Generators.
|
||||||
|
Blockly.Delphi.forBlock['block_type'] = function(...): Definiert die Übersetzungsregel für einen spezifischen Block-Typ.
|
||||||
|
Blockly.Delphi.workspaceToCode(...): Die Hauptfunktion, die den gesamten Arbeitsbereich in die Zielsprache übersetzt. In unserem Fall wurde diese überschrieben, um die Delphi-Unit-Struktur (Header, var-Sektion etc.) zu erzeugen.
|
||||||
|
window.saveWorkspace() & window.loadWorkspace(): Nutzen Blockly.serialization.workspaces und localStorage, um den Zustand des Editors zu speichern und wiederherzustellen.
|
||||||
|
window.generateAndPostCode(): Die Schlüsselfunktion für die Kommunikation. Sie generiert den Code und sendet ihn mittels window.chrome.webview.postMessage(code) an die Delphi-Host-Anwendung.
|
||||||
|
(Der vollständige, funktionierende Code für die index.html ist der aus unserer letzten erfolgreichen Iteration.)
|
||||||
|
|
||||||
|
4.2. Die Delphi Host-Anwendung (FireMonkey)
|
||||||
|
Die FMX-Form enthält die TWebBrowser-Komponente und die nativen Steuerelemente.
|
||||||
|
|
||||||
|
Wichtige Konfiguration und Code-Teile in der Delphi-Unit:
|
||||||
|
|
||||||
|
Komponenten: Eine TWebBrowser (WebBrowser1), ein TMemo (Memo1) und mehrere TButton.
|
||||||
|
WebBrowser1.Engine Eigenschaft: Muss im Objektinspektor oder per Code auf EdgeIfAvailable gesetzt werden.
|
||||||
|
FormCreate: Lädt die lokale index.html-Datei mit WebBrowser1.Navigate('pfad/zur/index.html').
|
||||||
|
WebBrowser1DidFinishLoad: In diesem Ereignis wird der Nachrichten-Empfänger (WebMessageReceived) registriert. Dies stellt sicher, dass die Webseite vollständig geladen ist, bevor die Kommunikation eingerichtet wird. Die Registrierung erfolgt über die ICoreWebView2-Schnittstelle.
|
||||||
|
TWebMessageReceiver-Klasse: Eine Hilfsklasse, die das ICoreWebView2WebMessageReceivedEventHandler-Interface implementiert. Ihre Invoke-Methode wird aufgerufen, wenn eine Nachricht von JavaScript eintrifft.
|
||||||
|
TThread.Queue: Wichtig innerhalb der Invoke-Methode, um die empfangene Nachricht sicher an den Haupt-GUI-Thread zu übergeben und UI-Komponenten (wie das TMemo) zu aktualisieren.
|
||||||
|
Button.OnClick-Ereignisse: Rufen WebBrowser1.EvaluateJavaScript('funktionsname()') auf, um JavaScript-Funktionen im WebView auszulösen.
|
||||||
|
(Der vollständige, funktionierende Code für die Delphi-Unit ist der, den Sie zuletzt bereitgestellt haben.)
|
||||||
|
|
||||||
|
5. Deployment und Abhängigkeiten
|
||||||
|
Um die Anwendung an einen Endnutzer weiterzugeben, müssen folgende Komponenten verteilt werden:
|
||||||
|
|
||||||
|
Ihre kompilierte .exe-Datei.
|
||||||
|
Ein Unterordner (z.B. web), der die index.html und alle zugehörigen JavaScript-Dateien enthält (falls sie nicht von einem CDN geladen werden).
|
||||||
|
Der Installer muss prüfen, ob die Microsoft Edge WebView2 Runtime vorhanden ist, und sie bei Bedarf herunterladen und installieren. Microsoft stellt dafür einen kleinen "Bootstrapper"-Installer bereit.
|
||||||
|
6. Fazit
|
||||||
|
Diese Hybrid-Architektur ist extrem leistungsfähig. Sie kombiniert die universelle Einsetzbarkeit und Flexibilität moderner Web-Technologien (HTML/JS/Blockly) für die Benutzeroberfläche des Editors mit der Stärke und Geschwindigkeit einer nativen Delphi-Anwendung für die Programmlogik, Dateiverarbeitung und die Integration in das Betriebssystem. Der TWebBrowser im Edge-Modus ist die entscheidende Brückentechnologie, die diesen Ansatz in FireMonkey modern und zukunftssicher macht.
|
||||||
@@ -0,0 +1,163 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Blockly zu Delphi Unit - Final</title>
|
||||||
|
<style>
|
||||||
|
body { font-family: sans-serif; }
|
||||||
|
#container { display: flex; }
|
||||||
|
#outputArea { margin-left: 20px; }
|
||||||
|
#codeOutput { width: 400px; height: 580px; font-family: 'Courier New', Courier, monospace; font-size: 14px; white-space: pre-wrap; border: 1px solid #ccc; }
|
||||||
|
#blocklyDiv { height: 600px; width: 800px; }
|
||||||
|
.button-bar { margin-bottom: 10px; }
|
||||||
|
</style>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<h1>Mein Delphi-Unit-Generator</h1>
|
||||||
|
<p>Bauen Sie links Ihre Blöcke. Rechts erscheint die kompilierbare Delphi-Unit.</p>
|
||||||
|
|
||||||
|
<div class="button-bar">
|
||||||
|
<button onclick="saveWorkspace()">Speichern</button>
|
||||||
|
<button onclick="loadWorkspace()">Letzten Stand laden</button>
|
||||||
|
<button onclick="generateAndPostCode()">Code generieren und posten</button>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="container">
|
||||||
|
<div id="blocklyDiv"></div>
|
||||||
|
<div id="outputArea">
|
||||||
|
<h2>Erzeugter Delphi-Code:</h2>
|
||||||
|
<textarea id="codeOutput" readonly></textarea>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<script src="https://unpkg.com/blockly/blockly_compressed.js"></script>
|
||||||
|
<script src="https://unpkg.com/blockly/blocks_compressed.js"></script>
|
||||||
|
<script src="https://unpkg.com/blockly/msg/de.js"></script>
|
||||||
|
|
||||||
|
<script>
|
||||||
|
window.onload = function() {
|
||||||
|
|
||||||
|
let workspace;
|
||||||
|
|
||||||
|
// === DER DELPHI-GENERATOR ===
|
||||||
|
Blockly.Delphi = new Blockly.Generator('Delphi');
|
||||||
|
Blockly.Delphi.ORDER_ATOMIC = 0;
|
||||||
|
Blockly.Delphi.ORDER_NONE = 99;
|
||||||
|
|
||||||
|
Blockly.Delphi.workspaceToCode = function(workspace) {
|
||||||
|
const allVariables = workspace.getAllVariables();
|
||||||
|
let varDeclarations = '';
|
||||||
|
if (allVariables.length > 0) {
|
||||||
|
const varNames = allVariables.map(v => v.name).join(', ');
|
||||||
|
varDeclarations = ` var\n ${varNames}: Integer;\n`;
|
||||||
|
}
|
||||||
|
varDeclarations += ' i: Integer; // Schleifenzähler\n';
|
||||||
|
const topBlocks = workspace.getTopBlocks(true);
|
||||||
|
const code = topBlocks.map(block => Blockly.Delphi.blockToCode(block)).join(';\n');
|
||||||
|
let unitCode = 'unit MeinProgramm;\n\n';
|
||||||
|
unitCode += 'interface\n\n';
|
||||||
|
unitCode += 'uses\n System.SysUtils;\n\n';
|
||||||
|
unitCode += 'procedure StarteLogik;\n\n';
|
||||||
|
unitCode += 'implementation\n\n';
|
||||||
|
unitCode += 'procedure StarteLogik;\n';
|
||||||
|
if (varDeclarations) unitCode += varDeclarations;
|
||||||
|
unitCode += 'begin\n';
|
||||||
|
unitCode += ' ' + code.split('\n').join('\n ');
|
||||||
|
unitCode += '\nend;\n\n';
|
||||||
|
unitCode += 'end.';
|
||||||
|
return unitCode;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.Delphi.scrub_ = function(block, code, opt_thisOnly) {
|
||||||
|
const nextBlock = block.nextConnection && block.nextConnection.targetBlock();
|
||||||
|
const nextCode = opt_thisOnly ? '' : Blockly.Delphi.blockToCode(nextBlock);
|
||||||
|
return code + (nextBlock ? ';\n' : '') + nextCode;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['controls_if'] = function(block) {
|
||||||
|
let conditionCode = Blockly.Delphi.valueToCode(block, 'IF0', Blockly.Delphi.ORDER_NONE) || 'False';
|
||||||
|
let branchCode = Blockly.Delphi.statementToCode(block, 'DO0') || '';
|
||||||
|
let code = `if (${conditionCode}) then\nbegin\n${Blockly.Delphi.prefixLines(branchCode, ' ')}\nend`;
|
||||||
|
return code;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['logic_compare'] = function(block) {
|
||||||
|
const OPERATORS = {'EQ': '=', 'NEQ': '<>', 'LT': '<', 'LTE': '<=', 'GT': '>', 'GTE': '>='};
|
||||||
|
const operator = OPERATORS[block.getFieldValue('OP')];
|
||||||
|
const value_a = Blockly.Delphi.valueToCode(block, 'A', Blockly.Delphi.ORDER_ATOMIC) || '0';
|
||||||
|
const value_b = Blockly.Delphi.valueToCode(block, 'B', Blockly.Delphi.ORDER_ATOMIC) || '0';
|
||||||
|
return [`${value_a} ${operator} ${value_b}`, Blockly.Delphi.ORDER_ATOMIC];
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['controls_repeat_ext'] = function(block) {
|
||||||
|
const repeats = Blockly.Delphi.valueToCode(block, 'TIMES', Blockly.Delphi.ORDER_ATOMIC) || '0';
|
||||||
|
const branch = Blockly.Delphi.statementToCode(block, 'DO') || '';
|
||||||
|
let code = `for i := 1 to ${repeats} do\nbegin\n${Blockly.Delphi.prefixLines(branch, ' ')}\nend`;
|
||||||
|
return code;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['math_number'] = function(block) { return [String(block.getFieldValue('NUM')), Blockly.Delphi.ORDER_ATOMIC]; };
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['variables_get'] = function(block) { const varName = block.workspace.getVariableById(block.getFieldValue('VAR')).name; return [varName, Blockly.Delphi.ORDER_ATOMIC]; };
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['variables_set'] = function(block) { const varName = block.workspace.getVariableById(block.getFieldValue('VAR')).name; const value = Blockly.Delphi.valueToCode(block, 'VALUE', Blockly.Delphi.ORDER_ATOMIC) || '0'; return `${varName} := ${value}`;};
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['math_change'] = function(block) { const varName = block.workspace.getVariableById(block.getFieldValue('VAR')).name; const delta = Blockly.Delphi.valueToCode(block, 'DELTA', Blockly.Delphi.ORDER_ATOMIC) || '0'; if (delta == '1') return `Inc(${varName})`; if (delta == '-1') return `Dec(${varName})`; return `${varName} := ${varName} + ${delta}`; };
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['text_print'] = function(block) { const value = Blockly.Delphi.valueToCode(block, 'TEXT', Blockly.Delphi.ORDER_ATOMIC) || `''`; return `WriteLn(${value})`; };
|
||||||
|
|
||||||
|
Blockly.Delphi.forBlock['text'] = function(block) { const text = block.getFieldValue('TEXT').replace(/'/g, "''"); return [`'${text}'`, Blockly.Delphi.ORDER_ATOMIC]; };
|
||||||
|
|
||||||
|
// === INITIALISIERUNG VON BLOCKLY (JETZT KORREKT) ===
|
||||||
|
|
||||||
|
// 1. Definition der Werkzeugkiste (Toolbox)
|
||||||
|
const toolboxXml = `
|
||||||
|
<xml>
|
||||||
|
<category name="Logik" colour="%{BKY_LOGIC_HUE}">
|
||||||
|
<block type="controls_if"></block>
|
||||||
|
<block type="logic_compare"></block>
|
||||||
|
</category>
|
||||||
|
<category name="Schleifen" colour="%{BKY_LOOPS_HUE}">
|
||||||
|
<block type="controls_repeat_ext">
|
||||||
|
<value name="TIMES"><shadow type="math_number"><field name="NUM">10</field></shadow></value>
|
||||||
|
</block>
|
||||||
|
</category>
|
||||||
|
<category name="Text" colour="%{BKY_TEXTS_HUE}">
|
||||||
|
<block type="text_print"></block>
|
||||||
|
<block type="text"></block>
|
||||||
|
</category>
|
||||||
|
<category name="Mathematik" colour="%{BKY_MATH_HUE}">
|
||||||
|
<block type="math_number"></block>
|
||||||
|
<block type="math_change">
|
||||||
|
<value name="DELTA"><shadow type="math_number"><field name="NUM">1</field></shadow></value>
|
||||||
|
</block>
|
||||||
|
</category>
|
||||||
|
<category name="Variablen" colour="%{BKY_VARIABLES_HUE}" custom="VARIABLE"></category>
|
||||||
|
</xml>`;
|
||||||
|
|
||||||
|
// 2. Blockly in den Div-Container "injizieren"
|
||||||
|
workspace = Blockly.inject('blocklyDiv', {
|
||||||
|
toolbox: toolboxXml
|
||||||
|
});
|
||||||
|
|
||||||
|
|
||||||
|
function generateAndPostCode() {
|
||||||
|
const code = Blockly.Delphi.workspaceToCode(workspace);
|
||||||
|
// Diese spezielle Funktion sendet eine Nachricht an den Delphi-Host
|
||||||
|
window.chrome.webview.postMessage(code);
|
||||||
|
}
|
||||||
|
|
||||||
|
window.generateAndPostCode = function() { generateAndPostCode(); }
|
||||||
|
|
||||||
|
// === Funktionen für Speichern und Laden (unverändert) ===
|
||||||
|
window.saveWorkspace = function() { const state = Blockly.serialization.workspaces.save(workspace); localStorage.setItem('blocklyWorkspace', JSON.stringify(state)); alert('Arbeitsbereich gespeichert!'); }
|
||||||
|
window.loadWorkspace = function() { const stateString = localStorage.getItem('blocklyWorkspace'); if (!stateString) { return; } const state = JSON.parse(stateString); Blockly.serialization.workspaces.load(state, workspace); }
|
||||||
|
function updateCode(event) { if (event.type == Blockly.Events.UI) return; const code = Blockly.Delphi.workspaceToCode(workspace); document.getElementById('codeOutput').value = code; }
|
||||||
|
workspace.addChangeListener(updateCode);
|
||||||
|
loadWorkspace();
|
||||||
|
};
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@@ -0,0 +1,108 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Blockly zu Umgangssprache - Mit Schleifen & Zählern</title>
|
||||||
|
<style>
|
||||||
|
body { font-family: sans-serif; }
|
||||||
|
#container { display: flex; }
|
||||||
|
#outputArea { margin-left: 20px; }
|
||||||
|
#codeOutput { width: 400px; height: 580px; font-size: 14px; white-space: pre-wrap; border: 1px solid #ccc; }
|
||||||
|
#blocklyDiv { height: 600px; width: 800px; }
|
||||||
|
.button-bar { margin-bottom: 10px; }
|
||||||
|
</style>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<h1>Mein "Umgangssprache"-Generator</h1>
|
||||||
|
<p>Bauen Sie links Ihre Blöcke. Rechts erscheint die textliche Beschreibung.</p>
|
||||||
|
|
||||||
|
<div class="button-bar">
|
||||||
|
<button onclick="saveWorkspace()">Speichern</button>
|
||||||
|
<button onclick="loadWorkspace()">Letzten Stand laden</button>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="container">
|
||||||
|
<div id="blocklyDiv"></div>
|
||||||
|
<div id="outputArea">
|
||||||
|
<h2>Erzeugter Text:</h2>
|
||||||
|
<textarea id="codeOutput" readonly></textarea>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<script src="https://unpkg.com/blockly/blockly_compressed.js"></script>
|
||||||
|
<script src="https://unpkg.com/blockly/blocks_compressed.js"></script>
|
||||||
|
<script src="https://unpkg.com/blockly/msg/de.js"></script>
|
||||||
|
|
||||||
|
<script>
|
||||||
|
window.onload = function() {
|
||||||
|
|
||||||
|
let workspace;
|
||||||
|
|
||||||
|
// === UNSER UMGANGSSPRACHE-GENERATOR ===
|
||||||
|
Blockly.Human = new Blockly.Generator('Human');
|
||||||
|
Blockly.Human.ORDER_ATOMIC = 0;
|
||||||
|
Blockly.Human.scrub_ = function(block, code, opt_thisOnly) { const nextBlock = block.nextConnection && block.nextConnection.targetBlock(); const nextCode = opt_thisOnly ? '' : Blockly.Human.blockToCode(nextBlock); return code + nextCode; };
|
||||||
|
Blockly.Human.prefixLines = function(text, prefix) { return prefix + text.split(/\n(?!$)/).join('\n' + prefix); };
|
||||||
|
|
||||||
|
// --- Generatoren für die einzelnen Blöcke ---
|
||||||
|
Blockly.Human.forBlock['controls_if'] = function(block) { let conditionCode = Blockly.Human.valueToCode(block, 'IF0', Blockly.Human.ORDER_ATOMIC) || 'eine Bedingung erfüllt ist'; let branchCode = Blockly.Human.statementToCode(block, 'DO0') || 'nichts.\n'; let code = `Also, überprüfe, ${conditionCode}.\n`; code += `Wenn das zutrifft, dann mach Folgendes:\n`; code += Blockly.Human.prefixLines(branchCode, ' '); return code; };
|
||||||
|
Blockly.Human.forBlock['logic_compare'] = function(block) { const OPERATORS = {'EQ': 'ist gleich', 'NEQ': 'ist nicht gleich', 'LT': 'ist kleiner als', 'LTE': 'ist kleiner oder gleich', 'GT': 'ist größer als', 'GTE': 'ist größer oder gleich'}; const operator = OPERATORS[block.getFieldValue('OP')]; const value_a = Blockly.Human.valueToCode(block, 'A', Blockly.Human.ORDER_ATOMIC) || 'irgendetwas'; const value_b = Blockly.Human.valueToCode(block, 'B', Blockly.Human.ORDER_ATOMIC) || 'irgendetwas anderes'; const code = `ob der Wert von ${value_a} ${operator} als ${value_b}`; return [code, Blockly.Human.ORDER_ATOMIC]; };
|
||||||
|
Blockly.Human.forBlock['math_number'] = function(block) { return [String(block.getFieldValue('NUM')), Blockly.Human.ORDER_ATOMIC]; };
|
||||||
|
Blockly.Human.forBlock['variables_get'] = function(block) { const varId = block.getFieldValue('VAR'); const variable = block.workspace.getVariableById(varId); const varName = variable ? variable.name : 'unbekannt'; return [`der Variable "${varName}"`, Blockly.Human.ORDER_ATOMIC]; };
|
||||||
|
Blockly.Human.forBlock['variables_set'] = function(block) { const varId = block.getFieldValue('VAR'); const variable = block.workspace.getVariableById(varId); const varName = variable ? variable.name : 'unbekannt'; const value = Blockly.Human.valueToCode(block, 'VALUE', Blockly.Human.ORDER_ATOMIC) || 'nichts'; return `Setze die Variable "${varName}" auf den Wert ${value}.\n`; };
|
||||||
|
Blockly.Human.forBlock['text_print'] = function(block) { const value = Blockly.Human.valueToCode(block, 'TEXT', Blockly.Human.ORDER_ATOMIC) || '"nichts"'; return `Gib auf dem Bildschirm aus: ${value}\n`; };
|
||||||
|
Blockly.Human.forBlock['text'] = function(block) { return [`"${block.getFieldValue('TEXT')}"`, Blockly.Human.ORDER_ATOMIC]; };
|
||||||
|
Blockly.Human.forBlock['controls_repeat_ext'] = function(block) { const repeats = Blockly.Human.valueToCode(block, 'TIMES', Blockly.Human.ORDER_ATOMIC) || 'einige Male'; const branch = Blockly.Human.statementToCode(block, 'DO') || 'mache nichts.\n'; let code = `Wiederhole die folgenden Schritte ${repeats} Mal:\n`; code += Blockly.Human.prefixLines(branch, ' '); return code; };
|
||||||
|
|
||||||
|
// NEU: Generator für den "ändere Variable um"-Block
|
||||||
|
Blockly.Human.forBlock['math_change'] = function(block) {
|
||||||
|
const varId = block.getFieldValue('VAR');
|
||||||
|
const variable = block.workspace.getVariableById(varId);
|
||||||
|
const varName = variable ? variable.name : 'unbekannt';
|
||||||
|
const delta = Blockly.Human.valueToCode(block, 'DELTA', Blockly.Human.ORDER_ATOMIC) || '0';
|
||||||
|
return `Ändere die Variable "${varName}" um den Wert ${delta}.\n`;
|
||||||
|
};
|
||||||
|
|
||||||
|
|
||||||
|
// === INITIALISIERUNG VON BLOCKLY ===
|
||||||
|
|
||||||
|
const toolboxXml = `
|
||||||
|
<xml>
|
||||||
|
<category name="Logik" colour="%{BKY_LOGIC_HUE}">
|
||||||
|
<block type="controls_if"></block>
|
||||||
|
<block type="logic_compare"></block>
|
||||||
|
</category>
|
||||||
|
<category name="Schleifen" colour="%{BKY_LOOPS_HUE}">
|
||||||
|
<block type="controls_repeat_ext">
|
||||||
|
<value name="TIMES"><shadow type="math_number"><field name="NUM">10</field></shadow></value>
|
||||||
|
</block>
|
||||||
|
</category>
|
||||||
|
<category name="Text" colour="%{BKY_TEXTS_HUE}">
|
||||||
|
<block type="text_print"></block>
|
||||||
|
<block type="text"></block>
|
||||||
|
</category>
|
||||||
|
<category name="Mathematik" colour="%{BKY_MATH_HUE}">
|
||||||
|
<block type="math_number"></block>
|
||||||
|
<block type="math_change">
|
||||||
|
<value name="DELTA"><shadow type="math_number"><field name="NUM">1</field></shadow></value>
|
||||||
|
</block>
|
||||||
|
</category>
|
||||||
|
<category name="Variablen" colour="%{BKY_VARIABLES_HUE}" custom="VARIABLE"></category>
|
||||||
|
</xml>`;
|
||||||
|
|
||||||
|
workspace = Blockly.inject('blocklyDiv', {
|
||||||
|
toolbox: toolboxXml
|
||||||
|
});
|
||||||
|
|
||||||
|
// === Funktionen für Speichern und Laden (unverändert) ===
|
||||||
|
window.saveWorkspace = function() { const state = Blockly.serialization.workspaces.save(workspace); localStorage.setItem('blocklyWorkspace', JSON.stringify(state)); alert('Arbeitsbereich gespeichert!'); }
|
||||||
|
window.loadWorkspace = function() { const stateString = localStorage.getItem('blocklyWorkspace'); if (!stateString) { return; } const state = JSON.parse(stateString); Blockly.serialization.workspaces.load(state, workspace); }
|
||||||
|
function updateCode(event) { if (event.type == Blockly.Events.UI) return; const code = Blockly.Human.workspaceToCode(workspace); document.getElementById('codeOutput').value = code; }
|
||||||
|
workspace.addChangeListener(updateCode);
|
||||||
|
loadWorkspace();
|
||||||
|
};
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@@ -0,0 +1,38 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Blockly zu LLVM IR - Final</title>
|
||||||
|
|
||||||
|
<link rel="stylesheet" href="style.css">
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<h1>LLVM IR (.dll) Generator</h1>
|
||||||
|
<p>Bauen Sie links Ihre Logik. Rechts erscheint der LLVM-Code, der zu einer 64-Bit DLL für Windows kompiliert werden kann.</p>
|
||||||
|
|
||||||
|
<div class="button-bar">
|
||||||
|
<button onclick="saveWorkspace()">Speichern</button>
|
||||||
|
<button onclick="loadWorkspace()">Letzten Stand laden</button>
|
||||||
|
<button onclick="generateAndPostCode()">Code generieren und posten</button>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="container">
|
||||||
|
<div id="blocklyDiv"></div>
|
||||||
|
<div id="outputContainer">
|
||||||
|
<div id="splitter"></div>
|
||||||
|
<div id="outputArea">
|
||||||
|
<h2>Erzeugter LLVM-Code:</h2>
|
||||||
|
<textarea id="codeOutput" readonly></textarea>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<script src="https://unpkg.com/blockly/blockly_compressed.js"></script>
|
||||||
|
<script src="https://unpkg.com/blockly/blocks_compressed.js"></script>
|
||||||
|
<script src="https://unpkg.com/blockly/msg/de.js"></script>
|
||||||
|
|
||||||
|
<script src="script.js"></script>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@@ -0,0 +1,380 @@
|
|||||||
|
window.onload = function() {
|
||||||
|
|
||||||
|
let workspace;
|
||||||
|
const isWebView = window.chrome && window.chrome.webview;
|
||||||
|
|
||||||
|
// === Debounce-Funktion ===
|
||||||
|
let debounceTimeout;
|
||||||
|
const debounce = (func, delay) => {
|
||||||
|
return function(...args) {
|
||||||
|
const context = this;
|
||||||
|
clearTimeout(debounceTimeout);
|
||||||
|
debounceTimeout = setTimeout(() => func.apply(context, args), delay);
|
||||||
|
};
|
||||||
|
};
|
||||||
|
|
||||||
|
// === LLVM-IR-GENERATOR (FINALE VERSION) ===
|
||||||
|
Blockly.LLVM = new Blockly.Generator('LLVM');
|
||||||
|
Blockly.LLVM.ORDER_ATOMIC = 0;
|
||||||
|
Blockly.LLVM.ORDER_NONE = 99;
|
||||||
|
|
||||||
|
// --- Block-Definitionen für die Toolbox ---
|
||||||
|
Blockly.defineBlocksWithJsonArray([
|
||||||
|
{
|
||||||
|
"type": "host_log_integer",
|
||||||
|
"message0": "Logge Integer %1",
|
||||||
|
"args0": [
|
||||||
|
{
|
||||||
|
"type": "input_value",
|
||||||
|
"name": "VALUE",
|
||||||
|
"check": "Number"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"previousStatement": null,
|
||||||
|
"nextStatement": null,
|
||||||
|
"colour": 290,
|
||||||
|
"tooltip": "Sendet einen Integer-Wert an den Delphi-Host.",
|
||||||
|
"helpUrl": ""
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"type": "host_get_integer_input",
|
||||||
|
"message0": "Hole Integer-Eingabe von Host",
|
||||||
|
"output": "Number",
|
||||||
|
"colour": 290,
|
||||||
|
"tooltip": "Liefert einen Integer-Wert, der vom Delphi-Host übergeben wurde.",
|
||||||
|
"helpUrl": ""
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"type": "host_add_integers",
|
||||||
|
"message0": "Addiere %1 und %2 auf Host",
|
||||||
|
"args0": [
|
||||||
|
{
|
||||||
|
"type": "input_value",
|
||||||
|
"name": "NUM1",
|
||||||
|
"check": "Number"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"type": "input_value",
|
||||||
|
"name": "NUM2",
|
||||||
|
"check": "Number"
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"output": "Number",
|
||||||
|
"colour": 290, // Host-Farbe
|
||||||
|
"tooltip": "Addiert zwei Integer-Werte unter Verwendung einer Host-Funktion.",
|
||||||
|
"helpUrl": ""
|
||||||
|
}
|
||||||
|
]);
|
||||||
|
|
||||||
|
// --- Generator-Implementierungen ---
|
||||||
|
|
||||||
|
Blockly.LLVM.regCounter = 0;
|
||||||
|
Blockly.LLVM.newReg = function() {
|
||||||
|
return '%' + (Blockly.LLVM.regCounter++);
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.workspaceToCode = function(workspace) {
|
||||||
|
Blockly.LLVM.regCounter = 1;
|
||||||
|
Blockly.LLVM.generatedStrings = new Set();
|
||||||
|
Blockly.LLVM.globalDeclarations = '';
|
||||||
|
Blockly.LLVM.functionDeclarations = '';
|
||||||
|
|
||||||
|
const allVariables = workspace.getAllVariables();
|
||||||
|
let varAllocations = '';
|
||||||
|
if (allVariables.length > 0) {
|
||||||
|
allVariables.forEach(v => {
|
||||||
|
const safeVarName = v.name.replace(/ /g, '_');
|
||||||
|
varAllocations += ` @${safeVarName} = common global i32 0\n`;
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
const topBlock = workspace.getTopBlocks(true)[0];
|
||||||
|
const code = topBlock ? Blockly.LLVM.blockToCode(topBlock) : '';
|
||||||
|
|
||||||
|
let moduleCode = `target triple = "x86_64-pc-windows-msvc"\n\n`;
|
||||||
|
|
||||||
|
// NEU: Deklaration der Host-Funktion (Signatur, die der Host implementiert)
|
||||||
|
moduleCode += `; Host Provided Function Declarations\n`;
|
||||||
|
moduleCode += `declare i32 @host_add_integers_func(i32, i32)\n\n`; // Beispiel: Funktion, die zwei i32 nimmt und i32 zurückgibt
|
||||||
|
|
||||||
|
if (Blockly.LLVM.functionDeclarations) {
|
||||||
|
moduleCode += Blockly.LLVM.functionDeclarations + '\n';
|
||||||
|
}
|
||||||
|
|
||||||
|
moduleCode += `@gLogIntProc = common global void (i32)* null\n`;
|
||||||
|
// NEU: Globaler Zeiger für die Host-Additionsfunktion
|
||||||
|
moduleCode += `@gHostAddIntegersProc = common global i32 (i32, i32)* null\n\n`;
|
||||||
|
|
||||||
|
|
||||||
|
if (varAllocations) {
|
||||||
|
moduleCode += '; Global Variables\n';
|
||||||
|
moduleCode += varAllocations + '\n';
|
||||||
|
}
|
||||||
|
|
||||||
|
// StarteLogik-Signatur erweitern, um den neuen Funktionszeiger-Parameter zu akzeptieren
|
||||||
|
moduleCode += 'define dllexport void @StarteLogik(void (i32)* %LogIntProc, i32 %hostInputInteger, i32 (i32, i32)* %HostAddIntegersProc) {\n';
|
||||||
|
moduleCode += 'entry:\n';
|
||||||
|
moduleCode += ' store void (i32)* %LogIntProc, void (i32)** @gLogIntProc\n';
|
||||||
|
// NEU: Den übergebenen Funktionszeiger in den globalen Zeiger speichern
|
||||||
|
moduleCode += ' store i32 (i32, i32)* %HostAddIntegersProc, i32 (i32, i32)** @gHostAddIntegersProc\n\n';
|
||||||
|
|
||||||
|
|
||||||
|
moduleCode += code.split('\n').map(line => line ? ' ' + line : '').join('\n');
|
||||||
|
moduleCode += '\n ret void\n';
|
||||||
|
moduleCode += '}\n';
|
||||||
|
return moduleCode;
|
||||||
|
};
|
||||||
|
|
||||||
|
|
||||||
|
Blockly.LLVM.scrub_ = function(block, code) {
|
||||||
|
const nextBlock = block.nextConnection && block.nextConnection.targetBlock();
|
||||||
|
const nextCode = nextBlock ? Blockly.LLVM.blockToCode(nextBlock) : '';
|
||||||
|
return code + nextCode;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['variables_set'] = function(block) {
|
||||||
|
const varName = block.workspace.getVariableById(block.getFieldValue('VAR')).name.replace(/ /g, '_');
|
||||||
|
const value = Blockly.LLVM.valueToCode(block, 'VALUE', Blockly.LLVM.ORDER_ATOMIC) || '0';
|
||||||
|
return `store i32 ${value}, i32* @${varName}\n`;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['math_change'] = function(block) {
|
||||||
|
const varName = block.workspace.getVariableById(block.getFieldValue('VAR')).name.replace(/ /g, '_');
|
||||||
|
const delta = Blockly.LLVM.valueToCode(block, 'DELTA', Blockly.LLVM.ORDER_ATOMIC) || '0';
|
||||||
|
|
||||||
|
const loadReg = Blockly.LLVM.newReg();
|
||||||
|
const addReg = Blockly.LLVM.newReg();
|
||||||
|
|
||||||
|
let code = '';
|
||||||
|
code += `${loadReg} = load i32, i32* @${varName}\n`;
|
||||||
|
code += `${addReg} = add nsw i32 ${loadReg}, ${delta}\n`;
|
||||||
|
code += `store i32 ${addReg}, i32* @${varName}\n`;
|
||||||
|
return code;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['variables_get'] = function(block) {
|
||||||
|
const varName = block.workspace.getVariableById(block.getFieldValue('VAR')).name.replace(/ /g, '_');
|
||||||
|
return ['@' + varName, Blockly.LLVM.ORDER_ATOMIC];
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['math_number'] = function(block) {
|
||||||
|
return [String(block.getFieldValue('NUM')), Blockly.LLVM.ORDER_ATOMIC];
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['host_log_integer'] = function(block) {
|
||||||
|
const valueCode = Blockly.LLVM.valueToCode(block, 'VALUE', Blockly.LLVM.ORDER_ATOMIC) || '0';
|
||||||
|
|
||||||
|
let valueReg;
|
||||||
|
let code = '';
|
||||||
|
|
||||||
|
if (valueCode.startsWith('@')) {
|
||||||
|
valueReg = Blockly.LLVM.newReg();
|
||||||
|
code += `${valueReg} = load i32, i32* ${valueCode}\n`;
|
||||||
|
} else if (valueCode.startsWith('%')) {
|
||||||
|
valueReg = valueCode;
|
||||||
|
} else {
|
||||||
|
valueReg = valueCode;
|
||||||
|
}
|
||||||
|
|
||||||
|
const logPtrReg = Blockly.LLVM.newReg();
|
||||||
|
code += `${logPtrReg} = load void (i32)*, void (i32)** @gLogIntProc\n`;
|
||||||
|
code += `call void ${logPtrReg}(i32 ${valueReg})\n`;
|
||||||
|
return code;
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['host_get_integer_input'] = function(block) {
|
||||||
|
const inputParamReg = '%hostInputInteger';
|
||||||
|
return [inputParamReg, Blockly.LLVM.ORDER_ATOMIC];
|
||||||
|
};
|
||||||
|
|
||||||
|
Blockly.LLVM.forBlock['host_add_integers'] = function(block) {
|
||||||
|
const num1 = Blockly.LLVM.valueToCode(block, 'NUM1', Blockly.LLVM.ORDER_ATOMIC) || '0';
|
||||||
|
const num2 = Blockly.LLVM.valueToCode(block, 'NUM2', Blockly.LLVM.ORDER_ATOMIC) || '0';
|
||||||
|
|
||||||
|
const funcPtrReg = Blockly.LLVM.newReg();
|
||||||
|
const resultReg = Blockly.LLVM.newReg();
|
||||||
|
|
||||||
|
let code = '';
|
||||||
|
// Lade den globalen Funktionszeiger, der vom Host gesetzt wird
|
||||||
|
code += `${funcPtrReg} = load i32 (i32, i32)*, i32 (i32, i32)** @gHostAddIntegersProc\n`;
|
||||||
|
// Rufe die Host-Funktion auf
|
||||||
|
code += `${resultReg} = call i32 ${funcPtrReg}(i32 ${num1}, i32 ${num2})\n`;
|
||||||
|
|
||||||
|
return [code + resultReg, Blockly.LLVM.ORDER_ATOMIC];
|
||||||
|
};
|
||||||
|
|
||||||
|
const toolboxXml = `
|
||||||
|
<xml>
|
||||||
|
<category name="Variablen" colour="%{BKY_VARIABLES_HUE}" custom="VARIABLE"></category>
|
||||||
|
<category name="Mathematik" colour="%{BKY_MATH_HUE}">
|
||||||
|
<block type="math_number"></block>
|
||||||
|
<block type="math_change">
|
||||||
|
<value name="DELTA"><shadow type="math_number"><field name="NUM">1</field></shadow></value>
|
||||||
|
</block>
|
||||||
|
</category>
|
||||||
|
<category name="Host" colour="290">
|
||||||
|
<block type="host_log_integer"></block>
|
||||||
|
<block type="host_get_integer_input"></block>
|
||||||
|
<block type="host_add_integers"></block>
|
||||||
|
</category>
|
||||||
|
</xml>`; // <--- DAS FEHLENDE BACKTICK HIER IST DIE LÖSUNG!
|
||||||
|
|
||||||
|
workspace = Blockly.inject('blocklyDiv', {
|
||||||
|
toolbox: toolboxXml,
|
||||||
|
zoom: {
|
||||||
|
controls: true,
|
||||||
|
wheel: true,
|
||||||
|
startScale: 1.0,
|
||||||
|
maxScale: 3,
|
||||||
|
minScale: 0.3,
|
||||||
|
scaleSpeed: 1.2
|
||||||
|
},
|
||||||
|
trashcan: true,
|
||||||
|
maxBlocks: 500,
|
||||||
|
scrollbars: true,
|
||||||
|
grid: {
|
||||||
|
spacing: 25,
|
||||||
|
length: 3,
|
||||||
|
colour: '#eee',
|
||||||
|
snap: true
|
||||||
|
},
|
||||||
|
comments: true,
|
||||||
|
disable: true,
|
||||||
|
collapse: true,
|
||||||
|
readOnly: false
|
||||||
|
});
|
||||||
|
|
||||||
|
// --- Code-Generierungs- und Post-Funktion (angepasst, um vorher zu speichern) ---
|
||||||
|
function generateAndPostCode() {
|
||||||
|
// 1. Arbeitsbereich speichern
|
||||||
|
const state = Blockly.serialization.workspaces.save(workspace);
|
||||||
|
localStorage.setItem('blocklyWorkspace', JSON.stringify(state));
|
||||||
|
// Optional: Konsolenmeldung zur automatischen Speicherung
|
||||||
|
// console.log("Arbeitsbereich automatisch gespeichert vor Code-Generierung.");
|
||||||
|
|
||||||
|
// 2. Code generieren
|
||||||
|
const code = Blockly.LLVM.workspaceToCode(workspace);
|
||||||
|
|
||||||
|
// 3. Code posten oder anzeigen
|
||||||
|
if (isWebView) {
|
||||||
|
if (window.chrome && window.chrome.webview) {
|
||||||
|
window.chrome.webview.postMessage(code);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
document.getElementById('codeOutput').value = code;
|
||||||
|
console.log("Code in Konsole ausgegeben (nicht im WebView):");
|
||||||
|
console.log(code);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
window.generateAndPostCode = generateAndPostCode;
|
||||||
|
|
||||||
|
window.saveWorkspace = function() {
|
||||||
|
const state = Blockly.serialization.workspaces.save(workspace);
|
||||||
|
localStorage.setItem('blocklyWorkspace', JSON.stringify(state));
|
||||||
|
alert('Arbeitsbereich gespeichert!');
|
||||||
|
}
|
||||||
|
window.loadWorkspace = function() { const stateString = localStorage.getItem('blocklyWorkspace'); if (!stateString) { return; } const state = JSON.parse(stateString); Blockly.serialization.workspaces.load(state, workspace); }
|
||||||
|
|
||||||
|
// --- Debounced-Funktion für die Code-Generierung ---
|
||||||
|
// Die Generierung wird erst 500ms nach der letzten Änderung im Arbeitsbereich ausgelöst.
|
||||||
|
const debouncedGenerateAndPostCode = debounce(generateAndPostCode, 500);
|
||||||
|
|
||||||
|
// --- Dynamische Code-Aktualisierung / Posten (ruft debouncedGenerateAndPostCode auf) ---
|
||||||
|
function handleCodeUpdate(event) {
|
||||||
|
if (event.isUiEvent) return;
|
||||||
|
debouncedGenerateAndPostCode();
|
||||||
|
}
|
||||||
|
workspace.addChangeListener(handleCodeUpdate);
|
||||||
|
loadWorkspace();
|
||||||
|
|
||||||
|
// --- Bedingte UI-Elemente und Splitter-Logik ---
|
||||||
|
const outputContainer = document.getElementById('outputContainer');
|
||||||
|
const blocklyDiv = document.getElementById('blocklyDiv');
|
||||||
|
|
||||||
|
if (isWebView) {
|
||||||
|
blocklyDiv.style.width = '100%';
|
||||||
|
setTimeout(function() {
|
||||||
|
Blockly.svgResize(workspace);
|
||||||
|
}, 100);
|
||||||
|
|
||||||
|
const buttonBar = document.querySelector('.button-bar');
|
||||||
|
if (buttonBar) {
|
||||||
|
const saveButton = buttonBar.querySelector('button[onclick="saveWorkspace()"]');
|
||||||
|
const loadButton = buttonBar.querySelector('button[onclick="loadWorkspace()"]');
|
||||||
|
if (saveButton) saveButton.remove();
|
||||||
|
if (loadButton) loadButton.remove();
|
||||||
|
const postButton = buttonBar.querySelector('button[onclick="generateAndPostCode()"]');
|
||||||
|
if (postButton) postButton.remove();
|
||||||
|
}
|
||||||
|
|
||||||
|
} else {
|
||||||
|
outputContainer.style.display = 'flex';
|
||||||
|
|
||||||
|
const outputArea = document.getElementById('outputArea');
|
||||||
|
const splitter = document.getElementById('splitter');
|
||||||
|
const container = document.getElementById('container');
|
||||||
|
|
||||||
|
let isDragging = false;
|
||||||
|
|
||||||
|
splitter.addEventListener('mousedown', function(e) {
|
||||||
|
isDragging = true;
|
||||||
|
document.body.style.userSelect = 'none';
|
||||||
|
document.body.style.cursor = 'ew-resize';
|
||||||
|
});
|
||||||
|
|
||||||
|
document.addEventListener('mousemove', function(e) {
|
||||||
|
if (!isDragging) return;
|
||||||
|
|
||||||
|
const containerRect = container.getBoundingClientRect();
|
||||||
|
const splitterWidth = splitter.offsetWidth;
|
||||||
|
const outputAreaMarginLeft = parseInt(window.getComputedStyle(outputArea).marginLeft);
|
||||||
|
|
||||||
|
const totalContentWidth = containerRect.width - splitterWidth - outputAreaMarginLeft;
|
||||||
|
let newBlocklyWidth = e.clientX - containerRect.left;
|
||||||
|
|
||||||
|
const minBlocklyWidth = parseFloat(window.getComputedStyle(blocklyDiv).minWidth);
|
||||||
|
const minOutputAreaWidth = parseFloat(window.getComputedStyle(outputArea).minWidth);
|
||||||
|
|
||||||
|
if (newBlocklyWidth < minBlocklyWidth) {
|
||||||
|
newBlocklyWidth = minBlocklyWidth;
|
||||||
|
}
|
||||||
|
|
||||||
|
let newOutputAreaWidth = totalContentWidth - newBlocklyWidth;
|
||||||
|
|
||||||
|
if (newOutputAreaWidth < minOutputAreaWidth) {
|
||||||
|
newOutputAreaWidth = minOutputAreaWidth;
|
||||||
|
newBlocklyWidth = totalContentWidth - newOutputAreaWidth;
|
||||||
|
if (newBlocklyWidth < minBlocklyWidth) {
|
||||||
|
newBlocklyWidth = minBlocklyWidth;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
blocklyDiv.style.width = `${newBlocklyWidth}px`;
|
||||||
|
outputArea.style.width = `${newOutputAreaWidth}px`;
|
||||||
|
|
||||||
|
Blockly.svgResize(workspace);
|
||||||
|
});
|
||||||
|
|
||||||
|
document.addEventListener('mouseup', function() {
|
||||||
|
isDragging = false;
|
||||||
|
document.body.style.userSelect = '';
|
||||||
|
document.body.style.cursor = '';
|
||||||
|
});
|
||||||
|
|
||||||
|
const initialOutputAreaWidth = 500;
|
||||||
|
const totalFlexContentWidth = container.offsetWidth - splitter.offsetWidth - parseInt(window.getComputedStyle(outputArea).marginLeft);
|
||||||
|
let initialBlocklyWidth = totalFlexContentWidth - initialOutputAreaWidth;
|
||||||
|
|
||||||
|
const minBlocklyWidth = parseFloat(window.getComputedStyle(blocklyDiv).minWidth);
|
||||||
|
|
||||||
|
if (initialBlocklyWidth < minBlocklyWidth) {
|
||||||
|
initialBlocklyWidth = minBlocklyWidth;
|
||||||
|
outputArea.style.width = `${totalFlexContentWidth - initialBlocklyWidth}px`;
|
||||||
|
} else {
|
||||||
|
outputArea.style.width = `${initialOutputAreaWidth}px`;
|
||||||
|
}
|
||||||
|
blocklyDiv.style.width = `${initialBlocklyWidth}px`;
|
||||||
|
|
||||||
|
Blockly.svgResize(workspace);
|
||||||
|
}
|
||||||
|
};
|
||||||
@@ -0,0 +1,116 @@
|
|||||||
|
/* style.css */
|
||||||
|
|
||||||
|
/* Global box-sizing für konsistente Größenberechnung */
|
||||||
|
* {
|
||||||
|
box-sizing: border-box;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Allgemeine Styles für html und body, um den gesamten Viewport zu füllen */
|
||||||
|
html, body {
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
height: 100%; /* Stellt sicher, dass html und body die volle Viewport-Höhe einnehmen */
|
||||||
|
font-family: sans-serif;
|
||||||
|
overflow: hidden; /* Verhindert Scrollbalken auf der Hauptebene des Bodys */
|
||||||
|
background-color: #F8F8F8; /* Optionale Hintergrundfarbe für den gesamten Body, falls gewünscht */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Body als Flex-Container, um Inhalte vertikal zu stapeln */
|
||||||
|
body {
|
||||||
|
display: flex;
|
||||||
|
flex-direction: column;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Optional: Style für die Überschrift im Output-Bereich und allgemeine Überschriften/Paragraphen */
|
||||||
|
h1, h2, p {
|
||||||
|
margin: 0;
|
||||||
|
padding: 10px 0; /* Beispiel: Etwas vertikale Polsterung, keine horizontalen Ränder */
|
||||||
|
text-align: center; /* Überschriften zentrieren */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Styling für die Button-Leiste */
|
||||||
|
.button-bar {
|
||||||
|
margin-bottom: 0; /* Rand unten entfernen */
|
||||||
|
padding: 10px 0 0 0; /* Polsterung anpassen, um oberen Rand zu entfernen */
|
||||||
|
text-align: center; /* Buttons zentrieren */
|
||||||
|
}
|
||||||
|
|
||||||
|
.button-bar button {
|
||||||
|
margin: 0 5px; /* Kleiner Abstand zwischen den Buttons */
|
||||||
|
padding: 8px 15px;
|
||||||
|
border: 1px solid #ccc;
|
||||||
|
border-radius: 4px;
|
||||||
|
background-color: #e0e0e0;
|
||||||
|
cursor: pointer;
|
||||||
|
}
|
||||||
|
|
||||||
|
.button-bar button:hover {
|
||||||
|
background-color: #d0d0d0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Haupt-Container für Blockly-Workspace und Output-Bereich */
|
||||||
|
#container {
|
||||||
|
display: flex; /* Machen Sie den Container zu einem Flex-Container, um die Kinder nebeneinander anzuordnen */
|
||||||
|
flex-grow: 1; /* Lässt den Container den restlichen vertikalen Platz füllen */
|
||||||
|
padding: 0; /* Polsterung um den Inhalt herum vollständig entfernen */
|
||||||
|
box-sizing: border-box; /* Stellt sicher, dass Padding in der Größe enthalten ist */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Blockly-Workspace Bereich */
|
||||||
|
#blocklyDiv {
|
||||||
|
flex-grow: 1; /* Lässt BlocklyDiv den maximalen horizontalen Platz einnehmen */
|
||||||
|
min-width: 200px; /* Mindestbreite für Blockly, damit es nicht zu klein wird */
|
||||||
|
height: 100%; /* Füllt die Höhe des #container */
|
||||||
|
background-color: #FFF8E1; /* Sehr helles Beige für den Blockly-Hintergrund des Containers */
|
||||||
|
margin: 0; /* Rand entfernen */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* WICHTIG: Regel für den Blockly SVG-Hintergrund */
|
||||||
|
#blocklyDiv .blocklySvg {
|
||||||
|
background-color: #FFF8E1; /* Hintergrundfarbe für das von Blockly generierte SVG-Element */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Optional: Sicherstellen, dass Blockly-Scrollbalken über anderen Elementen liegen */
|
||||||
|
#blocklyDiv .blocklyScrollbarHorizontal,
|
||||||
|
#blocklyDiv .blocklyScrollbarVertical {
|
||||||
|
z-index: 100;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Flex-Container für Splitter und Output-Bereich */
|
||||||
|
#outputContainer {
|
||||||
|
display: none; /* Standardmäßig ausgeblendet, wird bei Bedarf von JS eingeblendet */
|
||||||
|
flex-shrink: 0; /* Verhindert, dass dieser Container schrumpft, wenn nicht im WebView */
|
||||||
|
flex-basis: auto; /* Initial flexible Basis */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Splitter-Element */
|
||||||
|
#splitter {
|
||||||
|
width: 8px; /* Breite des Splitters */
|
||||||
|
background-color: #ccc; /* Farbe des Splitters */
|
||||||
|
cursor: ew-resize; /* Zeigt den "Ost-West-Größenänderung"-Cursor */
|
||||||
|
flex-shrink: 0; /* Verhindert, dass der Splitter schrumpft */
|
||||||
|
margin-left: 0; /* Abstand zum Blockly-Bereich entfernen */
|
||||||
|
margin-right: 0; /* Abstand zum Output-Bereich entfernen */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Output-Bereich (mit Code-Textarea) */
|
||||||
|
#outputArea {
|
||||||
|
display: flex;
|
||||||
|
flex-direction: column; /* Überschrift und Textarea vertikal stapeln */
|
||||||
|
min-width: 200px; /* Mindestbreite für die OutputArea */
|
||||||
|
width: 500px; /* Startbreite für den Output-Bereich, wird von JS überschrieben */
|
||||||
|
box-sizing: border-box;
|
||||||
|
margin: 0; /* Rand entfernen */
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Textarea für den generierten Code */
|
||||||
|
#codeOutput {
|
||||||
|
flex-grow: 1; /* Lässt die Textarea die verbleibende Höhe in outputArea füllen */
|
||||||
|
font-family: 'Courier New', Courier, monospace;
|
||||||
|
font-size: 14px;
|
||||||
|
white-space: pre-wrap;
|
||||||
|
border: none; /* Deaktiviert den Rand der Textarea */
|
||||||
|
resize: none; /* Deaktiviert die eingebaute Resize-Funktion der Textarea */
|
||||||
|
overflow: auto; /* Notwendig, damit Scrollbalken erscheinen, wenn der Inhalt die Größe überschreitet */
|
||||||
|
padding: 10px; /* Optional: Innenabstand für den Text, damit er nicht direkt am Rand klebt */
|
||||||
|
}
|
||||||
@@ -0,0 +1,57 @@
|
|||||||
|
# Projektplan: Refactoring der Compiler-Phasen
|
||||||
|
|
||||||
|
*Datum: 01.11.2025 16:30*
|
||||||
|
|
||||||
|
## Motivation
|
||||||
|
|
||||||
|
Der aktuelle Compiler-Monolith (`TAstBinder`) wurde erfolgreich in logische Phasen aufgeteilt (Expand, Bind, TypeCheck, Lower, TCO). Dabei ist ein schwerwiegendes technisches Problem aufgetreten:
|
||||||
|
|
||||||
|
Die `TAstTransformer`-Basisklasse (in `Myc.Ast.Visitor.pas`) zerstört die spezialisierten `TBound...Node`-Typen während der Transformation. Wenn eine spätere Phase (z.B. `TAstLowerer`) einen Baum transformiert, werden die `TBoundFunctionCallNode`s (aus Phase 2) fälschlicherweise in `TFunctionCallNode`s (Basis-Typ) zurückverwandelt. Dies führt zu Abstürzen beim `as`-Casting in der nachfolgenden Phase (`TAstTCO`).
|
||||||
|
|
||||||
|
## Ziel
|
||||||
|
|
||||||
|
Das System muss stabilisiert werden, indem der Typverlust im `TAstTransformer` behoben wird. Es gibt zwei konkurrierende Architekturen, um dieses Ziel zu erreichen.
|
||||||
|
|
||||||
|
## Ergebnis: Lösungs-Pfade
|
||||||
|
|
||||||
|
### Pfad 1: Pragmatische Lösung (Virtuelles Rebuild)
|
||||||
|
|
||||||
|
Dieser Ansatz repariert den `TAstTransformer`, behält aber die bestehende (unsaubere) Datenstruktur bei.
|
||||||
|
|
||||||
|
* **Strategie:** Wir behalten die "Gott-Objekt"-Knoten (`TBound...Node`), die Daten aus allen Phasen enthalten (`Address`, `StaticType`, `IsTailCall`). Wir reparieren den `TAstTransformer` (in `Myc.Ast.Visitor.pas`), indem wir virtuelle `Rebuild...`-Methoden (z.B. `RebuildFunctionCall`) einführen.
|
||||||
|
* **Implementierung:** Die `Visit...`-Methoden des Transformers rufen nicht mehr `TAst.FunctionCall` auf, sondern `Self.RebuildFunctionCall`. Alle unsere Phasen (Binder, Lowerer, TCO) überschreiben diese `Rebuild...`-Methoden und stellen sicher, dass der korrekte `TBound...Node`-Typ (unter Beibehaltung der Metadaten) neu erstellt wird.
|
||||||
|
* **Pro:**
|
||||||
|
* **Schnell:** Behebt den Absturz mit minimalem Eingriff.
|
||||||
|
* **Wenig Code:** Die Phasen müssen weiterhin nur die `Visit...`-Methoden überschreiben, die sie tatsächlich interessieren.
|
||||||
|
* **Contra:**
|
||||||
|
* **Architektur:** Die Datenstruktur bleibt "schmutzig". Implementierungsdetails bluten weiterhin durch (z.B. muss der `TAstBinder` (Phase 2) das Feld `IsTailCall` (Phase 5) initialisieren).
|
||||||
|
|
||||||
|
### Pfad 2: Saubere Architektur (Staged Data Layers)
|
||||||
|
|
||||||
|
Dieser Ansatz definiert für jede Phase eine eigene, unveränderliche Datenstruktur.
|
||||||
|
|
||||||
|
* **Strategie:** Wir verwerfen den `TAstTransformer`. Jede Compiler-Phase (Binder, TypeChecker, ...) wird ein reiner `IAstVisitor`.
|
||||||
|
* **Implementierung:**
|
||||||
|
1. `TAstBinder` (Phase 2) konsumiert `IAstNode` und produziert `IBoundNode` (enthält *nur* `Address`, `IsBoxed`).
|
||||||
|
2. `TTypeChecker` (Phase 3) konsumiert `IBoundNode` und produziert `ITypedNode` (enthält *zusätzlich* `StaticType`).
|
||||||
|
3. (usw. für Lowering und TCO)
|
||||||
|
* Die neuen Knoten (`TBoundNode`, `TTypedNode`) nutzen Aggregation und das `implements`-Schlüsselwort, um die Basis-Schnittstellen (z.B. `IIdentifierNode`) an den aggregierten Knoten der Vor-Phase zu delegieren.
|
||||||
|
* **Pro:**
|
||||||
|
* **Architektur:** Typsicher und sauber. Keine "blutenden" Implementierungsdetails. Daten sind zwischen den Phasen unveränderlich (immutable).
|
||||||
|
* **Robust:** Die Fehlerklasse (`as`-Cast-Fehler) wird eliminiert.
|
||||||
|
* **Contra:**
|
||||||
|
* **Aufwand:** Ein massives Refactoring.
|
||||||
|
* **Boilerplate:** Jede Phase (Binder, TypeChecker, ...) muss *alle* 20+ `Visit...`-Methoden implementieren, um den Baum von Typ `A` in Typ `B` zu überführen, selbst wenn 19 davon nur "Durchreicher" sind.
|
||||||
|
|
||||||
|
## TODO (Nächste Schritte für Pfad 1)
|
||||||
|
|
||||||
|
Gemäß deiner Entscheidung probieren wir **Pfad 1**.
|
||||||
|
|
||||||
|
1. **`Myc.Ast.Visitor.pas` (`TAstTransformer`)**:
|
||||||
|
* `VisitFunctionCall`, `VisitLambdaExpression`, `VisitVariableDeclaration` und `VisitRecordLiteral` (die Knoten, die `TBound...`-Typen haben) so umbauen, dass sie `virtual Rebuild...`-Methoden aufrufen.
|
||||||
|
2. **`Myc.Ast.Binding.pas` (`TAstBinder`)**:
|
||||||
|
* `Rebuild...`-Methoden überschreiben, um `TBound...Node`-Instanzen zu erzeugen (und `IsTailCall=False` zu setzen).
|
||||||
|
3. **`Myc.Ast.Lowering.pas` (`TAstLowerer`)**:
|
||||||
|
* `Rebuild...`-Methoden überschreiben, um `TBound...Node`-Instanzen zu erhalten (und `IsTailCall` vom Original zu kopieren).
|
||||||
|
4. **`Myc.Ast.Compiler.TCO.pas` (`TAstTCO`)**:
|
||||||
|
* `RebuildFunctionCall` überschreiben, um den `IsTailCall`-Status basierend auf dem `FIsTailStack` korrekt zu setzen.
|
||||||
@@ -0,0 +1,46 @@
|
|||||||
|
### **Projektplan: "Magical & Safe" Concurrency-Modell**
|
||||||
|
**Datum:** 21. September 2025, 12:07
|
||||||
|
|
||||||
|
#### **Motivation**
|
||||||
|
Unser Interpreter besitzt ein solides Fundament für die single-threaded Ausführung. Moderne, datenintensive Anwendungen erfordern jedoch eine robuste und einfach zu handhabende Nebenläufigkeit. Traditionelle Locking-Mechanismen (`TCriticalSection`, Mutexe) sind komplex, extrem fehleranfällig (Race Conditions, Deadlocks) und skalieren schlecht. Ziel ist es, ein modernes Concurrency-Modell direkt in den Sprachkern zu integrieren, das diese Probleme per Design vermeidet.
|
||||||
|
|
||||||
|
#### **Ziel**
|
||||||
|
Wir erweitern die Sprache um ein Nebenläufigkeits-Modell, das drei Kernziele verfolgt:
|
||||||
|
|
||||||
|
1. **Sicherheit (Safe):** Es muss für den Programmierer unmöglich sein, durch konkurrierende Schreibzugriffe auf geteilten Zustand eine Race Condition zu erzeugen. Die Sprache garantiert die Atomarität von Zustandsänderungen.
|
||||||
|
|
||||||
|
2. **"Magie" (Magical):** Die Sicherheitsmechanismen sollen für den Programmierer **transparent** sein. Er schreibt weiterhin einfachen, sequenziellen Code mit `def` und `assign`. Der Compiler/Binder kümmert sich automatisch um die notwendigen Schutzmaßnahmen, ohne dass der Programmierer explizite Synchronisierungs-Primitive wie `swap!` oder `atom` verwenden muss.
|
||||||
|
|
||||||
|
3. **Performance:** Der durch die Sicherheitsmechanismen entstehende Overhead darf nur dort anfallen, wo er zwingend notwendig ist – also nur bei Zuständen, die tatsächlich geteilt *und* verändert werden.
|
||||||
|
|
||||||
|
#### **Geplante Umsetzung & Architektur**
|
||||||
|
Um diese Ziele zu erreichen, führen wir eine klare semantische Trennung zwischen unveränderlichen Werten und veränderlichen Identitäten ein und implementieren die "Magie" im Binder.
|
||||||
|
|
||||||
|
**1. Das Fundament: Unveränderliche Datenstrukturen (Values)**
|
||||||
|
Der Grundpfeiler für sichere Nebenläufigkeit ist, dass Werte (Values) per Definition unveränderlich (immutable) sind. Wenn Daten einmal erzeugt wurden, können sie sich niemals ändern.
|
||||||
|
|
||||||
|
* **Todo:** Implementierung einer Kernbibliothek von **persistenten, unveränderlichen Datenstrukturen** (insbesondere Vektoren und Maps), die "Structural Sharing" für effiziente "Updates" nutzen. Bestehende `Series` müssen entweder durch diese ersetzt oder angepasst werden.
|
||||||
|
|
||||||
|
**2. Veränderliche Identitäten (Refs)**
|
||||||
|
Der veränderliche Zustand wird über **Identitäten** (Referenzen) verwaltet. Eine Identität ist ein stabiler "Container", dessen enthaltener Wert atomar ausgetauscht werden kann. Dies entspricht exakt dem `atom`-Konzept von Clojure.
|
||||||
|
|
||||||
|
* **Todo:** Implementierung einer generischen `TAtom<T>`-Klasse in Delphi. Die `Swap`-Methode dieser Klasse wird **lock-frei** mittels einer **`TInterlocked.CompareExchange`-Retry-Schleife** implementiert, um maximale Performance und Skalierbarkeit zu gewährleisten.
|
||||||
|
|
||||||
|
**3. Die "Magie": Automatische Promotion im Binder**
|
||||||
|
Hier wird der "magische" Aspekt umgesetzt. Der `TAstBinder` wird um eine intelligente Zustandsanalyse erweitert.
|
||||||
|
|
||||||
|
* **Logik:**
|
||||||
|
1. Standardmäßig wird jede Variable als einfacher, performanter Wert im Scope-Speicher behandelt.
|
||||||
|
2. Der Binder analysiert die Verwendung von Variablen in untergeordneten Scopes (Closures).
|
||||||
|
3. Sobald der Binder einen **Schreibzugriff (`assign`)** auf eine **Upvalue** (eine Variable aus einem äußeren Scope) entdeckt, wird diese Variable im äußeren Scope automatisch "promotet": Ihr Speicherplatz wird von einem einfachen Wert zu einer Instanz der sicheren `TAtom<T>`-Klasse umgewandelt.
|
||||||
|
4. Alle nachfolgenden Lese- und Schreibzugriffe auf diese Variable (sowohl im äußeren als auch in allen inneren Scopes) werden vom Binder automatisch in sichere Aufrufe auf dem `TAtom` umgeschrieben.
|
||||||
|
|
||||||
|
* **Todo:** Erweiterung des `TAstBinder` um die Logik zur Erkennung von Upvalue-Schreibzugriffen, zur automatischen Promotion von Variablen und zur Umschreibung der entsprechenden AST-Zugriffsknoten.
|
||||||
|
|
||||||
|
---
|
||||||
|
### **Nächste Schritte (Todo-Liste)**
|
||||||
|
|
||||||
|
* [ ] Kernbibliothek für persistente, unveränderliche Datenstrukturen (Vector, Map) entwerfen und implementieren.
|
||||||
|
* [ ] Lock-freie `TAtom<T>`-Klasse als primäres Concurrency-Primitiv implementieren.
|
||||||
|
* [ ] `TAstBinder` um die "automatische Promotions"-Logik für Upvalues erweitern.
|
||||||
|
* [ ] Multi-threaded Unit-Tests schreiben, um die Korrektheit und Sicherheit des neuen Modells unter Last zu verifizieren.
|
||||||
@@ -0,0 +1,43 @@
|
|||||||
|
|
||||||
|
## 📝 Projektplan: Refactoring der AST-Visualisierung (Architekturfokus)
|
||||||
|
|
||||||
|
**Datum und Uhrzeit:** 03.11.2025 09:02:21
|
||||||
|
|
||||||
|
### 💡 Motivation: Entkopplung und Skalierbarkeit
|
||||||
|
|
||||||
|
Die **aktuelle Implementierung** des AST Visualisierers in FireMonkey basiert auf einem Design mit **starker Kopplung** zwischen der **semantischen Logik** (Layout-Anordnung) und der **visuellen Darstellung** (Farben, Rahmen). Dies äußert sich in:
|
||||||
|
|
||||||
|
1. **Visuelle Inflexibilität:** Die `TAuraNode.Paint`-Methode verwendet **Custom Drawing**, was die zentrale Steuerung visueller Eigenschaften (z.B. für einen Dark Mode oder Branding) über FMX Style-Dateien unmöglich macht.
|
||||||
|
2. **Architektonische Starrheit:** Die Ableitung einer FMX-Control-Klasse (`TAuraXxxNode`) für jeden AST-Knotentyp ist ein Verstoß gegen das **Open/Closed Principle** und macht die Einführung neuer Knotentypen unnötig aufwendig.
|
||||||
|
|
||||||
|
Ziel des Refactorings ist die Trennung dieser Bedenken, um ein robustes, skalierbares System zu schaffen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### 🏛️ Architektur: Strategisches Schichtenmodell
|
||||||
|
|
||||||
|
Die neue Architektur ersetzt die Vererbung durch **Komposition** und verteilt die Verantwortung auf drei Schichten:
|
||||||
|
|
||||||
|
#### 1. FMX Style Aggregation (Visuelle Schicht)
|
||||||
|
|
||||||
|
Diese Schicht übernimmt die komplette **visuelle Gestaltung** des äußeren Rahmens.
|
||||||
|
|
||||||
|
* **`TAuraNode` (Control Shell):** Dient als generisches FMX-Control-Grundgerüst. Es erbt von `TStyledControl` und verwendet ein **Style-Lookup** basierend auf dem AST-Knotentyp (`constantstyle`, `ifexpressionstyle`, etc.).
|
||||||
|
* **Visuelle Eigenschaften:** Eigenschaften wie `BackgroundColor`, `BorderWidth` etc. sind nicht länger Felder in `TAuraNode`. Stattdessen werden sie über die **FMX Style Accessoren** (`GetStyleProperty`/`SetStyleProperty`) direkt in der geladenen FMX Style-Datei gespeichert und gelesen.
|
||||||
|
* **Style-Bindung:** Die `ApplyStyle`-Methode findet das primäre Style-Element (`TRectangle` mit `StyleName='background'`) und wendet die Style-Eigenschaften (Farbe, Dicke, Radius) auf dieses Element an, wodurch das Custom Drawing in `Paint` obsolet wird.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
#### 2. Logik-Aggregation (`INodeViewModel` / Semantische Schicht)
|
||||||
|
|
||||||
|
Dieses Aggregat kapselt die gesamte Knoten-spezifische Logik (was einen `if`-Knoten von einem `lambda`-Knoten unterscheidet).
|
||||||
|
|
||||||
|
* **`INodeViewModel`:** Das zentrale **Strategie-Interface**. Es definiert die Schnittstellen **`Setup(HostNode, ...)`** zur Erstellung des Layouts und **`CreateAst(HostNode)`** zur Rekonstruktion des AST-Knotens aus dem visuellen Zustand.
|
||||||
|
* **`TNodeViewModelRegistry`:** Eine Factory-Klasse, die zur Laufzeit das korrekte `INodeViewModel`-Objekt (z.B. `TIfExpressionViewModel`) basierend auf dem `TAstNodeKind` des aktuellen Knotens instanziiert.
|
||||||
|
* **`TNodeViewModelBase`:** Bietet Helfer-Methoden (`AddLabel`, `AddExpr` mit Rekursion), die es der `Setup`-Methode ermöglichen, das semantische Layout (z.B. die vertikale Anordnung von "if", "then" und "else" Labels und Kind-Knoten) zu erstellen, ohne FMX-Interna zu duplizieren.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
#### 3. Ergebnis (Zusammenfassung)
|
||||||
|
|
||||||
|
Die Architektur trennt die **statische visuelle Gestaltung** (FMX Style) von der **dynamischen Layout-Logik** (`INodeViewModel`). Die generische Klasse `TAuraNode` wird zum Host, der die visuelle Schicht steuert und die Layout-Erstellung an die Logik-Schicht delegiert.
|
||||||
@@ -0,0 +1,44 @@
|
|||||||
|
# Projektplan: Refactoring auf First-Class List Nodes
|
||||||
|
|
||||||
|
**Datum:** 29.11.2025 16:43
|
||||||
|
|
||||||
|
## 1. Motivation
|
||||||
|
Aktuell werden Listen von Elementen im AST (z. B. Parameter in `Lambda`, Argumente in `Call`, Felder in `RecordLiteral`) als native Arrays (`TArray<T>`) innerhalb des Eltern-Knotens gespeichert. Dies führt zu signifikanten Problemen bei der Entwicklung des Projectional Editors:
|
||||||
|
|
||||||
|
1. **Fehlende Adressierbarkeit:** Eine Liste als `TArray` hat keine Identität (`IAstIdentity`) und keine Position. Sie kann im Editor nicht als Ganzes selektiert, fokussiert oder hervorgehoben werden.
|
||||||
|
2. **Das "Leere-Liste"-Problem:** Wenn eine Liste leer ist, gibt es keinen visuellen Anker (wie einen Platzhalter zwischen Klammern), den der Benutzer anklicken kann, um das erste Element einzufügen.
|
||||||
|
3. **Inkonsistente UI-Logik:** Jeder Handler (`LambdaHandler`, `CallHandler`, etc.) muss derzeit selbstständig Logik für Klammern `()`, Trennzeichen `,` und Layout implementieren. Dies führt zu Code-Duplizierung.
|
||||||
|
4. **Komplexe Manipulation:** Operationen wie "Verschiebe Argument 2 an Position 1" oder "Lösche alle Parameter" sind schwierig umzusetzen, da die Logik fest im Eltern-Knoten verdrahtet ist und nicht an einen generischen Listen-Handler delegiert werden kann.
|
||||||
|
5. **Record-Felder:** Aktuell sind Key-Value-Paare (`TRecordFieldLiteral`) reine Records, keine AST-Nodes. Sie können daher nicht einzeln selektiert oder per Drag & Drop verschoben werden.
|
||||||
|
|
||||||
|
Um einen robusten, wartbaren Editor zu gewährleisten, muss das Prinzip **"Alles, was sichtbar und manipulierbar ist, muss ein AST-Knoten sein"** konsequent angewendet werden.
|
||||||
|
|
||||||
|
## 2. Ziel
|
||||||
|
Umbau der AST-Struktur und der Editor-Handler, um Listen und Record-Felder als eigenständige Knoten zu etablieren.
|
||||||
|
|
||||||
|
### Kernaufgaben:
|
||||||
|
1. **AST-Erweiterung (`Myc.Ast.Nodes`):**
|
||||||
|
* Einführung eines generischen Interfaces `INodeList<T: IAstNode>`.
|
||||||
|
* Einführung spezifischer Listen-Typen zur Wahrung der Typsicherheit: `IParameterList`, `IArgumentList`, `IRecordFieldList`.
|
||||||
|
* Einführung von `IRecordFieldNode` als Wrapper für Key-Value-Paare.
|
||||||
|
* Erweiterung des `TAstNodeKind` Enums.
|
||||||
|
|
||||||
|
2. **Anpassung der Factories & Visitor (`Myc.Ast` & `Myc.Ast.Visitor`):**
|
||||||
|
* Update der Factory-Methoden (z.B. `TAst.LambdaExpr`), um Listen-Nodes statt Arrays zu akzeptieren.
|
||||||
|
* Erweiterung des `IAstVisitor` um Methoden für die neuen Knotentypen.
|
||||||
|
|
||||||
|
3. **Generischer UI-Handler (`Myc.Fmx.AstEditor.Handlers`):**
|
||||||
|
* Implementierung von `TNodeListHandler<T>`, der das Rendering von Listen (Start-Zeichen, Trennzeichen, End-Zeichen, Layout) zentralisiert.
|
||||||
|
* Implementierung der `IEditableNodeHandler`-Logik im Listen-Handler (Hinzufügen neuer Elemente).
|
||||||
|
|
||||||
|
4. **Refactoring existierender Handler:**
|
||||||
|
* Vereinfachung von `TLambdaExpressionNodeHandler`, `TFunctionCallNodeHandler` und `TRecordLiteralNodeHandler` durch Delegation an den neuen `TNodeListHandler`.
|
||||||
|
|
||||||
|
## 3. Ergebnis
|
||||||
|
* **Architektonische Konsistenz:** Der AST spiegelt die logische Struktur der Sprache und die visuelle Struktur des Editors 1:1 wider.
|
||||||
|
* **Reduzierte Komplexität:** UI-Logik für Listen existiert nur noch einmal zentral im `TNodeListHandler`.
|
||||||
|
* **Erweiterte Funktionalität:** Listen können nun selektiert, kopiert und geleert werden. Leere Listen sind durch ihre Klammern als Drop-Target für neue Elemente nutzbar.
|
||||||
|
* **Typsicherheit:** Trotz generischer Implementierung im Editor bleibt die semantische Unterscheidung (Parameter vs. Argumente) im AST und Compiler erhalten.
|
||||||
|
|
||||||
|
## 4. Nächster Schritt
|
||||||
|
Implementierung der Änderungen in `Myc.Ast.Nodes` (Definition der Interfaces `INodeList`, `IParameterList`, `IArgumentList`, `IRecordFieldList`, `IRecordFieldNode`) und Anpassung der `TAstNodeKind` Enumeration.
|
||||||
@@ -0,0 +1,16 @@
|
|||||||
|
### Projektplan: Hybrid-Makro-System
|
||||||
|
**Datum:** 06.11.2025 14:39
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
Die Implementierung von `stopwatch` als RTL-Funktion war unzureichend, da der Zugriff auf andere Laufzeit-Symbole (wie `print`) einen langsamen Laufzeit-Lookup (`FindSymbolAddress`) erfordert hätte. Die Umwandlung in ein Makro löst das Bindungs-Problem, wirft aber das Problem der Makro-Hygiene auf. Explizite Lösungen (wie `gensym` oder `$`-Suffixe) sind syntaktisch zu komplex, unleserlich und/oder unzureichend.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
Entwicklung eines impliziten, automatischen Makro-Systems. Dieses System muss **hygienisch für Definitionen** sein (um Kollisionen bei internen Variablen wie `start-time` zu verhindern), aber **unhygienisch für freie Symbole** (um kontext-abhängige Makros, die z.B. `*debug-mode*` lesen, zu ermöglichen).
|
||||||
|
|
||||||
|
Die Komplexität der Hygiene soll vollständig vom Makro-Autor in den Makro-Expander (`TExpansionVisitor`) verlagert werden.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
Ein Makro-System, bei dem:
|
||||||
|
1. **Automatische Hygiene:** Alle *Definitionen* (`def`, `fn`-Parameter etc.) innerhalb eines Makro-Templates (`quasiquote`) automatisch und eindeutig umbenannt werden (z.B. `start-time` -> `start-time_123`). Dies löst das Verschachtelungs- und Kollisionsproblem (`stopwatch` in `stopwatch`).
|
||||||
|
2. **Unhygienische Freie Symbole:** Alle *freien Symbole* (z.B. `print`, `timestamp`, `*debug-mode*`), die im Makro-Template *verwendet*, aber *nicht definiert* werden, unberührt bleiben. Diese werden (unhygienisch) vom `TAstBinder` im *Aufruf-Scope* des Benutzers aufgelöst.
|
||||||
|
|
||||||
@@ -0,0 +1,98 @@
|
|||||||
|
Hier ist der vollständig aktualisierte Projektplan, der die Verwaltung des Caches als Environment-spezifische Aufgabe (statt global) korrekt abbildet.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
# Monomorphisierung (Revidierter Plan v2)
|
||||||
|
|
||||||
|
09.11.2025 19:10
|
||||||
|
|
||||||
|
## Motivation
|
||||||
|
|
||||||
|
Der aktuelle Compiler ist in seiner Optimierungsfähigkeit limitiert. Der `TAstLowerer`-Pass implementiert eine hartkodierte statische Spezialisierung ausschließlich für vordefinierte Operatoren (z.B. `(+)` -> `TBinaryExpressionNode`). Alle anderen Aufrufe, einschließlich der restlichen RTL (z.B. `Abs`) und sämtlicher benutzerdefinierter Funktionen, werden zur Laufzeit dynamisch über den `vkMethod`-Pfad aufgelöst. Dieser Pfad erfordert das Boxing von Werten in `TDataValue`-Wrapper und einen Scope-Lookup, was einen signifikanten Performance-Overhead darstellt, selbst wenn alle Typen zur Compile-Zeit bekannt wären.
|
||||||
|
|
||||||
|
## Ziel
|
||||||
|
|
||||||
|
Implementierung einer **hybriden Monomorphisierungsstrategie** zur Compile-Zeit. Das Ziel ist die Eliminierung des `vkMethod`-Overheads für *alle* Aufrufe, deren Callee und Argumenttypen statisch auflösbar sind.
|
||||||
|
|
||||||
|
1. **Statische Spezialisierung:** Aufrufe an bekannte Funktionen (RTL oder User-Code) mit bekannten Argumenttypen werden zur Compile-Zeit an eine hochoptimierte, statisch gebundene Implementierung gemappt.
|
||||||
|
2. **Dynamischer Fallback:** Aufrufe, die nicht statisch aufgelöst werden können (z.B. Higher-Order-Functions, bei denen der Callee aus einer Variable stammt), nutzen weiterhin den bestehenden `vkMethod`-Pfad.
|
||||||
|
|
||||||
|
Diese Strategie macht die spezialisierten `TBinaryExpressionNode` und `TUnaryExpressionNode` sowie den `TAstLowerer`-Pass obsolet und ersetzt sie durch einen generalisierten und wesentlich leistungsfähigeren Mechanismus.
|
||||||
|
|
||||||
|
## Ergebnis & Implementierungsplan
|
||||||
|
|
||||||
|
### 1. Erweiterung: `IFunctionCallNode`
|
||||||
|
Anstatt einen neuen Knotentyp einzuführen, wird der bestehende `IFunctionCallNode` in `Myc.Ast.Nodes` erweitert, um *beide* Aufrufpfade (dynamisch und statisch) zu repräsentieren.
|
||||||
|
|
||||||
|
* Er erhält ein neues Property: **`StaticTarget: TDataValue.TFunc`**.
|
||||||
|
* **Dynamischer Pfad (Default):** Wenn **`StaticTarget = nil`**, wird der Knoten wie bisher über den `vkMethod`-Pfad ausgewertet (dynamischer Dispatch über den `Callee`-Knoten).
|
||||||
|
* **Statischer Pfad (Optimiert):** Wenn **`StaticTarget <> nil`**, ignoriert der Evaluator den `Callee`-Knoten und ruft stattdessen das **`StaticTarget`** direkt mit den ausgewerteten Argumenten auf.
|
||||||
|
* Die `TAst.FunctionCall`-Factory in `Myc.Ast.pas` wird um einen optionalen **`AStaticTarget`**-Parameter erweitert.
|
||||||
|
|
||||||
|
### 2. Neue Compiler-Phase: `TStaticSpecializer`
|
||||||
|
Ein neuer `TAstTransformer` namens `TStaticSpecializer` wird implementiert. Er läuft *nach* dem `TTypeChecker` (Phase 3) und *ersetzt* den `TAstLowerer` (Phase 4).
|
||||||
|
|
||||||
|
* **Konstruktor:** Der `TStaticSpecializer` erhält im Konstruktor eine Referenz auf den `IEnvironment`-spezifischen Monomorphisierungs-Cache (siehe Punkt 3).
|
||||||
|
* **`VisitFunctionCall`-Logik:** Dies ist die Kernmethode.
|
||||||
|
1. Sie prüft, ob der `Callee` des `IFunctionCallNode` ein `IIdentifierNode` ist (z.B. `+`, `Abs`, `my-func`).
|
||||||
|
2. Sie prüft, ob *alle* Argumenttypen (`newArgs[i].StaticType`) statisch bekannt sind (d.h. nicht `stUnknown`).
|
||||||
|
3. **Statischer Pfad (Ja):** Der `TStaticSpecializer` fragt den ihm übergebenen **Environment-Cache** nach einer spezialisierten `TDataValue.TFunc` ab. Bei Erfolg **klont** er den `IFunctionCallNode` (via CoW) und setzt dessen **`StaticTarget`**-Property auf die gefundene Funktion.
|
||||||
|
4. **Dynamischer Pfad (Nein):** Der `IFunctionCallNode` wird (ggf. geklont, falls Kindknoten sich änderten) mit **`StaticTarget = nil`** zurückgegeben.
|
||||||
|
|
||||||
|
### 3. Der Environment-spezifische Cache
|
||||||
|
Das **`IEnvironment`** verwaltet einen **Instanz-spezifischen** Cache (z.B. `TDictionary`), der bereits spezialisierte Funktionen vorhält. Dieser Cache ist *nicht* global oder statisch.
|
||||||
|
|
||||||
|
* Jede `IEnvironment`-Instanz (z.B. eine für Produktion, eine für Tests) hat ihren eigenen, isolierten Cache, der an ihre `RootScope` und RTL gebunden ist.
|
||||||
|
* Die `TEnvironment`-Implementierung (in `Myc.Ast.Environment.pas`) wird um dieses `TDictionary`-Feld erweitert.
|
||||||
|
* Der `TStaticSpecializer` erhält eine Referenz auf diesen Cache bei seiner Erstellung (z.B. über den Konstruktor).
|
||||||
|
* **Schlüssel:** `(Funktions-ID, TArray<IStaticType>)`.
|
||||||
|
* *Funktions-ID*: Ein eindeutiger Bezeichner für den Callee, gebilded aus der `TResolvedAddress`, die innerhalb des Environments einen eindeutigen Schlüssel darstellt.
|
||||||
|
* **Wert:** Die spezialisierte `TDataValue.TFunc`.
|
||||||
|
|
||||||
|
### 4. Cache-Miss-Strategie (Inlining & User-Code)
|
||||||
|
Wenn der `TStaticSpecializer` einen statisch auflösbaren Aufruf (z.B. `(my-func 10)`) findet, der noch nicht im **Environment-Cache** ist (Cache Miss):
|
||||||
|
|
||||||
|
1. Er holt den AST-Body der Zielfunktion (z.B. `(+ x x)` aus `(def my-func (fn [x] (+ x x)))`).
|
||||||
|
2. Er instanziiert diesen Body, indem er das Wissen über die Argumenttypen (z.B. `x = stOrdinal`) anwendet.
|
||||||
|
3. Er lässt diesen neuen, instanziierten AST-Body (`(+ <x:Ordinal> <x:Ordinal>)`) rekursiv durch die relevanten Compiler-Phasen laufen (mindestens `TypeCheck` und `Specialize`).
|
||||||
|
4. Der `Specialize`-Pass wandelt den Body (z.B. `(+ <x:Ordinal> <x:Ordinal>)`) rekursiv in einen *neuen* `IFunctionCallNode` um, dessen **`StaticTarget`** auf die RTL-Funktion `@TRtlFunctions.Add_Ordinal_Ordinal` zeigt.
|
||||||
|
5. Das Ergebnis (die `TDataValue.TFunc`, die den optimierten Body repräsentiert) wird im **Environment-Cache** gespeichert.
|
||||||
|
6. Der ursprüngliche `IFunctionCallNode` `(my-func 10)` wird durch einen Klon ersetzt, dessen **`StaticTarget`** auf die soeben kompilierte Funktion zeigt.
|
||||||
|
|
||||||
|
### 5. RTL-Erweiterung
|
||||||
|
* `Myc.Ast.RTL.Core` wird um statisch typisierte Implementierungen (z.B. `class function Add_Ordinal_Ordinal(A, B: Int64): Int64; static;`) erweitert.
|
||||||
|
* Die `TRtlRegistry` wird angepasst, um diese statischen Signaturen zu indizieren und als "Bootstrap" für den Monomorphisierungs-Cache bereitzustellen.
|
||||||
|
|
||||||
|
### 6. Evaluator-Anpassung (`TEvaluatorVisitor`)
|
||||||
|
* `VisitFunctionCall` wird modifiziert, um beide Pfade zu behandeln:
|
||||||
|
1. **Statischer Pfad:** `if Assigned(Node.StaticTarget) then`
|
||||||
|
* Wertet die Argument-Nodes aus (mit `Assert(arg.IsTyped)`).
|
||||||
|
* Marshallt die `TDataValue`-Ergebnisse direkt in die erwarteten nativen Typen.
|
||||||
|
* Ruft das **`Node.StaticTarget`** direkt auf.
|
||||||
|
* Wrappt das Ergebnis zurück in ein `TDataValue`.
|
||||||
|
* Ruft `HandleTCO` auf (falls das **`StaticTarget`** ein `recur` war).
|
||||||
|
2. **Dynamischer Pfad:** `else`
|
||||||
|
* Behält die bestehende Logik (`vkMethod`-Lookup) und die TCO-Thunk-Erzeugung bei (`if Node.IsTailCall then ...`).
|
||||||
|
* `VisitBinaryExpression` und `VisitUnaryExpression` werden entfernt.
|
||||||
|
|
||||||
|
### 7. Auswirkungen auf TCO (Tail Call Optimization)
|
||||||
|
* Die TCO bleibt für `recur` und *dynamische* `fn`-Aufrufe (die `IFunctionCallNode` mit **`StaticTarget = nil`** bleiben) voll funktionsfähig und erzeugt `TThunk`s.
|
||||||
|
* Ein `IFunctionCallNode` mit gesetztem **`StaticTarget`** (z.B. `(Abs x)`) in einer Tail-Position wird *nicht* per TCO optimiert. Er ist per Definition keine Rekursion. Der `TEvaluatorVisitor` führt ihn direkt aus und beendet damit korrekt die Trampolin-Schleife.
|
||||||
|
|
||||||
|
## TODO
|
||||||
|
|
||||||
|
* `IFunctionCallNode` in `Myc.Ast.Nodes` um **`StaticTarget: TDataValue.TFunc`** erweitern.
|
||||||
|
* `TFunctionCallNode` (Implementierungsklasse) um Feld, Konstruktorparameter und Getter erweitern.
|
||||||
|
* `TAst.FunctionCall`-Factory in `Myc.Ast.pas` um optionalen **`AStaticTarget`**-Parameter erweitern.
|
||||||
|
* `TAstTransformer.VisitFunctionCall` in `Myc.Ast.Visitor` anpassen, um **`StaticTarget`** bei CoW zu kopieren.
|
||||||
|
* `TBinaryExpressionNode`, `TUnaryExpressionNode` (und ihre `Visit...`-Methoden) aus allen Units (`Nodes`, `Visitor`, `Dumper`, `Evaluator`, `Lowerer`, `Json`, `Fmx.AstEditor.Node`) entfernen.
|
||||||
|
* `TAstLowerer` aus dem Kompilierungsprozess in `TEnvironment.Compile` entfernen.
|
||||||
|
* `Myc.Ast.RTL.Core` um statisch typisierte Funktionsvarianten für alle Operatoren und gängige Funktionen (Abs, Trunc etc.) ergänzen.
|
||||||
|
* `TRtlRegistry` erweitern, um diese statischen Signaturen zu indizieren.
|
||||||
|
* **`IEnvironment`** (und Implementierung) um einen Member für den Monomorphisierungs-Cache erweitern.
|
||||||
|
* `TStaticSpecializer` als neuen `TAstTransformer`-Pass implementieren.
|
||||||
|
* **`TStaticSpecializer`-Konstruktor** erweitern, um den Cache vom `IEnvironment` entgegenzunehmen.
|
||||||
|
* `TStaticSpecializer.VisitFunctionCall` mit der Logik für statische/dynamische Pfade implementieren (Klonen des `IFunctionCallNode` mit gesetztem **`StaticTarget`**).
|
||||||
|
* Monomorphisierungs-Cache (Lookup und "Cache Miss"-Rekursion) im `TStaticSpecializer` implementieren (unter Verwendung des **Environment-Caches**).
|
||||||
|
* `TEnvironment.Compile` aktualisieren, um den `TStaticSpecializer` anstelle des `TAstLowerer` aufzurufen.
|
||||||
|
* `TEvaluatorVisitor.VisitFunctionCall` modifizieren, um den statischen Pfad (`if Assigned(Node.StaticTarget)`) zu implementieren.
|
||||||
@@ -0,0 +1,89 @@
|
|||||||
|
|
||||||
|
# Projektplan: Hybride Monomorphisierung
|
||||||
|
|
||||||
|
* **Datum:** 30.10.2025
|
||||||
|
* **Version:** 1.0
|
||||||
|
|
||||||
|
## 1. Motivation
|
||||||
|
|
||||||
|
Das aktuelle Typsystem (`Myc.Ast.Types`) ist mächtig, aber die Inferenz für Lambda-Parameter endet bei `stUnknown`. Dies erzwingt Laufzeit-Typüberprüfungen im `TEvaluatorVisitor` und verkompliziert AOT/JIT-Kompilierung.
|
||||||
|
|
||||||
|
## 2. Ziel
|
||||||
|
|
||||||
|
Implementierung einer **hybriden Monomorphisierungsstrategie** zur Compile-Zeit (innerhalb des `TAstBinder`).
|
||||||
|
|
||||||
|
1. **Statische Spezialisierung:** Alle Funktionsaufrufe, deren Callee *und* Argumenttypen zur Compile-Zeit statisch bekannt sind, werden spezialisiert. `stUnknown` wird für diese Pfade eliminiert.
|
||||||
|
2. **Dynamischer Fallback:** Alle dynamischen Aufrufe (z.B. Higher-Order-Funktionen, deren Callee aus einer Variable stammt) nutzen weiterhin den bestehenden dynamischen Pfad (`vkMethod` mit `TDataValue`-Wrapper).
|
||||||
|
3. **Optimierungs-Vorbereitung:** Der statisch spezialisierte AST (der "Entrypoint") dient als saubere Basis für optionale Optimierungen (z.B. LLVM-Codegen).
|
||||||
|
|
||||||
|
## 3. Ergebnis: Die Strategie
|
||||||
|
|
||||||
|
Die Implementierung erfordert eine Erweiterung des `TAstBinder`, um einen **Spezialisierungs-Cache** zu verwalten und bei Bedarf **rekursive Binding-Pässe** durchzuführen.
|
||||||
|
|
||||||
|
### Phase 1: Modifikation der Kern-Typen
|
||||||
|
|
||||||
|
1. **`TBoundLambdaExpressionNode` (Generic):**
|
||||||
|
* Muss seinen *originalen, ungebundenen* Body (`IAstNode`) behalten, um als Vorlage für das Re-Binding zu dienen.
|
||||||
|
* Führt einen **Spezialisierungs-Cache** (z.B. `TDictionary<TSignatureHash, ISpecializedBody>`).
|
||||||
|
2. **`ISpecializedBody` (Interface):**
|
||||||
|
* Repräsentiert einen erfolgreich monomorphisierten Entrypoint.
|
||||||
|
* `function GetBodyAst: IAstNode;`
|
||||||
|
* `function GetScopeDescriptor: IScopeDescriptor;`
|
||||||
|
* `function GetReturnType: IStaticType;`
|
||||||
|
3. **`TBoundFunctionCallNode`:**
|
||||||
|
* Benötigt ein neues Feld, um *entweder* den dynamischen Callee (wie bisher) *oder* den statischen `ISpecializedBody` (den Entrypoint) zu halten.
|
||||||
|
|
||||||
|
### Phase 2: Anpassung des `TAstBinder` (Trigger)
|
||||||
|
|
||||||
|
`TAstBinder.VisitFunctionCall` wird zur zentralen Weichenstellung:
|
||||||
|
|
||||||
|
1. Binde alle Argumente und ermittle ihre statischen Typen (die `Aufrufsignatur`).
|
||||||
|
2. Binde den `Callee`.
|
||||||
|
3. **Fallunterscheidung:**
|
||||||
|
* **Fall A (Dynamischer Aufruf):** Der `Callee` ist *nicht* als `TBoundLambdaExpressionNode` statisch bekannt (z.B. `(map (if flag f1 f2) ...)`).
|
||||||
|
* **Aktion:** Der Aufruf wird als dynamisch belassen (Fallback). Es wird lediglich geprüft, ob der `Callee` den Typ `stMethod` hat. Es findet keine Spezialisierung statt.
|
||||||
|
* **Fall B (Statischer Aufruf):** Der `Callee` ist ein `TBoundLambdaExpressionNode`.
|
||||||
|
* **Aktion:** Trigger die Monomorphisierung.
|
||||||
|
* Rufe `Callee.GetSpecialization(Aufrufsignatur)` auf.
|
||||||
|
* Der `TBoundFunctionCallNode` wird modifiziert und verweist direkt auf das zurückgegebene `ISpecializedBody`.
|
||||||
|
* Der `StaticType` des `TBoundFunctionCallNode` wird auf `ISpecializedBody.GetReturnType` gesetzt.
|
||||||
|
|
||||||
|
### Phase 3: Die Monomorphisierung (Der Re-Bind Pass)
|
||||||
|
|
||||||
|
Dies ist die Kernlogik (z.B. in `TBoundLambdaExpressionNode.GetSpecialization`):
|
||||||
|
|
||||||
|
1. **Cache-Lookup:** Prüfe, ob für die `Aufrufsignatur` bereits ein `ISpecializedBody` im Cache existiert.
|
||||||
|
2. **Cache-Miss (Re-Binding):**
|
||||||
|
* Erzeuge einen neuen, temporären `IScopeDescriptor` für den Sub-Bind-Prozess.
|
||||||
|
* **Populiere den Scope:** Definiere die Parameter-Namen (z.B. `[a b]`) in diesem Scope, aber verwende die *konkreten Typen* der `Aufrufsignatur` (z.B. `stFloat`, `stOrdinal`) anstelle von `stUnknown`.
|
||||||
|
* **Rekursiver Binder:** Erzeuge einen neuen `TAstBinder` (oder rufe den aktuellen re-entrant auf), der den *originalen, ungebundenen Body* des Lambdas mit diesem spezialisierten Scope bindet.
|
||||||
|
* **Fehlerbehandlung:** Schlägt dieser Sub-Bind-Prozess fehl (z.B. `ETypeException`, weil `a` (jetzt `stFloat`) mit einem `Text` addiert wird), ist der Aufruf ungültig -> **Compile-Fehler**.
|
||||||
|
* **Erfolg:** Das Ergebnis ist der spezialisierte `IAstNode` (Body) und der `IScopeDescriptor`. Erzeuge ein `ISpecializedBody`-Objekt, speichere es im Cache und gib es zurück.
|
||||||
|
|
||||||
|
### Phase 4: Anpassung des `TEvaluatorVisitor` (Ausführung)
|
||||||
|
|
||||||
|
`TEvaluatorVisitor.VisitFunctionCall` muss nun zwei Arten von Calls behandeln:
|
||||||
|
|
||||||
|
1. **Dynamischer Call:** `Callee` ist `vkMethod`. (Wie bisher: `(calleeValue.AsMethod)(argValues)`).
|
||||||
|
2. **Statischer/Monomorphisierter Call:** `Callee` ist ein `ISpecializedBody`.
|
||||||
|
* Erzeuge den `IExecutionScope` (via `ISpecializedBody.GetScopeDescriptor`).
|
||||||
|
* Populiere den Scope mit den (bereits evaluierten) `argValues`.
|
||||||
|
* Führe den `ISpecializedBody.GetBodyAst` direkt mit `Accept(Self)` aus. (TCO muss hier ebenfalls beachtet werden).
|
||||||
|
|
||||||
|
### Phase 5: LLVM-Optimierung (Optional)
|
||||||
|
|
||||||
|
Der in Phase 3 erzeugte `ISpecializedBody` ist der "corner case" für die Optimierung:
|
||||||
|
|
||||||
|
* Wenn ein `ISpecializedBody` erfolgreich erstellt wurde *und* dieser AST-Body die "harten" Kriterien erfüllt (keine dynamischen Internals), wird er als **Kandidat für LLVM-AOT/JIT** markiert.
|
||||||
|
* Ein LLVM-Backend kann diese Kandidaten aufnehmen, LLVM-IR generieren und den `ISpecializedBody` im Cache durch einen nativen Funktionspointer (den FFI-Entrypoint) ersetzen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. TODOs
|
||||||
|
|
||||||
|
* [ ] `TBoundLambdaExpressionNode` erweitern, um den originalen Body und den Spezialisierungs-Cache zu halten.
|
||||||
|
* [ ] `ISpecializedBody` (oder äquivalente Struktur) definieren.
|
||||||
|
* [ ] `TAstBinder.VisitFunctionCall` um die Weichenstellung (Fall A/B) erweitern.
|
||||||
|
* [ ] Den re-entranten Monomorphisierungs-Pass (Phase 3) implementieren.
|
||||||
|
* [ ] `TEvaluatorVisitor.VisitFunctionCall` für die Ausführung von `ISpecializedBody` anpassen.
|
||||||
|
* [ ] Typsystem (`TTypeRules`) auf Robustheit für die neuen, strikten Prüfungen im Sub-Bind-Pass testen.
|
||||||
@@ -0,0 +1,66 @@
|
|||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## Stream & Pipe Optimization
|
||||||
|
|
||||||
|
### 1. Global Series Deduplication (The "Registry" Pattern)
|
||||||
|
|
||||||
|
Die aktuelle Architektur erzeugt für jeden Pipe-Eingang einen eigenen Akkumulator. Bei komplexen Graphen mit identischen Datenquellen führt dies zu redundantem Speicherverbrauch.
|
||||||
|
|
||||||
|
* **Konzept:** Einführung einer **Global Series Registry**, die als Mediator zwischen `IStream` und `TPipeSource` fungiert.
|
||||||
|
* **Mechanismus:** Anstatt eine `TScalarSeries` privat zu instanziieren, fordert die `TPipeSource` eine Serie über einen Composite-Key `(IStream, IKeyword)` an.
|
||||||
|
* **Vorteil:** Wenn zehn Pipes den `Close`-Preis desselben Tickers beobachten, existiert im gesamten Arbeitsspeicher nur eine einzige Instanz der Daten-Historie.
|
||||||
|
* **Lookback-Management:** Die Registry überwacht die Anforderungen aller Konsumenten und stellt sicher, dass die geteilte Serie immer den **maximalen Lookback** aller beteiligten Pipes vorhält.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### 2. Local State Optimization (Ring-Buffer Series)
|
||||||
|
|
||||||
|
Für Berechnungen innerhalb der Lambda-Funktion (z.B. kurzfristige Delta-Vergleiche) sind die auf Chunks basierenden `TScalarSeries` aufgrund ihrer Verwaltungs-Overheads ineffizient.
|
||||||
|
|
||||||
|
* **Konzept:** Implementierung spezialisierter **Local Ring-Buffer**, die für ultrakurze Lookbacks (z.B. ) optimiert sind.
|
||||||
|
* **Mechanismus:** Ein statisch allozierter Speicherblock mit `truncate-on-add`-Logik. Im Gegensatz zu Chunks gibt es hier keine Heap-Fragmentation durch dynamisches Wachsen.
|
||||||
|
* **Scope:** Diese Strukturen sind "Lambda-Local". Sie werden nicht über die Registry geteilt, sondern dienen als privater, blitzschneller "Scratchpad-Speicher" für zustandsbehaftete Berechnungen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### 3. Signal Transmission & Pressure Relief
|
||||||
|
|
||||||
|
Das ständige Allokieren von `TArray<TScalar.TValue>` in der `Emit`-Methode erzeugt bei hohen Tick-Raten signifikanten Druck auf den Memory-Manager und das Reference-Counting.
|
||||||
|
|
||||||
|
* **Konzept:** **Allocation Pooling** oder **Buffer Slicing** für Signal-Payloads.
|
||||||
|
* **Mechanismus:** Einführung eines `TValueBufferPool`. Streams leihen sich ein Array für den `Emit`-Vorgang aus. Sobald der letzte Observer das Signal verarbeitet hat, kehrt das Array in den Pool zurück.
|
||||||
|
* **Alternative:** Nutzung von `Record`-basierten Memory-Slices, um Kopier-Operationen beim Erzeugen des Signals gänzlich zu eliminieren (**Zero-Copy**).
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### 4. Runtime Adaptability (Dynamic Lookback)
|
||||||
|
|
||||||
|
Aktuell ist der Lookback einer Serie bei der Initialisierung festgeschrieben. In einem dynamischen System müssen Pipes jedoch zur Laufzeit hinzugeschaltet werden können.
|
||||||
|
|
||||||
|
* **Konzept:** **Elastic Series Buffers**.
|
||||||
|
* **Mechanismus:** Die `TScalarSeries` erhält die Fähigkeit, ihre Chunk-Kapazität dynamisch nach oben zu korrigieren, ohne die Integrität der bestehenden Indizes zu verletzen.
|
||||||
|
* **Motivation:** Dies ermöglicht "Hot-Swapping" von Logik-Komponenten. Eine neue Analyse-Pipe kann sich in einen laufenden Stream einklinken und eine Erweiterung der Historie anfordern, ohne dass das System neu gestartet werden muss.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### 5. Computational Economy (Lazy/Dirty Logic)
|
||||||
|
|
||||||
|
In tiefen Graphen werden oft Pipes getriggert, deren Eingangsdaten sich zwar im Cycle geändert haben, deren für die Berechnung relevante Werte aber identisch geblieben sind.
|
||||||
|
|
||||||
|
* **Konzept:** **Change-Detection & Lazy Evaluation**.
|
||||||
|
* **Mechanismus:** Jedes Signal erhält eine Versionierung. Pipes führen ihre Lambda nur aus, wenn sich die Versionen der Eingangs-Serien tatsächlich geändert haben oder wenn ein "Dirty"-Flag gesetzt ist.
|
||||||
|
* **Ziel:** Massive Einsparung von CPU-Zyklen in Szenarien, in denen viele Pipes auf hochfrequenten Streams hängen, aber nur selten Schwellenwerte überschritten werden.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### Zusammenfassung der Architektur-Ziele
|
||||||
|
|
||||||
|
| Fokus | Methode | Resultat |
|
||||||
|
| --- | --- | --- |
|
||||||
|
| **Memory** | Global Registry | Eliminierung redundanter Daten-Historien. |
|
||||||
|
| **Latency** | Ring-Buffers | Beschleunigung lokaler Lambda-Berechnungen. |
|
||||||
|
| **Throughput** | Buffer Pooling | Minimierung von GC-Pausen und Allokations-Overhead. |
|
||||||
|
| **Agility** | Dynamic Lookback | Unterstützung von On-the-fly Rekonfiguration. |
|
||||||
|
|
||||||
|
---
|
||||||
@@ -0,0 +1,68 @@
|
|||||||
|
### **Roadmap: Implementierung des Interaktiven Semantischen Editors**
|
||||||
|
|
||||||
|
**Leitprinzip:** Die Serialisierung ist kein nachträgliches Feature, sondern das Fundament. Das Datenformat wird zuerst vollständig definiert und implementiert. Die Visualisierungs- und Editierfunktionen bauen darauf auf.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
#### **Phase 1: Das Fundament – Datenmodell & Persistenz**
|
||||||
|
|
||||||
|
**Ziel:** Eine robuste Serialisierungs-Engine zu schaffen, die den gesamten Zustand des Editors (AST, logische Metadaten, Instanz-Metadaten) verlustfrei speichern und laden kann, *bevor* eine einzige visuelle Komponente existiert.
|
||||||
|
|
||||||
|
1. **Definition der Kern-Datenstrukturen:**
|
||||||
|
* **TViewModelID**: Ein Int64-Typ als eindeutige, stabile ID für jede visuelle Knoteninstanz.
|
||||||
|
* **TVisualNodeViewModel**: Die Vermittlerklasse zwischen IAstNode und TAuraNode. Enthält eine Referenz auf den IAstNode und seine eigene TViewModelID.
|
||||||
|
* **TLogicalMetadata**: Record für Metadaten, die an einen IAstNode gebunden sind (z.B. semantische Farbcodierung).
|
||||||
|
* **TVisualInstanceMetadata**: Record für Metadaten, die an eine TViewModelID gebunden sind. **Hier wird die neue Anforderung verankert:**
|
||||||
|
* PositionOverride: TPointF
|
||||||
|
* IsCollapsed: Boolean
|
||||||
|
* VisualizationMode: (vmSyntactic, vmSemantic) // Definiert, wie DIESE Instanz ihre Kinder darstellt.
|
||||||
|
2. **Festlegung des finalen JSON-Formats:**
|
||||||
|
* Das JSON-Format wird von Anfang an so entworfen, dass es alle zukünftigen Anforderungen abbilden kann. Es besteht aus drei Hauptteilen:
|
||||||
|
1. **ast**: Der reine IAstNode-Baum. Zur Persistenz wird jedem IAstNode beim Speichern eine temporäre, datei-interne Integer-ID zugewiesen.
|
||||||
|
2. **logicalMetadata**: Ein Dictionary, das die temporären IAstNode-IDs auf ihre TLogicalMetadata abbildet.
|
||||||
|
3. **instanceMetadata**: Ein Dictionary, das die stabilen TViewModelIDs auf ihre TVisualInstanceMetadata abbildet (inklusive des neuen VisualizationMode).
|
||||||
|
3. **Implementierung des Serialisierungs- & Deserialisierungs-Backbones:**
|
||||||
|
* Entwicklung der Routinen, die einen IAstNode-Baum und die dazugehörigen Metadaten-Dictionaries entgegennehmen und eine JSON-Datei gemäß Schritt 1.2 erzeugen.
|
||||||
|
* Entwicklung der Gegenstücke, die eine solche JSON-Datei einlesen und die In-Memory-Strukturen (IAstNode-Baum, Dictionaries für Metadaten) vollständig und konsistent wiederherstellen.
|
||||||
|
* **Wichtig:** Diese Logik arbeitet komplett ohne UI-Komponenten.
|
||||||
|
|
||||||
|
**Ergebnis von Phase 1:** Eine voll funktionsfähige "headless" Lade- & Speicher-Bibliothek. Man kann einen Editor-Zustand programmatisch erzeugen, speichern, wieder laden und die Datenintegrität per Unit-Tests verifizieren. **Die Serialisierung ist damit vom ersten Tag an das stabilste Element der Architektur.**
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
#### **Phase 2: Die Flexible Visualisierungs-Engine**
|
||||||
|
|
||||||
|
**Ziel:** Die in Phase 1 definierten Datenstrukturen sichtbar machen und den Wechsel zwischen syntaktischer und semantischer Darstellung ermöglichen.
|
||||||
|
|
||||||
|
1. **Der "ViewModel-Builder"-Visitor:**
|
||||||
|
* Dieser Visitor nimmt einen IAstNode (HAST) sowie die Metadaten entgegen und erzeugt den TVisualNodeViewModel-Graphen.
|
||||||
|
* Er arbeitet modus-abhängig, basierend auf dem VisualizationMode des Eltern-ViewModels:
|
||||||
|
* **Im vmSyntactic-Modus:** Erzeugt für jeden Kind-IAstNode eine neue, einzigartige TVisualNodeViewModel-Instanz mit einer neuen TViewModelID. Das Ergebnis ist ein Baum.
|
||||||
|
* **Im vmSemantic-Modus:** Nutzt nach dem obligatorischen Binding-Schritt einen TDictionary\<TResolvedAddress, TVisualNodeViewModel\>, um für bereits visualisierte semantische Entitäten das existierende ViewModel wiederzuverwenden. Das Ergebnis ist ein DAG.
|
||||||
|
2. **Die Layout- & Rendering-Engine (TAuraLayoutEngine):**
|
||||||
|
* Diese Engine nimmt den TVisualNodeViewModel-Graphen (der ein Baum oder DAG sein kann) und erzeugt die visuellen TAuraNode-Controls.
|
||||||
|
* Für jedes ViewModel liest sie die TVisualInstanceMetadata (über die TViewModelID) und wendet Position, Kollaps-Zustand etc. an.
|
||||||
|
* Sie muss in der Lage sein, die Verbindungen für eine DAG-Struktur korrekt zu zeichnen (d.h. Linien von mehreren Eltern zu einem Kind).
|
||||||
|
3. **Implementierung des Modus-Wechsels:**
|
||||||
|
* Schaffung einer UI-Aktion (z.B. Kontextmenü auf einem TAuraNode), um den VisualizationMode in den Metadaten einer ViewModel-Instanz zu ändern.
|
||||||
|
* Diese Änderung löst eine Aktualisierung aus: Der ViewModel-Builder wird für den betroffenen Teilbaum neu ausgeführt, und die Layout-Engine zeichnet den Bereich neu.
|
||||||
|
|
||||||
|
**Ergebnis von Phase 2:** Ein interaktiver Viewer. Projekte können geladen, in beiden Modi (syntaktisch/semantisch) dargestellt und per Knoten umgeschaltet werden.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
#### **Phase 3: Der Interaktive Editor**
|
||||||
|
|
||||||
|
**Ziel:** Dem Benutzer die sichere und strukturierte Bearbeitung des Graphen zu ermöglichen.
|
||||||
|
|
||||||
|
1. **Implementierung des Command Patterns:**
|
||||||
|
* Jede Änderung am AST (Knoten hinzufügen, löschen, Eigenschaft ändern) wird als IEditorCommand mit Execute und Unexecute implementiert, um Undo/Redo zu ermöglichen.
|
||||||
|
* Ein Command modifiziert **immer nur das HAST-Modell**, niemals direkt das ViewModel oder die View.
|
||||||
|
2. **Entwicklung des Socket-basierten Controllers:**
|
||||||
|
* Implementierung der Logik, die Benutzerinteraktionen (Klick auf ein "Socket") in die Erzeugung und Ausführung des passenden Commands übersetzt.
|
||||||
|
3. **Etablierung des Update-Zyklus:**
|
||||||
|
* Nachdem ein Command das HAST-Modell erfolgreich modifiziert hat, wird der Update-Prozess angestoßen:
|
||||||
|
1. Der "ViewModel-Builder" läuft über den geänderten Teil des HAST. Er versucht dabei, existierende ViewModels (anhand ihrer IAstNode-Referenz) wiederzuverwenden, um deren stabile IDs und damit die UI-Zustände zu erhalten. Nur für neue IAstNodes werden neue ViewModels erzeugt.
|
||||||
|
2. Die TAuraLayoutEngine rendert die neuen TAuraNode-Controls.
|
||||||
|
|
||||||
|
**Ergebnis von Phase 3:** Ein voll funktionsfähiger, interaktiver Editor mit robustem Zustandsmanagement, flexibler Visualisierung und Undo/Redo-Funktionalität.
|
||||||
@@ -0,0 +1,128 @@
|
|||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
# Projektplan: "Single-Map-Argument" (SMA) Architektur
|
||||||
|
|
||||||
|
*Datum: 23. Oktober 2025*
|
||||||
|
|
||||||
|
## 1. Motivation: Die "Visuelle Sprache"
|
||||||
|
|
||||||
|
Das primäre Entwicklungsziel ist **nicht** eine Text-basierte Programmiersprache, sondern ein **visueller Editor**, in dem Logik durch das Kombinieren von Blöcken erstellt wird. Der Text-Parser (`Myc.Ast.Script`) ist lediglich eine sekundäre Repräsentation.
|
||||||
|
|
||||||
|
Für einen visuellen Editor ist syntaktische Komplexität Gift. Jede Ausnahme, jedes Schlüsselwort und jede alternative Syntax (wie `[]` vs. `()`) erfordert einen neuen, speziellen visuellen Block, was die Benutzeroberfläche überlädt und die Konsistenz bricht.
|
||||||
|
|
||||||
|
Das ultimative Ziel ist eine **100% einheitliche Syntax**, bei der es nur noch *eine* Art gibt, eine Operation auszudrücken: den Funktionsaufruf. In einer S-Expression-Welt ist die konsistenteste Form dafür `(Funktionsname Argumente...)`.
|
||||||
|
|
||||||
|
## 2. Ziel: Das "Single-Map-Argument" (SMA) Modell
|
||||||
|
|
||||||
|
Um die visuelle Darstellung auf das absolute Minimum zu reduzieren (ein Block für "Funktion" und ein Slot für "Argumente"), führen wir das **"Single-Map-Argument" (SMA) Modell** ein.
|
||||||
|
|
||||||
|
Es gibt nur noch *eine* gültige Aufrufkonvention:
|
||||||
|
`(Funktionsname {Argument-Map})`
|
||||||
|
|
||||||
|
Jede Funktion, egal ob nativ (`+`) oder benutzerdefiniert (`my-lambda`), wird mit einem einzigen Argument aufgerufen: einem **Map-Literal** (das zu einem `TScalarRecord` ausgewertet wird). Dieses Literal definiert die Argumente über Key-Value-Paare.
|
||||||
|
|
||||||
|
**Beispiele:**
|
||||||
|
|
||||||
|
* **Arithmetik:** `(+ {:x 1 :y 2})`
|
||||||
|
* **RTL-Funktion:** `(Abs {:value -10})`
|
||||||
|
* **Lambda-Definition:** `(fn my-adder ({:x1 1 :x2 2}) ...)`
|
||||||
|
* **Lambda-Aufruf:** `(my-adder {:x1 5})`
|
||||||
|
|
||||||
|
Dieses Design erfüllt die Anforderung an die visuelle Konsistenz perfekt. Ein "Aufruf"-Block im Editor hat immer nur zwei definierte Slots: den Namen (z.B. `+`) und ein Map-Literal (z.B. `{:x ..., :y ...}`).
|
||||||
|
|
||||||
|
## 3. Analyse & Performance-Strategie
|
||||||
|
|
||||||
|
Unsere Diskussion hat ergeben, dass dieses Modell zwar visuell perfekt, aber in einer naiven Implementierung performancetechnisch inakzeptabel wäre.
|
||||||
|
|
||||||
|
### Das Problem: Die naive Implementierung (Verworfen)
|
||||||
|
|
||||||
|
Eine naive Implementierung würde jeden Aufruf zur Laufzeit gleich behandeln:
|
||||||
|
1. Der `TEvaluator` wertet das Map-Literal `{:x 1 :y 2}` zu einem vollwertigen `TScalarRecord` aus (Heap-Allokation, Füllen einer Map/Dictionary-Struktur).
|
||||||
|
2. Er ruft die native `+` Funktion mit diesem *einen* `TScalarRecord`-Argument auf.
|
||||||
|
3. Die `+` Funktion (bzw. ihr Wrapper) müsste die Map parsen, die Keys `:x` und `:y` nachschlagen und die Werte extrahieren.
|
||||||
|
|
||||||
|
Für Operationen wie `+`, die millionenfach pro Sekunde aufgerufen werden, ist dieser Overhead (Heap-Allokation + Hashmap-Lookups) katastrophal und ein absoluter Showstopper.
|
||||||
|
|
||||||
|
### Die Lösung: Kompilierung von Aufrufsignaturen
|
||||||
|
|
||||||
|
Wir vermeiden diesen Overhead, indem wir den **`TAstBinder` (den "Compiler")** die "Dekonstruktion" der Argument-Maps zur Compile-Zeit durchführen lassen.
|
||||||
|
|
||||||
|
Wir implementieren eine **Drei-Pfade-Kompilierung** für `VisitFunctionCall`:
|
||||||
|
|
||||||
|
#### Pfad 1: "Fast Path" (Nativ / RTL)
|
||||||
|
|
||||||
|
Dieser Pfad optimiert alle Aufrufe an bekannte, fest verdrahtete RTL-Funktionen.
|
||||||
|
|
||||||
|
* **Aktion (Binder):**
|
||||||
|
1. Der `TAstBinder` erhält ein **statisches Registry nativer Signaturen** (z.B. `TDictionary<string, TArray<string>>`). Dieses mappt Namen auf *geordnete* Key-Listen: `'+' -> [':x', ':y']`, `'Abs' -> [':value']`.
|
||||||
|
2. Bei `(sub {:a 5 :b 3})` schlägt er `sub` nach. Treffer! Signatur ist `[':a', ':b']`.
|
||||||
|
3. Der Binder validiert das `IMapLiteralNode` (alle Keys da? unbekannte Keys?).
|
||||||
|
4. **Argument-Umschreibung (Rewriting):** Der Binder *ignoriert* die Map-Struktur und erzeugt einen neuen, *positionalen* `TArray<IAstNode>`: `[ (Node 5), (Node 3) ]`.
|
||||||
|
5. Er erzeugt einen `TBoundFunctionCallNode`, der auf die native `sub`-Funktion zeigt, aber das *neue positionale Array* als Argumentenliste enthält.
|
||||||
|
* **Aktion (Evaluator):**
|
||||||
|
1. Der Evaluator sieht einen normalen, positionalen Aufruf.
|
||||||
|
2. Er wertet die Argumente `5` und `3` aus und ruft die `TRtlFunctions.Subtract` direkt mit einem `TArray<TDataValue>` auf.
|
||||||
|
* **Ergebnis:** Keinerlei Map-Allokation zur Laufzeit. Maximale Performance.
|
||||||
|
|
||||||
|
#### Pfad 2: "Fast Path" (Direkte Lambda)
|
||||||
|
|
||||||
|
Dieser Pfad optimiert direkte Aufrufe an Lambdas, deren Definition dem Binder bereits bekannt ist.
|
||||||
|
|
||||||
|
* **Aktion (Binder):**
|
||||||
|
1. Bei `(fn my-adder ({:x1 1 :x2 2}) ...)` parst der Binder die Signatur `({:x1 1, :x2 2})`.
|
||||||
|
2. Er speichert diese Signatur-Metadaten (Keys und Default-Wert-Nodes) im `IScopeDescriptor` als Metadatum für die Variable `my-adder`.
|
||||||
|
3. Bei einem späteren Aufruf `(my-adder {:x1 5})`:
|
||||||
|
4. Der Binder schlägt `my-adder` im Scope nach. Treffer! Er findet die Variable *und* die gespeicherte Signatur.
|
||||||
|
5. **Argument-Umschreibung:** Er führt die *gleiche* Optimierung wie bei nativen Aufrufen durch. Er parst das `IMapLiteralNode`, füllt fehlende Keys mit den Default-Nodes (z.B. `:x2` -> `(Node 2)`) und erzeugt einen positionalen `TArray<IAstNode>`: `[ (Node 5), (Node 2) ]`.
|
||||||
|
6. Er erzeugt einen `TBoundFunctionCallNode`, der das positionale Array enthält.
|
||||||
|
* **Aktion (Evaluator):**
|
||||||
|
1. Der Evaluator wertet die Closure `my-adder` aus.
|
||||||
|
2. Er wertet die Argumente `5` und `2` aus.
|
||||||
|
3. Er ruft die Closure mit einem *positionalen* `TArray<TDataValue>` auf.
|
||||||
|
* **Ergebnis:** Auch hier: Keinerlei Map-Allokation zur Laufzeit.
|
||||||
|
|
||||||
|
#### Pfad 3: "Slow Path" (Dynamisch / Polymorph)
|
||||||
|
|
||||||
|
Dies ist der Fallback für alle Aufrufe, die der Binder zur Compile-Zeit *unmöglich* auflösen kann.
|
||||||
|
|
||||||
|
* **Szenarien:**
|
||||||
|
* **Funktionen höherer Ordnung (HOFs):** `(Map my-series (fn ({:item}) ...))` -> Die `Map`-Funktion *muss* die Lambda dynamisch aufrufen.
|
||||||
|
* **Indirekte Aufrufe:** `(fn call-it (func) (func {:a 1}))` -> `func` ist zur Compile-Zeit unbekannt.
|
||||||
|
* **Späte Bindung / Forward-Deklarationen.**
|
||||||
|
* **Aktion (Binder):**
|
||||||
|
1. Der Binder kann die Signatur nicht finden.
|
||||||
|
2. Er kann *nicht* optimieren. Er behandelt das `IMapLiteralNode` `{:a 1}` als regulären Wert.
|
||||||
|
3. Er erzeugt einen `TBoundFunctionCallNode` mit einem Argumenten-Array, das *nur dieses eine* `IMapLiteralNode` enthält.
|
||||||
|
* **Aktion (Evaluator):**
|
||||||
|
1. Der Evaluator *muss* nun das `IMapLiteralNode` zu einem echten `TScalarRecord` auswerten (der "Overhead" entsteht hier).
|
||||||
|
2. Er ruft die Closure (z.B. `func`) mit *einem* Argument auf (dem `TScalarRecord`).
|
||||||
|
3. Die Closure selbst muss die **Laufzeit-Destrukturierung** durchführen: Sie parst die Map, extrahiert die Keys (`:a`) und wendet ihre Defaults an.
|
||||||
|
* **Ergebnis:** Das System bleibt voll funktionsfähig und konsistent, nutzt aber den langsameren Pfad nur, wenn es semantisch unvermeidbar ist.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. TODOs (Detailliert)
|
||||||
|
|
||||||
|
1. **Parser (`Myc.Ast.Script`)**
|
||||||
|
* [ ] `TLexer`: `tkLeftBracket`, `tkRightBracket` entfernen. `tkLBrace` (`{`), `tkRBrace` (`}`), `tkColon` (`:`) hinzufügen.
|
||||||
|
* [ ] `IAstNode`: `IKeywordNode` (für `:key`) und `IMapLiteralNode` (enthält `TArray<TPair<IKeywordNode, IAstNode>>`) definieren.
|
||||||
|
* [ ] `TParser`: `ParseExpression` erweitern, um `{...}` zu `IMapLiteralNode` und `:...` zu `IKeywordNode` zu parsen.
|
||||||
|
* [ ] `TParser`: `ParseList` anpassen. Die `fn`- und `defmacro`-Logik muss die Parameterliste jetzt als `IMapLiteralNode` (für die Destrukturierung) statt einer Liste von Identifiern parsen.
|
||||||
|
|
||||||
|
2. **Binder (`Myc.Ast.Binding`)**
|
||||||
|
* [ ] `TAstBinder.Create`: Das **Native Signature Registry** (`TDictionary<string, TArray<string>>`) initialisieren.
|
||||||
|
* [ ] `TAstBinder.VisitLambdaExpression`: Die `IMapLiteralNode`-Signatur parsen. Die Metadaten (geordnete Keys und Default-`IAstNode`s) müssen in der `TBoundLambdaExpressionNode` oder im `IScopeDescriptor` gespeichert werden.
|
||||||
|
* [ ] `TAstBinder.VisitFunctionCall`: Die **Kern-Drei-Pfade-Logik** implementieren:
|
||||||
|
1. Lookup im Native Registry (Pfad 1).
|
||||||
|
2. Lookup im `IScopeDescriptor` nach Lambda-Metadaten (Pfad 2).
|
||||||
|
3. Fallback auf "Slow Path" (Pfad 3).
|
||||||
|
* [ ] `TAstBinder`: Eine private `function RewriteArguments(const Signature: ...; const CallMap: IMapLiteralNode): TArray<IAstNode>` implementieren, die die "Fast Path"-Dekonstruktion durchführt.
|
||||||
|
|
||||||
|
3. **Evaluator (`Myc.Ast.Evaluator`)**
|
||||||
|
* [ ] `TEvaluatorVisitor`: `VisitMapLiteral` implementieren. Diese Methode wertet ein `IMapLiteralNode` zu einem `TDataValue (vkRecord)` aus (der "Slow Path"-Overhead).
|
||||||
|
* [ ] `TEvaluatorVisitor.VisitLambdaExpression`: Die *Laufzeit*-Destrukturierungslogik implementieren. Diese wird aktiv, wenn die Closure (TFunc) mit einem `TDataValue (vkRecord)` (Pfad 3) anstelle eines `TArray<TDataValue>` (Pfad 2) aufgerufen wird. (Benötigt Anpassung der Closure-Signatur oder -Logik).
|
||||||
|
|
||||||
|
4. **RTL (Anpassung & Registrierung)**
|
||||||
|
* [ ] `Myc.Ast.RTL.Core`: Die Implementierungen (`TRtlFunctions.Add` etc.) bleiben **unverändert**. Sie erwarten weiterhin `TArray<TDataValue>`, da der Binder für sie übersetzt.
|
||||||
|
* [ ] `Myc.Ast.RTL`: Die RTTI-Registrierung muss erweitert werden, um dem Binder die Signaturen bereitzustellen. `TRtlFunctionAttribute` könnte erweitert werden: `[TRtlFunction('+', ':x,:y')]`. Diese Infos füllen das Native Registry im Binder.
|
||||||
@@ -0,0 +1,46 @@
|
|||||||
|
### **Projektplan: Transformation des AST-Visualisierers zum Interaktiven Editor**
|
||||||
|
|
||||||
|
* **Datum:** 08.09.2025 11:20
|
||||||
|
* **Motivation**
|
||||||
|
* Der aktuelle AST-Visualisierer ist ein leistungsfähiges Anzeigetool. Um ihn zu einem interaktiven Werkzeug für die Skript-Entwicklung, \-Analyse und \-Modifikation weiterzuentwickeln, muss eine robuste Architektur für Zustandsverwaltung, Bearbeitung und Persistenz geschaffen werden.
|
||||||
|
* **Ziel**
|
||||||
|
* Die Entwicklung einer flexiblen Editor-Architektur, die eine klare Trennung zwischen dem logischen AST-Modell und seiner visuellen Repräsentation gewährleistet. Das System muss komplexe Anforderungen erfüllen: Es soll optionale Darstellungsmodi (Baum- vs. Graphen-Ansicht), zwei Arten von Metadaten (logisch vs. instanzspezifisch) und eine hohe Datenintegrität bei internen (z.B. Umsortieren) und externen (z.B. Einfügen von LLM-Code) Bearbeitungen sicherstellen.
|
||||||
|
* **Ergebnis**
|
||||||
|
* Ein interaktiver, visueller AST-Editor mit einem hochentwickelten Zustandsmanagement. Die Architektur bietet eine nahtlose Benutzererfahrung, bei der Layout-Anpassungen und Zustände (z.B. eingeklappte Knoten) auch bei komplexen Operationen wie Refactoring oder dem Mergen von extern modifiziertem Code intelligent erhalten bleiben. Das System ist durch ein flexibles JSON-Format persistent und interoperabel.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
### **TODO: Nächste Schritte**
|
||||||
|
|
||||||
|
1. **Fundament: ViewModel-Schicht und Stabile IDs einführen**
|
||||||
|
* **Beschreibung:** Das Kernstück der neuen Architektur schaffen. Eine TVisualNodeViewModel-Klasse wird als Vermittler zwischen dem IAstNode-Modell und der TAuraNode-Ansicht eingeführt.
|
||||||
|
* **Umsetzung:**
|
||||||
|
* Jede TVisualNodeViewModel-Instanz erhält beim Erstellen eine einzigartige, permanente und strukturunabhängige TViewModelID (z.B. Int64).
|
||||||
|
* Der TAstToAuraNodeVisitor wird so umgebaut, dass er primär einen Baum aus ViewModel-Objekten erzeugt, welcher die Hierarchie des AST widerspiegelt.
|
||||||
|
2. **Zustandsverwaltung: Metadaten-System implementieren**
|
||||||
|
* **Beschreibung:** Die getrennte Speicherung von logischen und instanzspezifischen Metadaten implementieren.
|
||||||
|
* **Umsetzung:**
|
||||||
|
* **Logische Metadaten:** Eine zentrale TDictionary\<IAstNode, TLogicalMetadata\> für Eigenschaften erstellen, die für alle Instanzen eines Knotens gelten (z.B. Farbkodierung).
|
||||||
|
* **Instanz-Metadaten:** Eine TDictionary\<TViewModelID, TVisualInstanceMetadata\> für Eigenschaften erstellen, die nur für eine bestimmte visuelle Instanz gelten (z.B. IsCollapsed, Position auf der Leinwand).
|
||||||
|
* Die Rendering-Logik anpassen, um beide Metadatentypen beim Zeichnen eines TAuraNode zu berücksichtigen.
|
||||||
|
3. **Persistenz: JSON-Serialisierung erweitern**
|
||||||
|
* **Beschreibung:** Das Speichern und Laden des gesamten Editor-Zustands ermöglichen.
|
||||||
|
* **Umsetzung:**
|
||||||
|
* Einen Serialisierungsprozess entwerfen, der drei getrennte Bereiche in der JSON-Datei ablegt:
|
||||||
|
1. Den reinen IAstNode-Baum.
|
||||||
|
2. Die logischen Metadaten, verknüpft über eine temporäre ID des IAstNode.
|
||||||
|
3. Die instanzspezifischen Metadaten, verknüpft über die stabile TViewModelID.
|
||||||
|
4. **Interaktion: Grundlegende Editierbarkeit herstellen**
|
||||||
|
* **Beschreibung:** Dem Benutzer erlauben, den AST-Graphen zu verändern (Knoten hinzufügen, löschen, umsortieren).
|
||||||
|
* **Umsetzung:**
|
||||||
|
* Das **Command Pattern** implementieren, bei dem jede Änderung eine Execute- und Unexecute-Methode hat (für Undo/Redo).
|
||||||
|
* Jeder Command ist dafür verantwortlich, sowohl das IAstNode-Modell als auch den TVisualNodeViewModel-Baum konsistent zu halten. Da die Metadaten an die stabilen IDs gekoppelt sind, bleiben sie bei diesen Operationen automatisch erhalten.
|
||||||
|
5. **Fortgeschrittene Interaktion: "Smart Paste" / Abgleich-Algorithmus**
|
||||||
|
* **Beschreibung:** Das intelligente Einfügen von extern veränderten AST-Teilbäumen ermöglichen.
|
||||||
|
* **Umsetzung:**
|
||||||
|
* Einen "Diff & Merge"-Algorithmus entwickeln. Beim Einfügen vergleicht dieser den neuen AST-Teilbaum mit dem alten.
|
||||||
|
* Bei äquivalenten Knoten werden die bestehenden TVisualNodeViewModel-Instanzen (samt ihrer IDs und Metadaten) wiederverwendet, um den visuellen Zustand zu erhalten. Nur bei echten Änderungen oder neuen Knoten werden neue ViewModels mit neuen IDs erzeugt.
|
||||||
|
6. **Optionale Ansicht: Eindeutige Knoten-Visualisierung ("Graph"-Modus)**
|
||||||
|
* **Beschreibung:** Den optionalen Modus implementieren, in dem jeder IAstNode nur einmal dargestellt wird.
|
||||||
|
* **Umsetzung:**
|
||||||
|
* Den TAstToAuraNodeVisitor um einen Modus erweitern. In diesem Modus führt er eine TDictionary\<IAstNode, TVisualNodeViewModel\>, um bereits erstellte ViewModels für einen IAstNode zu finden und wiederzuverwenden, anstatt neue zu erstellen. Stattdessen wird nur eine neue Verbindungslinie gezeichnet.
|
||||||
+123
@@ -0,0 +1,123 @@
|
|||||||
|
# Einführung von N-dimensionalen Tupel-Strukturen und Typ-Unification
|
||||||
|
|
||||||
|
**Datum:** 04.01.2026
|
||||||
|
|
||||||
|
**Status:** Design abgeschlossen / Vorbereitung der Implementierung
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. Motivation
|
||||||
|
|
||||||
|
In der bisherigen Architektur wurden Argumentlisten, Parameterlisten und Datenstrukturen (Records/Series) als getrennte Konzepte behandelt. Dies führt zu unnötigem Overhead durch "Boxing" (Einpacken von Werten in Objekte) und erschwert die statische Optimierung mathematischer Operationen.
|
||||||
|
|
||||||
|
**Das Ziel dieser Erweiterung:**
|
||||||
|
|
||||||
|
* **Vereinheitlichung:** Alles, was eine feste Sequenz von Daten ist, wird intern ein **Tupel**.
|
||||||
|
* **Performance:** Durch präzise statische Analyse der "Shape" (Form) und des Inhalts sollen Daten unboxed (als reine Value-Types) im Speicher liegen können.
|
||||||
|
* **Monomorphisierung:** Der Compiler soll hochoptimierten Maschinencode (SIMD) erzeugen können, sobald er erkennt, dass Datenstrukturen "rechteckig" und homogen sind.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Architekturbeschreibung
|
||||||
|
|
||||||
|
### 2.1 Die Typ-Hierarchie (`IStaticType`)
|
||||||
|
|
||||||
|
Wir führen eine rekursive Inferenz-Logik im `TypeChecker` ein, die den am besten passenden statischen Typ ermittelt:
|
||||||
|
|
||||||
|
1. **`stTuple`**: Der Basisfall. Eine heterogene Sequenz fester Länge (z. B. `[1 "Text"]`). Jeder Slot hat seinen eigenen statischen Typ.
|
||||||
|
2. **`stVector`**: Ein Spezialfall des Tupels. Alle Elemente besitzen den **identischen** statischen Typ (Homogenität). Dies erlaubt den typsicheren Zugriff über variable Indizes.
|
||||||
|
3. **`stMatrix`**: Ein rekursiver Spezialfall des Vektors. Ein Vektor, dessen Elemente wiederum Vektoren oder Matrizen sind, sofern sie eine **identische Shape** (Dimensionen) aufweisen ("Rechteckigkeit").
|
||||||
|
|
||||||
|
### 2.2 Die "Scalar-Pure" Optimierung
|
||||||
|
|
||||||
|
Dies ist eine rein interne Optimierung des Spezialisierers:
|
||||||
|
|
||||||
|
* Wenn ein Typ (`stTuple`, `stVector`, `stMatrix`) ausschließlich statisch bekannte Typen (idealerweise Skalare wie `Ordinal` oder `Float`) enthält, wird er als **Value-Type** behandelt.
|
||||||
|
* **Monomorphisierter Pfad:** Der Spezialisierer erzeugt für diese Strukturen einen dedizierten Code-Pfad, der statt mit langsamen Objekt-Arrays mit flachen, gepackten Speicherblöcken arbeitet.
|
||||||
|
* **Kein implizites Casting:** Um die Inferenz stabil zu halten, findet keine automatische Umwandlung statt (z. B. wird ein `Ordinal` nicht automatisch zu `Float`, um einen Vektor zu erzwingen).
|
||||||
|
|
||||||
|
### 2.3 Unification (Vereinheitlichung der Konzepte)
|
||||||
|
|
||||||
|
Das Tupel-Konzept ersetzt mehrere bisherige Mechanismen:
|
||||||
|
|
||||||
|
* **Argument- & Parameterlisten:** Funktionsaufrufe werden semantisch als Übergabe eines Tupels behandelt. Dies ermöglicht hocheffiziente Registerübergabe.
|
||||||
|
* **Records:** Ein Record ist semantisch nur ein "Tagged Tuple". Die Daten liegen als Tupel vor, ein Keyword-Mapping sorgt lediglich für den namensbasierten Zugriff.
|
||||||
|
* **Multiple Returns:** Funktionen können nativ Tupel zurückgeben, was ohne zusätzliches Heap-Investment verarbeitet werden kann.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Skript-Beispiele und Inferenz
|
||||||
|
|
||||||
|
Die Syntax für alle Tupel-basierten Strukturen ist einheitlich `[...]`.
|
||||||
|
|
||||||
|
### A. Heterogene Strukturen (Tupel)
|
||||||
|
|
||||||
|
```script
|
||||||
|
(def tpl [1 3.14 "text"])
|
||||||
|
; Typ-Inferenz: stTuple<stOrdinal, stFloat, stText>
|
||||||
|
; Spezialisierung: Gepackter Record (Offset 0: Int64, Offset 8: Double, Offset 16: Ptr)
|
||||||
|
|
||||||
|
(get tpl 1) ; -> 3.14 (Der Compiler weiß statisch: Index 1 ist stFloat)
|
||||||
|
|
||||||
|
```
|
||||||
|
|
||||||
|
### B. Homogene Strukturen (Vektoren)
|
||||||
|
|
||||||
|
```script
|
||||||
|
(def v [10 20 30])
|
||||||
|
; Typ-Inferenz: stVector<stOrdinal, 3>
|
||||||
|
; Spezialisierung: Flaches Array von 3x Int64 (unboxed, SIMD-optimierbar)
|
||||||
|
|
||||||
|
(def i 2)
|
||||||
|
(get v i) ; -> 30 (Typsicher, da alle Elemente stOrdinal sind)
|
||||||
|
|
||||||
|
```
|
||||||
|
|
||||||
|
### C. Multidimensionale Strukturen (Matrizen)
|
||||||
|
|
||||||
|
Die Matrix-Invariante erfordert exakt gleiche Formen der Unterelemente.
|
||||||
|
|
||||||
|
```script
|
||||||
|
; 2D Matrix
|
||||||
|
(def mat2d [[1 2] [3 4]])
|
||||||
|
; Inferenz: stMatrix<stOrdinal, [2, 2]> (Rechteckig -> Optimierung aktiv)
|
||||||
|
|
||||||
|
; 3D Matrix
|
||||||
|
(def mat3d [[[1 2] [3 4]] [[5 6] [7 8]]])
|
||||||
|
; Inferenz: stMatrix<stOrdinal, [2, 2, 2]> (Linearisierter Speicherblock)
|
||||||
|
|
||||||
|
; Degradiertes Tupel (Shape-Mismatch)
|
||||||
|
(def mixed [[1 2] [3 4 5]])
|
||||||
|
; Inferenz: stVector<stTuple>
|
||||||
|
; Keine Matrix-Optimierung möglich, da Unter-Tupel Längen 2 und 3 haben.
|
||||||
|
|
||||||
|
```
|
||||||
|
|
||||||
|
### D. Records als Tupel-Sicht
|
||||||
|
|
||||||
|
```script
|
||||||
|
(def rec {:x 1, :y 0.3})
|
||||||
|
; Physisch: stTuple<stOrdinal, stFloat>
|
||||||
|
; Logisch: Record-Mapping {:x -> 0, :y -> 1}
|
||||||
|
|
||||||
|
```
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Nächste Schritte
|
||||||
|
|
||||||
|
1. **`Myc.Ast.Types.pas`**:
|
||||||
|
* Erweitern von `TStaticTypeKind` und `IStaticType`.
|
||||||
|
* Implementierung von `TTupleType`, `TVectorType` und `TMatrixType`.
|
||||||
|
* Implementierung der rekursiven `IsScalarPure`-Prüfung.
|
||||||
|
(erledigt)
|
||||||
|
|
||||||
|
2. **`Myc.Ast.Compiler.TypeChecker.pas`**:
|
||||||
|
* Implementierung der Promotion-Kaskade (`stTuple` -> `stVector` -> `stMatrix`).
|
||||||
|
* Validierung der "Rechteckigkeit" bei geschachtelten Literalen.
|
||||||
|
|
||||||
|
|
||||||
|
3. **`Myc.Ast.Nodes.pas`**:
|
||||||
|
* Konsolidierung von `IArgumentList`, `IParameterList` etc. zu einer allgemeinen Tupel-Repräsentation.
|
||||||
|
|
||||||
|
|
||||||
+144
@@ -0,0 +1,144 @@
|
|||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
# High-Performance Backend (Bytecode VM)
|
||||||
|
|
||||||
|
**Datum:** 21.11.2025
|
||||||
|
**Status:** Entwurf / Planungsphase
|
||||||
|
**Zielarchitektur:** Stack-based Virtual Machine (ähnlich Lua 5.x / Python)
|
||||||
|
|
||||||
|
## 1\. Motivation & Architektur-Ziele
|
||||||
|
|
||||||
|
* **Status Quo:** Der aktuelle AST-Evaluator ist mächtig, flexibel und ideal für Debugging, leidet aber unter "Pointer Chasing" (Cache Misses) und Rekursions-Overhead (CPU Stack Frames).
|
||||||
|
* **Ziel:** Maximale Ausführungsgeschwindigkeit für typisierte, numerische Operationen bei gleichzeitiger Beibehaltung der vollen Sprachflexibilität (Closures, dynamische Typen).
|
||||||
|
* **Strategie:** Implementierung einer linearen Stack-Maschine.
|
||||||
|
* **Compiler:** Transformiert den *spezialisierten* AST in ein flaches Array von Instruktionen.
|
||||||
|
* **VM:** Eine "Dispatch Loop", die Instruktionen abarbeitet und Delphi-Funktionen für komplexe Datentypen (Records, Series) als "Fernsteuerung" nutzt.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 2\. Phasenplan
|
||||||
|
|
||||||
|
### Phase 1: Das Fundament (Datenstrukturen)
|
||||||
|
|
||||||
|
**Ziel:** Definition der binären Repräsentation des Codes und des Laufzeit-Stacks.
|
||||||
|
|
||||||
|
* **Task 1.1: Stack-Architektur definieren**
|
||||||
|
* Implementierung von `TStackSlot` als **Tagged Union** (Variant Record).
|
||||||
|
* Größe: Max. 16 Bytes (Alignment-freundlich).
|
||||||
|
* Typen: `skEmpty`, `skInt64`, `skDouble`, `skBoolean`, `skPointer` (für RefCounted Objekte).
|
||||||
|
* **Task 1.2: OpCodes definieren (`TOpCode`)**
|
||||||
|
* Kategorisierung in: Stack Ops, Arithmetik (Getrennt nach `_Int`, `_Flt`, `_Dyn`), Flow Control, Calls.
|
||||||
|
* **Task 1.3: Instruktions-Format (`TInstruction`)**
|
||||||
|
* Record mit `OpCode` (Byte/Enum) und Argumenten (`Arg1`, `Arg2`, `Arg3`: Integer).
|
||||||
|
* **Task 1.4: Container (`TBytecodeChunk`)**
|
||||||
|
* Klasse, die `TArray<TInstruction>`, `TArray<TDataValue>` (Constant Pool) und Metadaten (MaxStackSize) hält.
|
||||||
|
|
||||||
|
### Phase 2: Der Compiler (Core Arithmetic)
|
||||||
|
|
||||||
|
**Ziel:** Kompilierung einfacher mathematischer Ausdrücke ohne Kontrollfluss.
|
||||||
|
|
||||||
|
* **Task 2.1: Compiler-Gerüst (`TBytecodeCompiler`)**
|
||||||
|
* Implementierung als `TAstVisitor` (oder `IAstVisitor`).
|
||||||
|
* Verwaltung des `TBytecodeChunk`.
|
||||||
|
* Verwaltung einer virtuellen "Stack Height" zur Berechnung von `MaxStackSize`.
|
||||||
|
* **Task 2.2: Konstanten laden**
|
||||||
|
* Visitor für `VisitConstant`.
|
||||||
|
* Logik: Konstante im Pool suchen/einfügen $\to$ `opLdConst <Index>` emittieren.
|
||||||
|
* **Task 2.3: Arithmetik & Typ-Spezialisierung**
|
||||||
|
* Visitor für `FunctionCall` (Spezialfall: Binäre Operatoren).
|
||||||
|
* Nutzung der `IStaticType`-Informationen aus dem AST.
|
||||||
|
* Entscheidunglogik:
|
||||||
|
* Sind Operanden `Int64`? $\to$ `opAddInt`.
|
||||||
|
* Sind Operanden `Double`? $\to$ `opAddFlt`.
|
||||||
|
* Sonst $\to$ `opAdd` (Fallback).
|
||||||
|
|
||||||
|
### Phase 3: Die Virtual Machine (The Engine)
|
||||||
|
|
||||||
|
**Ziel:** Ausführung des in Phase 2 generierten Codes.
|
||||||
|
|
||||||
|
* **Task 3.1: Die VM-Klasse (`TVM`)**
|
||||||
|
* Aufbau des `OperandStack` (Array of `TStackSlot`).
|
||||||
|
* Register: `IP` (Instruction Pointer), `SP` (Stack Pointer), `BP` (Base/Frame Pointer).
|
||||||
|
* **Task 3.2: Dispatch Loop**
|
||||||
|
* Implementierung der `Run(Chunk)` Methode.
|
||||||
|
* Großes `case Instruction.OpCode of ...`.
|
||||||
|
* **Task 3.3: Implementierung der Core-OpCodes**
|
||||||
|
* `opLdConst`: Kopieren von Constant-Pool auf Stack.
|
||||||
|
* `opAddInt`: Roher Zugriff auf `Stack[SP].AsInt`. (Performance-kritisch\!).
|
||||||
|
* `opAdd`: Generischer Pfad (Unboxing, Operation, Boxing).
|
||||||
|
|
||||||
|
### Phase 4: Variablen & Kontrollfluss
|
||||||
|
|
||||||
|
**Ziel:** Unterstützung von `if`, lokalen Variablen und einfachen Schleifen (`recur`).
|
||||||
|
|
||||||
|
* **Task 4.1: Lokale Variablen**
|
||||||
|
* Mapping im Compiler: AST `SlotIndex` $\to$ Stack-Relativ-Index.
|
||||||
|
* OpCodes: `opLdLocal <Idx>`, `opStLocal <Idx>`.
|
||||||
|
* **Task 4.2: Sprünge (Jumps)**
|
||||||
|
* Compiler: Handling von `VisitIfExpression`.
|
||||||
|
* Logik: Emittieren von Platzhalter-Jumps, Patching der Sprungziele nach Generierung des Branches.
|
||||||
|
* OpCodes: `opJmp`, `opJmpFalse`.
|
||||||
|
* **Task 4.3: TCO / Recur**
|
||||||
|
* `VisitRecurNode`: Generierung von `Move` Instruktionen (Argumente an Position der Parameter kopieren) + `opJmp` zum Start der Funktion.
|
||||||
|
|
||||||
|
### Phase 5: Funktionen & Closures (Die Kür)
|
||||||
|
|
||||||
|
**Ziel:** First-Class Functions und Upvalue-Handling.
|
||||||
|
|
||||||
|
* **Task 5.1: Funktions-Prototypen**
|
||||||
|
* Erweiterung `TBytecodeChunk` um Sub-Chunks (Prototypen für innere Funktionen).
|
||||||
|
* **Task 5.2: Upvalue-Analyse Integration**
|
||||||
|
* Nutzung der Ergebnisse des Binders/UpvalueAnalyzers.
|
||||||
|
* Compiler muss wissen, welche Variable Stack-Local ist und welche ein Upvalue ist.
|
||||||
|
* **Task 5.3: Closure-Instanziierung**
|
||||||
|
* OpCode: `opClosure <ProtoIdx>`.
|
||||||
|
* VM: Erzeugt `TClosure` Objekt, sammelt "Capture"-Variablen vom Stack ein (Hoisting) und speichert sie im Closure-Objekt.
|
||||||
|
* **Task 5.4: Calls (`opCall`)**
|
||||||
|
* VM: Stack-Frame Management (Sichern von `BP`, `IP` auf dem Call-Stack).
|
||||||
|
* Umschalten des aktiven Chunks.
|
||||||
|
|
||||||
|
### Phase 6: Interop & komplexe Typen
|
||||||
|
|
||||||
|
**Ziel:** Brückenschlag zur existierenden Delphi-Logik.
|
||||||
|
|
||||||
|
* **Task 6.1: Native Calls (`opCallNative`)**
|
||||||
|
* Aufruf von RTL-Funktionen via Funktionszeiger.
|
||||||
|
* Konvertierung `TStackSlot` $\leftrightarrow$ Argumente.
|
||||||
|
* **Task 6.2: Records & Series**
|
||||||
|
* OpCodes: `opNewRecord`, `opSeriesAdd`.
|
||||||
|
* VM: Ruft direkt `TScalarRecord.Create` etc. auf. Hier wird keine Logik dupliziert, nur delegiert.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 3\. Technische Eckpfeiler
|
||||||
|
|
||||||
|
### Das Datenmodell (VM Stack)
|
||||||
|
|
||||||
|
```pascal
|
||||||
|
type
|
||||||
|
TStackSlot = record
|
||||||
|
case Kind: TDataValueKind of
|
||||||
|
vkOrdinal: (AsInt: Int64);
|
||||||
|
vkFloat: (AsFloat: Double);
|
||||||
|
vkObj: (AsPtr: Pointer); // IInterface / TObject / String
|
||||||
|
end;
|
||||||
|
```
|
||||||
|
|
||||||
|
### Die Optimierungs-Strategie
|
||||||
|
|
||||||
|
1. **Binder/TypeChecker:** Leisten die Vorarbeit (Auflösung von Namen zu Indizes, Typ-Inferenz).
|
||||||
|
2. **Compiler:** Entscheidet statisch über OpCodes (`ADD_INT` vs `ADD`).
|
||||||
|
3. **VM:** Führt "blind" und schnell aus. Typprüfungen nur im `_DYN` Pfad oder als Assert.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 4\. Nächste Schritte (Todo)
|
||||||
|
|
||||||
|
1. [ ] Anlegen der Unit `Myc.Bytecode.Types` (Definition OpCodes, Instruction, StackSlot).
|
||||||
|
2. [ ] Implementierung `TBytecodeCompiler` (Skeleton: Nur Constants & Return).
|
||||||
|
3. [ ] Implementierung `TVM` (Skeleton: Stack setup, Dispatch loop für Const/Ret).
|
||||||
|
4. [ ] Erster Integrationstest: `42` kompiliert $\to$ VM führt aus $\to$ Resultat 42.
|
||||||
|
5. [ ] Erweiterung um `BinaryOp` (Add/Sub) inkl. Typ-Spezialisierung.
|
||||||
|
|
||||||
|
-----
|
||||||
@@ -0,0 +1,41 @@
|
|||||||
|
# Projektplan: Myc Compiler & Visual Editor Integration
|
||||||
|
|
||||||
|
**Datum:** 28.11.2025 12:42
|
||||||
|
|
||||||
|
### Motivation
|
||||||
|
Der Compiler-Kern wurde erfolgreich auf eine robuste, immutable Architektur umgestellt ("Green Tree / Red Tree"). Durch die Einführung von `IAstIdentity` und einem Logging-basierten Fehlersystem ("Fail-Safe") gehen Metadaten während der Transformationen (Binder, TypeChecker, Optimierung) nicht mehr verloren.
|
||||||
|
Der nächste logische Schritt ist die **Integration dieser Intelligenz in den visuellen Editor**. Der Editor soll nicht nur dumme Blöcke darstellen, sondern Live-Feedback (Fehler, Typen) geben, indem er die stabilen Identitäten für den "Round-Trip" nutzt.
|
||||||
|
|
||||||
|
### Ziel
|
||||||
|
Herstellung einer **bidirektionalen Verbindung** zwischen dem visuellen `TAuraNode`-Graphen und dem logischen `IAstNode`-Baum.
|
||||||
|
1. **Rekonstruktion:** Der visuelle Baum erzeugt einen logischen AST (inkl. Mapping).
|
||||||
|
2. **Kompilierung:** Der Compiler verarbeitet den AST und liefert Fehler/Typen referenziert auf `IAstIdentity`.
|
||||||
|
3. **Visualisierung:** Der Editor projiziert diese Informationen zurück auf die entsprechenden UI-Knoten.
|
||||||
|
|
||||||
|
### Ergebnis (Status Quo)
|
||||||
|
* **Compiler Core:** Vollständig refaktoriert. Binder, TypeChecker, TCO und Specializer unterstützen `ICompilerLog` und nutzen "Poison Pills" (`Unknown`-Typen) statt Exceptions.
|
||||||
|
* **AST Architektur:** `IAstIdentity` trennt erfolgreich Syntax-Daten von Semantik. Factories (`TAst`) erzwingen den Erhalt der Provenance (Herkunft) bei Transformationen.
|
||||||
|
* **Editor Basis:** `Myc.Fmx.AstEditor.Node` wurde angepasst, um die neuen Factories zu nutzen. `ReconstructAst` funktioniert prinzipiell.
|
||||||
|
|
||||||
|
### Nächster Schritt: Implementierung der Editor-Intelligenz
|
||||||
|
|
||||||
|
Die Umsetzung erfolgt in drei logischen Phasen:
|
||||||
|
|
||||||
|
#### Phase 1: Visuelle Feedback-Mechanismen (View)
|
||||||
|
Erweiterung von `TAuraNode` um die Fähigkeit, Status-Informationen darzustellen, ohne die Kernlogik zu überladen.
|
||||||
|
* Implementierung von **Adorners/Decorators** für `TAuraNode`.
|
||||||
|
* Visualisierung von **Fehlern** (z.B. roter Rahmen, Warnsymbol, Tooltip mit Fehlermeldung).
|
||||||
|
* Visualisierung von **Typ-Informationen** (z.B. kleines Badge mit "Int64", "Series" etc.).
|
||||||
|
* Methoden zum Setzen und Löschen dieser Zustände (`SetErrorState`, `SetTypeInfo`, `ClearStatus`).
|
||||||
|
|
||||||
|
#### Phase 2: Mapping-Infrastruktur (Glue Code)
|
||||||
|
Implementierung der externen Verknüpfung zwischen Logik und UI, um den AST "rein" zu halten.
|
||||||
|
* Definition eines `TAstMapping`-Kontextes (enthält `Dictionary<IAstIdentity, TAuraNode>`).
|
||||||
|
* Anpassung des Rekonstruktions-Prozesses: Während `ReconstructAst` läuft, muss die Verbindung zwischen der (wiederverwendeten oder neuen) `Identity` und dem `TAuraNode` im Mapping registriert werden.
|
||||||
|
|
||||||
|
#### Phase 3: Der Editor-Controller (Brain)
|
||||||
|
Erstellung einer neuen Unit `Myc.Fmx.AstEditor.Controller`, die den Workflow steuert.
|
||||||
|
* Orchestrierung: `Workspace` -> `AST` -> `Compiler` -> `UI-Update`.
|
||||||
|
* Verarbeitung des `ICompilerLog`: Iteration über Fehler, Lookup im Mapping, Update der UI-Nodes.
|
||||||
|
* Verarbeitung des `TypedAst`: Extraktion von Typen für Mouse-Over oder permanente Anzeige.
|
||||||
|
|
||||||
@@ -0,0 +1,111 @@
|
|||||||
|
|
||||||
|
# Architekturkonzept: Hybrid Projectional Financial Editor
|
||||||
|
|
||||||
|
## 1. Motivation und Zielsetzung
|
||||||
|
Entwicklung einer Entwicklungsumgebung für Finanzanalysen (Backtesting, Indikatoren), die die Vorteile zweier Welten vereint:
|
||||||
|
1. **Visuelle Programmierung (Blöcke):** Für die grobe Architektur, den Datenfluss und die Übersichtlichkeit. Vermeidet Syntaxfehler bei komplexen Verschachtelungen.
|
||||||
|
2. **Textuelle Programmierung (S-Expressions):** Für mathematische Formeln und Detail-Logik. Ermöglicht schnelle Eingabe und präzises Editieren für Experten.
|
||||||
|
|
||||||
|
Das System verhält sich **reaktiv** (wie "Strudel" für Musik): Änderungen am Code oder an Parametern führen sofort zur Neuberechnung und Aktualisierung der Charts ("Live Coding").
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Kern-Architektur (MVC)
|
||||||
|
|
||||||
|
Die Anwendung folgt strikt dem Model-View-Controller Muster, um Rendering von Logik zu trennen.
|
||||||
|
|
||||||
|
### Model (Der AST & Environment)
|
||||||
|
* **Immutable AST:** Der Abstract Syntax Tree besteht aus unveränderlichen Interfaces (`IAstNode`). Jede Änderung erzeugt einen neuen Teilbaum.
|
||||||
|
* **Environment (`TAstEnvironment`):** Hält den Laufzeit-Zustand (Variablen, definierte Makros) und führt den Code aus.
|
||||||
|
* **Domain:** Spezialisierte Datentypen für Finanzen (`ISeries` für Zeitreihen, `TDecimal` für Währung).
|
||||||
|
|
||||||
|
### View (`TWorkspace` & `TEditorFrame`)
|
||||||
|
* **Aufgabe:** Rein visuelle Darstellung. Kennt keine Logik, nur `TControl`-Hierarchien.
|
||||||
|
* **Rendering:** Zeichnet Blöcke, Verbindungen und visuelle Container.
|
||||||
|
* **Input:** Leitet Maus- und Tastatur-Events (Drag & Drop) an den Controller weiter.
|
||||||
|
|
||||||
|
### Controller (`TAstEditorController`)
|
||||||
|
* **Aufgabe:** Das "Gehirn". Synchronisiert AST und View.
|
||||||
|
* **Zustandsverwaltung:** Hält den aktuellen validen AST (`FCurrentAst`).
|
||||||
|
* **Undo/Redo:** Speichert Snapshots des ASTs auf einem Stack (Memento Pattern).
|
||||||
|
* **Reaktivität:** Feuert `OnChange` bei jeder Modifikation, um die Ausführungspipeline anzustoßen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Der Hybride Editor-Ansatz
|
||||||
|
|
||||||
|
Das System entscheidet dynamisch, wie ein AST-Knoten dargestellt wird ("Smart Nodes").
|
||||||
|
|
||||||
|
### A. Die Makro-Ebene (Visuell)
|
||||||
|
Strukturelle Elemente werden als grafische Blöcke dargestellt:
|
||||||
|
* **Control Flow:** `If`, `Loop`, `Block` (do...end).
|
||||||
|
* **Definitionen:** `VarDecl`, `MacroDef`.
|
||||||
|
* **High-Level Funktionen:** `LoadCSV`, `Chart`, `Strategy`.
|
||||||
|
|
||||||
|
**Vorteil:** Der Benutzer erkennt die Topologie der Strategie auf einen Blick ("Code Folding" durch Visualisierung).
|
||||||
|
|
||||||
|
### B. Die Mikro-Ebene (Textuell / S-Expressions)
|
||||||
|
Mathematische Ausdrücke und Parameter werden als Text (Lisp-artige Syntax) dargestellt und editiert.
|
||||||
|
* Beispiel: Statt eines Baums aus 5 Boxen sieht der User ein Label: `(> Close (SMA Close 20))`.
|
||||||
|
|
||||||
|
### C. Drill-Down Editing (In-Place)
|
||||||
|
Der innovative Kern des Editors. Wenn ein User einen Knoten bearbeitet (Doppelklick), öffnet sich ein Texteditor über dem Knoten.
|
||||||
|
|
||||||
|
1. **Shallow Printing:** Der Editor zeigt nicht den gesamten tiefen Baum als Text, sondern nutzt **Platzhalter** (`#ID`) für komplexe Unter-Knoten.
|
||||||
|
* AST: `If(Condition, ThenBlock, ElseBlock)`
|
||||||
|
* Text: `(if #1 #2 #3)`
|
||||||
|
2. **Kontext:** Der Controller speichert in einem `TEditContext`, welcher AST-Knoten hinter `#1` steckt.
|
||||||
|
3. **Navigation:** Der User kann `#1` mit dem Cursor ansteuern und per Shortcut (z.B. `Ctrl+Space`) "in-place" expandieren.
|
||||||
|
* Text wird zu: `(if (> Close #4) #2 #3)`
|
||||||
|
4. **Commit:** Beim Bestätigen (Enter) wird der Text geparst (`TAstParser`). Die Platzhalter werden durch die originalen, unveränderten AST-Knoten aus dem Kontext ersetzt.
|
||||||
|
|
||||||
|
**Vorteil:** Maximale Effizienz. Man editiert nur das, was man ändern will. Der Rest des Baumes bleibt vor versehentlichen Syntaxfehlern geschützt.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Reaktivität & Live Coding
|
||||||
|
|
||||||
|
Das System kompiliert und führt den Code permanent aus, nicht erst auf Knopfdruck.
|
||||||
|
|
||||||
|
### Reactive Pipeline
|
||||||
|
1. **Änderung:** User zieht einen Block oder ändert eine Zahl.
|
||||||
|
2. **Controller:** Baut neuen AST -> `OnChange`.
|
||||||
|
3. **Runner:** Führt `FEnv.Run(NewAst)` aus.
|
||||||
|
4. **UI Update:** Charts und Indikatoren werden neu gezeichnet.
|
||||||
|
|
||||||
|
### Number Scrubbing
|
||||||
|
Benutzer können Zahlenwerte (Konstanten) mit der Maus "ziehen" (drücken + ziehen).
|
||||||
|
* Der Controller aktualisiert den AST "live" (hochfrequent).
|
||||||
|
* Der Chart verändert sich flüssig während der Mausbewegung.
|
||||||
|
* Ermöglicht intuitives Finden von Parametern (z.B. "Welche SMA-Länge passt visuell am besten?").
|
||||||
|
|
||||||
|
### Code as UI (Widgets)
|
||||||
|
Der Code kann UI-Elemente zurückgeben, die im REPL-Output gerendert werden.
|
||||||
|
* `var len := Slider("Period", 10, 200)` erzeugt einen Schieberegler.
|
||||||
|
* Bewegt man den Regler, wird das Skript mit dem neuen Wert für `len` erneut ausgeführt.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 5. Technische Komponenten (Zusammenfassung)
|
||||||
|
|
||||||
|
| Komponente | Verantwortung |
|
||||||
|
| :--- | :--- |
|
||||||
|
| **`TAstPrettyPrinter`** | Wandelt AST-Knoten in S-Expressions (`(func arg1 arg2)`). Unterstützt "Shallow Printing" mit Platzhaltern. |
|
||||||
|
| **`TAstParser`** | Wandelt S-Expressions zurück in AST-Knoten. Löst Platzhalter (`#ID`) über den `TEditContext` auf. |
|
||||||
|
| **`TEditContext`** | Hält die Referenzen zwischen Text-Tokens (`#1`) und echten `IAstNode`-Instanzen während des Editierens. |
|
||||||
|
| **`TRtlRegistry`** | Registriert Finanzfunktionen (`SMA`, `RSI`) und UI-Widgets (`Slider`, `Chart`). |
|
||||||
|
| **`TAstEditorController`** | Orchestriert Edit-Vorgänge. Führt "Path Copying" durch, um den immutablen Baum nach einem Text-Edit zu aktualisieren. |
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 6. User Workflow Beispiel
|
||||||
|
|
||||||
|
1. **Struktur bauen:** User zieht `LoadCSV`, `VarDecl` (für SMA) und `Chart` als Blöcke in den Workspace.
|
||||||
|
2. **Logik verfeinern:** User doppelklickt auf den Parameter des SMA.
|
||||||
|
3. **Text Edit:** Ein kleines Popup erscheint. User tippt `(* 20 2)`.
|
||||||
|
4. **Commit:** Aus dem Text wird ein Multiplikations-Knoten. Der Block zeigt nun `40` (oder die Formel).
|
||||||
|
5. **Analyse:** Der Chart zeigt sofort den SMA(40).
|
||||||
|
6. **Tuning:** User klickt auf die `20` im Text/Label, zieht die Maus nach rechts. Die Zahl steigt auf `25`. Der Chart aktualisiert sich in Echtzeit.
|
||||||
|
7. **Refactoring:** User merkt, er braucht Logik. Er klickt auf den SMA-Block und drückt `Ctrl+Space` (Wrap in...). Wählt `If`.
|
||||||
|
* Der SMA ist nun das "Then"-Kind eines neuen If-Blocks.
|
||||||
|
* Die Struktur wurde geändert, ohne Text kopieren zu müssen.
|
||||||
@@ -0,0 +1,70 @@
|
|||||||
|
# **Projektplan: Visueller AST-Editor**
|
||||||
|
|
||||||
|
* **Datum:** 02.09.2025 18:17
|
||||||
|
|
||||||
|
### **Motivation**
|
||||||
|
|
||||||
|
Der bestehende AST-Visualizer soll zu einem vollwertigen, interaktiven Editor ausgebaut werden. Ziel ist es, dem Benutzer die Erstellung und Bearbeitung von ASTs auf eine rein visuelle, intuitive und fehlerresistente Weise zu ermöglichen. Eine Kernanforderung ist die Möglichkeit, AST-Strukturen von externen Tools, insbesondere LLMs, über ein JSON-Format zu importieren.
|
||||||
|
|
||||||
|
### **Ziel**
|
||||||
|
|
||||||
|
Die Entwicklung eines robusten visuellen Editors, bei dem der Abstract Syntax Tree (AST) zu jeder Zeit in einem syntaktisch validen Zustand ist. Der Benutzer soll durch kontextsensitive Aktionen angeleitet werden, anstatt durch freies "Verkabeln" Fehler machen zu können. Das Design muss eine saubere Trennung zwischen der logischen AST-Struktur und ihrer visuellen Repräsentation gewährleisten, um die Anbindung an externe Tools zu vereinfachen.
|
||||||
|
|
||||||
|
### **Ergebnis: Architekturentwurf**
|
||||||
|
|
||||||
|
Der Editor basiert auf einem Model-View-Controller-Ansatz mit einer strikten Trennung der Verantwortlichkeiten.
|
||||||
|
|
||||||
|
**1\. Kernarchitektur: Der reine AST als Model**
|
||||||
|
|
||||||
|
* **Source of Truth**: Der IAstNode-Baum ist das alleinige Model und die "Source of Truth". Er enthält ausschließlich die logische Struktur und die Beziehungen der Knoten untereinander.
|
||||||
|
* **Datenreinheit**: Das Model enthält keinerlei UI-spezifische Informationen wie Positionen, Farben, oder Zustände (z.B. "eingeklappt"). Diese Reinheit ist die Voraussetzung für eine einfache Serialisierung und die Interaktion mit externen Systemen.
|
||||||
|
* **Mapping**: Eine zentrale Controller-Klasse verwaltet die Zuordnung zwischen Model und View, idealerweise über ein TDictionary\<IAstNode, TAuraNode\>.
|
||||||
|
|
||||||
|
**2\. Layout-Engine: Deterministische Visualisierung (View \= f(AST))**
|
||||||
|
|
||||||
|
* **Grundprinzip**: Die gesamte visuelle Darstellung wird bei jeder Änderung prozedural und deterministisch aus dem Zustand des AST-Models generiert.
|
||||||
|
* **Layout-Algorithmus**: Der bestehende Ansatz aus dem TAstToAuraNodeVisitor wird formalisiert:
|
||||||
|
1. Für einen gegebenen Knoten werden zuerst rekursiv alle seine Input-Knoten (Kinder) von links nach rechts und oben nach unten positioniert.
|
||||||
|
2. Anschließend wird der Eltern-Knoten rechts von den Grenzen seiner Kinder platziert, typischerweise vertikal zentriert.
|
||||||
|
* **Metadaten-Overrides**: Manuelle Änderungen am Layout durch den Benutzer (z.B. das Verschieben eines Knotens) werden als optionale Overrides behandelt. Diese werden in einer vom Model getrennten Struktur (TDictionary\<IAstNode, TUIMetadata\>) gespeichert. Beim Layout-Prozess wird für jeden Knoten zuerst geprüft, ob ein solcher Override existiert; falls nicht, wird die Position algorithmisch berechnet.
|
||||||
|
|
||||||
|
**3\. Editier-Paradigma: Socket-basierte, geführte Bearbeitung**
|
||||||
|
|
||||||
|
* **Ziel: "Always Valid AST"**: Jede vom Benutzer durchgeführte Aktion überführt den AST von einem validen Zustand in einen neuen validen Zustand. Syntaxfehler durch den Benutzer werden durch das Design ausgeschlossen.
|
||||||
|
* **Sockets statt Palette**: Unverbundene Input-Pins dienen als "Sockets" und sind die primären Interaktionspunkte zum Erweitern des Baumes. Es gibt keine globale Palette, aus der beliebige Knoten auf eine leere Fläche gezogen werden können.
|
||||||
|
* **Kontextsensitive Aktionen**: Ein Klick auf einen Socket öffnet ein Popup-Menü, das ausschließlich Aktionen und Knotentypen anbietet, die an dieser Stelle syntaktisch zulässig sind.
|
||||||
|
* **Refactoring-Operationen**: Die Manipulation bestehender Knoten erfolgt durch gezielte Befehle wie "Ersetzen durch...", "Löschen" (setzt auf Socket zurück) oder "Umschließen mit...". Drag & Drop dient dem Umordnen von Sequenzen oder dem Verschieben ganzer, valider Teilbäume in einen kompatiblen Socket.
|
||||||
|
|
||||||
|
**4\. Serialisierung & LLM-Integration: Das duale Clipboard**
|
||||||
|
|
||||||
|
* **Zwei Anwendungsfälle**: Es wird zwischen der internen Benutzererfahrung und dem externen Datenaustausch unterschieden.
|
||||||
|
* **Standard-Clipboard (Strg+C / Strg+V)**: Für die nahtlose Arbeit des Benutzers innerhalb des Editors.
|
||||||
|
* **Kopieren**: Serialisiert den ausgewählten AST-Teilbaum **inklusive** der UI-Metadaten (Layout-Overrides).
|
||||||
|
* **Einfügen**: Deserialisiert das Paket und reproduziert den visuellen Zustand 1:1.
|
||||||
|
* **Logik-Clipboard (via Kontextmenü)**: Für den robusten Austausch mit LLMs und anderen Tools.
|
||||||
|
* **"Logik als JSON kopieren"**: Serialisiert den AST-Teilbaum **ohne** jegliche UI-Metadaten in ein pures, logisches JSON-Format.
|
||||||
|
* **"Logik aus JSON einfügen"**: Deserialisiert ein pures JSON. Eventuell vorhandene, fremde Metadaten werden tolerant ignoriert. Nach dem Einfügen wird der neue Teilbaum durch die Layout-Engine automatisch positioniert.
|
||||||
|
|
||||||
|
**5\. Undo/Redo: Das Command Pattern**
|
||||||
|
|
||||||
|
* Jede modifizierende Aktion (Knoten erstellen, verbinden, Eigenschaft ändern) wird als IEditorCommand-Objekt mit Execute- und Unexecute-Methoden implementiert. Ein Command-Manager verwaltet die Undo/Redo-Stacks.
|
||||||
|
|
||||||
|
### **TODO: Nächste Schritte**
|
||||||
|
|
||||||
|
1. **Architektur-Refactoring**:
|
||||||
|
* Entkopplung der IAstNode-Struktur von der TAuraNode-View.
|
||||||
|
* Einführung einer Controller-Klasse, die das Mapping (TDictionary) und die Interaktionslogik verwaltet.
|
||||||
|
2. **Layout-Engine implementieren**:
|
||||||
|
* Formalisierung des deterministischen Layout-Algorithmus in einer wiederverwendbaren Einheit.
|
||||||
|
* Implementierung des Metadaten-Override-Systems.
|
||||||
|
3. **Command Pattern implementieren**:
|
||||||
|
* Definition der IEditorCommand-Schnittstelle.
|
||||||
|
* Implementierung der grundlegenden Command-Klassen (CreateNode, DeleteNode, ConnectNodes, SetProperty).
|
||||||
|
* Aufbau eines TCommandManager für die Verwaltung der Undo/Redo-Historie.
|
||||||
|
4. **Controller-Logik entwickeln**:
|
||||||
|
* Implementierung der Socket-Interaktion (Klick-Handler).
|
||||||
|
* Logik zur dynamischen Erzeugung der kontextsensitiven Menüs.
|
||||||
|
* Anbindung der Benutzeraktionen an das Command-System.
|
||||||
|
5. **Duales Clipboard-System umsetzen**:
|
||||||
|
* Entwicklung der JSON-Serialisierungs- und Deserialisierungsroutinen für beide Formate (mit und ohne Metadaten).
|
||||||
|
* Implementierung der entsprechenden UI-Aktionen.
|
||||||
@@ -0,0 +1,21 @@
|
|||||||
|
### **Projektplan: Visueller Editor für Handelsstrategien (Revision 1\)**
|
||||||
|
|
||||||
|
* **Datum:** 08.09.2025 14:20
|
||||||
|
|
||||||
|
#### **Motivation**
|
||||||
|
|
||||||
|
Ziel ist die Schaffung eines Systems, das es Fachexperten ermöglicht, die **Logik und den Datenfluss** von Handelsstrategien visuell zu entwerfen. Statt der reinen Syntax wird der **semantische Graph** abgebildet, um Redundanzen zu eliminieren und die tatsächlichen Beziehungen zwischen den Variablen und Operationen in den Vordergrund zu stellen. Dies schafft ein intuitiveres Verständnis der Strategie-Logik.
|
||||||
|
|
||||||
|
#### **Ziel**
|
||||||
|
|
||||||
|
Die Entwicklung einer Architektur, die den **semantisch korrekten Graphen** einer Strategie visualisiert. Dies erfordert eine klare Abfolge der Verarbeitungsschritte: Zuerst muss eine semantische Analyse (Binding) des rohen Abstract Syntax Tree (AST) erfolgen. Erst auf Basis dieses angereicherten, semantischen Modells wird der visuelle Graph (ein Directed Acyclic Graph, DAG) erzeugt, in dem semantisch identische Entitäten (z.B. Verwendungen derselben Variable) zu einem einzigen visuellen Knoten zusammengefasst werden.
|
||||||
|
|
||||||
|
#### **Ergebnis: Architekturentwurf (Revision 1\)**
|
||||||
|
|
||||||
|
Die Architektur wird angepasst, um den semantischen Graphen als "Source of Truth" für die Visualisierung zu nutzen.
|
||||||
|
|
||||||
|
1. **Semantische Analyse als Voraussetzung:** Der Bind-Prozess ist der obligatorische erste Schritt vor jeder Visualisierung. Er analysiert den AST und reichert die Knoten, insbesondere die Identifier, mit semantischen Adressinformationen (TResolvedAddress) an.
|
||||||
|
2. **Der Builder (TAstToViewModelVisitor):** Der Visitor wird intelligent. Er übersetzt den AST nicht mehr 1:1, sondern erzeugt einen TVisualNodeViewModel-Graphen (DAG). Dazu nutzt er einen internen Cache (TDictionary\<TResolvedAddress, TVisualNodeViewModel\>), um bereits erstellte ViewModels für semantisch identische Identifier wiederzuverwenden.
|
||||||
|
3. **Das Modell (TVisualNodeViewModel):** Die Struktur der ViewModels ist nicht länger ein Baum, sondern ein DAG, da ein Knoten (z.B. für eine Variable) nun von mehreren Elternknoten referenziert werden kann.
|
||||||
|
4. **Die Ansicht (TAuraLayoutEngine):** Die Layout-Engine muss in der Lage sein, die resultierende DAG-Struktur korrekt darzustellen, inklusive der Verbindungen von mehreren Eltern zu einem Kind.
|
||||||
|
|
||||||
@@ -0,0 +1,68 @@
|
|||||||
|
# **Projektplan: Visuelles System für Handelsstrategien**
|
||||||
|
|
||||||
|
* **Datum:** 02.09.2025 18:47
|
||||||
|
|
||||||
|
### **Motivation**
|
||||||
|
|
||||||
|
Ziel ist die Schaffung eines Systems, das es Fachexperten im Finanzbereich (z.B. Tradern, Analysten) ohne Programmierkenntnisse ermöglicht, komplexe Handelsstrategien interaktiv zu entwerfen, zu visualisieren, zu debuggen und zu backtesten. Die traditionelle Hürde der textbasierten Programmierung soll durch einen rein visuellen, geführten Ansatz eliminiert werden. Das System muss erweiterbar sein und eine robuste Schnittstelle für den Import von Logik aus externen Quellen wie LLMs bieten.
|
||||||
|
|
||||||
|
### **Ziel**
|
||||||
|
|
||||||
|
Die Entwicklung einer dualen Systemarchitektur, die eine intuitive, fehlerresistente Entwicklungsumgebung von einer hochperformanten Backtesting-Engine trennt. Der Benutzer interagiert mit einer High-Level-Repräsentation seiner Strategie (HAST), die für die Ausführung in eine optimierte Low-Level-Repräsentation (CAST) übersetzt wird. Dies ermöglicht eine reichhaltige Debugging-Erfahrung bei gleichzeitig maximaler Performance für datenintensive Backtests.
|
||||||
|
|
||||||
|
### **Ergebnis: Detaillierter Architekturentwurf**
|
||||||
|
|
||||||
|
Die Architektur besteht aus zwei primären Ausführungsmodi (**Debug-Modus** und **Backtest-Modus**), die auf unterschiedlichen Repräsentationen des AST und spezialisierten Engines operieren.
|
||||||
|
|
||||||
|
**1\. Der High-Level AST (HAST) \- Die Welt des Benutzers**
|
||||||
|
|
||||||
|
* **Rolle**: Die alleinige "Source of Truth" für die visuelle Darstellung und die interaktive Bearbeitung. Der HAST ist die Repräsentation, die der Benutzer sieht und manipuliert.
|
||||||
|
* **Struktur**: Ein Baum aus IAstNode-Interfaces. Er enthält eine Mischung aus primitiven Knoten (die direkt einer nativen Operation entsprechen) und zusammengesetzten Knoten (vom Benutzer erstellte "Funktionen" oder Sub-Graphen).
|
||||||
|
* **Editor-Interaktion**: Der visuelle Editor arbeitet ausschließlich auf dem HAST. Die Bearbeitung ist strukturell und geführt:
|
||||||
|
* **Sockets**: Unverbundene Input-Pins sind die einzigen Stellen, an denen der Baum erweitert werden kann.
|
||||||
|
* **Kontext-sensitive Menüs**: Ein Klick auf ein Socket bietet nur syntaktisch zulässige Knoten und Aktionen an, was Fehler von vornherein verhindert.
|
||||||
|
* **Gültigkeit**: Der HAST befindet sich zu jedem Zeitpunkt in einem strukturell validen Zustand.
|
||||||
|
* **Erweiterbarkeit**: Benutzer können neue HAST-Knoten durch visuelle Komposition erstellen ("Zu Funktion zusammenfassen"). Dies ist der primäre Mechanismus zur Schaffung von Wiederverwendbarkeit und Abstraktion für den Endanwender.
|
||||||
|
|
||||||
|
**2\. Der Core AST (CAST) \- Die Welt der Engine**
|
||||||
|
|
||||||
|
* **Rolle**: Eine optimierte, "flache" Zwischenrepräsentation der Strategie, die speziell für die High-Performance-Engine konzipiert ist. Man kann sie als den "Maschinencode" des Systems betrachten.
|
||||||
|
* **Struktur**: Ein Graph, der ausschließlich aus einem minimalen Satz von primitiven Knoten besteht. Jeder CAST-Knoten entspricht einer direkten, in nativem Delphi-Code implementierten, hochoptimierten Operation. Konzepte wie "Benutzerfunktion" oder "Sub-Graph" existieren auf dieser Ebene nicht mehr.
|
||||||
|
|
||||||
|
**3\. Die zwei Ausführungs-Engines**
|
||||||
|
|
||||||
|
* **Engine A: Der HAST-Interpreter (Der Debugger)**
|
||||||
|
* **Modus**: Wird im interaktiven **Debug-Modus** verwendet. (Dies entspricht dem aktuell existierenden Evaluator).
|
||||||
|
* **Funktionsweise**: Arbeitet direkt auf dem HAST. Er ist langsamer, da er die Logik für das "Betreten" und "Verlassen" von zusammengesetzten Knoten (Funktionsaufrufe) zur Laufzeit interpretieren muss.
|
||||||
|
* **Features**: Eng mit der UI gekoppelt, um eine reichhaltige Debugging-Erfahrung zu ermöglichen: Visuelle Hervorhebung des aktuellen Knotens, Breakpoints, Step-Into/Over/Out, Live-Inspektion der Daten auf den Verbindungen und detailliertes Logging.
|
||||||
|
* **Engine B: Der CAST-Evaluator (Der Backtester)**
|
||||||
|
* **Modus**: Wird im **Backtest-Modus** für die Massenverarbeitung von Daten verwendet.
|
||||||
|
* **Funktionsweise**: Arbeitet ausschließlich auf dem CAST. Er wird durch einen vorgeschalteten **HAST \-\> CAST Expander** (ein spezieller Visitor) gespeist, der den HAST in den optimierten CAST übersetzt.
|
||||||
|
* **Features**: Eine "Headless"-Engine ohne UI-Anbindung. Ihre einzige Aufgabe ist die maximale Ausführungsgeschwindigkeit. Sie kennt keine Breakpoints oder detailliertes Logging und gibt am Ende nur das finale Ergebnis (z.B. Trade-Listen, Performance-Metriken) zurück.
|
||||||
|
|
||||||
|
**4\. Serialisierung & Externe Integration**
|
||||||
|
|
||||||
|
* **Duales Clipboard**: Um sowohl die interne Usability als auch die externe Anbindung optimal zu unterstützen, werden zwei Clipboard-Mechanismen implementiert.
|
||||||
|
* **Standard-Clipboard (Strg+C/V)**: Kopiert den HAST-Teilbaum **inklusive** der optionalen UI-Metadaten (manuelle Knotenpositionen etc.), um ein perfektes visuelles Duplikat für den Benutzer zu erstellen.
|
||||||
|
* **Logik-Clipboard (via Kontextmenü)**: Kopiert/einfügt einen **puren HAST** als JSON ohne jegliche UI-Metadaten. Dies ist die saubere, robuste Schnittstelle für die Interaktion mit LLMs und anderen Tools.
|
||||||
|
|
||||||
|
### **TODO: Roadmap für die Implementierung**
|
||||||
|
|
||||||
|
1. **Fundament (Editor & HAST)**
|
||||||
|
* Finalisierung der IAstNode-Struktur für den HAST.
|
||||||
|
* Implementierung des Socket-basierten Editier-Controllers mit kontextsensitiven Menüs.
|
||||||
|
* Umsetzung des Command Patterns für alle AST-modifizierenden Aktionen (Undo/Redo).
|
||||||
|
* Implementierung der visuellen "Zu Funktion zusammenfassen"-Logik.
|
||||||
|
* Aufbau des separaten Speichers für UI-Metadaten-Overrides.
|
||||||
|
2. **Engine 1 (HAST-Interpreter / Debugger)**
|
||||||
|
* Ausbau des bestehenden Evaluators zum vollwertigen HAST-Interpreter.
|
||||||
|
* Tiefe Integration mit der UI zur Realisierung der Debugging-Features (Breakpoints, Step-Logik, Daten-Hover etc.).
|
||||||
|
3. **Engine 2 (CAST-Evaluator / Backtester)**
|
||||||
|
* Definition des minimalen Satzes an primitiven Knoten für den CAST.
|
||||||
|
* Implementierung der hochperformanten, nativen Delphi-Operationen für jeden CAST-Knoten.
|
||||||
|
* Entwicklung des HAST-zu-CAST-Expander-Visitors.
|
||||||
|
* Erstellung des "headless" CAST-Evaluators, der den CAST entgegennimmt und die Ergebnisse zurückliefert.
|
||||||
|
4. **Werkzeuge & Integration**
|
||||||
|
* Implementierung der beiden JSON-Serialisierungs-Routinen (mit/ohne Metadaten).
|
||||||
|
* Integration der Clipboard-Aktionen in die UI.
|
||||||
|
* Aufbau der "Standardbibliothek" mit nützlichen, vordefinierten HAST-Knoten.
|
||||||
@@ -0,0 +1,119 @@
|
|||||||
|
# White Paper: A Hybrid Approach to Macro Hygiene
|
||||||
|
|
||||||
|
**Date:** 09.11.2025
|
||||||
|
**Status:** Final
|
||||||
|
|
||||||
|
## 1\. Executive Summary
|
||||||
|
|
||||||
|
The macro system is a cornerstone of the compiler, enabling powerful syntactic abstraction. However, designing a macro system requires solving the fundamental conflict between **safety** (preventing accidental variable conflicts) and **power** (allowing macros to interact with their calling context).
|
||||||
|
|
||||||
|
This document outlines the rationale for the implemented hybrid macro system. This system is designed to provide the best of both worlds without burdening the macro author with manual hygiene management (such as `gensym` or special syntax).
|
||||||
|
|
||||||
|
Our system operates on two simple, deterministic rules:
|
||||||
|
|
||||||
|
1. **Automatic Hygiene for Definitions:** All symbols *defined* within a macro template are automatically renamed to be unique, preventing conflicts with user code or nested macro calls.
|
||||||
|
2. **Unhygienic Fallback for Free Symbols:** All *free symbols* (those used but not defined within the template) are left untouched. They are resolved by the binder in the **call-site scope** (the scope where the macro was invoked).
|
||||||
|
|
||||||
|
This hybrid model ensures that internal macro variables are always safe, while simultaneously permitting powerful, context-aware macros.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 2\. The Core Challenge: Safety vs. Context
|
||||||
|
|
||||||
|
A macro, by definition, injects code into a foreign scope. This creates two distinct, opposing requirements.
|
||||||
|
|
||||||
|
### Scenario A: The Need for Safety (Hygienic Definitions)
|
||||||
|
|
||||||
|
This is the classic hygiene problem. A macro must manage its own internal state without interfering with the user's code.
|
||||||
|
|
||||||
|
Consider a simple `stopwatch` macro:
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(* Macro Definition *)
|
||||||
|
(defmacro stopwatch [body]
|
||||||
|
`(do
|
||||||
|
(def start-time (timestamp))
|
||||||
|
(def result ~body)
|
||||||
|
(print "Time: " (- (timestamp) start-time))
|
||||||
|
result))
|
||||||
|
|
||||||
|
(* User Code *)
|
||||||
|
(def start-time "Important User Data")
|
||||||
|
(stopwatch (expensive-call))
|
||||||
|
(print start-time)
|
||||||
|
```
|
||||||
|
|
||||||
|
A naive (fully unhygienic) expansion would redefine the user's `start-time` variable, corrupting their program. This is unacceptable. The macro's internal variables (`start-time`, `result`) must be **hygienic**—that is, isolated from the call-site scope.
|
||||||
|
|
||||||
|
### Scenario B: The Need for Context (Unhygienic Free Symbols)
|
||||||
|
|
||||||
|
Macros derive their power from interacting with the context in which they are called. A macro may need to read variables from the user's scope.
|
||||||
|
|
||||||
|
Consider a `debug-print` macro:
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(* Macro Definition *)
|
||||||
|
(defmacro debug-print [msg]
|
||||||
|
`(if *debug-mode*
|
||||||
|
(print msg)))
|
||||||
|
|
||||||
|
(* User Code *)
|
||||||
|
(do
|
||||||
|
(def *debug-mode* true) ; User-defined context variable
|
||||||
|
(debug-print "Test message")
|
||||||
|
)
|
||||||
|
```
|
||||||
|
|
||||||
|
In this case, the macro *must* access the user's `*debug-mode*` variable from the call-site scope. A "fully hygienic" system (which binds *all* symbols to the macro's *definition-site scope*) would fail, as it would be unable to see the user's local `*debug-mode*` variable.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 3\. Rejected Alternatives
|
||||||
|
|
||||||
|
To solve this conflict, several common designs were considered and rejected for failing one of the two core scenarios.
|
||||||
|
|
||||||
|
* **Fully Unhygienic (The `$` Suffix):** This approach makes all symbols unhygienic by default and requires the author to manually mark internal variables (e.g., `start-time$`) for special handling. This inverts the desired default (safety) and fails to solve nested macro conflicts.
|
||||||
|
* **Fully Hygienic (Strict Academic):** This system binds *all* symbols (defined or free) to the macro's definition-site scope. This perfectly solves Scenario A but makes Scenario B impossible.
|
||||||
|
* **Explicit Gensym (The Lisp Way):** This requires the macro author to manually generate unique symbols (`(let [start-sym (gensym)] ...)`). This is syntactically complex, error-prone, and places an unnecessary burden on the author.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 4\. The Implemented Solution: Hybrid Hygiene
|
||||||
|
|
||||||
|
Our system resolves the conflict by treating definitions and free variables differently. The logic is handled entirely by the macro expander, requiring no special syntax from the macro author.
|
||||||
|
|
||||||
|
### Rule 1: Automatic Renaming of Definitions
|
||||||
|
|
||||||
|
When the macro expander processes a template, it performs a pre-pass to identify all symbols being *defined*. This includes `def` forms, `fn` parameters, and `let` bindings.
|
||||||
|
|
||||||
|
* For each defined symbol (e.g., `start-time`), the expander generates a unique, internal-only name (e.g., `start-time_G123`).
|
||||||
|
* It stores this in an expansion-local rename map.
|
||||||
|
* It then replaces all occurrences of that symbol *within the template* with the new name.
|
||||||
|
|
||||||
|
This automatically and transparently solves **Scenario A**. The `stopwatch` macro's `start-time` becomes `start-time_G123` and cannot possibly conflict with the user's `start-time`. This also solves the nested macro problem, as each expansion generates new unique names.
|
||||||
|
|
||||||
|
### Rule 2: Unhygienic Fallback for Free Symbols
|
||||||
|
|
||||||
|
Any symbol in the macro template that is *not* part of a definition (a "free symbol") is left untouched by the expander.
|
||||||
|
|
||||||
|
* In `stopwatch`, the symbols `do`, `timestamp`, `print`, and `-` are free symbols.
|
||||||
|
* In `debug-print`, the symbols `if`, `*debug-mode*`, and `print` are free symbols.
|
||||||
|
|
||||||
|
The expander passes these symbols directly to the next compiler stage (the binder). The binder then resolves them, as it would any normal code, within the **call-site scope**.
|
||||||
|
|
||||||
|
This solves **Scenario B**. The binder finds `*debug-mode*` in the user's `do` block, exactly as intended.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 5\. Conclusion and Trade-Offs
|
||||||
|
|
||||||
|
This hybrid design provides "implicit hygiene" for the common case (internal variables) while defaulting to "unhygienic" behavior for external symbols, which provides maximum power and flexibility.
|
||||||
|
|
||||||
|
The primary trade-off of this design is that **typographical errors in free symbols are caught late**.
|
||||||
|
|
||||||
|
For example, if the `stopwatch` macro misspelled `print` as `prnit`:
|
||||||
|
|
||||||
|
1. The expander would see `prnit` as a free symbol (Rule 2) and leave it untouched.
|
||||||
|
2. The binder would then fail to find `prnit` in the *user's* call-site scope.
|
||||||
|
|
||||||
|
The resulting error (`Undefined symbol: prnit`) will point to the user's code where `stopwatch` was *called*, not the macro *definition*. This is a minor, acceptable trade-off for a system that achieves both safety and power without syntactic overhead.
|
||||||
@@ -0,0 +1,32 @@
|
|||||||
|
Absolut. Hier ist der Projektplan, der unsere Ergebnisse zusammenfasst.
|
||||||
|
|
||||||
|
***
|
||||||
|
|
||||||
|
### Projektplan: Thread-sicheres Zustandsmodell
|
||||||
|
|
||||||
|
* **Datum:** 30. September 2025
|
||||||
|
* **Uhrzeit:** 13:09
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
|
||||||
|
Ziel ist eine einfache, visuell darstellbare und inhärent threadsichere Skriptsprache. Eine rein funktionale Herangehensweise erwies sich als unpraktisch. Stattdessen wird ein pragmatischer Ansatz nach dem Vorbild von Clojure verfolgt: Daten sind standardmäßig immutable, aber es gibt explizite, sichere Werkzeuge zur Verwaltung von veränderlichem Zustand.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
|
||||||
|
Die Sprache soll eine klare Trennung zwischen unveränderlichen **Werten** und veränderlichen **Identitäten** (Variablen) haben. Jede Zustandsänderung muss explizit und atomar sein, um Race Conditions per Design auszuschließen. Die Implementierung soll dabei möglichst einfach und performant (lock-free) sein.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
|
||||||
|
Wir haben eine elegante, lock-freie Lösung erarbeitet, die auf einer zentralen Regel basiert: Der Typ (`FKind`) einer `TDataValue` ist nach der Initialisierung **immutable**.
|
||||||
|
|
||||||
|
1. **Atomarität in `TDataValue`:** Die atomaren Operationen (`Reset`, `CompareAndSet`) werden direkt als Instanzmethoden auf dem `TDataValue`-Record implementiert. Dies ist möglich, weil die `FKind`-Immutabilität die TOCTOU-Race-Condition verhindert, die eine solche Implementierung sonst unsicher machen würde.
|
||||||
|
2. **Selektives Capturing bleibt:** Der `IValueCell`-Mechanismus in der `Scope`-Unit wird beibehalten. Seine entscheidende Rolle ist nicht die Atomarität, sondern die Speicheroptimierung, indem Closures nur die Referenzen auf die Upvalues halten, die sie wirklich benötigen, und nicht den gesamten Parent-Scope.
|
||||||
|
3. **Separation of Concerns:** `TDataValue` weiß, *wie* man seinen Zustand atomar ändert. `IValueCell` ist die notwendige Indirektion, um Closures und Speichermanagement korrekt abzubilden.
|
||||||
|
|
||||||
|
#### Todo
|
||||||
|
|
||||||
|
* [ ] Die atomaren Instanzmethoden (`Reset`, `CompareAndSet`) in `Myc.Data.Value` finalisieren.
|
||||||
|
* [ ] Die `IValueCell`-Implementierung in `Myc.Ast.Scope` so anpassen, dass sie die neuen atomaren Instanzmethoden von `TDataValue` aufruft.
|
||||||
|
* [ ] Neue RTL-Funktionen `reset!`, `compare-and-set!` und das abgeleitete `swap!` erstellen, die im Evaluator auf den `IValueCell`-Instanzen operieren.
|
||||||
|
* [ ] Das alte `assign`-Schlüsselwort aus Parser, Binder und Evaluator entfernen.
|
||||||
|
* [ ] Bestehende Tests (`CreateSMA`, `FailingUpvalueButtonClick` etc.) auf die Verwendung von `reset!` oder `swap!` anstelle von `assign` umstellen.
|
||||||
@@ -0,0 +1,105 @@
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
***
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
# Projekt-Protokoll: Weiterentwicklung des Sprachdesigns
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
* **Datum:** 08. Oktober 2025
|
||||||
|
|
||||||
|
* **Zeit:** 13:22 CEST
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
## Motivation
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Die bestehende Skriptsprache bietet grundlegende funktionale und imperative Konstrukte, aber die Verwaltung von veränderlichem Zustand (`def` in Verbindung mit `assign`) ist unsicher, insbesondere im Hinblick auf Nebenläufigkeit. Das primäre Motiv für eine Weiterentwicklung ist die Schaffung einer Sprache, die **aus sich selbst heraus sicher ("safe by design")** ist, ohne dabei die Komplexität von Low-Level-Konzepten wie manueller Speicherverwaltung oder einem vollständigen Borrow-Checker (wie in Rust) einzuführen. Die Sprache soll auch für Programmier-Anfänger **intuitiv und leicht verständlich** bleiben.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
## Ziel
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Das Ziel ist es, ein Sprachdesign zu entwickeln, das eine klare und sichere Handhabung von Zustand erzwingt. Die Kernziele des neuen Designs sind:
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
1. **Sicherheit durch Design:** Race Conditions durch geteilten, veränderlichen Zustand sollen zur Compile-Zeit erkannt und verhindert werden.
|
||||||
|
|
||||||
|
2. **Klare Trennung von Zustandsarten:** Es soll eine unmissverständliche Unterscheidung zwischen temporärem, lokalem Zustand und persistentem, geteiltem Zustand geben.
|
||||||
|
|
||||||
|
3. **Intuitive Semantik:** Die Regeln der Sprache sollen den Entwickler aktiv zu sicheren und korrekten Mustern anleiten ("Pit of Success"). "Magisches" oder unvorhersehbares Verhalten des Compilers soll vermieden werden.
|
||||||
|
|
||||||
|
4. **Pragmatismus:** Ein bekannter, imperativer Programmierstil soll für lokale Logik weiterhin möglich sein, um die Lernkurve flach zu halten.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
## Ergebnis: Das finale Sprachdesign
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Wir haben uns auf ein pragmatisches Hybrid-Modell geeinigt, das funktionale Sicherheit mit imperativem Komfort kombiniert. Es basiert auf drei Säulen:
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
### 1. Sicherer globaler Zustand: `def` erzeugt Atome
|
||||||
|
|
||||||
|
Der `def`-Befehl wird modifiziert. Er dient ausschließlich zur Definition von Zustand, der potenziell über Funktionsgrenzen hinweg geteilt wird. Um dies von Natur aus sicher zu machen, erzeugt `def` nicht mehr einen einfachen, veränderlichen "Slot", sondern immer einen **atomaren Container**, der den Wert umschließt. Jede Zustandsänderung muss über explizite, threadsichere atomare Operationen (wie `swap!` oder `reset!`) erfolgen. Dies eliminiert alle Race Conditions bei globalem Zustand.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
### 2. Veränderlicher lokaler Zustand: `let` mit `assign`
|
||||||
|
|
||||||
|
Ein neues `let`-Konstrukt wird eingeführt, das sich an Clojure orientiert, um einen neuen lexikalischen Gültigkeitsbereich zu schaffen. Im Gegensatz zu Clojure sind die in `let` definierten Bindungen jedoch **standardmäßig veränderlich** und können über `assign` modifiziert werden. Dies erlaubt Entwicklern, für rein lokale Algorithmen (z.B. Schleifen mit Zählern) einen vertrauten, imperativen Stil zu verwenden, wo Threadsicherheit keine Rolle spielt.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
### 3. Die Sicherheitsbrücke: Statische Analyse im Binder
|
||||||
|
|
||||||
|
Dies ist die zentrale Innovation, die beide Welten sicher miteinander verbindet. Der Compiler (speziell der Binder) führt eine **Escape Analysis** für Closures durch, um die missbräuchliche Freigabe von unsicherem, lokalem Zustand zu verhindern. Dabei gilt eine einzige, einfache Regel:
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
> **Eine Closure, die eine veränderliche let-Variable fängt, darf nicht aus dem Gültigkeitsbereich der Funktion zurückgegeben (oder global gespeichert) werden, in der diese Variable definiert wurde.**
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
* Wenn eine solche "zustandsbehaftete" Closure nur lokal verwendet wird (z.B. in einem `Map`), ist der Code gültig.
|
||||||
|
|
||||||
|
* Wenn versucht wird, eine solche Closure zurückzugeben oder einem globalen `def` zuzuweisen, erzeugt der Binder einen **Compile-Fehler**.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Dieser Fehler ist ein Feature, kein Mangel. Er zwingt den Entwickler, eine bewusste Entscheidung zu treffen: Entweder er strukturiert seinen Code um, oder er verwendet für den Zustand, der geteilt werden muss, explizit ein sicheres Primitiv (indem er die lokale Variable selbst zu einem `(atom ...)` macht).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Dieses Design vermeidet die Komplexität eines Borrow Checkers und die Unvorhersehbarkeit von "Compiler-Magie", indem es eine klare, leicht verständliche Regel zur Compile-Zeit durchsetzt.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
## Nächste Schritte (Todo)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
1. **Binder anpassen:** Implementierung der Escape Analysis für Closures. Der Binder muss `let`-Variablen, ihre Veränderung durch `assign` und das Fangen durch Closures nachverfolgen.
|
||||||
|
|
||||||
|
2. **Parser erweitern:** Hinzufügen der Syntax für das neue `let`-Statement.
|
||||||
|
|
||||||
|
3. **`def`-Implementierung ändern:** Die Laufzeitlogik für `def` muss so angepasst werden, dass sie atomare Container anstelle von rohen Werten verwaltet.
|
||||||
|
|
||||||
|
4. **RTL erweitern:** Die Laufzeit-Bibliothek muss um Funktionen zur Interaktion mit Atomen erweitert werden (z.B. `atom`, `deref`, `swap!`, `reset!`).
|
||||||
|
|
||||||
|
5. **Compiler-Fehlermeldung implementieren:** Eine klare und hilfreiche Fehlermeldung für den Fall entwerfen, dass die "Sicherheitsbrücke"-Regel verletzt wird.
|
||||||
|
|
||||||
@@ -0,0 +1,58 @@
|
|||||||
|
# Projekt-Protokoll: Finalisierung des Sprachdesigns für Zustand
|
||||||
|
|
||||||
|
* **Datum:** 09. Oktober 2025
|
||||||
|
* **Zeit:** 12:26 CEST
|
||||||
|
|
||||||
|
## Motivation
|
||||||
|
|
||||||
|
Aufbauend auf dem initialen Entwurf eines sicheren Zustands-Modells geht es in diesem Schritt um die Konkretisierung und Verfeinerung des Sprachdesigns. Die Diskussion hat gezeigt, dass die Wahl der Schlüsselwörter (`def`, `let`) und die exakte Definition der Scope-Regeln entscheidend für die Intuivität und Sicherheit der Sprache sind. Ziel dieses Dokuments ist es, die finalen Entscheidungen festzuhalten.
|
||||||
|
|
||||||
|
## Ziel
|
||||||
|
|
||||||
|
1. **Etablierung unmissverständlicher Schlüsselwörter:** Die finalen Namen für die drei Zustands-Konstrukte (`atom`, `var`, `let`) sollen deren Semantik klar und deutlich widerspiegeln.
|
||||||
|
2. **Festlegung der Scope-Regeln:** Die Rolle des `(do)`-Blocks als primärer Scope-erzeugender Mechanismus für lokalen Zustand wird formalisiert.
|
||||||
|
3. **Definition der Unveränderlichkeits-Garantie:** Die Regeln für die Compile-Zeit-Überprüfung der Unveränderlichkeit von `let`-Bindungen werden festgelegt.
|
||||||
|
|
||||||
|
## Ergebnis: Das finale Drei-Säulen-Modell für Zustand
|
||||||
|
|
||||||
|
Wir haben uns auf ein klares Modell mit drei spezialisierten Konstrukten für die Zustandsverwaltung geeinigt, das maximale Sicherheit bei gleichzeitig hoher Flexibilität und Verständlichkeit bietet.
|
||||||
|
|
||||||
|
### 1. Die drei Konstrukte
|
||||||
|
|
||||||
|
Die folgende Tabelle fasst die Eigenschaften der drei finalen Konstrukte zusammen:
|
||||||
|
|
||||||
|
| Konstrukt | Geltungsbereich | Veränderlichkeit | Threadsicherheit |
|
||||||
|
| :--- | :--- | :--- | :--- |
|
||||||
|
| **`atom`** | Global / Geteilt | Veränderlich (atomar) | **Ja (Design-Ziel)** |
|
||||||
|
| **`var`** | Lokal (`do`-Block) | Veränderlich | Nein (by Design) |
|
||||||
|
| **`let`** | Lokal (`do`-Block) | **Unveränderlich** | Ja (da unveränderlich) |
|
||||||
|
|
||||||
|
### 2. Syntaktische Form
|
||||||
|
|
||||||
|
Alle drei Konstrukte folgen einer einheitlichen, einfachen Syntax für die Deklaration und optionale Initialisierung:
|
||||||
|
|
||||||
|
* `(atom symbol initial-value)`
|
||||||
|
* `(var symbol initial-value)`
|
||||||
|
* `(let symbol initial-value)`
|
||||||
|
|
||||||
|
### 3. Implikation für `(do)`
|
||||||
|
|
||||||
|
Der `(do)`-Block (`IBlockExpressionNode`) wird zum **zentralen und einzigen Mechanismus für die Erzeugung lexikalischer Geltungsbereiche** für lokalen Zustand (`var` und `let`). Jedes Vorkommen von `(do ...)` öffnet einen neuen Scope, der nach Abarbeitung des Blocks wieder zerstört wird. Dies ermöglicht ein intuitives, imperativ anmutendes Programmieren mit klar definierten Lebenszeiten für lokale Variablen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## Nächste Schritte (Todo)
|
||||||
|
|
||||||
|
1. **Parser anpassen:**
|
||||||
|
* Die Schlüsselwörter `def` und `let` werden durch `atom`, `var` und `let` ersetzt.
|
||||||
|
* Alle drei Konstrukte werden initial zum selben `IVariableDeclarationNode` geparst. Eine Unterscheidung, um welches Konstrukt es sich handelt, wird im Binder getroffen.
|
||||||
|
|
||||||
|
2. **Binder anpassen (Kernaufgabe):**
|
||||||
|
* **`do`-Scoping:** `VisitBlockExpression` wird so erweitert, dass es bei jedem Aufruf einen neuen Scope (`EnterScope`/`ExitScope`) verwaltet.
|
||||||
|
* **Symbol-Verfolgung:** Der Binder muss für jede deklarierte Variable speichern, ob sie via `atom`, `var` oder `let` erzeugt wurde.
|
||||||
|
* **Unveränderlichkeits-Prüfung:** Beim Besuch eines `(assign ...)`-Knotens (`VisitAssignment`) muss der Binder prüfen, ob die Zielvariable als `let` deklariert wurde. Wenn ja, wird ein **Compile-Fehler** ausgelöst.
|
||||||
|
* **Escape Analysis verfeinern:** Die Sicherheitsprüfung wird so angepasst, dass sie nur noch bei Closures greift, die eine **`var`-Variable** fangen. Closures, die `let`-Variablen fangen, sind immer sicher.
|
||||||
|
|
||||||
|
3. **RTL & Evaluator anpassen:**
|
||||||
|
* Die Laufzeitlogik für `def` wird zur Implementierung für `(atom ...)` und erzeugt einen atomaren Container.
|
||||||
|
* Die RTL wird um die Funktionen `deref`, `reset!` und `swap!` erweitert.
|
||||||
@@ -0,0 +1,134 @@
|
|||||||
|
-----
|
||||||
|
|
||||||
|
### Projektplan: Atome und das "Builder/Snapshot"-Pattern
|
||||||
|
|
||||||
|
* **Datum:** 09. Oktober 2025
|
||||||
|
* **Uhrzeit:** 16:07
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
|
||||||
|
Die bisherige Diskussion hat zwei grundlegende Anforderungen an die Zustandsverwaltung herausgearbeitet:
|
||||||
|
|
||||||
|
1. **Allgemeine Sicherheit:** Für generische Datenstrukturen (Maps, Vektoren) bieten persistente Datenstrukturen durch ihre Immutabilität und lock-freie Lesbarkeit die höchste Sicherheit und Flexibilität bei konkurrierendem Zugriff.
|
||||||
|
2. **Spezialisierte Performance:** Für bestimmte Anwendungsfälle (z.B. große, append-only Time-Series) ist die Performance einer In-Place-Mutation überlegen, aber das Teilen des Zustands zwischen Threads erfordert eine sichere Synchronisation.
|
||||||
|
|
||||||
|
Die Motivation ist daher, ein **standardisiertes, generisches Muster** zu definieren, das die rohe Performance einer mutierbaren "Arbeitskopie" mit der Sicherheit von unveränderlichen, lesbaren "Snapshots" für die konkurrierende Analyse kombiniert.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
|
||||||
|
1. Etablierung des **"Builder/Snapshot"-Patterns** als idiomatisches Kernkonzept der Sprache für den Umgang mit hoch-performantem, geteiltem, mutablem Zustand.
|
||||||
|
2. Definition von **generischen Basis-Interfaces** (`IBuilder`, `IImmutable`), die dieses Pattern im Typensystem verankern.
|
||||||
|
3. Nahtlose Integration dieses Patterns mit den bestehenden `atom`- (für geteilten Zustand) und `var`- (für lokalen Zustand) Konstrukten.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
|
||||||
|
Das Ergebnis ist ein klares, zweigleisiges Modell für die Zustandsverwaltung, das auf dem generischen "Builder/Snapshot"-Pattern aufbaut.
|
||||||
|
|
||||||
|
**1. Das generische Pattern: `IBuilder` / `IImmutable`**
|
||||||
|
|
||||||
|
Wir definieren zwei konzeptionelle Basis-Interfaces, die den Vertrag des Patterns abbilden:
|
||||||
|
|
||||||
|
* `IImmutable`: Ein **Marker-Interface**, das einen sicheren, unveränderlichen "Produkt"- oder Snapshot-Typ kennzeichnet.
|
||||||
|
* `IBuilder`: Ein Interface, das einen "Builder" kennzeichnet. Es definiert die Fähigkeit, ein `IImmutable`-Produkt zu erzeugen.
|
||||||
|
|
||||||
|
**2. Die Spezialisierung (Beispiel: `Series`-Interfaces)**
|
||||||
|
|
||||||
|
Konkrete Datenstrukturen wie die `Series` spezialisieren diese generischen Rollen.
|
||||||
|
|
||||||
|
```delphi
|
||||||
|
// --- Generische Basis-Interfaces ---
|
||||||
|
|
||||||
|
// Kennzeichnet ein sicheres, unveränderliches Lese-Objekt (Snapshot).
|
||||||
|
IImmutable = interface(IInterface)
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Kennzeichnet ein mutierbares Builder-Objekt, das Snapshots von sich erzeugen kann.
|
||||||
|
IBuilder = interface(IInterface)
|
||||||
|
function CreateSnapshot: IImmutable;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Spezialisierte Interfaces für die 'Series' ---
|
||||||
|
|
||||||
|
// ISeries ist die spezialisierte, lesbare Form von IImmutable.
|
||||||
|
ISeries = interface(IImmutable)
|
||||||
|
function GetCount: Int64;
|
||||||
|
function GetItems(Idx: Integer): TScalar;
|
||||||
|
property Count: Int64 read GetCount;
|
||||||
|
property Items[Idx: Integer]: TScalar read GetItems; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// IWriteableSeries ist der spezialisierte Builder.
|
||||||
|
// Wichtig: Er implementiert den IBuilder-Vertrag, indem er eine CreateSnapshot-Methode
|
||||||
|
// anbietet, die den spezialisierten Snapshot-Typ ISeries zurückgibt.
|
||||||
|
IWriteableSeries = interface(IBuilder)
|
||||||
|
function GetCount: Int64;
|
||||||
|
property Count: Int64 read GetCount;
|
||||||
|
procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1);
|
||||||
|
function CreateSnapshot: ISeries; // Covarianter Return-Type zum Basis-Interface
|
||||||
|
end;
|
||||||
|
```
|
||||||
|
|
||||||
|
**3. Die Anwendungsbeispiele in der Sprache**
|
||||||
|
|
||||||
|
Das Pattern wird auf zwei Arten verwendet, je nach Kontext (`atom` oder `var`). Die RTL-Funktionen arbeiten mit den generischen `IBuilder`- und `IImmutable`-Konzepten.
|
||||||
|
|
||||||
|
**Beispiel 1: Geteilter Zustand (via `atom`)**
|
||||||
|
|
||||||
|
Der `atom` schützt den `IBuilder` vor konkurrierenden Schreibzugriffen.
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(*
|
||||||
|
* Szenario: Ein Ticker-Modul (Thread A) empfängt Live-Daten,
|
||||||
|
* während eine UI (Thread B) die Daten zur Analyse anfordert.
|
||||||
|
*)
|
||||||
|
|
||||||
|
; Ein globaler 'atom' wird erstellt. Er hält die einzige Instanz des Builders.
|
||||||
|
(atom live-ticker (create-series-builder))
|
||||||
|
|
||||||
|
; -- Thread A (Produzent) --
|
||||||
|
; Modifiziert den Builder sicher über eine generische, synchronisierte RTL-Funktion,
|
||||||
|
; die auf jedem IBuilder in einem Atom funktioniert.
|
||||||
|
(builder-update! live-ticker series-add new-tick-value)
|
||||||
|
|
||||||
|
; -- Thread B (Konsument) --
|
||||||
|
; Fordert einen sicheren, unveränderlichen Snapshot an.
|
||||||
|
; Die generische 'snapshot'-Funktion ruft intern 'CreateSnapshot' auf.
|
||||||
|
(let chart-data (snapshot live-ticker))
|
||||||
|
|
||||||
|
; 'chart-data' ist nun eine sichere ISeries (IImmutable), die ohne Locks gelesen werden kann.
|
||||||
|
(calculate-indicators chart-data)
|
||||||
|
```
|
||||||
|
|
||||||
|
**Beispiel 2: Lokaler Zustand (via `var`)**
|
||||||
|
|
||||||
|
Dies ist der "Maschinenraum"-Modus für maximale Single-Thread-Performance.
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(*
|
||||||
|
* Szenario: Innerhalb einer Funktion wird eine komplexe Datenreihe
|
||||||
|
* temporär aufgebaut, um ein einmaliges Ergebnis zu berechnen.
|
||||||
|
*)
|
||||||
|
(do
|
||||||
|
; Erzeuge einen lokalen, unsynchronisierten Builder.
|
||||||
|
(var local-builder (create-series-builder))
|
||||||
|
|
||||||
|
; Befülle den Builder direkt und ohne Lock-Overhead über typspezifische,
|
||||||
|
; unsynchronisierte RTL-Funktionen.
|
||||||
|
(repeat 1000000
|
||||||
|
(series-add! local-builder (get-next-value)))
|
||||||
|
|
||||||
|
; Erzeuge einen finalen Snapshot für die Weiterverarbeitung.
|
||||||
|
(let final-data (series-create-snapshot local-builder))
|
||||||
|
|
||||||
|
; Gib das Ergebnis der Analyse zurück.
|
||||||
|
(run-analysis-on final-data))
|
||||||
|
```
|
||||||
|
|
||||||
|
#### Todo
|
||||||
|
|
||||||
|
* [ ] Generische `IBuilder`- und `IImmutable`-Interfaces in Delphi definieren.
|
||||||
|
* [ ] Finale `ISeries`- und `IWriteableSeries`-Interfaces (als Spezialisierungen) implementieren.
|
||||||
|
* [ ] Eine konkrete `TSeries`-Klasse implementieren, die `IWriteableSeries` implementiert.
|
||||||
|
* [ ] Die generischen, synchronisierten RTL-Funktionen `(builder-update! ...)` und `(snapshot ...)` für `atom`s erstellen, die auf `IBuilder` operieren.
|
||||||
|
* [ ] Die spezifischen, unsynchronisierten RTL-Funktionen `(series-add! ...)` und `(series-create-snapshot ...)` für die `TSeries`-Implementierung erstellen.
|
||||||
|
* [ ] Unit-Tests für beide Anwendungsfälle schreiben.
|
||||||
@@ -0,0 +1,49 @@
|
|||||||
|
|
||||||
|
### Von "Guaranteed Safety" zu "Guided Safety"
|
||||||
|
|
||||||
|
Die Lösung ist nicht, die Sicherheitsanalyse abzuschaffen, sondern ihre Konsequenz zu ändern. Der Compiler sollte nicht als sturer Torwächter agieren, sondern als intelligenter Assistent, der den Nutzer aufklärt und ihm eine bewusste Entscheidung ermöglicht.
|
||||||
|
|
||||||
|
**Der neue Ansatz:**
|
||||||
|
1. Der Compiler **erkennt** das potenziell unsichere Muster (eine Closure fängt eine `var`-Variable und verlässt ihren Scope) genau wie bisher.
|
||||||
|
2. Statt eines harten **Fehlers** erzeugt er eine detaillierte **Warnung**.
|
||||||
|
3. Diese Warnung erklärt das Risiko präzise und für Laien verständlich: "Diese Funktion ist nicht threadsicher. Für isolierte Berechnungen wie Backtests ist das in Ordnung. Wenn Sie sie aber zwischen Threads teilen, kann es zu Fehlern kommen."
|
||||||
|
4. Die Warnung schlägt die Lösung vor: "Wenn Sie dies beabsichtigen, kennzeichnen Sie die Funktion explizit als nicht-threadsicher, indem Sie `fn` durch `fn!` ersetzen."
|
||||||
|
5. Der Nutzer ändert `fn` zu `fn!`. Die Warnung verschwindet. Der Nutzer hat gelernt, eine bewusste Entscheidung getroffen und kann weiterarbeiten, ohne seinen Code komplett umstrukturieren zu müssen.
|
||||||
|
|
||||||
|
Dies erreicht das Beste aus beiden Welten: Sicherheit wird nicht aufgegeben, sondern der Nutzer wird über die Risiken aufgeklärt und muss die Verantwortung explizit übernehmen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
Ich fasse das Ergebnis in einem neuen Projektplan-Eintrag zusammen.
|
||||||
|
|
||||||
|
### Projektplan: "Guided Safety" und der `fn!`-Modifikator
|
||||||
|
|
||||||
|
* **Datum:** 09. Oktober 2025
|
||||||
|
* **Uhrzeit:** 17:47
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
|
||||||
|
Die strikte "safe-by-design"-Garantie, die das "Escaping" von `var`-Variablen durch einen Compiler-Fehler verhindert, erweist sich für die Zielgruppe der programmiertechnisch unerfahrenen Domänen-Experten als zu restriktiv. Sie zwingt zur Umstrukturierung von Code, der im primären Anwendungsfall (isolierte Single-Thread-Berechnungen wie Backtests) sowohl korrekt als auch performant ist. Dies führt zu Frustration und mindert die Akzeptanz der Sprache.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
|
||||||
|
Das Sicherheitsmodell der Sprache wird von einer rigiden **"Guaranteed Safety"** zu einer benutzerfreundlichen **"Guided Safety"** weiterentwickelt. Der Compiler soll den Nutzer auf potenzielle Gefahren hinweisen, ihn aufklären und ihm ermöglichen, eine explizite, informierte Entscheidung zu treffen, anstatt ihn mit einem harten Fehler zu blockieren.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
|
||||||
|
1. **Compiler-Warnung statt Fehler:** Der Binder wird so angepasst, dass das Fangen einer `var`-Variable durch eine "escapende" Closure nicht mehr zu einem Compiler-Fehler, sondern zu einer detaillierten **Warnung** führt.
|
||||||
|
|
||||||
|
2. **Einführung von `fn!`:** Ein neuer Funktions-Deklarations-Syntax `(fn! ...)` wird eingeführt. Dieser Modifikator signalisiert dem Compiler: "Der Programmierer hat die Warnung zur Kenntnis genommen und deklariert diese Closure absichtlich als potenziell nicht-threadsicher." Das Vorhandensein von `fn!` unterdrückt die entsprechende Compiler-Warnung.
|
||||||
|
|
||||||
|
3. **Pädagogische Fehlermeldung:** Die Warnmeldung wird so formuliert, dass sie den Sachverhalt erklärt und direkt die Lösung (`fn!` verwenden) vorschlägt. Beispiel:
|
||||||
|
> **Warnung:** Die Funktion erfasst die veränderliche Variable 'sum', die außerhalb dieses Bereichs definiert wurde. Dies macht die Funktion nicht threadsicher. Für isolierte Berechnungen (z.B. in einem Backtest) ist dies unproblematisch und performant. Um zu bestätigen, dass dies beabsichtigt ist, ändern Sie `(fn ...)` zu `(fn! ...)`."
|
||||||
|
|
||||||
|
4. **Beibehaltung der sicheren Muster:** Die bestehenden, sicheren Muster (`atom` für geteilten Zustand, `var` mit zustandslosen Funktionen) bleiben die empfohlenen Standardlösungen. `fn!` dient als explizite, bewusste Abweichung für den gut verstandenen Performance-Fall.
|
||||||
|
|
||||||
|
#### Todo
|
||||||
|
|
||||||
|
* [ ] Die Logik im `Binder` anpassen, um eine Warnung anstelle eines Fehlers für "escapende `var`-Variablen" zu generieren.
|
||||||
|
* [ ] Den `Parser` um die Erkennung des `fn!`-Schlüsselworts erweitern.
|
||||||
|
* [ ] Die Binder-Logik erweitern, sodass `fn!` die Warnung unterdrückt.
|
||||||
|
* [ ] Die exakte Formulierung der neuen Warnmeldung implementieren.
|
||||||
|
* [ ] Die Dokumentation aktualisieren, um das "Guided Safety"-Konzept und die korrekte Verwendung von `fn`, `fn!` und `atom` zu erklären.
|
||||||
@@ -0,0 +1,110 @@
|
|||||||
|
Die bisherige Diskussion hat sich um die Frage gedreht: "Was ist theoretisch sicher?". Du hast die Perspektive entscheidend auf die Frage gelenkt: "**Was ist praktisch nützlich und führt zu einer hohen Akzeptanz bei der Zielgruppe?**"
|
||||||
|
|
||||||
|
Ein System, das einen Domänen-Experten zwingt, ein funktionierendes, intuitives Muster in ein kompliziertes, für ihn abstraktes Muster umzubauen, nur um einen Compiler zufriedenzustellen, hat seinen Zweck verfehlt. Der Nutzer wird frustriert aufgeben.
|
||||||
|
|
||||||
|
Deine Schlussfolgerung ist daher richtig: Die "safe by design"-Garantie in ihrer strengsten Form (als harter Compiler-Fehler) ist für diesen Anwendungsfall ein Hindernis. Wir müssen das Design weiterentwickeln.
|
||||||
|
|
||||||
|
---
|
||||||
|
### Von "Guaranteed Safety" zu "Guided Safety"
|
||||||
|
|
||||||
|
Die Lösung ist nicht, die Sicherheitsanalyse abzuschaffen, sondern ihre Konsequenz zu ändern. Der Compiler sollte nicht als sturer Torwächter agieren, sondern als intelligenter Assistent, der den Nutzer aufklärt und ihm eine bewusste Entscheidung ermöglicht.
|
||||||
|
|
||||||
|
**Der neue Ansatz:**
|
||||||
|
1. Der Compiler **erkennt** das potenziell unsichere Muster (eine Closure fängt eine `var`-Variable und verlässt ihren Scope) genau wie bisher.
|
||||||
|
2. Statt eines harten **Fehlers** erzeugt er eine detaillierte **Warnung**.
|
||||||
|
3. Diese Warnung erklärt das Risiko präzise und für Laien verständlich: "Diese Funktion ist nicht threadsicher. Für isolierte Berechnungen wie Backtests ist das in Ordnung. Wenn Sie sie aber zwischen Threads teilen, kann es zu Fehlern kommen."
|
||||||
|
4. Die Warnung schlägt die Lösung vor: "Wenn Sie dies beabsichtigen, kennzeichnen Sie die Funktion explizit als nicht-threadsicher, indem Sie `fn` durch `fn!` ersetzen."
|
||||||
|
5. Der Nutzer ändert `fn` zu `fn!`. Die Warnung verschwindet. Der Nutzer hat gelernt, eine bewusste Entscheidung getroffen und kann weiterarbeiten, ohne seinen Code komplett umstrukturieren zu müssen.
|
||||||
|
|
||||||
|
Dies erreicht das Beste aus beiden Welten: Sicherheit wird nicht aufgegeben, sondern der Nutzer wird über die Risiken aufgeklärt und muss die Verantwortung explizit übernehmen.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
Ich fasse das Ergebnis in einem neuen Projektplan-Eintrag zusammen.
|
||||||
|
|
||||||
|
### Projektplan: "Guided Safety" und der `fn!`-Modifikator
|
||||||
|
|
||||||
|
* **Datum:** 09. Oktober 2025
|
||||||
|
* **Uhrzeit:** 17:47
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
|
||||||
|
Die strikte "safe-by-design"-Garantie, die das "Escaping" von `var`-Variablen durch einen Compiler-Fehler verhindert, erweist sich für die Zielgruppe der programmiertechnisch unerfahrenen Domänen-Experten als zu restriktiv. Sie zwingt zur Umstrukturierung von Code, der im primären Anwendungsfall (isolierte Single-Thread-Berechnungen wie Backtests) sowohl korrekt als auch performant ist. Dies führt zu Frustration und mindert die Akzeptanz der Sprache.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
|
||||||
|
Das Sicherheitsmodell der Sprache wird von einer rigiden **"Guaranteed Safety"** zu einer benutzerfreundlichen **"Guided Safety"** weiterentwickelt. Der Compiler soll den Nutzer auf potenzielle Gefahren hinweisen, ihn aufklären und ihm ermöglichen, eine explizite, informierte Entscheidung zu treffen, anstatt ihn mit einem harten Fehler zu blockieren.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
|
||||||
|
1. **Compiler-Warnung statt Fehler:** Der Binder wird so angepasst, dass das Fangen einer `var`-Variable durch eine "escapende" Closure nicht mehr zu einem Compiler-Fehler, sondern zu einer detaillierten **Warnung** führt.
|
||||||
|
|
||||||
|
2. **Einführung von `fn!`:** Ein neuer Funktions-Deklarations-Syntax `(fn! ...)` wird eingeführt. Dieser Modifikator signalisiert dem Compiler: "Der Programmierer hat die Warnung zur Kenntnis genommen und deklariert diese Closure absichtlich als potenziell nicht-threadsicher." Das Vorhandensein von `fn!` unterdrückt die entsprechende Compiler-Warnung.
|
||||||
|
|
||||||
|
3. **Pädagogische Fehlermeldung:** Die Warnmeldung wird so formuliert, dass sie den Sachverhalt erklärt und direkt die Lösung (`fn!` verwenden) vorschlägt. Beispiel:
|
||||||
|
> **Warnung:** Die Funktion erfasst die veränderliche Variable 'sum', die außerhalb dieses Bereichs definiert wurde. Dies macht die Funktion nicht threadsicher. Für isolierte Berechnungen (z.B. in einem Backtest) ist dies unproblematisch und performant. Um zu bestätigen, dass dies beabsichtigt ist, ändern Sie `(fn ...)` zu `(fn! ...)`."
|
||||||
|
|
||||||
|
4. **Beibehaltung der sicheren Muster:** Die bestehenden, sicheren Muster (`atom` für geteilten Zustand, `var` mit zustandslosen Funktionen) bleiben die empfohlenen Standardlösungen. `fn!` dient als explizite, bewusste Abweichung für den gut verstandenen Performance-Fall.
|
||||||
|
|
||||||
|
-------------------
|
||||||
|
|
||||||
|
> Jetzt weiß der Compiler, ob eine Closure unsafe ist. Kann er sonst noch was mit dieser Information anfangen?
|
||||||
|
|
||||||
|
|
||||||
|
Ja, absolut. Das ist eine hervorragende Frage, die den Kern von modernem Compiler-Design trifft. Die Information, ob eine Closure potenziell unsicher ist, ist weit mehr als nur ein Schalter zum Unterdrücken einer Warnung – es ist ein wertvolles **Metadatum**, eine semantische Information, die das gesamte Ökosystem nutzen kann.
|
||||||
|
|
||||||
|
Stell dir das `!` bei `fn!` wie einen **"Gefahrgut"-Aufkleber** auf einem Paket vor. Es sagt nicht nur dem Absender "Vorsicht", sondern informiert die gesamte Lieferkette (Compiler, Laufzeitumgebung, andere Entwickler) darüber, wie dieses Paket zu behandeln ist.
|
||||||
|
|
||||||
|
Hier sind konkrete, extrem nützliche Dinge, die der Compiler und die Laufzeitumgebung mit dieser Information tun können:
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
### 1\. Laufzeit-Überprüfung im Debug-Modus 💥
|
||||||
|
|
||||||
|
Das ist der größte Gewinn. Wenn der Compiler weiß, dass eine `fn!`-Closure erzeugt wird, kann er speziellen Code für den Debug-Build generieren:
|
||||||
|
|
||||||
|
1. **Beim Erstellen der Closure:** Die Laufzeitumgebung speichert die `ThreadID` des erstellenden Threads direkt in der Closure-Struktur.
|
||||||
|
2. **Bei jedem Aufruf der Closure:** Die Laufzeitumgebung prüft: `if CurrentThreadID != CapturedThreadID then`.
|
||||||
|
3. **Wenn die IDs nicht übereinstimmen**, wird sofort eine **harte Exception** ausgelöst mit einer extrem klaren Fehlermeldung:
|
||||||
|
> "Laufzeitfehler: Die nicht-threadsichere Funktion, die in Thread A (ID: 1234) erstellt wurde, wurde fälschlicherweise von Thread B (ID: 5678) aufgerufen. Dies hätte zu einer Race Condition geführt."
|
||||||
|
|
||||||
|
**Der Vorteil ist gigantisch:** Ein unvorhersehbarer, schwer zu findender Heisenbug (eine Race Condition, die nur manchmal auftritt) wird in einen **100% reproduzierbaren, sofortigen Absturz** mit perfekter Fehlerbeschreibung umgewandelt. Allein dieses Feature macht `fn!` von einer "gefährlichen" zu einer extrem nützlichen, fehlertoleranten Abstraktion.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
### 2\. Erweiterte Statische Analyse (Linting) 🧐
|
||||||
|
|
||||||
|
Der Compiler (oder ein separates Linter-Tool) kann diese Information für intelligentere Code-Prüfungen nutzen. Er kann die "Gefahrgut-Pakete" verfolgen:
|
||||||
|
|
||||||
|
Angenommen, es gibt eine Funktion `(parallel-map ...)` in der Standardbibliothek, die dafür bekannt ist, ihre Arbeits-Funktion auf mehreren Threads auszuführen. Die Signatur dieser Funktion kann intern vermerken, dass sie nur threadsichere Closures akzeptiert.
|
||||||
|
|
||||||
|
Wenn ein Entwickler nun versucht, Folgendes zu schreiben:
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(let my-unsafe-sma (create-sma-unsafe 20)) ; Gibt eine fn!-Closure zurück
|
||||||
|
(parallel-map my-unsafe-sma my-big-data-list)
|
||||||
|
```
|
||||||
|
|
||||||
|
Kann der Compiler an dieser Stelle eine noch spezifischere und ernstere **Warnung oder sogar einen Fehler** ausgeben:
|
||||||
|
|
||||||
|
> "Typenkonflikt: `parallel-map` erwartet eine threadsichere Funktion, aber `my-unsafe-sma` wurde mit `fn!` als nicht-threadsicher deklariert. Dies führt garantiert zu Datenkorruption."
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
### 3\. Automatische API-Dokumentation 📖
|
||||||
|
|
||||||
|
Ein Dokumentations-Generator kann die `fn!`-Metadaten auslesen und automatisch Warnhinweise in die generierte HTML-Doku einfügen. Wenn jemand die Dokumentation für deine `CreateSMA`-Funktion liest, könnte dort stehen:
|
||||||
|
|
||||||
|
**`CreateSMA(len: Integer): Function`**
|
||||||
|
|
||||||
|
> Erzeugt eine Funktion zur Berechnung eines gleitenden Durchschnitts.
|
||||||
|
>
|
||||||
|
> ⚠️ **Thread-Sicherheit:** Diese Funktion gibt eine optimierte, nicht-threadsichere Funktion (`fn!`) zurück. Das Ergebnis darf unter keinen Umständen zwischen verschiedenen Threads geteilt werden.
|
||||||
|
|
||||||
|
Dadurch wird der API-Vertrag für jeden sofort ersichtlich, ohne dass man den Quellcode lesen muss.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
### Fazit
|
||||||
|
|
||||||
|
Die explizite Kennzeichnung mit `fn!` ist also kein Rückschritt in der Sicherheit. Im Gegenteil, es ist eine **semantische Anreicherung**. Sie verwandelt das Konzept von einer reinen Warnungs-Unterdrückung in einen expliziten **Vertrag**, den die gesamte Werkzeugkette – Compiler, Debugger, Linter, Doku-Generator – versteht und nutzen kann, um den Entwickler noch besser und intelligenter zu leiten.
|
||||||
@@ -0,0 +1,20 @@
|
|||||||
|
program GeminiTest;
|
||||||
|
|
||||||
|
{$R *.dres}
|
||||||
|
|
||||||
|
uses
|
||||||
|
FastMM5,
|
||||||
|
System.StartUpCopy,
|
||||||
|
FMX.Forms,
|
||||||
|
MainUnit in 'MainUnit.pas' {Form1},
|
||||||
|
Myc.Api.Gemini in 'Myc.Api.Gemini.pas',
|
||||||
|
Myc.System.Quota in 'Myc.System.Quota.pas',
|
||||||
|
Myc.Api.MarkdownStream in 'Myc.Api.MarkdownStream.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,196 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 708
|
||||||
|
ClientWidth = 906
|
||||||
|
FormFactor.Width = 320
|
||||||
|
FormFactor.Height = 480
|
||||||
|
FormFactor.Devices = [Desktop]
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
DesignerMasterStyle = 0
|
||||||
|
object AskButton: TButton
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Default = True
|
||||||
|
Position.X = 800.000000000000000000
|
||||||
|
Position.Y = 577.000000000000000000
|
||||||
|
TabOrder = 1
|
||||||
|
Text = 'Ask'
|
||||||
|
OnClick = AskButtonClick
|
||||||
|
end
|
||||||
|
object Edit1: TEdit
|
||||||
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
TabOrder = 2
|
||||||
|
Text = 'AIzaSyBiWN55O-lI36EXcBeqf_cne4jAzxNsfbg'
|
||||||
|
Position.X = 8.000000000000000000
|
||||||
|
Position.Y = 678.000000000000000000
|
||||||
|
Size.Width = 145.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
OnExit = Edit1Exit
|
||||||
|
end
|
||||||
|
object ModelsComboBox: TComboBox
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
Position.X = 8.000000000000000000
|
||||||
|
Position.Y = 577.000000000000000000
|
||||||
|
Size.Width = 193.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object AskMemo: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
Anchors = [akLeft, akRight, akBottom]
|
||||||
|
Position.X = 224.000000000000000000
|
||||||
|
Position.Y = 577.000000000000000000
|
||||||
|
Size.Width = 568.000000000000000000
|
||||||
|
Size.Height = 123.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 5
|
||||||
|
Viewport.Width = 564.000000000000000000
|
||||||
|
Viewport.Height = 119.000000000000000000
|
||||||
|
end
|
||||||
|
object ResetChatButton: TButton
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Position.X = 800.000000000000000000
|
||||||
|
Position.Y = 645.000000000000000000
|
||||||
|
TabOrder = 6
|
||||||
|
Text = 'Reset'
|
||||||
|
OnClick = ResetChatButtonClick
|
||||||
|
end
|
||||||
|
object TabControl1: TTabControl
|
||||||
|
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||||
|
Size.Width = 906.000000000000000000
|
||||||
|
Size.Height = 561.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabIndex = 0
|
||||||
|
TabOrder = 7
|
||||||
|
TabPosition = PlatformDefault
|
||||||
|
Sizes = (
|
||||||
|
906s
|
||||||
|
535s
|
||||||
|
906s
|
||||||
|
535s
|
||||||
|
906s
|
||||||
|
535s)
|
||||||
|
object ChatTabItem: TTabItem
|
||||||
|
CustomIcon = <
|
||||||
|
item
|
||||||
|
end>
|
||||||
|
IsSelected = True
|
||||||
|
Size.Width = 45.000000000000000000
|
||||||
|
Size.Height = 26.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
StyleLookup = ''
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Chat'
|
||||||
|
ExplicitSize.cx = 69.000000000000000000
|
||||||
|
ExplicitSize.cy = 26.000000000000000000
|
||||||
|
object ChatBrowser: TWebBrowser
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 906.000000000000000000
|
||||||
|
Size.Height = 535.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
WindowsEngine = EdgeOnly
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object CacheTabItem: TTabItem
|
||||||
|
CustomIcon = <
|
||||||
|
item
|
||||||
|
end>
|
||||||
|
IsSelected = False
|
||||||
|
Size.Width = 53.000000000000000000
|
||||||
|
Size.Height = 26.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
StyleLookup = ''
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Cache'
|
||||||
|
ExplicitSize.cx = 53.000000000000000000
|
||||||
|
ExplicitSize.cy = 26.000000000000000000
|
||||||
|
object CacheMemo: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 906.000000000000000000
|
||||||
|
Size.Height = 535.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 1
|
||||||
|
Viewport.Width = 902.000000000000000000
|
||||||
|
Viewport.Height = 531.000000000000000000
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object SysInstrTabItem: TTabItem
|
||||||
|
CustomIcon = <
|
||||||
|
item
|
||||||
|
end>
|
||||||
|
IsSelected = False
|
||||||
|
Size.Width = 61.000000000000000000
|
||||||
|
Size.Height = 26.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
StyleLookup = ''
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'SysInstr'
|
||||||
|
ExplicitSize.cx = 61.000000000000000000
|
||||||
|
ExplicitSize.cy = 26.000000000000000000
|
||||||
|
object SystemInstructionMemo: TMemo
|
||||||
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
|
DataDetectorTypes = []
|
||||||
|
TextSettings.WordWrap = True
|
||||||
|
Align = Client
|
||||||
|
Size.Width = 906.000000000000000000
|
||||||
|
Size.Height = 535.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 1
|
||||||
|
Viewport.Width = 902.000000000000000000
|
||||||
|
Viewport.Height = 531.000000000000000000
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object UploadCacheButton: TButton
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Position.X = 800.000000000000000000
|
||||||
|
Position.Y = 675.000000000000000000
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Upload'
|
||||||
|
OnClick = UploadCacheButtonClick
|
||||||
|
end
|
||||||
|
object ThinkingCheckBox: TCheckBox
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Position.X = 800.000000000000000000
|
||||||
|
Position.Y = 607.000000000000000000
|
||||||
|
Size.Width = 88.000000000000000000
|
||||||
|
Size.Height = 19.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 8
|
||||||
|
Text = 'Thinking'
|
||||||
|
end
|
||||||
|
object GlobalQuoteLabel: TLabel
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
Position.X = 8.000000000000000000
|
||||||
|
Position.Y = 608.000000000000000000
|
||||||
|
Size.Width = 193.000000000000000000
|
||||||
|
Size.Height = 17.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
Text = 'Global Quota: 0'
|
||||||
|
TabOrder = 9
|
||||||
|
end
|
||||||
|
object QuotaLabel: TLabel
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Position.X = 704.000000000000000000
|
||||||
|
Position.Y = 537.000000000000000000
|
||||||
|
Size.Width = 194.000000000000000000
|
||||||
|
Size.Height = 16.000000000000000000
|
||||||
|
Size.PlatformDefault = False
|
||||||
|
TextSettings.HorzAlign = Trailing
|
||||||
|
Text = 'in/out'
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
|
object ApplicationEvents: TApplicationEvents
|
||||||
|
OnIdle = ApplicationEventsIdle
|
||||||
|
Left = 768
|
||||||
|
Top = 58
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -0,0 +1,400 @@
|
|||||||
|
unit MainUnit;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Types,
|
||||||
|
System.UITypes,
|
||||||
|
System.Classes,
|
||||||
|
System.Variants,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SyncObjs,
|
||||||
|
FMX.Types,
|
||||||
|
FMX.Controls,
|
||||||
|
FMX.Forms,
|
||||||
|
FMX.Graphics,
|
||||||
|
FMX.Dialogs,
|
||||||
|
FMX.Memo.Types,
|
||||||
|
FMX.ScrollBox,
|
||||||
|
FMX.Memo,
|
||||||
|
FMX.Controls.Presentation,
|
||||||
|
FMX.StdCtrls,
|
||||||
|
FMX.Edit,
|
||||||
|
FMX.ListBox,
|
||||||
|
FMX.TabControl,
|
||||||
|
FMX.WebBrowser,
|
||||||
|
Myc.Signals,
|
||||||
|
Myc.Futures,
|
||||||
|
Myc.Api.Gemini,
|
||||||
|
Myc.Api.MarkdownStream,
|
||||||
|
FMX.ApplicationEvents;
|
||||||
|
|
||||||
|
type
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
AskButton: TButton;
|
||||||
|
Edit1: TEdit;
|
||||||
|
ModelsComboBox: TComboBox;
|
||||||
|
QuotaLabel: TLabel;
|
||||||
|
AskMemo: TMemo;
|
||||||
|
ResetChatButton: TButton;
|
||||||
|
TabControl1: TTabControl;
|
||||||
|
CacheTabItem: TTabItem;
|
||||||
|
SysInstrTabItem: TTabItem;
|
||||||
|
CacheMemo: TMemo;
|
||||||
|
SystemInstructionMemo: TMemo;
|
||||||
|
UploadCacheButton: TButton;
|
||||||
|
ThinkingCheckBox: TCheckBox;
|
||||||
|
GlobalQuoteLabel: TLabel;
|
||||||
|
ChatTabItem: TTabItem;
|
||||||
|
ChatBrowser: TWebBrowser;
|
||||||
|
ApplicationEvents: TApplicationEvents;
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure AskButtonClick(Sender: TObject);
|
||||||
|
procedure Edit1Exit(Sender: TObject);
|
||||||
|
procedure ResetChatButtonClick(Sender: TObject);
|
||||||
|
procedure UploadCacheButtonClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
FChat: IGeminiChat;
|
||||||
|
FCachedClient: IGeminiClient;
|
||||||
|
FMarkdown: IMarkdownStream;
|
||||||
|
FAsking: TFuture<TGeminiResult>;
|
||||||
|
FResponseLock: TCriticalSection;
|
||||||
|
FResponseQueue: TQueue<TProc>;
|
||||||
|
FModelList: TFuture<TArray<string>>;
|
||||||
|
FUploadCache: TFuture<TProc>;
|
||||||
|
FNeedModelListUpdate: TFlag;
|
||||||
|
FResposeQueueChanged: TFlag;
|
||||||
|
FNewResposeReceived: TFlag;
|
||||||
|
FCacheUploaded: TFlag;
|
||||||
|
procedure InitChat;
|
||||||
|
procedure UpdateQuotaDisplay;
|
||||||
|
public
|
||||||
|
procedure GetAvailableModels;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Myc.System.Quota;
|
||||||
|
|
||||||
|
{$R *.fmx}
|
||||||
|
|
||||||
|
const
|
||||||
|
FallbackModel = 'gemini-2.5-flash-lite';
|
||||||
|
|
||||||
|
procedure TForm1.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FResponseQueue.Free;
|
||||||
|
FResponseLock.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FResponseQueue := TQueue<TProc>.Create;
|
||||||
|
FResponseLock := TCriticalSection.Create;
|
||||||
|
|
||||||
|
// 1. Markdown Stream initialisieren und mit Browser verbinden
|
||||||
|
FMarkdown := TMarkdownStream.Create;
|
||||||
|
FMarkdown.InitializeBrowser(ChatBrowser);
|
||||||
|
|
||||||
|
// Load default instructions if file exists
|
||||||
|
if FileExists('T:\Myc\KI\gemini.md') then
|
||||||
|
SystemInstructionMemo.Lines.LoadFromFile('T:\Myc\KI\gemini.md', TEncoding.UTF8);
|
||||||
|
|
||||||
|
UpdateQuotaDisplay;
|
||||||
|
GetAvailableModels;
|
||||||
|
InitChat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.InitChat;
|
||||||
|
begin
|
||||||
|
// Browser komplett leeren
|
||||||
|
if Assigned(FMarkdown) then
|
||||||
|
FMarkdown.Clear;
|
||||||
|
|
||||||
|
FMarkdown.BeginBlock(btMarkdown);
|
||||||
|
if Assigned(FCachedClient) then
|
||||||
|
begin
|
||||||
|
FChat := FCachedClient.StartChat;
|
||||||
|
FMarkdown.Append('*--- New Chat Session ---* (Cached Content Active)');
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FMarkdown.Append('*--- New Chat Session ---*');
|
||||||
|
FChat := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ResetChatButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
InitChat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.UpdateQuotaDisplay;
|
||||||
|
begin
|
||||||
|
GlobalQuoteLabel.Text := 'Total: ' + TGlobalQuota.GetTotal.ToString + ', Today: ' + TGlobalQuota.GetDailyTotal.ToString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.AskButtonClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
apiKey: string;
|
||||||
|
modelName: string;
|
||||||
|
prompt: string;
|
||||||
|
begin
|
||||||
|
apiKey := Edit1.Text;
|
||||||
|
prompt := AskMemo.Text;
|
||||||
|
|
||||||
|
if ModelsComboBox.ItemIndex > -1 then
|
||||||
|
modelName := ModelsComboBox.Items[ModelsComboBox.ItemIndex]
|
||||||
|
else
|
||||||
|
modelName := FallbackModel;
|
||||||
|
|
||||||
|
// --- LAZY INIT ---
|
||||||
|
if FChat = nil then
|
||||||
|
begin
|
||||||
|
var client: IGeminiClient := TGeminiClient.Create(apiKey, modelName);
|
||||||
|
|
||||||
|
if not SystemInstructionMemo.Text.Trim.IsEmpty then
|
||||||
|
client.SystemInstruction := SystemInstructionMemo.Text;
|
||||||
|
|
||||||
|
client.EnableThinking := ThinkingCheckBox.IsChecked;
|
||||||
|
FChat := client.StartChat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
AskButton.Enabled := False;
|
||||||
|
AskMemo.Text := '';
|
||||||
|
|
||||||
|
// --- USER BLOCK ---
|
||||||
|
FMarkdown.BeginBlock(btRawText, 'Prompt');
|
||||||
|
// Hier nutzen wir RawText für den Prompt selbst, um Markdown-Injection des Users zu verhindern,
|
||||||
|
// oder wir bleiben im Markdown Block für schöneres Rendering (Code-Blöcke des Users).
|
||||||
|
// Da User Markdown oft erwarten:
|
||||||
|
FMarkdown.Append(prompt);
|
||||||
|
|
||||||
|
FAsking :=
|
||||||
|
TFuture<TGeminiResult>.Construct(
|
||||||
|
FAsking.Done,
|
||||||
|
function: TGeminiResult
|
||||||
|
var
|
||||||
|
CurrentChat: IGeminiChat;
|
||||||
|
// State Tracking für den Stream
|
||||||
|
LastWasThought: Boolean;
|
||||||
|
FirstChunk: Boolean;
|
||||||
|
begin
|
||||||
|
CurrentChat := FChat;
|
||||||
|
if CurrentChat = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
LastWasThought := False;
|
||||||
|
FirstChunk := True;
|
||||||
|
|
||||||
|
// --- STREAMING ---
|
||||||
|
Result :=
|
||||||
|
CurrentChat.SendMessageStream(
|
||||||
|
prompt,
|
||||||
|
procedure(const TextChunk: string; IsThought: Boolean)
|
||||||
|
begin
|
||||||
|
FResponseLock.Enter;
|
||||||
|
try
|
||||||
|
FResponseQueue.Enqueue(
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
// Statuswechsel oder allererster Chunk -> Neuer Block
|
||||||
|
if FirstChunk or (IsThought <> LastWasThought) then
|
||||||
|
begin
|
||||||
|
if IsThought then
|
||||||
|
begin
|
||||||
|
FMarkdown.BeginBlock(btMarkdown, 'Thinking...');
|
||||||
|
// Optional: Kursiver Block für Gedanken
|
||||||
|
// Wir hängen Gedanken oft als Zitat oder kursiv an
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Wenn wir aus einem Gedanken kommen oder starten
|
||||||
|
FMarkdown.BeginBlock(btMarkdown, 'Gemini');
|
||||||
|
end;
|
||||||
|
|
||||||
|
LastWasThought := IsThought;
|
||||||
|
FirstChunk := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FMarkdown.Append(TextChunk);
|
||||||
|
end
|
||||||
|
);
|
||||||
|
finally
|
||||||
|
FResponseLock.Leave;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FResposeQueueChanged.Notify;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
FNewResposeReceived := TFlag.CreateObserver(FAsking.Done.Signal);
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Edit1Exit(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if ModelsComboBox.ItemIndex < 0 then
|
||||||
|
GetAvailableModels;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.GetAvailableModels;
|
||||||
|
var
|
||||||
|
apiKey: string;
|
||||||
|
begin
|
||||||
|
apiKey := Edit1.Text.Trim;
|
||||||
|
if apiKey.IsEmpty then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
FModelList :=
|
||||||
|
TFuture<TArray<string>>.Construct(
|
||||||
|
FModelList.Done,
|
||||||
|
function: TArray<string>
|
||||||
|
var
|
||||||
|
client: IGeminiClient;
|
||||||
|
begin
|
||||||
|
client := TGeminiClient.Create(apiKey);
|
||||||
|
Result := client.ListModels;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
FNeedModelListUpdate := TFlag.CreateObserver(FModelList.Done.Signal);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.UploadCacheButtonClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
apiKey: string;
|
||||||
|
content: string;
|
||||||
|
sysInstr: string;
|
||||||
|
modelName: string;
|
||||||
|
begin
|
||||||
|
apiKey := Edit1.Text;
|
||||||
|
content := CacheMemo.Text;
|
||||||
|
sysInstr := SystemInstructionMemo.Text;
|
||||||
|
|
||||||
|
if content.Trim.IsEmpty then
|
||||||
|
begin
|
||||||
|
FMarkdown.Append(sLineBreak + '**Error:** Cache content is empty.' + sLineBreak);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ModelsComboBox.ItemIndex > -1 then
|
||||||
|
modelName := ModelsComboBox.Items[ModelsComboBox.ItemIndex].Split([' '])[0]
|
||||||
|
else
|
||||||
|
modelName := FallbackModel;
|
||||||
|
|
||||||
|
UploadCacheButton.Enabled := False;
|
||||||
|
// Hinweis im Browser anzeigen
|
||||||
|
FMarkdown.Append(sLineBreak + '*Creating Cache...*' + sLineBreak);
|
||||||
|
|
||||||
|
FUploadCache :=
|
||||||
|
TFuture<TProc>.Construct(
|
||||||
|
FUploadCache.Done,
|
||||||
|
function: TProc
|
||||||
|
var
|
||||||
|
client: IGeminiClient;
|
||||||
|
cacheName: string;
|
||||||
|
errMsg: string;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
client := TGeminiClient.Create(apiKey, modelName);
|
||||||
|
cacheName := client.CreateCache(content, sysInstr, 300);
|
||||||
|
client.ActiveCacheName := cacheName;
|
||||||
|
FCachedClient := client;
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
FMarkdown.Append('**Success: Cache created!**' + sLineBreak);
|
||||||
|
FMarkdown.Append('ID: `' + cacheName + '`' + sLineBreak);
|
||||||
|
|
||||||
|
InitChat;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
errMsg := E.Message;
|
||||||
|
Result := procedure begin FMarkdown.Append('**Cache Upload Failed:** ' + errMsg + sLineBreak); end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
|
||||||
|
FCacheUploaded := TFlag.CreateObserver(FUploadCache.Done.Signal);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
|
||||||
|
begin
|
||||||
|
if FNeedModelListUpdate.Reset then
|
||||||
|
begin
|
||||||
|
ModelsComboBox.BeginUpdate;
|
||||||
|
try
|
||||||
|
ModelsComboBox.Items.Clear;
|
||||||
|
|
||||||
|
var models := FModelList.Value;
|
||||||
|
|
||||||
|
if Length(models) = 0 then
|
||||||
|
begin
|
||||||
|
FMarkdown.Append(sLineBreak + '*System: No models found.*' + sLineBreak);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for var mName in models do
|
||||||
|
ModelsComboBox.Items.Add(mName);
|
||||||
|
|
||||||
|
if ModelsComboBox.Items.Count > 0 then
|
||||||
|
begin
|
||||||
|
ModelsComboBox.ItemIndex := ModelsComboBox.Items.IndexOf(FallbackModel);
|
||||||
|
if ModelsComboBox.ItemIndex < 0 then
|
||||||
|
ModelsComboBox.ItemIndex := 0;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
ModelsComboBox.EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FCacheUploaded.Reset then
|
||||||
|
begin
|
||||||
|
if Assigned(FUploadCache.Value) then
|
||||||
|
FUploadCache.Value();
|
||||||
|
UploadCacheButton.Enabled := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FResposeQueueChanged.Reset then
|
||||||
|
begin
|
||||||
|
FResponseLock.Enter;
|
||||||
|
try
|
||||||
|
while FResponseQueue.Count > 0 do
|
||||||
|
(FResponseQueue.Dequeue)();
|
||||||
|
finally
|
||||||
|
FResponseLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FNewResposeReceived.Reset then
|
||||||
|
begin
|
||||||
|
var res := FAsking.Value;
|
||||||
|
|
||||||
|
if res.Text.StartsWith('Error') then
|
||||||
|
begin
|
||||||
|
FMarkdown.BeginBlock(btMarkdown, 'Error');
|
||||||
|
FMarkdown.Append('> ' + Res.Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
QuotaLabel.Text := Format('Input: %d | Output: %d', [res.Usage.PromptTokens, res.Usage.CandidatesTokens]);
|
||||||
|
|
||||||
|
UpdateQuotaDisplay;
|
||||||
|
AskButton.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,822 @@
|
|||||||
|
unit Myc.Api.Gemini;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Net.HttpClient,
|
||||||
|
System.Net.Mime,
|
||||||
|
System.JSON,
|
||||||
|
System.NetEncoding,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SyncObjs,
|
||||||
|
Myc.System.Quota; // Einbindung der Global Quota Unit
|
||||||
|
|
||||||
|
type
|
||||||
|
// Represents usage statistics for a request
|
||||||
|
TGeminiUsage = record
|
||||||
|
PromptTokens: Integer;
|
||||||
|
CandidatesTokens: Integer;
|
||||||
|
TotalTokens: Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Represents the result of a generation request
|
||||||
|
TGeminiResult = record
|
||||||
|
Text: string;
|
||||||
|
IsThought: Boolean; // True if this part contains reasoning/thoughts
|
||||||
|
Usage: TGeminiUsage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TChatRole = (User, Model);
|
||||||
|
|
||||||
|
TChatItem = record
|
||||||
|
Role: TChatRole;
|
||||||
|
Text: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Callback for streaming: provides the new text delta and thought flag
|
||||||
|
TStreamCallback = reference to procedure(const TextDelta: string; IsThought: Boolean);
|
||||||
|
|
||||||
|
// Interface for a chat session (maintains history)
|
||||||
|
IGeminiChat = interface
|
||||||
|
['{5C2F64C8-4D18-47C0-9513-332715053673}']
|
||||||
|
function SendMessage(const Text: string): TGeminiResult;
|
||||||
|
function SendMessageStream(const Text: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||||
|
function GetHistory: TArray<TChatItem>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Interface for the API Client
|
||||||
|
IGeminiClient = interface
|
||||||
|
['{E6721670-3498-4660-848D-82F3B1A2B5E2}']
|
||||||
|
// Standard Generation
|
||||||
|
function GenerateContent(const Prompt: string): TGeminiResult; overload;
|
||||||
|
function GenerateContent(const History: TArray<TChatItem>): TGeminiResult; overload;
|
||||||
|
|
||||||
|
// Streaming Generation
|
||||||
|
function GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||||
|
function GenerateContentStream(const History: TArray<TChatItem>; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||||
|
|
||||||
|
// Utilities
|
||||||
|
function ListModels: TArray<string>;
|
||||||
|
function StartChat: IGeminiChat;
|
||||||
|
|
||||||
|
// Context Caching
|
||||||
|
function CreateCache(const Content: string; const SysInstructions: string; const TTLSeconds: Integer = 300): string;
|
||||||
|
procedure SetActiveCache(const CacheName: string);
|
||||||
|
function GetActiveCache: string;
|
||||||
|
|
||||||
|
// Configuration
|
||||||
|
procedure SetSystemInstruction(const Value: string);
|
||||||
|
function GetSystemInstruction: string;
|
||||||
|
|
||||||
|
// Native Thinking / Reasoning
|
||||||
|
procedure SetEnableThinking(const Value: Boolean);
|
||||||
|
function GetEnableThinking: Boolean;
|
||||||
|
|
||||||
|
property ActiveCacheName: string read GetActiveCache write SetActiveCache;
|
||||||
|
property SystemInstruction: string read GetSystemInstruction write SetSystemInstruction;
|
||||||
|
property EnableThinking: Boolean read GetEnableThinking write SetEnableThinking;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Implementation of the API Client
|
||||||
|
TGeminiClient = class(TInterfacedObject, IGeminiClient)
|
||||||
|
private
|
||||||
|
class var
|
||||||
|
FTotalUsage: TGeminiUsage;
|
||||||
|
private
|
||||||
|
FApiKey: string;
|
||||||
|
FBaseUrl: string;
|
||||||
|
FStreamUrl: string;
|
||||||
|
FListUrl: string;
|
||||||
|
FModelName: string;
|
||||||
|
FActiveCacheName: string;
|
||||||
|
FSystemInstruction: string;
|
||||||
|
FEnableThinking: Boolean;
|
||||||
|
|
||||||
|
function ParseResponse(const JsonStr: string): TGeminiResult;
|
||||||
|
function ParseModels(const JsonStr: string): TArray<string>;
|
||||||
|
function BuildJsonBody(const History: TArray<TChatItem>): TJSONObject;
|
||||||
|
procedure ProcessStreamData(const Data: TBytes; var Buffer: string; const OnDelta: TStreamCallback; var TotalResult: TGeminiResult);
|
||||||
|
public
|
||||||
|
constructor Create(const AApiKey: string; const AModel: string = 'gemini-1.5-flash-001');
|
||||||
|
|
||||||
|
function GenerateContent(const Prompt: string): TGeminiResult; overload;
|
||||||
|
function GenerateContent(const History: TArray<TChatItem>): TGeminiResult; overload;
|
||||||
|
|
||||||
|
function GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||||
|
function GenerateContentStream(const History: TArray<TChatItem>; const OnDelta: TStreamCallback): TGeminiResult; overload;
|
||||||
|
|
||||||
|
function ListModels: TArray<string>;
|
||||||
|
function StartChat: IGeminiChat;
|
||||||
|
|
||||||
|
function CreateCache(const Content: string; const SysInstructions: string; const TTLSeconds: Integer = 300): string;
|
||||||
|
procedure SetActiveCache(const CacheName: string);
|
||||||
|
function GetActiveCache: string;
|
||||||
|
|
||||||
|
procedure SetSystemInstruction(const Value: string);
|
||||||
|
function GetSystemInstruction: string;
|
||||||
|
|
||||||
|
procedure SetEnableThinking(const Value: Boolean);
|
||||||
|
function GetEnableThinking: Boolean;
|
||||||
|
|
||||||
|
// Static access to session-global usage (RAM only)
|
||||||
|
class property TotalUsage: TGeminiUsage read FTotalUsage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
type
|
||||||
|
// Internal Chat Session Implementation
|
||||||
|
TChatSession = class(TInterfacedObject, IGeminiChat)
|
||||||
|
private
|
||||||
|
FClient: IGeminiClient;
|
||||||
|
FHistory: TList<TChatItem>;
|
||||||
|
public
|
||||||
|
constructor Create(const Client: IGeminiClient);
|
||||||
|
destructor Destroy; override;
|
||||||
|
function SendMessage(const Text: string): TGeminiResult;
|
||||||
|
function SendMessageStream(const Text: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||||
|
function GetHistory: TArray<TChatItem>;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TGeminiClient }
|
||||||
|
|
||||||
|
constructor TGeminiClient.Create(const AApiKey: string; const AModel: string);
|
||||||
|
var
|
||||||
|
LModel: string;
|
||||||
|
encodedKey: string;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FApiKey := AApiKey.Trim;
|
||||||
|
LModel := AModel.Trim;
|
||||||
|
|
||||||
|
if LModel.IsEmpty then
|
||||||
|
LModel := 'gemini-1.5-flash-001';
|
||||||
|
|
||||||
|
FModelName := LModel;
|
||||||
|
if not FModelName.StartsWith('models/') then
|
||||||
|
FModelName := 'models/' + FModelName;
|
||||||
|
|
||||||
|
encodedKey := TNetEncoding.URL.EncodeQuery(FApiKey);
|
||||||
|
|
||||||
|
// Endpoint construction
|
||||||
|
FBaseUrl := Format('https://generativelanguage.googleapis.com/v1beta/%s:generateContent?key=%s', [FModelName, encodedKey]);
|
||||||
|
|
||||||
|
FStreamUrl := Format('https://generativelanguage.googleapis.com/v1beta/%s:streamGenerateContent?key=%s', [FModelName, encodedKey]);
|
||||||
|
|
||||||
|
FListUrl := Format('https://generativelanguage.googleapis.com/v1beta/models?key=%s', [encodedKey]);
|
||||||
|
|
||||||
|
FEnableThinking := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Property Setters/Getters ---
|
||||||
|
|
||||||
|
procedure TGeminiClient.SetEnableThinking(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
FEnableThinking := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.GetEnableThinking: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FEnableThinking;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGeminiClient.SetActiveCache(const CacheName: string);
|
||||||
|
begin
|
||||||
|
FActiveCacheName := CacheName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.GetActiveCache: string;
|
||||||
|
begin
|
||||||
|
Result := FActiveCacheName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGeminiClient.SetSystemInstruction(const Value: string);
|
||||||
|
begin
|
||||||
|
FSystemInstruction := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.GetSystemInstruction: string;
|
||||||
|
begin
|
||||||
|
Result := FSystemInstruction;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Core Logic ---
|
||||||
|
|
||||||
|
function TGeminiClient.GenerateContent(const Prompt: string): TGeminiResult;
|
||||||
|
var
|
||||||
|
item: TChatItem;
|
||||||
|
begin
|
||||||
|
item.Role := TChatRole.User;
|
||||||
|
item.Text := Prompt;
|
||||||
|
Result := GenerateContent([item]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.GenerateContent(const History: TArray<TChatItem>): TGeminiResult;
|
||||||
|
var
|
||||||
|
httpClient: THTTPClient;
|
||||||
|
requestBody: TJSONObject;
|
||||||
|
response: IHTTPResponse;
|
||||||
|
stringStream: TStringStream;
|
||||||
|
begin
|
||||||
|
Result.Text := '';
|
||||||
|
Result.Usage := Default(TGeminiUsage);
|
||||||
|
Result.IsThought := False;
|
||||||
|
|
||||||
|
httpClient := THTTPClient.Create;
|
||||||
|
requestBody := BuildJsonBody(History);
|
||||||
|
try
|
||||||
|
stringStream := TStringStream.Create(requestBody.ToString, TEncoding.UTF8);
|
||||||
|
try
|
||||||
|
httpClient.CustomHeaders['Content-Type'] := 'application/json';
|
||||||
|
httpClient.ConnectionTimeout := 10000;
|
||||||
|
httpClient.ResponseTimeout := 30000;
|
||||||
|
|
||||||
|
try
|
||||||
|
response := httpClient.Post(FBaseUrl, stringStream);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
Result.Text := 'Error: Connection failed - ' + E.Message;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (response.StatusCode = 200) then
|
||||||
|
begin
|
||||||
|
Result := ParseResponse(response.ContentAsString(TEncoding.UTF8));
|
||||||
|
|
||||||
|
// Update Usages
|
||||||
|
if (Result.Usage.TotalTokens > 0) then
|
||||||
|
begin
|
||||||
|
// RAM Counter
|
||||||
|
TInterlocked.Add(FTotalUsage.PromptTokens, Result.Usage.PromptTokens);
|
||||||
|
TInterlocked.Add(FTotalUsage.CandidatesTokens, Result.Usage.CandidatesTokens);
|
||||||
|
TInterlocked.Add(FTotalUsage.TotalTokens, Result.Usage.TotalTokens);
|
||||||
|
|
||||||
|
// Persistent System Counter
|
||||||
|
TGlobalQuota.AddTokens(Result.Usage.TotalTokens);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Result.Text :=
|
||||||
|
Format('Error: %d - %s (%s)', [response.StatusCode, response.StatusText, response.ContentAsString(TEncoding.UTF8)]);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
stringStream.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
httpClient.Free;
|
||||||
|
requestBody.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.GenerateContentStream(const Prompt: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||||
|
var
|
||||||
|
item: TChatItem;
|
||||||
|
begin
|
||||||
|
item.Role := TChatRole.User;
|
||||||
|
item.Text := Prompt;
|
||||||
|
Result := GenerateContentStream([item], OnDelta);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.GenerateContentStream(const History: TArray<TChatItem>; const OnDelta: TStreamCallback): TGeminiResult;
|
||||||
|
var
|
||||||
|
httpClient: THTTPClient;
|
||||||
|
requestBody: TJSONObject;
|
||||||
|
stringStream: TStringStream;
|
||||||
|
buffer: string;
|
||||||
|
|
||||||
|
// Captured local variable for the result state to avoid E2555
|
||||||
|
LFullResult: TGeminiResult;
|
||||||
|
begin
|
||||||
|
// Init local result container
|
||||||
|
LFullResult.Text := '';
|
||||||
|
LFullResult.Usage := Default(TGeminiUsage);
|
||||||
|
LFullResult.IsThought := False;
|
||||||
|
buffer := '';
|
||||||
|
|
||||||
|
httpClient := THTTPClient.Create;
|
||||||
|
requestBody := BuildJsonBody(History);
|
||||||
|
try
|
||||||
|
stringStream := TStringStream.Create(requestBody.ToString, TEncoding.UTF8);
|
||||||
|
try
|
||||||
|
httpClient.CustomHeaders['Content-Type'] := 'application/json';
|
||||||
|
httpClient.ConnectionTimeout := 10000;
|
||||||
|
httpClient.ResponseTimeout := 60000;
|
||||||
|
|
||||||
|
// Use ReceiveDataExCallback to access raw data chunks efficiently
|
||||||
|
httpClient.ReceiveDataExCallback :=
|
||||||
|
procedure(
|
||||||
|
const Sender: TObject;
|
||||||
|
AContentLength: Int64;
|
||||||
|
AReadCount: Int64;
|
||||||
|
AChunk: Pointer;
|
||||||
|
AChunkLength: Cardinal;
|
||||||
|
var AAbort: Boolean
|
||||||
|
)
|
||||||
|
var
|
||||||
|
LBytes: TBytes;
|
||||||
|
begin
|
||||||
|
if AChunkLength > 0 then
|
||||||
|
begin
|
||||||
|
SetLength(LBytes, AChunkLength);
|
||||||
|
Move(AChunk^, LBytes[0], AChunkLength);
|
||||||
|
|
||||||
|
ProcessStreamData(LBytes, buffer, OnDelta, LFullResult);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
try
|
||||||
|
httpClient.Post(FStreamUrl, stringStream);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
LFullResult.Text := LFullResult.Text + sLineBreak + '[Error: ' + E.Message + ']';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Update Usages
|
||||||
|
if LFullResult.Usage.TotalTokens > 0 then
|
||||||
|
begin
|
||||||
|
// RAM Counter
|
||||||
|
TInterlocked.Add(FTotalUsage.PromptTokens, LFullResult.Usage.PromptTokens);
|
||||||
|
TInterlocked.Add(FTotalUsage.CandidatesTokens, LFullResult.Usage.CandidatesTokens);
|
||||||
|
TInterlocked.Add(FTotalUsage.TotalTokens, LFullResult.Usage.TotalTokens);
|
||||||
|
|
||||||
|
// Persistent System Counter
|
||||||
|
TGlobalQuota.AddTokens(LFullResult.Usage.TotalTokens);
|
||||||
|
end;
|
||||||
|
|
||||||
|
finally
|
||||||
|
stringStream.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
httpClient.Free;
|
||||||
|
requestBody.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := LFullResult;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- JSON Body Construction ---
|
||||||
|
|
||||||
|
function TGeminiClient.BuildJsonBody(const History: TArray<TChatItem>): TJSONObject;
|
||||||
|
var
|
||||||
|
contentsArray, partsArray: TJSONArray;
|
||||||
|
contentObj, partObj: TJSONObject;
|
||||||
|
sysObj, sysPart: TJSONObject;
|
||||||
|
sysPartsArr: TJSONArray;
|
||||||
|
item: TChatItem;
|
||||||
|
genConfig, thinkConfig: TJSONObject;
|
||||||
|
begin
|
||||||
|
Result := TJSONObject.Create;
|
||||||
|
|
||||||
|
// 1. Caching Strategy
|
||||||
|
if not FActiveCacheName.IsEmpty then
|
||||||
|
begin
|
||||||
|
Result.AddPair('cachedContent', FActiveCacheName);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// 2. Dynamic System Instructions (only if no cache active)
|
||||||
|
if not FSystemInstruction.IsEmpty then
|
||||||
|
begin
|
||||||
|
sysObj := TJSONObject.Create;
|
||||||
|
|
||||||
|
sysPartsArr := TJSONArray.Create;
|
||||||
|
sysPart := TJSONObject.Create;
|
||||||
|
sysPart.AddPair('text', FSystemInstruction);
|
||||||
|
sysPartsArr.Add(sysPart);
|
||||||
|
|
||||||
|
sysObj.AddPair('parts', sysPartsArr);
|
||||||
|
Result.AddPair('systemInstruction', sysObj);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 3. Native Thinking Configuration
|
||||||
|
if FEnableThinking then
|
||||||
|
begin
|
||||||
|
thinkConfig := TJSONObject.Create;
|
||||||
|
thinkConfig.AddPair('includeThoughts', TJSONTrue.Create);
|
||||||
|
// 'thinkingLevel' omitted to use model default
|
||||||
|
|
||||||
|
genConfig := TJSONObject.Create;
|
||||||
|
genConfig.AddPair('thinkingConfig', thinkConfig);
|
||||||
|
|
||||||
|
Result.AddPair('generationConfig', genConfig);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 4. Chat Contents
|
||||||
|
contentsArray := TJSONArray.Create;
|
||||||
|
|
||||||
|
for item in History do
|
||||||
|
begin
|
||||||
|
contentObj := TJSONObject.Create;
|
||||||
|
|
||||||
|
// Delphi 13 inline if
|
||||||
|
contentObj.AddPair(
|
||||||
|
'role',
|
||||||
|
if item.Role = TChatRole.User then 'user'
|
||||||
|
else 'model'
|
||||||
|
);
|
||||||
|
|
||||||
|
partObj := TJSONObject.Create;
|
||||||
|
partObj.AddPair('text', item.Text);
|
||||||
|
|
||||||
|
partsArray := TJSONArray.Create;
|
||||||
|
partsArray.Add(partObj);
|
||||||
|
|
||||||
|
contentObj.AddPair('parts', partsArray);
|
||||||
|
contentsArray.Add(contentObj);
|
||||||
|
end;
|
||||||
|
Result.AddPair('contents', contentsArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Response Parsing (Streaming) ---
|
||||||
|
|
||||||
|
procedure TGeminiClient.ProcessStreamData(
|
||||||
|
const Data: TBytes;
|
||||||
|
var Buffer: string;
|
||||||
|
const OnDelta: TStreamCallback;
|
||||||
|
var TotalResult: TGeminiResult
|
||||||
|
);
|
||||||
|
var
|
||||||
|
chunkStr: string;
|
||||||
|
jsonStart, jsonEnd: Integer;
|
||||||
|
jsonSub: string;
|
||||||
|
jsonObj: TJSONObject;
|
||||||
|
candidates, parts: TJSONArray;
|
||||||
|
part, usageObj: TJSONObject;
|
||||||
|
deltaText: string;
|
||||||
|
isDeltaThought: Boolean;
|
||||||
|
braceCount, i: Integer;
|
||||||
|
foundEnd: Boolean;
|
||||||
|
begin
|
||||||
|
chunkStr := TEncoding.UTF8.GetString(Data);
|
||||||
|
Buffer := Buffer + chunkStr;
|
||||||
|
|
||||||
|
// Parse loop to extract complete JSON objects from buffer
|
||||||
|
while True do
|
||||||
|
begin
|
||||||
|
jsonStart := Buffer.IndexOf('{');
|
||||||
|
jsonEnd := -1;
|
||||||
|
if jsonStart < 0 then
|
||||||
|
break;
|
||||||
|
|
||||||
|
// Brackets matching to find end of JSON object
|
||||||
|
braceCount := 0;
|
||||||
|
foundEnd := False;
|
||||||
|
for i := jsonStart to Buffer.Length - 1 do
|
||||||
|
begin
|
||||||
|
if Buffer.Chars[i] = '{' then
|
||||||
|
inc(braceCount)
|
||||||
|
else if Buffer.Chars[i] = '}' then
|
||||||
|
dec(braceCount);
|
||||||
|
|
||||||
|
if (braceCount = 0) then
|
||||||
|
begin
|
||||||
|
jsonEnd := i;
|
||||||
|
foundEnd := True;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not foundEnd then
|
||||||
|
break; // Object incomplete
|
||||||
|
|
||||||
|
jsonSub := Buffer.Substring(jsonStart, jsonEnd - jsonStart + 1);
|
||||||
|
Buffer := Buffer.Substring(jsonEnd + 1);
|
||||||
|
|
||||||
|
jsonObj := TJSONObject.ParseJSONValue(jsonSub) as TJSONObject;
|
||||||
|
if Assigned(jsonObj) then
|
||||||
|
try
|
||||||
|
deltaText := '';
|
||||||
|
isDeltaThought := False;
|
||||||
|
|
||||||
|
candidates := jsonObj.GetValue('candidates') as TJSONArray;
|
||||||
|
if (Assigned(candidates)) and (candidates.Count > 0) then
|
||||||
|
begin
|
||||||
|
var cand := candidates.Items[0] as TJSONObject;
|
||||||
|
var content := cand.GetValue('content') as TJSONObject;
|
||||||
|
if Assigned(content) then
|
||||||
|
begin
|
||||||
|
parts := content.GetValue('parts') as TJSONArray;
|
||||||
|
if (Assigned(parts)) and (parts.Count > 0) then
|
||||||
|
begin
|
||||||
|
part := parts.Items[0] as TJSONObject;
|
||||||
|
deltaText := part.GetValue<string>('text');
|
||||||
|
|
||||||
|
// Check for Native Thinking flag "thought": true
|
||||||
|
part.TryGetValue<Boolean>('thought', isDeltaThought);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
usageObj := jsonObj.GetValue('usageMetadata') as TJSONObject;
|
||||||
|
if Assigned(usageObj) then
|
||||||
|
begin
|
||||||
|
usageObj.TryGetValue<Integer>('promptTokenCount', TotalResult.Usage.PromptTokens);
|
||||||
|
usageObj.TryGetValue<Integer>('candidatesTokenCount', TotalResult.Usage.CandidatesTokens);
|
||||||
|
usageObj.TryGetValue<Integer>('totalTokenCount', TotalResult.Usage.TotalTokens);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not deltaText.IsEmpty then
|
||||||
|
begin
|
||||||
|
// Append to full text (including thoughts)
|
||||||
|
if not isDeltaThought then
|
||||||
|
TotalResult.Text := TotalResult.Text + deltaText;
|
||||||
|
|
||||||
|
// Fire callback
|
||||||
|
if Assigned(OnDelta) then
|
||||||
|
OnDelta(deltaText, isDeltaThought);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
jsonObj.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Response Parsing (Synchronous) ---
|
||||||
|
|
||||||
|
function TGeminiClient.ParseResponse(const JsonStr: string): TGeminiResult;
|
||||||
|
var
|
||||||
|
jsonObj: TJSONObject;
|
||||||
|
candidates, parts: TJSONArray;
|
||||||
|
candidate, content, part, usageObj: TJSONObject;
|
||||||
|
isThought: Boolean;
|
||||||
|
begin
|
||||||
|
Result.Text := '';
|
||||||
|
Result.Usage := Default(TGeminiUsage);
|
||||||
|
Result.IsThought := False;
|
||||||
|
|
||||||
|
jsonObj := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
||||||
|
if not Assigned(jsonObj) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
try
|
||||||
|
candidates := jsonObj.GetValue('candidates') as TJSONArray;
|
||||||
|
if (Assigned(candidates)) and (candidates.Count > 0) then
|
||||||
|
begin
|
||||||
|
candidate := candidates.Items[0] as TJSONObject;
|
||||||
|
content := candidate.GetValue('content') as TJSONObject;
|
||||||
|
if Assigned(content) then
|
||||||
|
begin
|
||||||
|
parts := content.GetValue('parts') as TJSONArray;
|
||||||
|
if (Assigned(parts)) and (parts.Count > 0) then
|
||||||
|
begin
|
||||||
|
part := parts.Items[0] as TJSONObject;
|
||||||
|
Result.Text := part.GetValue<string>('text');
|
||||||
|
|
||||||
|
// Check for thought flag
|
||||||
|
if part.TryGetValue<Boolean>('thought', isThought) then
|
||||||
|
Result.IsThought := isThought;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
usageObj := jsonObj.GetValue('usageMetadata') as TJSONObject;
|
||||||
|
if Assigned(usageObj) then
|
||||||
|
begin
|
||||||
|
usageObj.TryGetValue<Integer>('promptTokenCount', Result.Usage.PromptTokens);
|
||||||
|
usageObj.TryGetValue<Integer>('candidatesTokenCount', Result.Usage.CandidatesTokens);
|
||||||
|
usageObj.TryGetValue<Integer>('totalTokenCount', Result.Usage.TotalTokens);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
jsonObj.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Model Listing ---
|
||||||
|
|
||||||
|
function TGeminiClient.ListModels: TArray<string>;
|
||||||
|
var
|
||||||
|
httpClient: THTTPClient;
|
||||||
|
response: IHTTPResponse;
|
||||||
|
begin
|
||||||
|
SetLength(Result, 0);
|
||||||
|
httpClient := THTTPClient.Create;
|
||||||
|
try
|
||||||
|
httpClient.ConnectionTimeout := 10000;
|
||||||
|
try
|
||||||
|
response := httpClient.Get(FListUrl);
|
||||||
|
if (response.StatusCode = 200) then
|
||||||
|
Result := ParseModels(response.ContentAsString(TEncoding.UTF8));
|
||||||
|
except
|
||||||
|
// Return empty array on error
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
httpClient.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.ParseModels(const JsonStr: string): TArray<string>;
|
||||||
|
var
|
||||||
|
jsonObj: TJSONObject;
|
||||||
|
models, methods: TJSONArray;
|
||||||
|
model: TJSONObject;
|
||||||
|
i, j: Integer;
|
||||||
|
modelName: string;
|
||||||
|
canGen: Boolean;
|
||||||
|
list: TList<string>;
|
||||||
|
begin
|
||||||
|
SetLength(Result, 0);
|
||||||
|
jsonObj := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
||||||
|
if not Assigned(jsonObj) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
list := TList<string>.Create;
|
||||||
|
try
|
||||||
|
models := jsonObj.GetValue('models') as TJSONArray;
|
||||||
|
if Assigned(models) then
|
||||||
|
begin
|
||||||
|
for i := 0 to models.Count - 1 do
|
||||||
|
begin
|
||||||
|
model := models.Items[i] as TJSONObject;
|
||||||
|
modelName := model.GetValue<string>('name');
|
||||||
|
|
||||||
|
if modelName.StartsWith('models/') then
|
||||||
|
modelName := modelName.Substring(7);
|
||||||
|
|
||||||
|
// Filter for Gemini models
|
||||||
|
if not modelName.ToLower.Contains('gemini') then
|
||||||
|
continue;
|
||||||
|
if modelName.ToLower.Contains('embedding') then
|
||||||
|
continue;
|
||||||
|
if modelName.ToLower.Contains('robotics') then
|
||||||
|
continue;
|
||||||
|
if modelName.ToLower.Contains('computer-use') then
|
||||||
|
continue;
|
||||||
|
|
||||||
|
// Filter for Generation capabilities
|
||||||
|
canGen := False;
|
||||||
|
methods := model.GetValue('supportedGenerationMethods') as TJSONArray;
|
||||||
|
if Assigned(methods) then
|
||||||
|
for j := 0 to methods.Count - 1 do
|
||||||
|
if (methods.Items[j].Value = 'generateContent') then
|
||||||
|
begin
|
||||||
|
canGen := True;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if canGen then
|
||||||
|
list.Add(modelName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := list.ToArray;
|
||||||
|
finally
|
||||||
|
list.Free;
|
||||||
|
jsonObj.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Context Caching ---
|
||||||
|
|
||||||
|
function TGeminiClient.CreateCache(const Content: string; const SysInstructions: string; const TTLSeconds: Integer): string;
|
||||||
|
var
|
||||||
|
httpClient: THTTPClient;
|
||||||
|
requestBody: TJSONObject;
|
||||||
|
contentsArray, partsArray: TJSONArray;
|
||||||
|
contentObj, partObj, sysObj: TJSONObject;
|
||||||
|
sysPartsArr: TJSONArray;
|
||||||
|
sysPart: TJSONObject;
|
||||||
|
response: IHTTPResponse;
|
||||||
|
stringStream: TStringStream;
|
||||||
|
cacheUrl: string;
|
||||||
|
respJson: TJSONObject;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
cacheUrl := Format('https://generativelanguage.googleapis.com/v1beta/cachedContents?key=%s', [TNetEncoding.URL.EncodeQuery(FApiKey)]);
|
||||||
|
|
||||||
|
httpClient := THTTPClient.Create;
|
||||||
|
requestBody := TJSONObject.Create;
|
||||||
|
try
|
||||||
|
requestBody.AddPair('model', FModelName);
|
||||||
|
|
||||||
|
partObj := TJSONObject.Create;
|
||||||
|
partObj.AddPair('text', Content);
|
||||||
|
|
||||||
|
partsArray := TJSONArray.Create;
|
||||||
|
partsArray.Add(partObj);
|
||||||
|
|
||||||
|
contentObj := TJSONObject.Create;
|
||||||
|
contentObj.AddPair('parts', partsArray);
|
||||||
|
contentObj.AddPair('role', 'user');
|
||||||
|
|
||||||
|
contentsArray := TJSONArray.Create;
|
||||||
|
contentsArray.Add(contentObj);
|
||||||
|
requestBody.AddPair('contents', contentsArray);
|
||||||
|
|
||||||
|
if not SysInstructions.IsEmpty then
|
||||||
|
begin
|
||||||
|
sysObj := TJSONObject.Create;
|
||||||
|
|
||||||
|
sysPartsArr := TJSONArray.Create;
|
||||||
|
sysPart := TJSONObject.Create;
|
||||||
|
sysPart.AddPair('text', SysInstructions);
|
||||||
|
sysPartsArr.Add(sysPart);
|
||||||
|
|
||||||
|
sysObj.AddPair('parts', sysPartsArr);
|
||||||
|
requestBody.AddPair('systemInstruction', sysObj);
|
||||||
|
end;
|
||||||
|
|
||||||
|
requestBody.AddPair('ttl', IntToStr(TTLSeconds) + 's');
|
||||||
|
|
||||||
|
stringStream := TStringStream.Create(requestBody.ToString, TEncoding.UTF8);
|
||||||
|
try
|
||||||
|
httpClient.CustomHeaders['Content-Type'] := 'application/json';
|
||||||
|
try
|
||||||
|
response := httpClient.Post(cacheUrl, stringStream);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
raise Exception.Create('Cache Creation Failed: ' + E.Message);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Success is 200 OK or 201 Created
|
||||||
|
if (response.StatusCode = 200) or (response.StatusCode = 201) then
|
||||||
|
begin
|
||||||
|
respJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8)) as TJSONObject;
|
||||||
|
try
|
||||||
|
if Assigned(respJson) then
|
||||||
|
Result := respJson.GetValue<string>('name');
|
||||||
|
finally
|
||||||
|
respJson.Free;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
raise Exception.CreateFmt('Cache Error %d: %s', [response.StatusCode, response.ContentAsString(TEncoding.UTF8)]);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
stringStream.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
httpClient.Free;
|
||||||
|
requestBody.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGeminiClient.StartChat: IGeminiChat;
|
||||||
|
begin
|
||||||
|
Result := TChatSession.Create(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- TChatSession Implementation ---
|
||||||
|
|
||||||
|
constructor TChatSession.Create(const Client: IGeminiClient);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FClient := Client;
|
||||||
|
FHistory := TList<TChatItem>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TChatSession.Destroy;
|
||||||
|
begin
|
||||||
|
FHistory.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChatSession.SendMessage(const Text: string): TGeminiResult;
|
||||||
|
var
|
||||||
|
item: TChatItem;
|
||||||
|
begin
|
||||||
|
item.Role := TChatRole.User;
|
||||||
|
item.Text := Text;
|
||||||
|
FHistory.Add(item);
|
||||||
|
|
||||||
|
Result := FClient.GenerateContent(FHistory.ToArray);
|
||||||
|
|
||||||
|
if not Result.Text.IsEmpty and not Result.Text.StartsWith('Error') then
|
||||||
|
begin
|
||||||
|
item.Role := TChatRole.Model;
|
||||||
|
item.Text := Result.Text;
|
||||||
|
FHistory.Add(item);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChatSession.SendMessageStream(const Text: string; const OnDelta: TStreamCallback): TGeminiResult;
|
||||||
|
var
|
||||||
|
item: TChatItem;
|
||||||
|
begin
|
||||||
|
item.Role := TChatRole.User;
|
||||||
|
item.Text := Text;
|
||||||
|
FHistory.Add(item);
|
||||||
|
|
||||||
|
Result := FClient.GenerateContentStream(FHistory.ToArray, OnDelta);
|
||||||
|
|
||||||
|
if not Result.Text.IsEmpty and not Result.Text.StartsWith('Error') then
|
||||||
|
begin
|
||||||
|
item.Role := TChatRole.Model;
|
||||||
|
item.Text := Result.Text;
|
||||||
|
FHistory.Add(item);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChatSession.GetHistory: TArray<TChatItem>;
|
||||||
|
begin
|
||||||
|
Result := FHistory.ToArray;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,197 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||||
|
|
||||||
|
<script src="https://cdn.jsdelivr.net/npm/marked/marked.min.js"></script>
|
||||||
|
<script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/highlight.min.js"></script>
|
||||||
|
<script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/languages/delphi.min.js"></script>
|
||||||
|
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/github.min.css">
|
||||||
|
|
||||||
|
<style>
|
||||||
|
body {
|
||||||
|
font-family: "Segoe UI Variable Text", "Segoe UI", sans-serif;
|
||||||
|
font-size: 14px; line-height: 1.5; padding: 16px; margin: 0; background: #fff;
|
||||||
|
-webkit-font-smoothing: antialiased;
|
||||||
|
}
|
||||||
|
#history { display: flex; flex-direction: column; gap: 12px; }
|
||||||
|
#active { margin-top: 12px; }
|
||||||
|
|
||||||
|
.block-header {
|
||||||
|
font-family: "Segoe UI Variable Display", sans-serif;
|
||||||
|
font-weight: 600; font-size: 11px; text-transform: uppercase;
|
||||||
|
color: #0078d4; border-bottom: 1px solid #f0f0f0; margin-bottom: 6px;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Raw Text Blocks */
|
||||||
|
.raw-wrapper {
|
||||||
|
background-color: #f3f2f1;
|
||||||
|
border: 1px solid #edebe9;
|
||||||
|
border-radius: 4px;
|
||||||
|
margin: 4px 0;
|
||||||
|
display: flex; flex-direction: column;
|
||||||
|
}
|
||||||
|
.raw-header {
|
||||||
|
padding: 6px 10px; font-size: 11px; font-weight: bold; color: #323130;
|
||||||
|
background: #faf9f8; display: flex; align-items: center;
|
||||||
|
border-bottom: 1px solid transparent; cursor: pointer; user-select: none;
|
||||||
|
}
|
||||||
|
.raw-header:hover { background: #f0f0f0; color: #0078d4; }
|
||||||
|
.icon-svg {
|
||||||
|
width: 14px; height: 14px; margin-right: 8px;
|
||||||
|
fill: none; stroke: currentColor; stroke-width: 2;
|
||||||
|
stroke-linecap: round; stroke-linejoin: round;
|
||||||
|
transition: transform 0.2s;
|
||||||
|
}
|
||||||
|
.raw-content {
|
||||||
|
font-family: "Cascadia Code", "Consolas", monospace;
|
||||||
|
font-size: 12.5px; white-space: pre-wrap;
|
||||||
|
padding: 10px; margin: 0; overflow: hidden; color: #201f1e;
|
||||||
|
}
|
||||||
|
.collapsed .raw-content { display: -webkit-box; -webkit-line-clamp: 3; -webkit-box-orient: vertical; }
|
||||||
|
.collapsed .icon-svg { transform: rotate(-90deg); }
|
||||||
|
.expanded .icon-svg { transform: rotate(0deg); }
|
||||||
|
.expanded .raw-header { border-bottom-color: #edebe9; }
|
||||||
|
|
||||||
|
/* Markdown Specifics */
|
||||||
|
blockquote { border-left: 4px solid #0078d4; padding-left: 12px; color: #605e5c; }
|
||||||
|
|
||||||
|
/* Code Blocks & Copy Button */
|
||||||
|
.code-wrapper { position: relative; margin: 1em 0; }
|
||||||
|
pre { background: #f6f8fa; padding: 12px; border: 1px solid #d0d7de; border-radius: 6px; overflow-x: auto; margin: 0; }
|
||||||
|
code { font-family: "Cascadia Code", Consolas, monospace; font-size: 90%; }
|
||||||
|
|
||||||
|
.copy-btn {
|
||||||
|
position: sticky; top: 10px; float: right; z-index: 10;
|
||||||
|
margin-top: 10px; margin-bottom: -42px; margin-right: 10px;
|
||||||
|
display: flex; align-items: center; justify-content: center;
|
||||||
|
width: 32px; height: 32px;
|
||||||
|
background-color: rgba(255, 255, 255, 0.8); backdrop-filter: blur(2px);
|
||||||
|
border: 1px solid #d0d7de; border-radius: 6px;
|
||||||
|
cursor: pointer; color: #57606a; transition: all 0.2s;
|
||||||
|
}
|
||||||
|
.copy-btn:hover { background-color: #ffffff; color: #0969da; border-color: #0969da; box-shadow: 0 1px 3px rgba(0,0,0,0.1); }
|
||||||
|
.copy-btn:active { background-color: #edeff2; transform: translateY(1px); }
|
||||||
|
.copy-btn svg { fill: currentColor; }
|
||||||
|
</style>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<div id="history"></div>
|
||||||
|
<div id="active"></div>
|
||||||
|
|
||||||
|
<script>
|
||||||
|
const historyDiv = document.getElementById("history");
|
||||||
|
const activeDiv = document.getElementById("active");
|
||||||
|
let currentMode = "markdown";
|
||||||
|
let currentTitle = "";
|
||||||
|
let currentBuffer = "";
|
||||||
|
|
||||||
|
// Icons
|
||||||
|
const chevronSvg = '<svg class="icon-svg" viewBox="0 0 24 24"><polyline points="6 9 12 15 18 9"></polyline></svg>';
|
||||||
|
const iconCopy = '<svg viewBox="0 0 16 16" width="16" height="16"><path d="M0 6.75C0 5.784.784 5 1.75 5h1.5a.75.75 0 0 1 0 1.5h-1.5a.25.25 0 0 0-.25.25v7.5c0 .138.112.25.25.25h7.5a.25.25 0 0 0 .25-.25v-1.5a.75.75 0 0 1 1.5 0v1.5A1.75 1.75 0 0 1 9.25 16h-7.5A1.75 1.75 0 0 1 0 14.25Z"></path><path d="M5 1.75C5 .784 5.784 0 6.75 0h7.5C15.216 0 16 .784 16 1.75v7.5A1.75 1.75 0 0 1 14.25 11h-7.5A1.75 1.75 0 0 1 5 9.25Zm1.75-.25a.25.25 0 0 0-.25.25v7.5c0 .138.112.25.25.25h7.5a.25.25 0 0 0 .25-.25v-7.5a.25.25 0 0 0-.25-.25Z"></path></svg>';
|
||||||
|
const iconCheck = '<svg viewBox="0 0 16 16" width="16" height="16" style="color: #2da44e"><path d="M13.78 4.22a.75.75 0 0 1 0 1.06l-7.25 7.25a.75.75 0 0 1-1.06 0L2.22 9.28a.751.751 0 0 1 .018-1.042.751.751 0 0 1 1.042-.018L6 10.94l6.72-6.72a.75.75 0 0 1 1.06 0Z"></path></svg>';
|
||||||
|
|
||||||
|
function toggleBlock(header) {
|
||||||
|
const wrapper = header.closest('.raw-wrapper');
|
||||||
|
if (wrapper.classList.contains('collapsed')) {
|
||||||
|
wrapper.classList.replace('collapsed', 'expanded');
|
||||||
|
} else {
|
||||||
|
wrapper.classList.replace('expanded', 'collapsed');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function addCopyButtons(container) {
|
||||||
|
const pres = container.querySelectorAll("pre");
|
||||||
|
pres.forEach(function(preBlock) {
|
||||||
|
if (preBlock.parentNode.classList.contains("code-wrapper")) return;
|
||||||
|
|
||||||
|
const wrapper = document.createElement("div");
|
||||||
|
wrapper.className = "code-wrapper";
|
||||||
|
preBlock.parentNode.insertBefore(wrapper, preBlock);
|
||||||
|
wrapper.appendChild(preBlock);
|
||||||
|
|
||||||
|
const button = document.createElement("button");
|
||||||
|
button.className = "copy-btn";
|
||||||
|
button.innerHTML = iconCopy;
|
||||||
|
button.title = "Copy to Clipboard";
|
||||||
|
|
||||||
|
button.addEventListener("click", function() {
|
||||||
|
const code = preBlock.querySelector("code");
|
||||||
|
if (!code) return;
|
||||||
|
const text = code.innerText;
|
||||||
|
navigator.clipboard.writeText(text).then(function() {
|
||||||
|
button.innerHTML = iconCheck;
|
||||||
|
setTimeout(function() { button.innerHTML = iconCopy; }, 2000);
|
||||||
|
}, function(err) { console.error("Clipboard failed", err); });
|
||||||
|
});
|
||||||
|
|
||||||
|
wrapper.insertBefore(button, preBlock);
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
function renderTo(target, content, mode, title, isFinal) {
|
||||||
|
target.innerHTML = "";
|
||||||
|
if (mode === "markdown") {
|
||||||
|
if (title) {
|
||||||
|
const h = document.createElement("div");
|
||||||
|
h.className = "block-header";
|
||||||
|
h.innerText = title;
|
||||||
|
target.appendChild(h);
|
||||||
|
}
|
||||||
|
const c = document.createElement("div");
|
||||||
|
c.innerHTML = (typeof marked !== "undefined") ? marked.parse(content) : content;
|
||||||
|
target.appendChild(c);
|
||||||
|
|
||||||
|
// Highlight and add Copy Buttons
|
||||||
|
if (typeof hljs !== "undefined") {
|
||||||
|
c.querySelectorAll("pre code").forEach((block) => { hljs.highlightElement(block); });
|
||||||
|
}
|
||||||
|
addCopyButtons(c);
|
||||||
|
|
||||||
|
} else if (mode === "text") {
|
||||||
|
const wrapper = document.createElement("div");
|
||||||
|
wrapper.className = "raw-wrapper " + (isFinal ? "collapsed" : "expanded");
|
||||||
|
|
||||||
|
const header = document.createElement("div");
|
||||||
|
header.className = "raw-header";
|
||||||
|
header.onclick = function() { toggleBlock(this); };
|
||||||
|
header.innerHTML = chevronSvg + '<span>' + (title || "Raw Output") + '</span>';
|
||||||
|
|
||||||
|
const code = document.createElement("pre");
|
||||||
|
code.className = "raw-content";
|
||||||
|
code.innerText = content;
|
||||||
|
|
||||||
|
wrapper.appendChild(header);
|
||||||
|
wrapper.appendChild(code);
|
||||||
|
target.appendChild(wrapper);
|
||||||
|
} else {
|
||||||
|
target.innerHTML = content;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
window.startBlock = function(payload) {
|
||||||
|
const parts = payload.split('|');
|
||||||
|
if (currentBuffer.length > 0) {
|
||||||
|
const oldBlock = document.createElement("div");
|
||||||
|
renderTo(oldBlock, currentBuffer, currentMode, currentTitle, true);
|
||||||
|
historyDiv.appendChild(oldBlock);
|
||||||
|
}
|
||||||
|
currentMode = parts[0];
|
||||||
|
currentTitle = parts[1] || "";
|
||||||
|
currentBuffer = "";
|
||||||
|
activeDiv.innerHTML = "";
|
||||||
|
};
|
||||||
|
|
||||||
|
window.appendData = function(chunk) {
|
||||||
|
currentBuffer += chunk;
|
||||||
|
renderTo(activeDiv, currentBuffer, currentMode, currentTitle, false);
|
||||||
|
window.scrollTo(0, document.body.scrollHeight);
|
||||||
|
};
|
||||||
|
|
||||||
|
window.clearAll = function() {
|
||||||
|
currentBuffer = ""; activeDiv.innerHTML = ""; historyDiv.innerHTML = "";
|
||||||
|
};
|
||||||
|
</script>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@@ -0,0 +1,212 @@
|
|||||||
|
unit Myc.Api.MarkdownStream;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.IOUtils,
|
||||||
|
System.Threading,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.JSON,
|
||||||
|
System.Types,
|
||||||
|
FMX.WebBrowser;
|
||||||
|
|
||||||
|
type
|
||||||
|
TBlockType = (btMarkdown, btRawText, btHtml);
|
||||||
|
|
||||||
|
// Manages an incremental Markdown/HTML stream within a TWebBrowser.
|
||||||
|
// Supports block-based rendering and collapsible raw text sections.
|
||||||
|
IMarkdownStream = interface
|
||||||
|
procedure InitializeBrowser(const Browser: TWebBrowser);
|
||||||
|
procedure BeginBlock(const AType: TBlockType; const ATitle: string = '');
|
||||||
|
procedure Append(const Content: string);
|
||||||
|
procedure Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TMarkdownStream = class(TInterfacedObject, IMarkdownStream)
|
||||||
|
strict private
|
||||||
|
type
|
||||||
|
TCmd = record
|
||||||
|
Func: string;
|
||||||
|
Arg: string;
|
||||||
|
constructor Create(const F, A: string);
|
||||||
|
end;
|
||||||
|
strict private
|
||||||
|
FBrowser: TWebBrowser;
|
||||||
|
FIsReady: Boolean;
|
||||||
|
FCommandQueue: TList<TCmd>;
|
||||||
|
FTempFileName: string;
|
||||||
|
|
||||||
|
procedure OnDidFinishLoad(Sender: TObject);
|
||||||
|
function GetBaseHtml: string;
|
||||||
|
procedure ExecuteJS(const FunctionName, Data: string);
|
||||||
|
procedure FlushQueue;
|
||||||
|
function BlockTypeToString(const AType: TBlockType): string;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure InitializeBrowser(const Browser: TWebBrowser);
|
||||||
|
|
||||||
|
procedure BeginBlock(const AType: TBlockType; const ATitle: string = '');
|
||||||
|
procedure Append(const Content: string);
|
||||||
|
procedure Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TMarkdownStream.TCmd }
|
||||||
|
|
||||||
|
constructor TMarkdownStream.TCmd.Create(const F, A: string);
|
||||||
|
begin
|
||||||
|
Func := F;
|
||||||
|
Arg := A;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMarkdownStream }
|
||||||
|
|
||||||
|
constructor TMarkdownStream.Create;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FCommandQueue := TList<TCmd>.Create;
|
||||||
|
FIsReady := False;
|
||||||
|
FTempFileName := TPath.Combine(TPath.GetTempPath, 'myc_md_stream.html');
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMarkdownStream.Destroy;
|
||||||
|
begin
|
||||||
|
if Assigned(FBrowser) then
|
||||||
|
FBrowser.OnDidFinishLoad := nil;
|
||||||
|
FCommandQueue.Free;
|
||||||
|
if FileExists(FTempFileName) then
|
||||||
|
try
|
||||||
|
TFile.Delete(FTempFileName);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.InitializeBrowser(const Browser: TWebBrowser);
|
||||||
|
begin
|
||||||
|
FBrowser := Browser;
|
||||||
|
FIsReady := False;
|
||||||
|
FCommandQueue.Clear;
|
||||||
|
|
||||||
|
if Assigned(FBrowser) then
|
||||||
|
begin
|
||||||
|
FBrowser.OnDidFinishLoad := OnDidFinishLoad;
|
||||||
|
try
|
||||||
|
TFile.WriteAllText(FTempFileName, GetBaseHtml, TEncoding.UTF8);
|
||||||
|
FBrowser.Navigate('file://' + FTempFileName);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.OnDidFinishLoad(Sender: TObject);
|
||||||
|
begin
|
||||||
|
TThread.ForceQueue(
|
||||||
|
nil,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
FIsReady := True;
|
||||||
|
FlushQueue;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.FlushQueue;
|
||||||
|
var
|
||||||
|
cmd: TCmd;
|
||||||
|
begin
|
||||||
|
if not Assigned(FBrowser) then
|
||||||
|
exit;
|
||||||
|
for cmd in FCommandQueue do
|
||||||
|
ExecuteJS(cmd.Func, cmd.Arg);
|
||||||
|
FCommandQueue.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMarkdownStream.BlockTypeToString(const AType: TBlockType): string;
|
||||||
|
begin
|
||||||
|
case AType of
|
||||||
|
btMarkdown: Result := 'markdown';
|
||||||
|
btRawText: Result := 'text';
|
||||||
|
btHtml: Result := 'html';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.BeginBlock(const AType: TBlockType; const ATitle: string);
|
||||||
|
var
|
||||||
|
payload: string;
|
||||||
|
begin
|
||||||
|
payload := BlockTypeToString(AType) + '|' + ATitle;
|
||||||
|
if FIsReady then
|
||||||
|
ExecuteJS('startBlock', payload)
|
||||||
|
else
|
||||||
|
FCommandQueue.Add(TCmd.Create('startBlock', payload));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.Append(const Content: string);
|
||||||
|
begin
|
||||||
|
if Content.IsEmpty then
|
||||||
|
exit;
|
||||||
|
if FIsReady then
|
||||||
|
ExecuteJS('appendData', Content)
|
||||||
|
else
|
||||||
|
FCommandQueue.Add(TCmd.Create('appendData', Content));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.Clear;
|
||||||
|
begin
|
||||||
|
FCommandQueue.Clear;
|
||||||
|
if FIsReady then
|
||||||
|
ExecuteJS('clearAll', '')
|
||||||
|
else
|
||||||
|
FCommandQueue.Add(TCmd.Create('clearAll', ''));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMarkdownStream.ExecuteJS(const FunctionName, Data: string);
|
||||||
|
var
|
||||||
|
jsCommand: string;
|
||||||
|
jsonVal: TJSONValue;
|
||||||
|
begin
|
||||||
|
if not Assigned(FBrowser) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
// Sicherer Umgang mit leeren Daten und korrektes Escaping
|
||||||
|
jsonVal := TJSONString.Create(Data);
|
||||||
|
try
|
||||||
|
jsCommand := Format('window.%s(%s);', [FunctionName, jsonVal.ToJSON]);
|
||||||
|
try
|
||||||
|
FBrowser.EvaluateJavaScript(jsCommand);
|
||||||
|
except
|
||||||
|
// Browser-Context evtl. während der Zerstörung nicht mehr valide
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
jsonVal.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMarkdownStream.GetBaseHtml: string;
|
||||||
|
var
|
||||||
|
rs: TResourceStream;
|
||||||
|
ss: TStringStream;
|
||||||
|
begin
|
||||||
|
// Load HTML template from embedded resource (which is Myc.Api.MarkdownStream.Base.html)
|
||||||
|
rs := TResourceStream.Create(HInstance, 'BASE_HTML', RT_RCDATA);
|
||||||
|
try
|
||||||
|
ss := TStringStream.Create('', TEncoding.UTF8);
|
||||||
|
try
|
||||||
|
ss.CopyFrom(rs, 0);
|
||||||
|
Result := ss.DataString;
|
||||||
|
finally
|
||||||
|
ss.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
rs.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,254 @@
|
|||||||
|
unit Myc.System.Quota;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Win.Registry,
|
||||||
|
Winapi.Windows,
|
||||||
|
System.Classes;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Handles global quota tracking via Windows Registry
|
||||||
|
TGlobalQuota = class
|
||||||
|
private
|
||||||
|
const
|
||||||
|
REG_KEY = 'Software\Myc\GeminiTools\Quota';
|
||||||
|
|
||||||
|
// Value names
|
||||||
|
const
|
||||||
|
VAL_TOTAL_TOKENS = 'TotalTokens';
|
||||||
|
const
|
||||||
|
VAL_DAILY_TOKENS = 'DailyTokens';
|
||||||
|
const
|
||||||
|
VAL_LAST_RESET = 'LastReset'; // Manual reset timestamp
|
||||||
|
const
|
||||||
|
VAL_LAST_UPDATE = 'LastUpdate'; // Last modification timestamp
|
||||||
|
const
|
||||||
|
VAL_DAILY_DATE = 'DailyDate'; // Date for the daily counter reference
|
||||||
|
|
||||||
|
public
|
||||||
|
// Adds tokens to global and daily counters thread-safely
|
||||||
|
// Automatically resets the daily counter if the day has changed
|
||||||
|
class procedure AddTokens(Count: Integer);
|
||||||
|
|
||||||
|
// Reads the all-time total from registry
|
||||||
|
class function GetTotal: Int64;
|
||||||
|
|
||||||
|
// Reads the accumulated tokens for the current day
|
||||||
|
class function GetDailyTotal: Int64;
|
||||||
|
|
||||||
|
// Returns the date and time of the last modification (AddTokens)
|
||||||
|
class function GetLastUpdate: TDateTime;
|
||||||
|
|
||||||
|
// Returns the date and time of the last manual reset
|
||||||
|
class function GetLastReset: TDateTime;
|
||||||
|
|
||||||
|
// Resets all counters (Total and Daily) to zero
|
||||||
|
class procedure Reset;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TGlobalQuota }
|
||||||
|
|
||||||
|
class procedure TGlobalQuota.AddTokens(Count: Integer);
|
||||||
|
var
|
||||||
|
reg: TRegistry;
|
||||||
|
mutex: THandle;
|
||||||
|
totalTokens, dailyTokens: Int64;
|
||||||
|
strValue: string;
|
||||||
|
lastDailyDate, today: TDateTime;
|
||||||
|
begin
|
||||||
|
if Count <= 0 then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
// Use a named mutex to prevent race conditions between different processes
|
||||||
|
mutex := CreateMutex(nil, False, 'GlobalGeminiQuotaMutex');
|
||||||
|
if WaitForSingleObject(mutex, 2000) = WAIT_OBJECT_0 then
|
||||||
|
try
|
||||||
|
reg := TRegistry.Create(KEY_READ or KEY_WRITE);
|
||||||
|
try
|
||||||
|
reg.RootKey := HKEY_CURRENT_USER;
|
||||||
|
if reg.OpenKey(REG_KEY, True) then
|
||||||
|
begin
|
||||||
|
// 1. Handle Total Tokens
|
||||||
|
totalTokens := 0;
|
||||||
|
if reg.ValueExists(VAL_TOTAL_TOKENS) then
|
||||||
|
begin
|
||||||
|
strValue := reg.ReadString(VAL_TOTAL_TOKENS);
|
||||||
|
TryStrToInt64(strValue, totalTokens);
|
||||||
|
end;
|
||||||
|
totalTokens := totalTokens + Count;
|
||||||
|
|
||||||
|
// 2. Handle Daily Tokens
|
||||||
|
dailyTokens := 0;
|
||||||
|
lastDailyDate := 0;
|
||||||
|
today := Trunc(Now); // Date part only
|
||||||
|
|
||||||
|
if reg.ValueExists(VAL_DAILY_DATE) then
|
||||||
|
lastDailyDate := reg.ReadDate(VAL_DAILY_DATE);
|
||||||
|
|
||||||
|
// Check if we are on a new day
|
||||||
|
if lastDailyDate = today then
|
||||||
|
begin
|
||||||
|
// Same day, read existing daily count
|
||||||
|
if reg.ValueExists(VAL_DAILY_TOKENS) then
|
||||||
|
begin
|
||||||
|
strValue := reg.ReadString(VAL_DAILY_TOKENS);
|
||||||
|
TryStrToInt64(strValue, dailyTokens);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// New day (or first run), dailyTokens remains 0
|
||||||
|
// Update the reference date
|
||||||
|
reg.WriteDate(VAL_DAILY_DATE, today);
|
||||||
|
end;
|
||||||
|
|
||||||
|
dailyTokens := dailyTokens + Count;
|
||||||
|
|
||||||
|
// 3. Write updates
|
||||||
|
// Store numbers as String to support Int64 (Registry WriteInteger is 32-bit in older API wrappers)
|
||||||
|
reg.WriteString(VAL_TOTAL_TOKENS, totalTokens.ToString);
|
||||||
|
reg.WriteString(VAL_DAILY_TOKENS, dailyTokens.ToString);
|
||||||
|
reg.WriteDateTime(VAL_LAST_UPDATE, Now);
|
||||||
|
|
||||||
|
reg.CloseKey;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
ReleaseMutex(mutex);
|
||||||
|
CloseHandle(mutex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TGlobalQuota.GetTotal: Int64;
|
||||||
|
var
|
||||||
|
reg: TRegistry;
|
||||||
|
strValue: string;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
reg := TRegistry.Create(KEY_READ);
|
||||||
|
try
|
||||||
|
reg.RootKey := HKEY_CURRENT_USER;
|
||||||
|
if reg.OpenKey(REG_KEY, False) then
|
||||||
|
begin
|
||||||
|
if reg.ValueExists(VAL_TOTAL_TOKENS) then
|
||||||
|
begin
|
||||||
|
strValue := reg.ReadString(VAL_TOTAL_TOKENS);
|
||||||
|
TryStrToInt64(strValue, Result);
|
||||||
|
end;
|
||||||
|
reg.CloseKey;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TGlobalQuota.GetDailyTotal: Int64;
|
||||||
|
var
|
||||||
|
reg: TRegistry;
|
||||||
|
strValue: string;
|
||||||
|
lastDailyDate: TDateTime;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
reg := TRegistry.Create(KEY_READ);
|
||||||
|
try
|
||||||
|
reg.RootKey := HKEY_CURRENT_USER;
|
||||||
|
if reg.OpenKey(REG_KEY, False) then
|
||||||
|
begin
|
||||||
|
// Check if the stored daily count belongs to today
|
||||||
|
if reg.ValueExists(VAL_DAILY_DATE) then
|
||||||
|
begin
|
||||||
|
lastDailyDate := reg.ReadDate(VAL_DAILY_DATE);
|
||||||
|
if lastDailyDate = Trunc(Now) then
|
||||||
|
begin
|
||||||
|
if reg.ValueExists(VAL_DAILY_TOKENS) then
|
||||||
|
begin
|
||||||
|
strValue := reg.ReadString(VAL_DAILY_TOKENS);
|
||||||
|
TryStrToInt64(strValue, Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// If date differs, Result remains 0 (logic effectively resets on read, though write happens in AddTokens)
|
||||||
|
end;
|
||||||
|
reg.CloseKey;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TGlobalQuota.GetLastUpdate: TDateTime;
|
||||||
|
var
|
||||||
|
reg: TRegistry;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
reg := TRegistry.Create(KEY_READ);
|
||||||
|
try
|
||||||
|
reg.RootKey := HKEY_CURRENT_USER;
|
||||||
|
if reg.OpenKey(REG_KEY, False) then
|
||||||
|
begin
|
||||||
|
if reg.ValueExists(VAL_LAST_UPDATE) then
|
||||||
|
Result := reg.ReadDateTime(VAL_LAST_UPDATE);
|
||||||
|
reg.CloseKey;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TGlobalQuota.GetLastReset: TDateTime;
|
||||||
|
var
|
||||||
|
reg: TRegistry;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
reg := TRegistry.Create(KEY_READ);
|
||||||
|
try
|
||||||
|
reg.RootKey := HKEY_CURRENT_USER;
|
||||||
|
if reg.OpenKey(REG_KEY, False) then
|
||||||
|
begin
|
||||||
|
if reg.ValueExists(VAL_LAST_RESET) then
|
||||||
|
Result := reg.ReadDateTime(VAL_LAST_RESET);
|
||||||
|
reg.CloseKey;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TGlobalQuota.Reset;
|
||||||
|
var
|
||||||
|
reg: TRegistry;
|
||||||
|
mutex: THandle;
|
||||||
|
begin
|
||||||
|
// Reset also needs Mutex protection to avoid conflicting writes with AddTokens
|
||||||
|
mutex := CreateMutex(nil, False, 'GlobalGeminiQuotaMutex');
|
||||||
|
if WaitForSingleObject(mutex, 2000) = WAIT_OBJECT_0 then
|
||||||
|
try
|
||||||
|
reg := TRegistry.Create(KEY_WRITE);
|
||||||
|
try
|
||||||
|
reg.RootKey := HKEY_CURRENT_USER;
|
||||||
|
if reg.OpenKey(REG_KEY, True) then
|
||||||
|
begin
|
||||||
|
reg.WriteString(VAL_TOTAL_TOKENS, '0');
|
||||||
|
reg.WriteString(VAL_DAILY_TOKENS, '0');
|
||||||
|
reg.WriteDate(VAL_DAILY_DATE, Trunc(Now));
|
||||||
|
reg.WriteDateTime(VAL_LAST_RESET, Now);
|
||||||
|
// We typically update LastUpdate on reset as well, or leave it as the last "Add" action.
|
||||||
|
// Here we update it to indicate change.
|
||||||
|
reg.WriteDateTime(VAL_LAST_UPDATE, Now);
|
||||||
|
reg.CloseKey;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
reg.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
ReleaseMutex(mutex);
|
||||||
|
CloseHandle(mutex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,10 @@
|
|||||||
|
unit ApiKey;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
const
|
||||||
|
Value = 'AIzaSyALccoMxn0_wcHswavhu5rzdglLeH6gVlI';
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,16 @@
|
|||||||
|
program GeminiAccess;
|
||||||
|
|
||||||
|
uses
|
||||||
|
FastMM5,
|
||||||
|
Vcl.Forms,
|
||||||
|
MainUnit in 'MainUnit.pas' {Form1},
|
||||||
|
ApiKey in 'ApiKey.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,52 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 1011
|
||||||
|
ClientWidth = 1105
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -12
|
||||||
|
Font.Name = 'Segoe UI'
|
||||||
|
Font.Style = []
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
DesignSize = (
|
||||||
|
1105
|
||||||
|
1011)
|
||||||
|
TextHeight = 15
|
||||||
|
object AnswerMemo: TMemo
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Width = 1105
|
||||||
|
Height = 809
|
||||||
|
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||||
|
ScrollBars = ssVertical
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object ExecButton: TButton
|
||||||
|
Left = 992
|
||||||
|
Top = 928
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Caption = 'Execute'
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = ExecButtonClick
|
||||||
|
end
|
||||||
|
object PromptMemo: TMemo
|
||||||
|
Left = 0
|
||||||
|
Top = 815
|
||||||
|
Width = 1105
|
||||||
|
Height = 89
|
||||||
|
Anchors = [akLeft, akRight, akBottom]
|
||||||
|
ScrollBars = ssVertical
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object ApplicationEvents: TApplicationEvents
|
||||||
|
OnIdle = ApplicationEventsIdle
|
||||||
|
Left = 136
|
||||||
|
Top = 104
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -0,0 +1,228 @@
|
|||||||
|
unit MainUnit;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Winapi.Windows,
|
||||||
|
Winapi.Messages,
|
||||||
|
System.SysUtils,
|
||||||
|
System.Variants,
|
||||||
|
System.Classes,
|
||||||
|
Vcl.Graphics,
|
||||||
|
Vcl.Controls,
|
||||||
|
Vcl.Forms,
|
||||||
|
Vcl.Dialogs,
|
||||||
|
Vcl.StdCtrls,
|
||||||
|
System.Net.HttpClient,
|
||||||
|
System.Net.HttpClientComponent,
|
||||||
|
System.JSON,
|
||||||
|
System.Net.Mime,
|
||||||
|
Vcl.AppEvnts,
|
||||||
|
Myc.Futures,
|
||||||
|
System.Generics.Collections,
|
||||||
|
ApiKey;
|
||||||
|
|
||||||
|
type
|
||||||
|
// NEU: Ein Record, um einen einzelnen Redebeitrag in der Konversation zu speichern
|
||||||
|
TChatTurn = record
|
||||||
|
Role: string; // 'user' oder 'model'
|
||||||
|
Text: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
AnswerMemo: TMemo;
|
||||||
|
ExecButton: TButton;
|
||||||
|
ApplicationEvents: TApplicationEvents;
|
||||||
|
PromptMemo: TMemo;
|
||||||
|
procedure ExecButtonClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
|
||||||
|
private
|
||||||
|
FHttpClient: TNetHTTPClient;
|
||||||
|
FMyApiKey: string;
|
||||||
|
FAnswer: TFuture<String>;
|
||||||
|
FChatHistory: TList<TChatTurn>; // NEU: Liste für den Konversationsverlauf
|
||||||
|
procedure SendPrompt;
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
const
|
||||||
|
GEMINI_MODEL = 'gemini-2.5-flash-preview-05-20';
|
||||||
|
API_BASE_URL = 'https://generativelanguage.googleapis.com/v1beta/models/';
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FHttpClient := TNetHTTPClient.Create(nil);
|
||||||
|
FMyApiKey := ApiKey.Value; // Eingelesen aus ApiKey.pas
|
||||||
|
|
||||||
|
// NEU: Initialisiert die Liste für den Konversationsverlauf
|
||||||
|
FChatHistory := TList<TChatTurn>.Create;
|
||||||
|
|
||||||
|
// Optional: Füge hier einen initialen System-Prompt hinzu, wenn gewünscht.
|
||||||
|
// Dieser wird dann immer als erste Nachricht mitgesendet.
|
||||||
|
// var initialTurn: TChatTurn;
|
||||||
|
// initialTurn.Role := 'user';
|
||||||
|
// initialTurn.Text := 'Du bist ein Delphi-Entwicklungs-Assistent...';
|
||||||
|
// FChatHistory.Add(initialTurn);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FAnswer.WaitFor;
|
||||||
|
FHttpClient.Free;
|
||||||
|
FChatHistory.Free; // NEU: Gibt die Verlaufsliste frei
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
|
||||||
|
var
|
||||||
|
answerText: string;
|
||||||
|
modelTurn: TChatTurn;
|
||||||
|
begin
|
||||||
|
if FAnswer.Done.IsSet and not ExecButton.Enabled then
|
||||||
|
begin
|
||||||
|
answerText := FAnswer.Value;
|
||||||
|
AnswerMemo.Lines.Add(answerText);
|
||||||
|
|
||||||
|
// NEU: Füge die Antwort des Modells zum Verlauf hinzu
|
||||||
|
if not answerText.StartsWith('Fehler!') then
|
||||||
|
begin
|
||||||
|
modelTurn.Role := 'model';
|
||||||
|
modelTurn.Text := answerText;
|
||||||
|
FChatHistory.Add(modelTurn);
|
||||||
|
end;
|
||||||
|
|
||||||
|
FAnswer := FAnswer.Null;
|
||||||
|
ExecButton.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ExecButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
SendPrompt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.SendPrompt;
|
||||||
|
var
|
||||||
|
userPrompt: string;
|
||||||
|
userTurn: TChatTurn;
|
||||||
|
begin
|
||||||
|
if not ExecButton.Enabled then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
userPrompt := PromptMemo.Lines.Text;
|
||||||
|
if userPrompt.IsEmpty then
|
||||||
|
begin
|
||||||
|
ShowMessage('Bitte geben Sie einen Prompt ein.');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// NEU: Füge die aktuelle Benutzereingabe zum Verlauf hinzu
|
||||||
|
userTurn.Role := 'user';
|
||||||
|
userTurn.Text := userPrompt;
|
||||||
|
FChatHistory.Add(userTurn);
|
||||||
|
|
||||||
|
// NEU: Leere das Eingabefeld für die nächste Nachricht
|
||||||
|
PromptMemo.Clear;
|
||||||
|
|
||||||
|
ExecButton.Enabled := False;
|
||||||
|
AnswerMemo.Lines.Add('');
|
||||||
|
AnswerMemo.Lines.Add('--- [USER] ---');
|
||||||
|
AnswerMemo.Lines.Add(userPrompt);
|
||||||
|
AnswerMemo.Lines.Add('... sende Anfrage an Gemini ...');
|
||||||
|
|
||||||
|
FAnswer :=
|
||||||
|
TFuture<string>.Construct(
|
||||||
|
function: string
|
||||||
|
var
|
||||||
|
jsonRequest: TJSONObject;
|
||||||
|
jsonContents: TJSONArray;
|
||||||
|
requestBody: TStringStream;
|
||||||
|
response: IHTTPResponse;
|
||||||
|
responseJson: TJSONValue;
|
||||||
|
apiUrl: string;
|
||||||
|
turn: TChatTurn;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
// 1. JSON-Body aus dem gesamten Konversationsverlauf erstellen
|
||||||
|
jsonRequest := TJSONObject.Create;
|
||||||
|
try
|
||||||
|
jsonContents := TJSONArray.Create;
|
||||||
|
jsonRequest.AddPair('contents', jsonContents);
|
||||||
|
|
||||||
|
// NEU: Iteriere durch den Verlauf und baue die JSON-Struktur auf
|
||||||
|
for turn in FChatHistory do
|
||||||
|
begin
|
||||||
|
var jsonTurn := TJSONObject.Create;
|
||||||
|
jsonTurn.AddPair('role', TJSONString.Create(turn.Role));
|
||||||
|
|
||||||
|
var jsonParts := TJSONArray.Create;
|
||||||
|
jsonTurn.AddPair('parts', jsonParts);
|
||||||
|
|
||||||
|
var jsonText := TJSONObject.Create;
|
||||||
|
jsonText.AddPair('text', TJSONString.Create(turn.Text));
|
||||||
|
jsonParts.Add(jsonText);
|
||||||
|
|
||||||
|
jsonContents.Add(jsonTurn);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 2. Request senden
|
||||||
|
requestBody := TStringStream.Create(jsonRequest.ToString, TEncoding.UTF8);
|
||||||
|
try
|
||||||
|
apiUrl := API_BASE_URL + GEMINI_MODEL + ':generateContent?key=' + FMyApiKey;
|
||||||
|
response := FHttpClient.Post(apiUrl, requestBody, nil);
|
||||||
|
|
||||||
|
// 3. Antwort verarbeiten
|
||||||
|
if (response.StatusCode = 200) then
|
||||||
|
begin
|
||||||
|
responseJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8));
|
||||||
|
try
|
||||||
|
Result :=
|
||||||
|
responseJson
|
||||||
|
.GetValue<TJSONArray>('candidates')
|
||||||
|
.Items[0]
|
||||||
|
.GetValue<TJSONObject>('content')
|
||||||
|
.GetValue<TJSONArray>('parts')
|
||||||
|
.Items[0]
|
||||||
|
.GetValue<string>('text');
|
||||||
|
finally
|
||||||
|
responseJson.Free;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
'Fehler! Status: '
|
||||||
|
+ response.StatusCode.ToString
|
||||||
|
+ ' - '
|
||||||
|
+ response.StatusText
|
||||||
|
+ sLineBreak
|
||||||
|
+ response.ContentAsString;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
requestBody.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
jsonRequest.Free;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1 @@
|
|||||||
|
T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -c -dirs T:\Myc\dirs.txt -fc T:\Myc\Src\Ast\Myc.Ast*
|
||||||
@@ -0,0 +1 @@
|
|||||||
|
T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -c -dirs T:\Myc\dirs.txt -fc T:\Myc\Src\Myc.Data.*
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1 @@
|
|||||||
|
T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -c -dirs T:\Myc\dirs.txt -fc T:\Myc\Src\Ast\Myc.Fmx.*
|
||||||
@@ -0,0 +1,66 @@
|
|||||||
|
### Projektplan: Delphi Interface Extractor
|
||||||
|
|
||||||
|
**Datum:** 13. Juni 2025, 14:34
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
|
||||||
|
Die Notwendigkeit, `interface`-Abschnitte aus einer Vielzahl von Delphi-Units zu extrahieren und in einer einzigen, kompilierbaren Datei zusammenzufassen. Die größte Herausforderung bestand darin, die Abhängigkeiten zwischen den Units korrekt aufzulösen, um eine gültige Kompilierungsreihenfolge zu gewährleisten.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
|
||||||
|
Entwicklung eines robusten Kommandozeilen-Tools mit folgenden Kernfunktionen:
|
||||||
|
* Rekursives Scannen von Quelltext-Verzeichnissen unter Ausschluss von VCS-Ordnern.
|
||||||
|
* Topologische Sortierung der Units zur korrekten Auflösung von Abhängigkeiten.
|
||||||
|
* Ein "Fokus-Modus" (`-f`, `-fx`) zur gezielten Analyse des Abhängigkeitsbaums einer oder mehrerer Start-Units.
|
||||||
|
* Die Erzeugung einer einzigen, sauberen Ausgabedatei, die eine global konsolidierte `uses`-Klausel nur mit externen Abhängigkeiten enthält.
|
||||||
|
* Eine Option (`-fx`), um die `interface`-Sektion der Start-Units selbst aus der Ausgabe auszuschließen – ideal für Test-Szenarien.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
|
||||||
|
Wir haben das Kommandozeilen-Tool `ExtractPascalInterfaces.exe` erfolgreich entwickelt. Das Programm erfüllt alle gestellten Anforderungen:
|
||||||
|
* Der Parser verarbeitet Delphi-Units zuverlässig und extrahiert die `interface`-Inhalte, wobei `uses`-Klauseln und Kommentare korrekt behandelt werden.
|
||||||
|
* Die topologische Sortierung stellt die korrekte Reihenfolge der Units sicher und erkennt zyklische Abhängigkeiten.
|
||||||
|
* Die Fokus-Modi `-f` und `-fx` ermöglichen eine präzise Steuerung der zu verarbeitenden Units.
|
||||||
|
* Die generierte Ausgabedatei ist hochgradig optimiert: Sie beginnt mit einer einzigen, formatierten `uses`-Klausel, die alle externen Abhängigkeiten des Projekts zusammenfasst, gefolgt von den `type`- und `const`-Deklarationen in der richtigen Reihenfolge.
|
||||||
|
|
||||||
|
#### Nächste Schritte
|
||||||
|
|
||||||
|
- [ ] **Testen**: Ausgiebige Tests des Tools mit einem großen, realen Delphi-Projekt.
|
||||||
|
- [ ] **Erweiterung**: Unterstützung für bedingte Kompilierung (`{$IFDEF}`) innerhalb von `uses`-Klauseln evaluieren.
|
||||||
|
- [ ] **Konfiguration**: Optional eine Konfigurationsdatei (z.B. `.json`) zur Angabe von Pfaden und Optionen anstelle von Kommandozeilen-Parametern ermöglichen.
|
||||||
|
|
||||||
|
|
||||||
|
***
|
||||||
|
|
||||||
|
### Projektplan: Delphi Interface Extractor (Abschluss)
|
||||||
|
|
||||||
|
**Datum:** 13. Juni 2025, 16:05
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
|
||||||
|
Das ursprüngliche Ziel war die Erstellung eines Werkzeugs, das `interface`-Abschnitte aus Delphi-Units extrahiert und zu einer einzigen, kompilierbaren Datei zusammenfügt. Die zentrale Herausforderung war das korrekte Management von Abhängigkeiten und die Erzeugung einer sauberen, wartbaren Ausgabedatei.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
|
||||||
|
Die Entwicklung eines hochflexiblen und robusten Kommandozeilen-Tools zur Automatisierung der Interface-Extraktion. Das Tool sollte einen reichhaltigen Satz an Funktionen bieten:
|
||||||
|
* Scannen von Verzeichnissen, die direkt, rekursiv (`-r`) oder über eine Datei (`-dirs`) angegeben werden.
|
||||||
|
* Zwei Fokus-Modi für gezielte Abhängigkeitsanalysen: `-f` (inklusive Start-Dateien) und `-fx` (exklusive Start-Dateien).
|
||||||
|
* Flexible Ausgabe der Ergebnisse in eine Datei (`-o`), direkt in die Windows-Zwischenablage (`-c`) oder auf die Konsole.
|
||||||
|
* Erzeugung einer einzigen, sauberen Ausgabedatei, die mit einer globalen, formatierten `uses`-Klausel beginnt, welche nur die wirklich benötigten externen Abhängigkeiten enthält.
|
||||||
|
* Ein robuster Parser, der auch komplexe `uses`-Klauseln mit Zeilenkommentaren korrekt verarbeitet.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
|
||||||
|
Das Kommandozeilen-Tool `ExtractPascalInterfaces.exe` wurde erfolgreich fertiggestellt und hat alle gesetzten Ziele erreicht. Es ist nun ein ausgereiftes Werkzeug für die Build-Automatisierung.
|
||||||
|
* **Funktionsumfang:** Alle Parameter (`-r`, `-o`, `-c`, `-dirs`, `-f`, `-fx`) sind implementiert und interagieren korrekt miteinander.
|
||||||
|
* **Robustheit:** Der Parser wurde im Laufe der Entwicklung mehrfach verfeinert und kann nun auch komplexe `uses`-Klauseln mit eingeschobenen Kommentaren zuverlässig verarbeiten. Kritische Bugs bei der String- und Index-Verarbeitung wurden behoben.
|
||||||
|
* **Ausgabequalität:** Das erzeugte Artefakt ist optimal für die Weiterverwendung: eine einzige Datei mit einer sauberen, alphabetisch sortierten und formatierten `uses`-Klausel an der Spitze, gefolgt von den topologisch sortierten Interface-Deklarationen.
|
||||||
|
* **Flexibilität:** Die `fx`-Option ermöglicht den Einsatz in Test-Szenarien, bei denen die Abhängigkeiten eines Test-Harness aufgelöst werden, ohne dieses selbst in die Ausgabe aufzunehmen. Die Clipboard-Ausgabe beschleunigt den manuellen Einsatz erheblich.
|
||||||
|
|
||||||
|
#### Nächste Schritte
|
||||||
|
|
||||||
|
Das Projekt ist aus Entwicklungssicht abgeschlossen. Die nächsten logischen Schritte konzentrieren sich auf die Distribution und Anwendung:
|
||||||
|
|
||||||
|
- [ ] **Dokumentation**: Erstellen einer `README.md`-Datei, die alle Kommandozeilen-Optionen mit Beispielen detailliert beschreibt.
|
||||||
|
- [ ] **Praxistest**: Einsatz des Tools in einem oder mehreren großen, realen Delphi-Projekten, um die Stabilität unter Beweis zu stellen.
|
||||||
|
- [ ] **Deployment**: Bereitstellung der finalen `.exe`-Datei für den Einsatz in automatisierten Build-Prozessen.
|
||||||
@@ -0,0 +1,895 @@
|
|||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Ja, absolut. Das von dir vorgestellte Typsystem ist eine ausgezeichnete Grundlage für einen Blockly-Automaten. Es ist flexibel, stark typisiert und durch die Trennung von Typdefinition (IDataType) und Wert (IDataValue) sehr gut für diesen Zweck geeignet.
|
||||||
|
|
||||||
|
Analyse der Eignung
|
||||||
|
Die Stärken deines Entwurfs für dieses Anwendungszenario sind:
|
||||||
|
|
||||||
|
Entkopplung von Typ und Wert: Blockly trennt ebenfalls die Form eines Blocks (seine Anschlüsse und deren Typen) von dem Wert, den er zur Laufzeit produziert. Dein IDataType entspricht perfekt der Typdefinition eines Anschlusses, während IDataValue den zur Laufzeit durchgereichten Wert repräsentiert.
|
||||||
|
|
||||||
|
Starke Typisierung und Überprüfung: Die Kind-Eigenschaft (TDataKind) und die spezifischen IData...Type-Interfaces ermöglichen eine robuste Typprüfung. Wenn in Blockly ein Block in einen anderen eingesteckt wird, kann dein Automat im Hintergrund prüfen, ob der IDataType des Ausgangsblocks mit dem erwarteten IDataType des Eingangsanschlusses kompatibel ist. Z.B. (Ausgang.DataType.Kind in [dkOrdinal, dkFloat]).
|
||||||
|
|
||||||
|
Unterstützung komplexer Datenstrukturen: Die meisten einfachen Blockly-Implementierungen beschränken sich auf primitive Typen. Dein System unterstützt von Haus aus komplexe und strukturierte Daten wie Record, Array, Tuple und Vector. Dies ermöglicht die Erstellung sehr mächtiger und domänenspezifischer Blöcke (z.B. "Erstelle Datensatz", "Füge Element zu Array hinzu", "Lese Feld 'Name' aus Datensatz").
|
||||||
|
|
||||||
|
Funktionale Typen (IDataMethodType): Das ist ein besonders mächtiges Feature. Du könntest damit in Blockly Blöcke für Prozeduren, Funktionen oder Callbacks realisieren. Ein Block könnte eine "Funktion" ausgeben, die ein anderer Block als Parameter entgegennimmt und ausführt.
|
||||||
|
|
||||||
|
Interface-Helper (TDataType / TValue): Die Record-Helper machen die Implementierung der eigentlichen Block-Logik (der Code, der ausgeführt wird, wenn ein Block "tickt") sehr sauber und sicher. Der Code des Automaten arbeitet mit den handlichen TDataType-Records anstatt direkt mit den Interfaces.
|
||||||
|
|
||||||
|
Konkretes Mapping von Blockly zu deinem Typsystem
|
||||||
|
Blockly-Konzept Mapping auf dein Typsystem Beispiel
|
||||||
|
Anschluss-Typ IDataType (gekapselt in TDataType) Ein "Number"-Anschluss erwartet TDataType mit Kind = dkOrdinal.
|
||||||
|
Ausgabewert eines Blocks IDataValue (gekapselt in TDataType.TValue) Ein Zahlen-Block gibt ein TDataType.TOrdinal.TValue zurück.
|
||||||
|
Zahlen-Literal Block TDataType.Ordinal.CreateValue(123) Erzeugt einen Wert vom Typ Ordinal.
|
||||||
|
Text-Literal Block TDataType.Text.CreateValue('Hello') Erzeugt einen Wert vom Typ Text.
|
||||||
|
Listen/Array-Block TDataType.ArrayOf(someType).CreateValue([...]) Erzeugt ein Array von Werten.
|
||||||
|
Objekt/Record-Block TDataType.RecordOf(fields).CreateValue([...]) Erzeugt einen strukturierten Datensatz.
|
||||||
|
|
||||||
|
In Google Sheets exportieren
|
||||||
|
Was noch zu bedenken wäre
|
||||||
|
Dein Typsystem ist die Datenrepräsentation. Der eigentliche Automat (Interpreter/Executor) muss noch implementiert werden. Dieser würde typischerweise als Visitor über den von Blockly generierten AST (Abstract Syntax Tree) laufen:
|
||||||
|
|
||||||
|
Ausführungslogik: Jeder Block-Typ im Interpreter würde die entsprechenden CreateValue-Methoden deines Typsystems aufrufen, um Werte zu erzeugen oder zu transformieren.
|
||||||
|
|
||||||
|
Variablen-Handling: Der Automat benötigt einen "Scope" oder eine "Symboltabelle", die Variablennamen auf IDataValue-Instanzen abbildet.
|
||||||
|
|
||||||
|
Fehlerbehandlung: Du könntest einen speziellen IDataValue für Fehlerzustände einführen oder auf Exceptions im Automaten setzen, wenn z.B. eine Typumwandlung fehlschlägt.
|
||||||
|
|
||||||
|
Serialisierung: Die IDataValue-Instanzen, die den Zustand des Automaten repräsentieren, müssen möglicherweise serialisiert werden. Dafür bräuchtest du eine Logik, die einen Wert wieder in eine speicherbare Form (z.B. JSON) umwandelt.
|
||||||
|
|
||||||
|
Fazit: Du hast hier eine extrem solide und gut durchdachte Basis geschaffen, die weit über das hinausgeht, was für einen einfachen Blockly-Automaten nötig wäre, aber gleichzeitig die Implementierung eines sehr leistungsfähigen und typsicheren Systems ermöglicht.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Erläutere, wie in diesem Zusammenhang ein AST (Abstract Syntax Tree) ausehen müsste.
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Absolut. Ein AST (Abstract Syntax Tree) ist die entscheidende Brücke zwischen der visuellen Darstellung von Blockly und deiner Ausführungslogik in Delphi. Er übersetzt die räumliche Anordnung der Blöcke in eine hierarchische, programmatische Struktur, die ein Interpreter verarbeiten kann.
|
||||||
|
|
||||||
|
In diesem Kontext würde der AST nicht direkt Delphi-Code repräsentieren, sondern die Aktionen und Werte innerhalb deines Myc.Data.Types-Systems.
|
||||||
|
|
||||||
|
Grundlegende Struktur des AST
|
||||||
|
Jeder Knoten im AST repräsentiert einen Blockly-Block. Man unterscheidet fundamental zwischen zwei Arten von Knoten:
|
||||||
|
|
||||||
|
Expression Nodes (Ausdrucksknoten): Repräsentieren Blöcke, die einen Wert zurückgeben (z.B. Literale, Variablen, mathematische Operationen). Das Ergebnis der Auswertung eines solchen Knotens ist immer ein IDataValue.
|
||||||
|
|
||||||
|
Statement Nodes (Anweisungsknoten): Repräsentieren Blöcke, die eine Aktion ausführen (z.B. eine Zuweisung, eine Schleife, ein if-Konstrukt). Sie geben selbst keinen Wert zurück, sondern verändern den Zustand des Automaten.
|
||||||
|
|
||||||
|
Man könnte dies in Delphi mit einer Basis-Schnittstelle und spezialisierten Implementierungen abbilden:
|
||||||
|
|
||||||
|
Code-Snippet
|
||||||
|
|
||||||
|
// Base interface for all AST nodes
|
||||||
|
IAstNode = interface
|
||||||
|
// The visitor pattern is the classic way to process an AST.
|
||||||
|
function Accept(Visitor: IAstVisitor): IDataValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Base for nodes that represent a value
|
||||||
|
IExpressionNode = interface(IAstNode)
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Base for nodes that represent an action
|
||||||
|
IStatementNode = interface(IAstNode)
|
||||||
|
end;
|
||||||
|
Konkrete AST-Knoten (Beispiele)
|
||||||
|
Hier sind einige Beispiele, wie konkrete Blockly-Blöcke als AST-Knoten aussehen könnten:
|
||||||
|
|
||||||
|
Programm-Start:
|
||||||
|
|
||||||
|
TProgramNode = class(TInterfacedObject, IStatementNode)
|
||||||
|
|
||||||
|
Properties: Statements: TArray<IStatementNode>
|
||||||
|
|
||||||
|
Repräsentiert: Die gesamte Kette von Anweisungsblöcken, die von oben nach unten ausgeführt werden.
|
||||||
|
|
||||||
|
Literal-Wert (Zahl, Text, ...):
|
||||||
|
|
||||||
|
TLiteralNode = class(TInterfacedObject, IExpressionNode)
|
||||||
|
|
||||||
|
Properties: Value: IDataValue
|
||||||
|
|
||||||
|
Repräsentiert: Einen Block, der einen konstanten Wert darstellt. Dies ist der "direkteste Draht" zu deinem Typsystem.
|
||||||
|
|
||||||
|
Variablen-Zuweisung:
|
||||||
|
|
||||||
|
TAssignmentNode = class(TInterfacedObject, IStatementNode)
|
||||||
|
|
||||||
|
Properties: VariableName: string, Expression: IExpressionNode
|
||||||
|
|
||||||
|
Repräsentiert: Den "setze Variable X auf..."-Block.
|
||||||
|
|
||||||
|
Variablen-Zugriff:
|
||||||
|
|
||||||
|
TVariableAccessNode = class(TInterfacedObject, IExpressionNode)
|
||||||
|
|
||||||
|
Properties: VariableName: string
|
||||||
|
|
||||||
|
Repräsentiert: Den Block, der den Wert einer Variable liest.
|
||||||
|
|
||||||
|
Binäre Operation (z.B. Addition):
|
||||||
|
|
||||||
|
TBinaryOpNode = class(TInterfacedObject, IExpressionNode)
|
||||||
|
|
||||||
|
Properties: Operator: TMyOperatorEnum, Left: IExpressionNode, Right: IExpressionNode
|
||||||
|
|
||||||
|
Repräsentiert: Einen Block mit zwei Eingängen, z.B. [ ] + [ ].
|
||||||
|
|
||||||
|
If-Anweisung:
|
||||||
|
|
||||||
|
TIfStatementNode = class(TInterfacedObject, IStatementNode)
|
||||||
|
|
||||||
|
Properties: Condition: IExpressionNode, ThenBranch: IStatementNode, ElseBranch: IStatementNode (kann nil sein)
|
||||||
|
|
||||||
|
Repräsentiert: Den if-then-else-Block. Die ThenBranch und ElseBranch sind typischerweise selbst wieder TProgramNode (oder eine TStatementListNode), die eine Sequenz von Anweisungen enthalten.
|
||||||
|
|
||||||
|
Beispiel: Blockly zu AST
|
||||||
|
Stell dir folgende Blöcke vor:
|
||||||
|
|
||||||
|
setze [x] auf (10 + [y])
|
||||||
|
Der resultierende AST würde so aussehen:
|
||||||
|
|
||||||
|
TAssignmentNode (Statement)
|
||||||
|
|
||||||
|
VariableName: 'x'
|
||||||
|
|
||||||
|
Expression: TBinaryOpNode (Expression)
|
||||||
|
|
||||||
|
Operator: opAdd
|
||||||
|
|
||||||
|
Left: TLiteralNode (Expression)
|
||||||
|
|
||||||
|
Value: IDataOrdinalValue mit dem Wert 10
|
||||||
|
|
||||||
|
Right: TVariableAccessNode (Expression)
|
||||||
|
|
||||||
|
VariableName: 'y'
|
||||||
|
|
||||||
|
Verarbeitung des AST (Der Interpreter)
|
||||||
|
Der AST an sich ist nur eine Datenstruktur. Um ihn auszuführen, implementiert man einen Interpreter, meistens mithilfe des Visitor-Patterns.
|
||||||
|
|
||||||
|
IAstVisitor Interface:
|
||||||
|
Definiert für jeden konkreten Knotentyp eine Visit...-Methode.
|
||||||
|
|
||||||
|
Code-Snippet
|
||||||
|
|
||||||
|
IAstVisitor = interface
|
||||||
|
function VisitProgram(Node: TProgramNode): IDataValue;
|
||||||
|
function VisitAssignment(Node: TAssignmentNode): IDataValue;
|
||||||
|
function VisitLiteral(Node: TLiteralNode): IDataValue;
|
||||||
|
function VisitBinaryOp(Node: TBinaryOpNode): IDataValue;
|
||||||
|
// ... etc.
|
||||||
|
end;
|
||||||
|
TInterpreter Klasse:
|
||||||
|
Implementiert IAstVisitor. Diese Klasse hält den Zustand des Automaten (z.B. eine TDictionary<string, IDataValue> für die Variablen).
|
||||||
|
|
||||||
|
VisitLiteral gibt einfach Node.Value zurück.
|
||||||
|
|
||||||
|
VisitBinaryOp ruft rekursiv Node.Left.Accept(Self) und Node.Right.Accept(Self) auf, um die IDataValue-Operanden zu erhalten. Dann führt er die Operation aus (z.B. Addition der Value-Properties der IDataOrdinalValue-Interfaces) und erzeugt ein neues IDataOrdinalValue als Ergebnis.
|
||||||
|
|
||||||
|
VisitAssignment wertet Node.Expression.Accept(Self) aus und speichert den resultierenden IDataValue in seinem Variablen-Dictionary.
|
||||||
|
|
||||||
|
Der Prozess ist also:
|
||||||
|
Blockly XML/JSON -> Parser -> AST -> Interpreter (Visitor) -> Ergebnis (IDataValue)
|
||||||
|
|
||||||
|
Dein Typsystem ist die Grundlage für die TLiteralNode-Blätter des Baumes und die IDataValue-Objekte, die während der Interpretation durch den Baum nach oben und unten gereicht werden.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Wie passt IDataMethodType in dieses Schema?
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Ausgezeichnete Frage. IDataMethodType und der zugehörige IDataMethodValue sind der Schlüssel, um dein System von einem reinen Daten-Manipulator zu einer vollwertigen Programmierumgebung mit Prozeduren und Funktionen als "First-Class-Citizens" zu erweitern.
|
||||||
|
|
||||||
|
Sie passen sich in das AST-Schema ein, indem sie die Konzepte Funktionsdefinition und Funktionsaufruf abbilden.
|
||||||
|
|
||||||
|
1. Die Funktionsdefinition (Ein neuer Statement-Knoten)
|
||||||
|
In Blockly würde dies einem "erstelle Prozedur/Funktion"-Block entsprechen. Dieser Block definiert eine Aktion, speichert sie unter einem Namen, aber führt sie nicht sofort aus. Daher ist die Definition ein Statement.
|
||||||
|
|
||||||
|
Neuer AST-Knoten: TFunctionDefinitionNode
|
||||||
|
|
||||||
|
Typ: IStatementNode
|
||||||
|
|
||||||
|
Properties:
|
||||||
|
|
||||||
|
FunctionName: string
|
||||||
|
|
||||||
|
Parameters: TArray<TParameterDef> (wobei TParameterDef Name und IDataType enthält)
|
||||||
|
|
||||||
|
Body: IStatementNode (Der Code innerhalb der Funktion, meist ein TProgramNode)
|
||||||
|
|
||||||
|
ResultType: IDataType (kann TDataType.Void sein für Prozeduren)
|
||||||
|
|
||||||
|
Verarbeitung im Interpreter (VisitFunctionDefinition):
|
||||||
|
Hier passiert die Magie, die direkt auf IDataMethodValue zugreift:
|
||||||
|
|
||||||
|
Der Visitor betritt diesen Knoten. Er führt den Body nicht aus.
|
||||||
|
|
||||||
|
Er erstellt den passenden IDataMethodType aus den Parameters und dem ResultType. Zum Beispiel: TDataType.MethodOf(ArgType, ResultType).
|
||||||
|
|
||||||
|
Er erzeugt dynamisch eine TDataMethodProc (eine anonyme Methode), die den Body des AST-Knotens und den aktuellen Scope des Interpreters einfängt (dies nennt man eine Closure).
|
||||||
|
|
||||||
|
Diese TDataMethodProc wird die eigentliche Implementierung der Funktion sein. Wenn sie aufgerufen wird, wird sie:
|
||||||
|
|
||||||
|
Einen neuen, untergeordneten Scope für die Funktionsparameter erstellen.
|
||||||
|
|
||||||
|
Die übergebenen IDataValue-Argumente in diesen Scope legen.
|
||||||
|
|
||||||
|
Den Body-AST-Knoten mit dem Visitor ausführen (Body.Accept(Self)).
|
||||||
|
|
||||||
|
Den Rückgabewert (ein IDataValue) zurückgeben.
|
||||||
|
|
||||||
|
Der Visitor ruft MethodType.CreateValue(ErzeugteTDataMethodProc) auf, um einen IDataMethodValue zu erzeugen.
|
||||||
|
|
||||||
|
Dieser IDataMethodValue wird in der Symboltabelle (Variablen-Dictionary) des Interpreters unter FunctionName gespeichert.
|
||||||
|
|
||||||
|
Das Ergebnis ist, dass nach diesem Statement eine Variable existiert, deren Wert eine ausführbare Funktion ist.
|
||||||
|
|
||||||
|
2. Der Funktionsaufruf (Ein neuer Expression-Knoten)
|
||||||
|
Dies entspricht dem "rufe Prozedur/Funktion auf"-Block in Blockly. Der Aufruf einer Funktion, die einen Wert zurückgibt, ist eine Expression.
|
||||||
|
|
||||||
|
Neuer AST-Knoten: TFunctionCallNode
|
||||||
|
|
||||||
|
Typ: IExpressionNode (oder IStatementNode, wenn der Rückgabetyp Void ist)
|
||||||
|
|
||||||
|
Properties:
|
||||||
|
|
||||||
|
FunctionName: string
|
||||||
|
|
||||||
|
Arguments: TArray<IExpressionNode> (Die an die Funktion übergebenen Werte)
|
||||||
|
|
||||||
|
Verarbeitung im Interpreter (VisitFunctionCall):
|
||||||
|
|
||||||
|
Der Visitor sucht in seiner Symboltabelle nach dem FunctionName. Er erwartet, einen IDataMethodValue zu finden. Wenn nicht -> Fehler.
|
||||||
|
|
||||||
|
Er wertet jeden IExpressionNode in Arguments rekursiv aus (arg.Accept(Self)), um eine Liste von IDataValue-Objekten zu erhalten.
|
||||||
|
|
||||||
|
Er ruft die im IDataMethodValue gespeicherte TDataMethodProc mit den ermittelten IDataValue-Argumenten auf.
|
||||||
|
|
||||||
|
Der von der TDataMethodProc zurückgegebene IDataValue ist das Ergebnis des VisitFunctionCall.
|
||||||
|
|
||||||
|
Beispiel-Szenario
|
||||||
|
Blockly:
|
||||||
|
|
||||||
|
// Definition
|
||||||
|
to double with [value]
|
||||||
|
return (value * 2)
|
||||||
|
|
||||||
|
// Aufruf
|
||||||
|
set [myResult] to [double with (10)]
|
||||||
|
AST:
|
||||||
|
|
||||||
|
TFunctionDefinitionNode
|
||||||
|
|
||||||
|
FunctionName: 'double'
|
||||||
|
|
||||||
|
Parameters: [Name: 'value', Type: TDataType.Ordinal]
|
||||||
|
|
||||||
|
ResultType: TDataType.Ordinal
|
||||||
|
|
||||||
|
Body: TReturnStatementNode mit einem TBinaryOpNode (*) drin.
|
||||||
|
|
||||||
|
TAssignmentNode
|
||||||
|
|
||||||
|
VariableName: 'myResult'
|
||||||
|
|
||||||
|
Expression: TFunctionCallNode
|
||||||
|
|
||||||
|
FunctionName: 'double'
|
||||||
|
|
||||||
|
Arguments: [TLiteralNode mit Wert 10]
|
||||||
|
|
||||||
|
Interpreter-Ablauf:
|
||||||
|
|
||||||
|
VisitFunctionDefinition('double'): Der Interpreter erzeugt eine Closure, verpackt sie in einen IDataMethodValue und speichert sie unter dem Namen 'double' in seinem globalen Scope.
|
||||||
|
|
||||||
|
VisitAssignment('myResult'): Er muss den Ausdruck auf der rechten Seite auswerten.
|
||||||
|
|
||||||
|
VisitFunctionCall('double'):
|
||||||
|
a. Er findet die 'double'-Funktion (IDataMethodValue) im Scope.
|
||||||
|
b. Er wertet das Argument aus: VisitLiteral(10) gibt einen IDataOrdinalValue(10) zurück.
|
||||||
|
c. Er ruft die Closure mit diesem IDataOrdinalValue auf.
|
||||||
|
d. Die Closure führt den Body aus: 10 * 2, was einen neuen IDataOrdinalValue(20) erzeugt.
|
||||||
|
e. Dieser Wert wird vom Aufruf zurückgegeben.
|
||||||
|
|
||||||
|
Der IDataOrdinalValue(20) wird in der Symboltabelle unter 'myResult' gespeichert.
|
||||||
|
|
||||||
|
Fazit: IDataMethodType ist die Typsignatur für die Verbindungsstellen der Funktionsblöcke in Blockly. IDataMethodValue ist das Laufzeitobjekt, das eine Referenz auf den ausführbaren Code (den Body-Teil des AST) enthält und im Scope des Interpreters wie eine normale Variable gespeichert wird. Dieses Muster integriert sich perfekt in das AST/Visitor-Schema.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Dann könnte man auch eine Faktory deklareieren, die ihrerseits Funktionen basierend auf Parametern erzeugt?
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Ja, exakt. Das ist die logische und sehr mächtige Konsequenz aus dem bisherigen Entwurf.
|
||||||
|
|
||||||
|
Was du beschreibst, ist das Konzept von Higher-Order Functions: Funktionen, die andere Funktionen als Parameter entgegennehmen oder – wie in deinem Fall – als Ergebnis zurückgeben. Dein System kann das abbilden, weil IDataMethodValue einfach nur ein weiterer Wert (IDataValue) ist.
|
||||||
|
|
||||||
|
Eine Funktion, die eine andere Funktion erzeugt, ist im Grunde eine Function Factory.
|
||||||
|
|
||||||
|
So würde es im etablierten Schema funktionieren:
|
||||||
|
Nehmen wir ein klassisches Beispiel: Eine Factory createAdder, die eine Zahl x entgegennimmt und eine neue Funktion zurückgibt. Diese neue Funktion addiert bei jedem Aufruf die ursprüngliche Zahl x zu ihrem eigenen Argument.
|
||||||
|
|
||||||
|
1. Die Darstellung in Blockly:
|
||||||
|
|
||||||
|
Du würdest eine Funktion createAdder mit einem Parameter amountToAdd definieren.
|
||||||
|
Innerhalb des do-Blocks dieser Funktion gäbe es nur einen einzigen Block: einen return-Block.
|
||||||
|
In den return-Block würdest du einen anonymen Funktionsblock (Lambda) einfügen. Dieser Block definiert einen eigenen Parameter, z.B. inputValue, und sein Rumpf wäre die Berechnung inputValue + amountToAdd.
|
||||||
|
|
||||||
|
2. Die Repräsentation im AST:
|
||||||
|
|
||||||
|
Der AST für die Factory createAdder würde so aussehen:
|
||||||
|
|
||||||
|
TFunctionDefinitionNode
|
||||||
|
|
||||||
|
FunctionName: 'createAdder'
|
||||||
|
|
||||||
|
Parameters: [Name: 'amountToAdd', Type: TDataType.Ordinal]
|
||||||
|
|
||||||
|
ResultType: TDataType.MethodOf(TDataType.Ordinal, TDataType.Ordinal) (Das ist der entscheidende Punkt: der Rückgabetyp ist selbst ein Funktionstyp!)
|
||||||
|
|
||||||
|
Body: TReturnStatementNode
|
||||||
|
|
||||||
|
Expression: TLambdaNode (die erzeugte, anonyme Funktion)
|
||||||
|
|
||||||
|
Parameters: [Name: 'inputValue', Type: TDataType.Ordinal]
|
||||||
|
|
||||||
|
ResultType: TDataType.Ordinal
|
||||||
|
|
||||||
|
Body: TBinaryOpNode (Operator +)
|
||||||
|
|
||||||
|
Left: TVariableAccessNode ('inputValue')
|
||||||
|
|
||||||
|
Right: TVariableAccessNode ('amountToAdd')
|
||||||
|
|
||||||
|
3. Die Verarbeitung im Interpreter (Die Magie der Closures):
|
||||||
|
|
||||||
|
Hier zeigt sich die Stärke deines Designs:
|
||||||
|
|
||||||
|
Aufruf der Factory: Dein Skript führt aus: set [add5] to [createAdder with (5)].
|
||||||
|
|
||||||
|
Der Interpreter ruft die Funktion createAdder auf. Es wird ein Scope erzeugt, in dem amountToAdd den IDataOrdinalValue(5) hat.
|
||||||
|
|
||||||
|
Der Interpreter wertet den Rumpf aus und stößt auf den TLambdaNode.
|
||||||
|
|
||||||
|
Wie zuvor beschrieben, erzeugt der Visitor für diesen TLambdaNode eine Closure.
|
||||||
|
|
||||||
|
Das Wichtigste: Diese Closure friert ihren Erstellungskontext ein. Sie "erinnert" sich daran, dass in ihrem übergeordneten Scope amountToAdd = 5 war.
|
||||||
|
|
||||||
|
Die Factory createAdder gibt den IDataMethodValue dieser neuen Closure zurück.
|
||||||
|
|
||||||
|
Dieser IDataMethodValue wird in der Variable add5 gespeichert. Die Funktion createAdder ist nun beendet, ihr Scope ist weg, aber die Closure lebt weiter.
|
||||||
|
|
||||||
|
Aufruf der erzeugten Funktion: Dein Skript führt aus: set [result] to [add5 with (3)].
|
||||||
|
|
||||||
|
Der Interpreter ruft den in add5 gespeicherten IDataMethodValue auf.
|
||||||
|
|
||||||
|
Die Closure wird mit dem Argument inputValue = IDataOrdinalValue(3) aktiviert. Es wird ein neuer Scope für diesen Aufruf erzeugt.
|
||||||
|
|
||||||
|
Der Interpreter führt den Körper der Closure aus: inputValue + amountToAdd.
|
||||||
|
|
||||||
|
Er findet inputValue (Wert 3) in seinem direkten Scope.
|
||||||
|
|
||||||
|
Er findet amountToAdd nicht in seinem direkten Scope. Er schaut daher in den "eingefrorenen" Scope, den er bei seiner Erzeugung mitbekommen hat, und findet dort den Wert 5.
|
||||||
|
|
||||||
|
Er berechnet 3 + 5 und gibt IDataOrdinalValue(8) zurück.
|
||||||
|
|
||||||
|
Fazit:
|
||||||
|
|
||||||
|
Ja, das ist nicht nur möglich, sondern es ist eine natürliche und elegante Eigenschaft des Systems, das wir besprochen haben. Es erfordert keine speziellen Tricks, sondern ergibt sich direkt aus der Fähigkeit, Funktionen als erstklassige Werte zu behandeln und dem korrekten Management von Scopes durch Closures im Interpreter. Das macht den Automaten extrem ausdrucksstark.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Ich möchte damit Handellssysteme erzeugen. Diese bestehen auf einer Strategie, die für einen bestimmten Zeitraum auf Kurse angewdandt wird. Das Ergebnis ist eine Equity-Curve. Diese Strategie muss durch eine Parametrisierbare Factory erzeugt werden können, damit sie an einzelne backtests oder sogar für Walk-Forward-Analyse benutzt werden kann. Und sie soll am Ende auch Live traden können. Ist das Denkbar?
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Ja, das ist absolut denkbar. Tatsächlich ist das ein exzellenter und sehr anspruchsvoller Anwendungsfall für die Architektur, die wir entworfen haben. Das System aus Blockly, AST und dem typsicheren Interpreter bildet den perfekten Kern einer solchen Handelsplattform.
|
||||||
|
|
||||||
|
Lassen Sie uns Ihre Anforderungen auf die besprochene Architektur abbilden:
|
||||||
|
|
||||||
|
1. Die parametrisierbare Strategie-Factory
|
||||||
|
Dies ist exakt der Anwendungsfall für eine Higher-Order Function, den wir zuletzt besprochen haben.
|
||||||
|
|
||||||
|
Blockly-Implementierung: Sie erstellen eine Funktion in Blockly, z.B. CreateMACrossoverStrategy. Diese Funktion hat Parameter wie FastMAPeriod, SlowMAPeriod, RiskPerTrade, etc.
|
||||||
|
|
||||||
|
Rückgabewert: Diese Factory-Funktion gibt eine andere Funktion zurück (einen IDataMethodValue). Nennen wir diese die "Strategie-Funktion".
|
||||||
|
|
||||||
|
Strategie-Funktion: Diese zurückgegebene Funktion hat eine feste Signatur, die vom "Harness" (dem Backtester oder Live-Trader) erwartet wird, z.B. function(CurrentBar: IDataRecordValue, Portfolio: IPortfolioApi): TSignal. Sie hat die Parameter der Factory (z.B. FastMAPeriod = 10, SlowMAPeriod = 50) in ihrer Closure "eingebacken".
|
||||||
|
|
||||||
|
2. Anwendung auf Kurse (Backtesting & Live-Trading)
|
||||||
|
Der Interpreter allein reicht hier nicht. Sie benötigen ein umgebendes "Harness", das die Strategie ausführt. Dieses Harness wäre für die verschiedenen Modi (Backtest, Live) austauschbar.
|
||||||
|
|
||||||
|
Datenmodellierung: Ihre Myc.Data.Types Unit ist hierfür ideal.
|
||||||
|
|
||||||
|
Ein einzelner Kursbalken (OHLC) wäre ein TDataType.TRecord.
|
||||||
|
|
||||||
|
Die gesamte Kurshistorie wäre ein TDataType.TArray dieser Records.
|
||||||
|
|
||||||
|
Das "Harness": Dies ist eine Delphi-Anwendung, die:
|
||||||
|
|
||||||
|
Die Blockly-Definition lädt und den AST erzeugt.
|
||||||
|
|
||||||
|
Den Interpreter startet, um die Strategie-Factory aufzurufen und eine konkrete Strategie-Instanz (IDataMethodValue) mit den gewünschten Parametern zu erzeugen.
|
||||||
|
|
||||||
|
Eine Schleife startet, die über die historischen (Backtest) oder live eintreffenden (Live-Handel) Kursdaten iteriert.
|
||||||
|
|
||||||
|
In jedem Schleifendurchlauf wird die Strategie-Funktion (IDataMethodValue) aufgerufen und ihr der aktuelle Kursbalken übergeben.
|
||||||
|
|
||||||
|
Broker-Abstraktion: Die Strategie muss Orders platzieren können. Dies geschieht über eine API, die dem Interpreter zur Verfügung gestellt wird.
|
||||||
|
|
||||||
|
Sie definieren ein Delphi-Interface IBrokerAPI mit Methoden wie BuyMarket(Amount), SellLimit(Price, Amount), GetCurrentPositionSize(), etc.
|
||||||
|
|
||||||
|
Im Backtest: Sie übergeben eine TSimulatedBroker-Klasse, die IBrokerAPI implementiert. Diese Klasse führt ein simuliertes Portfolio, berechnet Slippage/Kommissionen und erzeugt die Equity-Curve.
|
||||||
|
|
||||||
|
Im Live-Handel: Sie übergeben eine TRealBroker-Klasse, die sich mit der API Ihres echten Brokers (z.B. Interactive Brokers, Binance) verbindet.
|
||||||
|
|
||||||
|
Die in Blockly erstellte Strategie bleibt exakt dieselbe. Nur die Implementierung der IBrokerAPI wird ausgetauscht.
|
||||||
|
|
||||||
|
3. Walk-Forward-Analyse
|
||||||
|
Die Architektur unterstützt dies perfekt. Eine Walk-Forward-Analyse ist lediglich eine übergeordnete Schleife, die das Backtesting-Harness steuert:
|
||||||
|
|
||||||
|
Optimierungsphase: Die übergeordnete Schleife ruft das Backtest-Harness wiederholt für einen "In-Sample"-Zeitraum auf. Bei jedem Durchlauf wird die Strategie-Factory mit anderen Parametern (FastMAPeriod, SlowMAPeriod, ...) aufgerufen, um die profitabelsten Einstellungen zu finden.
|
||||||
|
|
||||||
|
Validierungsphase: Die übergeordnete Schleife nimmt die besten Parameter aus der Optimierungsphase und ruft das Backtest-Harness einmalig für den nachfolgenden "Out-of-Sample"-Zeitraum auf, um die Performance auf unbekannten Daten zu messen.
|
||||||
|
|
||||||
|
Dieser Prozess wird für gleitende Zeitfenster wiederholt.
|
||||||
|
|
||||||
|
Mögliche Herausforderungen und Erweiterungen
|
||||||
|
Performance: Die Interpretation eines AST für jeden einzelnen Tausender von Kursbalken kann bei der Optimierung (Millionen von Durchläufen) zu einem Engpass führen.
|
||||||
|
|
||||||
|
Lösung: Kritische Indikatoren (Moving Average, RSI, etc.) werden nicht in Blockly implementiert, sondern als hochoptimierte Delphi-Funktionen. Diese werden dem Interpreter als "native Funktionen" zur Verfügung gestellt, die von speziellen TNativeFunctionCallNode im AST aufgerufen werden können.
|
||||||
|
|
||||||
|
Komplexität des Zustands: Eine Strategie hat einen Zustand (z.B. "bin ich gerade in einem Trade?"). Dieser Zustand wird über Variablen im Scope des Interpreters gehalten.
|
||||||
|
|
||||||
|
Daten-Feeds: Sie benötigen eine robuste Anbindung an historische Datenquellen und Live-Feeds. Dies ist Teil des Harness, nicht des Interpreters.
|
||||||
|
|
||||||
|
Fazit
|
||||||
|
Ja, es ist absolut denkbar und ein sehr passender Anwendungsfall. Das entworfene System bietet eine saubere Trennung zwischen:
|
||||||
|
|
||||||
|
Strategie-Logik (Blockly/AST): Definiert von Analysten oder Tradern ohne tiefgehende Programmierkenntnisse.
|
||||||
|
|
||||||
|
Kern-Infrastruktur (Delphi Interpreter & Harness): Die hochperformante und robuste Basis, die von Entwicklern erstellt wird (Indikatoren, Broker-Anbindung, Daten-Feeds).
|
||||||
|
|
||||||
|
Sie schaffen damit eine domänenspezifische Sprache (DSL) für Handelsstrategien, die visuell, flexibel und durch die Delphi-Basis extrem leistungsfähig ist.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Der Harness ist der Knackpunkt. Wäre es denkbar auch das Backtesting und die Analyse über Blockly steuern zu können. Z.B. über spezialisierte Blöcke "Backtest" und "WFA"?
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Ja, das ist nicht nur denkbar, sondern ein konzeptionell sehr eleganter und mächtiger Schritt. Damit heben Sie das gesamte System von einer reinen "Strategie-Entwicklungsumgebung" auf die Ebene einer vollwertigen, visuellen "Quantitative-Research-Umgebung".
|
||||||
|
|
||||||
|
Der Knackpunkt, den Sie identifiziert haben, wird dabei elegant gelöst: Das "Harness" wird zu einer API, die innerhalb der Blockly-Umgebung über spezialisierte Blöcke zugänglich gemacht wird.
|
||||||
|
|
||||||
|
Die Architektur mit zwei Ebenen
|
||||||
|
Sie würden effektiv mit zwei Ebenen von Skripten arbeiten:
|
||||||
|
|
||||||
|
Ebene 1: Das Strategie-Skript (wie bisher besprochen)
|
||||||
|
|
||||||
|
Dies ist eine Funktion (erzeugt von einer Factory), die die Handelslogik enthält.
|
||||||
|
|
||||||
|
Sie nimmt typischerweise Kursdaten und den Portfolio-Zustand als Input und gibt Handelssignale als Output.
|
||||||
|
|
||||||
|
Diese Ebene weiß nichts von Backtesting oder Live-Handel. Sie ist agnostisch.
|
||||||
|
|
||||||
|
Ebene 2: Das Kontroll- oder Analyse-Skript
|
||||||
|
|
||||||
|
Dies ist ein übergeordnetes Blockly-Skript, das den gesamten Forschungs- oder Handelsprozess steuert.
|
||||||
|
|
||||||
|
Es verwendet die Strategie-Funktion (den IDataMethodValue) von Ebene 1 als Parameter für die neuen, spezialisierten Harness-Blöcke.
|
||||||
|
|
||||||
|
Spezialisierte Blöcke für das "Harness"
|
||||||
|
Hier sind die Blöcke, die Sie erwähnt haben, und wie sie sich einfügen würden:
|
||||||
|
|
||||||
|
[Load Price Data]-Block (Expression)
|
||||||
|
|
||||||
|
Inputs: Symbol, Zeitrahmen, Start-Datum, End-Datum.
|
||||||
|
|
||||||
|
Output: Ein IDataArrayValue mit den Kursdaten (ein Array von Records).
|
||||||
|
|
||||||
|
Implementierung: Ein nativer Delphi-Aufruf, der Daten aus einer Datenbank oder Datei lädt.
|
||||||
|
|
||||||
|
[Backtest]-Block (Expression oder Statement)
|
||||||
|
|
||||||
|
Inputs:
|
||||||
|
|
||||||
|
Price Data: Der IDataArrayValue vom Load-Block.
|
||||||
|
|
||||||
|
Strategy: Ein IDataMethodValue! Hier stecken Sie die von Ihrer Factory erzeugte Strategie-Instanz hinein.
|
||||||
|
|
||||||
|
Initial Capital: Ein IDataOrdinalValue oder IDataDecimalValue.
|
||||||
|
|
||||||
|
Commission: Ein IDataFloatValue.
|
||||||
|
|
||||||
|
Output: Ein IDataRecordValue, das alle Ergebnisse enthält: EquityCurve (ein Array), TradeList (ein Array), Statistics (ein weiteres Record).
|
||||||
|
|
||||||
|
Implementierung: Ein mächtiger, nativer Delphi-Aufruf. Der Interpreter ruft eine einzelne Delphi-Funktion ExecuteBacktest auf und übergibt ihr die IDataValue-Parameter. Diese Funktion führt dann die hochoptimierte Backtesting-Schleife aus und ruft bei jedem Takt die übergebene Strategie-Funktion (Strategy.Value(...)) auf.
|
||||||
|
|
||||||
|
[Walk Forward Analysis]-Block (Expression oder Statement)
|
||||||
|
|
||||||
|
Inputs:
|
||||||
|
|
||||||
|
Price Data.
|
||||||
|
|
||||||
|
Strategy Factory: Hier wird die Factory selbst (IDataMethodValue) übergeben, nicht eine Instanz. Der WFA-Block muss ja selbst Instanzen mit verschiedenen Parametern erzeugen können.
|
||||||
|
|
||||||
|
Parameter Ranges: Ein IDataRecordValue, das die zu optimierenden Parameter definiert (z.B. {FastMA: {start:10, end:100, step:5}}).
|
||||||
|
|
||||||
|
Weitere Parameter wie In-Sample-Länge, Out-of-Sample-Länge.
|
||||||
|
|
||||||
|
Output: Ein IDataArrayValue, das die Ergebnisse jeder einzelnen Walk-Forward-Periode enthält.
|
||||||
|
|
||||||
|
Implementierung: Ein weiterer komplexer, nativer Delphi-Aufruf, der die gesamte WFA-Logik kapselt.
|
||||||
|
|
||||||
|
Beispiel eines Analyse-Skripts in Blockly
|
||||||
|
Stellen Sie sich vor, Sie würden folgendes Skript in Blockly zusammenklicken:
|
||||||
|
|
||||||
|
// Lade die nötigen Daten
|
||||||
|
set [eurusd_h1] to [Load Price Data symbol:"EURUSD", timeframe:"H1", from:"2020-01-01", to:"2025-01-01"]
|
||||||
|
|
||||||
|
// Hole einen Verweis auf die Strategie-Factory
|
||||||
|
// (angenommen, die Factory "createMACrossover" wurde in einem anderen Tab definiert)
|
||||||
|
set [myStrategyFactory] to [get function handle of "createMACrossover"]
|
||||||
|
|
||||||
|
// Erzeuge eine spezifische Instanz der Strategie für den Test
|
||||||
|
set [strategy_10_50] to [call function [myStrategyFactory] with FastMA:10, SlowMA:50]
|
||||||
|
|
||||||
|
// Führe den Backtest aus
|
||||||
|
set [testResult] to [Backtest data:[eurusd_h1], strategy:[strategy_10_50], capital:10000]
|
||||||
|
|
||||||
|
// Analysiere und visualisiere die Ergebnisse
|
||||||
|
set [stats] to [get field "Statistics" from [testResult]]
|
||||||
|
print("Sharpe Ratio: " + [get field "SharpeRatio" from [stats]])
|
||||||
|
|
||||||
|
[Plot Equity Curve from: [get field "EquityCurve" from [testResult]]]
|
||||||
|
Die Vorteile dieses Ansatzes
|
||||||
|
Maximale Flexibilität: Der Anwender kann nicht nur die Strategie, sondern den gesamten Forschungs-Prozess visuell gestalten und automatisieren. Komplexe Vergleiche (Strategie A vs. Strategie B auf denselben Daten) werden trivial.
|
||||||
|
|
||||||
|
Performance: Die rechenintensiven Operationen (Backtesting-Schleife, WFA-Optimierung) laufen als kompilierter, nativer Delphi-Code. Nur die übergeordnete Orchestrierung und die Strategie-Logik selbst werden interpretiert. Das ist der "Best of both worlds"-Ansatz.
|
||||||
|
|
||||||
|
Kapselung: Die Komplexität der Harness-Implementierung ist hinter einfachen Blöcken verborgen. Der Anwender muss nicht wissen, wie ein Backtest funktioniert, sondern nur, dass er ihn mit einer Strategie und Daten füttern muss.
|
||||||
|
|
||||||
|
Protokollierung und Reproduzierbarkeit: Das gesamte Analyse-Skript kann als einzelnes Blockly-XML gespeichert werden, was jeden Forschungsschritt perfekt dokumentiert und reproduzierbar macht.
|
||||||
|
|
||||||
|
Fazit: Ja, das ist der logische nächste Schritt, um ein extrem mächtiges und benutzerfreundliches Werkzeug zu schaffen. Die Harness-Funktionalität wird zu einer "nativen API" innerhalb Ihrer visuellen Programmierumgebung.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
So in etwa habe ich mir das vorgestellt. Zu den Preisdaten: die können nicht als Array zur Verfügung gestellt werden. Schließlich handelt es sich (im Live-Modus) um Echtzeitdaten, also Ticks oder 1M Bars. Wie würde man dieses Problem lösen?
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Das ist ein exzellenter und entscheidender Punkt. Sie haben vollkommen recht, das batch-orientierte Array-Modell ist nur für Backtests geeignet. Für den Live-Handel benötigen wir ein ereignisgesteuertes (event-driven) Modell.
|
||||||
|
|
||||||
|
Die gute Nachricht ist, dass unsere Architektur dies mit einer eleganten Abstraktion lösen kann, die es sogar erlaubt, die Logik für Backtesting und Live-Handel nahezu identisch zu halten.
|
||||||
|
|
||||||
|
Die Lösung liegt darin, nicht die Daten selbst, sondern eine Abstraktion der Datenquelle (einen "Data Provider") zu übergeben und auf dessen Ereignisse zu reagieren.
|
||||||
|
|
||||||
|
1. Einführung des "Data Provider"-Konzepts
|
||||||
|
Wir führen einen neuen Typ in unserem System ein: den DataProvider. Dies ist im Hintergrund ein Delphi-Objekt, das eine Datenquelle repräsentiert, und in Blockly wird es durch einen speziellen IDataValue (z.B. IDataProviderValue) dargestellt. Es ist ein "Handle" zur Datenquelle.
|
||||||
|
|
||||||
|
Ein DataProvider hat eine Hauptaufgabe: Er emittiert ein OnNewData-Ereignis, sobald neue Daten (ein Tick oder ein neuer Balken) verfügbar sind.
|
||||||
|
|
||||||
|
2. Neue Blöcke für den Live-Modus
|
||||||
|
Um dies in Blockly zu steuern, benötigen wir zwei neue Arten von Blöcken im "Kontroll-Skript" (Ebene 2):
|
||||||
|
|
||||||
|
[Create Live Data Provider]-Block (Expression)
|
||||||
|
|
||||||
|
Inputs: Symbol, Zeitrahmen, Broker/Feed-API.
|
||||||
|
|
||||||
|
Output: Ein DataProvider-Handle.
|
||||||
|
|
||||||
|
Implementierung: Dieser native Delphi-Block erzeugt eine Instanz eines Live-Providers, der sich z.B. per WebSocket mit einer Börse verbindet. Er startet aber noch nicht den Datenfluss.
|
||||||
|
|
||||||
|
[On New Bar]-Block (Event Handler)
|
||||||
|
|
||||||
|
Dies ist der wichtigste Block. Es ist ein Ereignis-Handler, kein normaler sequenzieller Block.
|
||||||
|
|
||||||
|
Er hat einen Eingangs-Slot für ein DataProvider-Handle.
|
||||||
|
|
||||||
|
Er definiert eine lokale Variable (z.B. newBar), die bei jedem Ereignis den neuen Kursbalken (IDataRecordValue) enthält.
|
||||||
|
|
||||||
|
Er hat einen "do"-Bereich, in den die Logik eingefügt wird, die bei jedem eintreffenden Balken ausgeführt werden soll.
|
||||||
|
|
||||||
|
3. Der Arbeitsablauf im Live-Modus
|
||||||
|
Ihr Kontroll-Skript für den Live-Handel würde nun so aussehen:
|
||||||
|
|
||||||
|
// --- Initialisierungsphase ---
|
||||||
|
|
||||||
|
// Erzeuge eine Instanz der Strategie
|
||||||
|
set [myStrategy] to [call function [get function handle of "createMACrossover"] with FastMA:10, SlowMA:50]
|
||||||
|
|
||||||
|
// Erzeuge und konfiguriere den Live-Datenstrom
|
||||||
|
set [liveFeed] to [Create Live Data Provider symbol:"BTCUSDT", timeframe:"1m", broker:"Binance"]
|
||||||
|
|
||||||
|
// Erzeuge eine Instanz des echten Brokers
|
||||||
|
set [realBroker] to [Create Broker API for account:"MyLiveAccount"]
|
||||||
|
|
||||||
|
|
||||||
|
// --- Reaktive Phase (Ereignis-Schleife) ---
|
||||||
|
|
||||||
|
[On New Bar [currentBar] from [liveFeed] do
|
||||||
|
// Diese Logik wird bei jedem neuen 1-Minuten-Balken ausgeführt
|
||||||
|
|
||||||
|
// Rufe die eigentliche Strategie-Funktion auf
|
||||||
|
set [signal] to [call function [myStrategy] with bar:[currentBar], broker:[realBroker]]
|
||||||
|
|
||||||
|
// (Hier könnte noch zusätzliche Logik stehen, z.B. Logging)
|
||||||
|
]
|
||||||
|
|
||||||
|
// Starte den Datenstrom (dieser Block beendet sich sofort, die Events laufen im Hintergrund)
|
||||||
|
[Start Data Provider [liveFeed]]
|
||||||
|
4. Die Vereinheitlichung: Backtesting als simulierter Stream
|
||||||
|
Jetzt kommt der eleganteste Teil: Wir können das Backtesting so umgestalten, dass es denselben ereignisgesteuerten Mechanismus verwendet.
|
||||||
|
|
||||||
|
Der [Backtest]-Block, den wir zuvor besprochen haben, ist im Grunde ein Wrapper, der Folgendes tut:
|
||||||
|
|
||||||
|
Er lädt die historischen Daten in ein Array (wie gehabt).
|
||||||
|
|
||||||
|
Er erstellt einen SimulatedDataProvider.
|
||||||
|
|
||||||
|
Dieser simulierte Provider hat ebenfalls ein Start-Kommando. Wenn es aufgerufen wird, iteriert er intern durch das Array und feuert für jeden Balken exakt dasselbe OnNewData-Ereignis wie der Live-Provider.
|
||||||
|
|
||||||
|
Wenn das Array-Ende erreicht ist, feuert er ein OnFinished-Ereignis.
|
||||||
|
|
||||||
|
Der Backtest-Block führt die Logik aus, wartet auf das OnFinished-Ereignis und gibt dann das gesammelte Ergebnis zurück.
|
||||||
|
|
||||||
|
Der entscheidende Vorteil: Die Logik innerhalb des [On New Bar ... do ...]-Blocks muss nicht wissen, ob die Balken aus einem Live-Feed oder einem Simulator kommen. Sie kann für beide Szenarien identisch sein. Dies eliminiert einen der größten Risikofaktoren im algorithmischen Handel: Diskrepanzen zwischen Backtest- und Live-Implementierung.
|
||||||
|
|
||||||
|
Fazit:
|
||||||
|
|
||||||
|
Sie lösen das Problem, indem Sie von einem daten-zentrierten (Übergabe eines Arrays) zu einem quell-zentrierten (Übergabe eines Providers) Modell wechseln und eine ereignisgesteuerte Verarbeitung einführen. Das ist die Standard-Architektur für reaktive Systeme und passt perfekt zum Live-Handel.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Könnte man dem Provider das [On New Bar...] nicht auch einfach als closure-Parameter mitgeben?
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Ja, absolut. Das ist eine hervorragende Beobachtung und eine konzeptionell sehr saubere, funktionale Alternative zum deklarativen Event-Handler-Block. Anstatt auf ein globales Ereignis zu lauschen, würden Sie die Verarbeitungslogik direkt als Parameter übergeben.
|
||||||
|
|
||||||
|
Dieser Ansatz passt perfekt zum Higher-Order-Function-Paradigma, das wir bereits für die Strategie-Factories etabliert haben.
|
||||||
|
|
||||||
|
So würde der Ansatz mit dem Closure-Parameter aussehen:
|
||||||
|
Sie würden den [On New Bar]-Block durch einen "ausführenden" Block ersetzen, der die Logik als Argument entgegennimmt.
|
||||||
|
|
||||||
|
Neuer Block: [Subscribe to Provider] oder [Run Provider] (Statement)
|
||||||
|
|
||||||
|
Inputs:
|
||||||
|
|
||||||
|
Provider: Das DataProvider-Handle (wie gehabt).
|
||||||
|
|
||||||
|
onNewBar: Ein IDataMethodValue. Dies ist der entscheidende Input – ein Slot, der eine Funktion erwartet. Die Signatur dieser Funktion wäre function(bar: IDataRecordValue).
|
||||||
|
|
||||||
|
onError (optional): Ein weiterer IDataMethodValue für die Fehlerbehandlung.
|
||||||
|
|
||||||
|
onFinished (optional): Ein IDataMethodValue, der aufgerufen wird, wenn der Stream endet (relevant für Backtests).
|
||||||
|
|
||||||
|
Implementierung: Dieser native Delphi-Block würde den Provider starten und die übergebene onNewBar-Closure als Callback für das interne OnNewData-Ereignis des Providers registrieren.
|
||||||
|
|
||||||
|
Beispiel-Skript im neuen Stil
|
||||||
|
Das Live-Trading-Skript würde sich leicht verändern. Die Logik, die vorher im "do"-Bereich des Event-Handlers stand, wird nun in einen anonymen Funktionsblock (Lambda) gepackt und direkt übergeben:
|
||||||
|
|
||||||
|
// --- Initialisierungsphase (bleibt gleich) ---
|
||||||
|
set [myStrategy] to [...]
|
||||||
|
set [liveFeed] to [...]
|
||||||
|
set [realBroker] to [...]
|
||||||
|
|
||||||
|
// --- Start der Verarbeitung mit Closure als Callback ---
|
||||||
|
|
||||||
|
[Subscribe to Provider [liveFeed] onNewBar: [
|
||||||
|
// Dies ist ein anonymer Funktionsblock (Lambda),
|
||||||
|
// der als IDataMethodValue in den Slot gereicht wird.
|
||||||
|
|
||||||
|
function with [currentBar] do
|
||||||
|
call function [myStrategy] with bar:[currentBar], broker:[realBroker]
|
||||||
|
end function
|
||||||
|
]]
|
||||||
|
Vergleich der beiden Ansätze
|
||||||
|
Beide Ansätze sind valide und führen zum Ziel. Es ist eine Design-Entscheidung, welche Metapher Sie in Ihrer visuellen Sprache bevorzugen.
|
||||||
|
|
||||||
|
Eigenschaft Ansatz 1: [On New Bar ...] Ansatz 2: Closure-Parameter
|
||||||
|
Metapher Abonnement / Event-Listener Callback / Higher-Order Function
|
||||||
|
Stil Deklarativ, ereignisgesteuert. Funktional, imperativ.
|
||||||
|
Vorteile - Visuell sehr intuitiv, ähnlich wie UI-Programmierung (button.onClick).<br>- Einfache Anbindung mehrerer, unabhängiger Handler an dieselbe Quelle. - Konzeptionell extrem sauber und in sich geschlossen.<br>- Expliziter Daten- und Kontrollfluss.<br>- Konsistent mit dem "Alles ist ein Wert"-Prinzip.
|
||||||
|
Nachteile - Der Kontrollfluss ist weniger explizit; die Verbindung zwischen Quelle und Handler ist implizit.<br>- Wirkt weniger wie ein einzelnes, zusammenhängendes Programm. - Visuell etwas "verschachtelter" durch den Lambda-Block.<br>- Anbindung mehrerer Handler erfordert eine manuelle Dispatcher-Funktion.
|
||||||
|
AST-Knoten TEventHandlerNode TFunctionCallNode (für "Subscribe"), der einen TLambdaNode als Argument nimmt.
|
||||||
|
|
||||||
|
In Google Sheets exportieren
|
||||||
|
Fazit
|
||||||
|
Ihr Vorschlag ist exzellent. Er ist aus Programmierersicht oft die "reinere" Lösung, da er Abhängigkeiten explizit macht. Für eine visuelle DSL, die vielleicht auch von Nicht-Programmierern genutzt werden soll, kann der [On New Bar]-Ansatz manchmal eingängiger sein.
|
||||||
|
|
||||||
|
Die Schönheit Ihrer Architektur ist, dass die zugrundeliegende Delphi-Implementierung des DataProvider (mit einem simplen TEvent OnNewData) problemlos beide Block-Varianten unterstützen kann. Sie könnten sogar beide Blöcke anbieten und dem Benutzer die Wahl lassen, welchen Stil er bevorzugt.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Schwierig. Ich möchte z.B. in der Lage sein, aus einem Feed mehrere Signale in verschiedenen Timeframes zu generieren und diese dann zu gewichten. Und es soll auch möglich sein, mehrere verschieden Feeds zu analysieren um einee Handelsentscheidung zu treffen.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
D
|
||||||
|
Delphi Coding
|
||||||
|
Benutzerdefiniertes Gem
|
||||||
|
|
||||||
|
Gedankengang anzeigen
|
||||||
|
Das ist eine exzellente, praxisnahe Anforderung. Und hier zeigt sich, meiner Meinung nach, die klare Stärke des ereignisgesteuerten Ansatzes ([On New Bar ...]) gegenüber dem funktionalen Callback-Ansatz.
|
||||||
|
|
||||||
|
Ihr Vorschlag mit der Closure ist elegant für einen einzelnen Datenstrom. Aber für die parallele Verarbeitung mehrerer asynchroner Datenströme, deren Ergebnisse zu einem Zeitpunkt X zusammengeführt werden müssen, ist das Abonnement-Modell (Subscription) oft wesentlich klarer und flexibler.
|
||||||
|
|
||||||
|
Ihre Anforderung lässt sich mit folgenden Konzepten abbilden:
|
||||||
|
|
||||||
|
DataProvider-Ketten (Resampler): Ein Baustein, der einen DataProvider als Input nimmt und einen neuen DataProvider als Output liefert.
|
||||||
|
|
||||||
|
Parallele Event-Handler: Mehrere [On New Bar]-Blöcke, die unabhängig voneinander auf verschiedene Datenquellen lauschen.
|
||||||
|
|
||||||
|
Geteilter Zustand (Shared State): Globale Variablen im Kontroll-Skript, die die Signale der einzelnen Quellen speichern.
|
||||||
|
|
||||||
|
Aggregationslogik: Eine Prozedur, die immer dann aufgerufen wird, wenn sich einer der Inputs ändert, um eine finale Handelsentscheidung zu treffen.
|
||||||
|
|
||||||
|
Szenario 1: Mehrere Timeframes aus einem Feed
|
||||||
|
Ziel: Aus einem 1-Minuten-Feed Signale für 1M, 5M und 15M generieren und gewichten.
|
||||||
|
|
||||||
|
Lösung: Wir führen einen neuen "intelligenten" Provider-Block ein, den Resampler.
|
||||||
|
|
||||||
|
Neuer Block: [Aggregate Timeframe] (oder [Create Resampled Feed])
|
||||||
|
|
||||||
|
Input:
|
||||||
|
|
||||||
|
Source Provider: Der DataProvider der feineren Zeiteinheit (z.B. der 1M-Live-Feed).
|
||||||
|
|
||||||
|
New Timeframe: z.B. "5m", "15m", "1h".
|
||||||
|
|
||||||
|
Output: Ein neuer DataProvider-Handle, der nur dann ein OnNewData-Ereignis auslöst, wenn ein vollständiger Balken der neuen Zeiteinheit fertig ist.
|
||||||
|
|
||||||
|
Implementierung: Ein nativer Delphi-Wrapper, der die ankommenden 1M-Balken sammelt und zu 5M-Balken zusammenfügt.
|
||||||
|
|
||||||
|
Ihr Kontroll-Skript würde dann so aussehen:
|
||||||
|
|
||||||
|
// --- 1. Initialisierung der Datenquellen ---
|
||||||
|
set [live_1m_feed] to [Create Live Data Provider symbol:"BTCUSDT", timeframe:"1m"]
|
||||||
|
|
||||||
|
// Erzeuge die aggregierten Feeds aus der 1M-Quelle
|
||||||
|
set [feed_5m] to [Aggregate Timeframe from:[live_1m_feed] to:"5m"]
|
||||||
|
set [feed_15m] to [Aggregate Timeframe from:[live_1m_feed] to:"15m"]
|
||||||
|
|
||||||
|
|
||||||
|
// --- 2. Initialisierung des geteilten Zustands ---
|
||||||
|
set [signal_1m] to 0
|
||||||
|
set [signal_5m] to 0
|
||||||
|
set [signal_15m] to 0
|
||||||
|
|
||||||
|
|
||||||
|
// --- 3. Parallele Verarbeitung der Feeds (Event Handlers) ---
|
||||||
|
|
||||||
|
[On New Bar [bar] from [live_1m_feed] do
|
||||||
|
set [signal_1m] to [call function [calculateSignal_1m] with data:[bar]]
|
||||||
|
call function [MakeFinalDecision] // Prüfe bei jedem 1M-Tick neu
|
||||||
|
]
|
||||||
|
|
||||||
|
[On New Bar [bar] from [feed_5m] do
|
||||||
|
set [signal_5m] to [call function [calculateSignal_5m] with data:[bar]]
|
||||||
|
// Eine Neubewertung ist hier nicht zwingend nötig, da sie schon durch den 1M-Feed getriggert wird.
|
||||||
|
]
|
||||||
|
|
||||||
|
[On New Bar [bar] from [feed_15m] do
|
||||||
|
set [signal_15m] to [call function [calculateSignal_15m] with data:[bar]]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
// --- 4. Aggregationslogik ---
|
||||||
|
to MakeFinalDecision do
|
||||||
|
// Diese Funktion liest den geteilten Zustand und trifft die Entscheidung
|
||||||
|
set [weighted_signal] to ([signal_1m] * 0.5) + ([signal_5m] * 0.3) + ([signal_15m] * 0.2)
|
||||||
|
|
||||||
|
if [weighted_signal] > 0.8 then
|
||||||
|
[Buy Market on broker:[myBroker] amount:1]
|
||||||
|
else if [weighted_signal] < -0.8 then
|
||||||
|
[Sell Market on broker:[myBroker] amount:1]
|
||||||
|
end if
|
||||||
|
end function
|
||||||
|
Szenario 2: Mehrere verschiedene Feeds
|
||||||
|
Ziel: Den BTC/USDT-Feed und zusätzlich einen S&P500-Feed zur Stimmungsanalyse nutzen.
|
||||||
|
|
||||||
|
Architektonisch ist dies exakt derselbe Anwendungsfall. Anstatt die Feeds durch Resampling zu erzeugen, erstellen Sie einfach zwei unabhängige Live Data Provider.
|
||||||
|
|
||||||
|
// --- 1. Initialisierung der Datenquellen ---
|
||||||
|
set [btc_feed] to [Create Live Data Provider symbol:"BTCUSDT", timeframe:"1h"]
|
||||||
|
set [sp500_feed] to [Create Live Data Provider symbol:"SPY", timeframe:"1h"]
|
||||||
|
|
||||||
|
|
||||||
|
// --- 2. Initialisierung des geteilten Zustands ---
|
||||||
|
set [btc_trend_signal] to 0
|
||||||
|
set [market_sentiment] to "NEUTRAL" // Kann Text, Zahl, etc. sein
|
||||||
|
|
||||||
|
|
||||||
|
// --- 3. Parallele Verarbeitung der Feeds ---
|
||||||
|
|
||||||
|
[On New Bar [bar] from [btc_feed] do
|
||||||
|
set [btc_trend_signal] to [call function [calculateBTCTrend] with data:[bar]]
|
||||||
|
call function [MakeFinalBTCDecision] // Nur hier wird eine Handelsentscheidung für BTC getroffen
|
||||||
|
]
|
||||||
|
|
||||||
|
[On New Bar [bar] from [sp500_feed] do
|
||||||
|
set [market_sentiment] to [call function [calculateSentiment] with data:[bar]]
|
||||||
|
// Hier wird nur der Zustand aktualisiert, keine Order platziert
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
// --- 4. Aggregationslogik ---
|
||||||
|
to MakeFinalBTCDecision do
|
||||||
|
// Diese Funktion berücksichtigt jetzt den Zustand beider Feeds
|
||||||
|
if ([btc_trend_signal] > 0.7) and ([market_sentiment] = "BULLISH") then
|
||||||
|
[Buy Market on broker:[myBroker] for symbol:"BTCUSDT" amount:1]
|
||||||
|
end if
|
||||||
|
end function
|
||||||
|
Fazit
|
||||||
|
Die ereignisgesteuerte Architektur mit parallelen On New Bar-Handlern ist für diese komplexen, realen Szenarien wie geschaffen. Sie ermöglicht:
|
||||||
|
|
||||||
|
Entkopplung: Jeder "Signal-Generator" ist eine eigenständige, isolierte Einheit.
|
||||||
|
|
||||||
|
Klarheit: Das visuelle Layout der parallelen Blöcke spiegelt die tatsächliche parallele Datenverarbeitung wider.
|
||||||
|
|
||||||
|
Flexibilität: Das Hinzufügen einer weiteren Datenquelle (z.B. Zinsdaten) bedeutet lediglich das Hinzufügen eines weiteren DataProvider- und On New Bar-Blockpaars und die Anpassung der finalen Entscheidungslogik.
|
||||||
|
|
||||||
|
Der Versuch, dies mit verschachtelten Callbacks (dem Closure-Ansatz) abzubilden, würde schnell zu einem unübersichtlichen und schwer wartbaren Code führen (bekannt als "Callback Hell" oder "Pyramid of Doom"). Hier ist das deklarative Abo-Modell klar überlegen.
|
||||||
+25462
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,7 @@
|
|||||||
|
### Regeln zur Erzeugung eines White Paper
|
||||||
|
|
||||||
|
- Format: Markdown
|
||||||
|
- Sprache: Englisch
|
||||||
|
|
||||||
|
- Direkte Bezüge auf den Delphi-Quelltext sind verboten.
|
||||||
|
- Wir machen keinen Vorschlag zur Implementierung, sondern begründen, warum etwas bereits implementiert wurde.
|
||||||
+227
@@ -0,0 +1,227 @@
|
|||||||
|
# Zweck und Ziele
|
||||||
|
|
||||||
|
* Unterstütze mich bei der Entwicklung unter Embarcadero Delphi.
|
||||||
|
* Ich bin ein sehr erfahrener Softwareentwickler. Fasse dich kurz und nutze Fachsprache.
|
||||||
|
* Du brauchst mich nicht zu loben.
|
||||||
|
* Wir nutzen immer die neueste Delphi-Version, aktuell ist das Delphi 13.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
# Allgemeine Regeln
|
||||||
|
|
||||||
|
* Sprache im Code und in den Kommentaren: Englisch
|
||||||
|
* Sprache im Chat: Deutsch
|
||||||
|
|
||||||
|
* Ändere niemals den Code, den ich poste - es sei denn, ich fordere dich ausdrücklich dazu auf. Wenn ich Code poste, dann analysiere ihn zunächst und weise mich gegebenenfalls auf Unstimmigkeiten hin.
|
||||||
|
|
||||||
|
* Von mir geposteter Code ersetzt grundsätzlich die ältere Versionen des selben Codes.
|
||||||
|
|
||||||
|
* Bei der Code-Analyse zählt nur die tatsächliche Implementierung. Kommentare können veraltet sein. Weise mich auf Differenzen zwischen Implementierung und Kommentaren hin.
|
||||||
|
|
||||||
|
* Finde Schlüsselstellen im Code und zeige mir durch eine kurze Erklärung, dass du sie verstanden hast.
|
||||||
|
|
||||||
|
* Effizienz ist mir sehr wichtig. Wenn dir etwas auffällt, das die Performance negativ beeinflussen kann, dann weise mich darauf hin.
|
||||||
|
|
||||||
|
* Schlage gegebenenfalls Korrekturen vor. Warte auf meine Zustimmung, bevor die sie vornimmst.
|
||||||
|
|
||||||
|
* Erkläre niemals grundlegende Syntax, es sei denn ich frage ausdrücklich danach.
|
||||||
|
|
||||||
|
* Fasse dich kurz. Behalte den Kontext während der gesamten Konversation bei. Alle Ideen und Antworten sollen mit der vorherigen Diskussion in Verbindung stehen. Schweife nicht ab.
|
||||||
|
|
||||||
|
* Wenn ich unvollständigen Code poste, erstelle einen Plan, wie die Implementierung aussehen könnte und präsentiere ihn kurz und prägnant.
|
||||||
|
|
||||||
|
# TODO
|
||||||
|
|
||||||
|
* Wenn ich Code poste, der einen TODO-Eintrag enthält, dann implementiere die dort spezifizierten Anforderungen.
|
||||||
|
|
||||||
|
* Ändere *nicht* den umliegenden Code. Nutze den vorhandenen Kontext um die Anforderung zu erledigen.
|
||||||
|
|
||||||
|
* Dokumentiere die Änderung knapp direkt im Code.
|
||||||
|
|
||||||
|
* Gib mir als Ergebnis den vollständigen Codeblock zurück.
|
||||||
|
|
||||||
|
# Code-Generierung
|
||||||
|
|
||||||
|
* Befolge die gängigen Delphi-Formatierungsstandards mit folgenden Ausnahmen:
|
||||||
|
|
||||||
|
- Einrückung mit 4 Leerzeichen anstelle von 2. Auch bei Kommentaren.
|
||||||
|
- Das Code-Format ist UTF-8. Nur ASCII, keine Sonderzeichen erlaubt (insb. kein No-Break-Space!)
|
||||||
|
- Folgende Schlüsselwörter müssen klein geschrieben werden:
|
||||||
|
and, or, not, mod, div, in, as, is, array of, sizeof(), inc(), dec(), exit, inc, dec, shl, shr
|
||||||
|
- Compiler-Direktiven (z.B. $region) sollen immer klein geschrieben werden.
|
||||||
|
- Achte darauf keine Schlüsselwörter als Bezeichner (type, Result, if, etc) zu verwenden, da Delphi das nicht unterstützt.
|
||||||
|
|
||||||
|
* Ändere niemals vorhandene Bezeichner im vom Benutzer bereitgestellten Code, es sei denn du wirst dazu aufgefordert.
|
||||||
|
|
||||||
|
* Bei verketteten Vergleichen innerhalb von if-Anweisungen müssen immer runde Klammern verwendet werden, um Teilausdrücke klar zu gruppieren:
|
||||||
|
"if (a > b) and (c < d) then"
|
||||||
|
|
||||||
|
* Funktions- und Prozedurparameter dürfen keinen Präfix haben. Sie sollten großgeschrieben werden:
|
||||||
|
"procedure ProcessData(InputArray: TIntegerArray; const Count: Integer)"
|
||||||
|
|
||||||
|
* Ausnahme: Parameter von Konstruktoren haben "A" als Präfix:
|
||||||
|
"constructor Create(const AValue: Integer)"
|
||||||
|
|
||||||
|
* Lokale Variablen sollten mit einem kleinen Buchstaben beginnen (camel case) (z.B. tempValue: Integer;). Wenn ich von dieser Regel abweiche, ist das in Ordnung.
|
||||||
|
|
||||||
|
* Achte beim Erstellen von Format-Strings (z. B. mit Format()), darauf, dass die Anzahl der Parameter genau der Anzahl der Format-Tags (z. B. %s, %d) entspricht. Überprüfe die Typkompatibilität.
|
||||||
|
|
||||||
|
* Denke daran, dass Delphi nicht zwischen Groß- und Kleinschreibung unterscheidet. Bezeichner müssen sich immer von Schlüsselwörtern unterscheiden.
|
||||||
|
|
||||||
|
* Interfaces benötigen keine GUIDs. Füge keine GUIDs in Interfaces ein und schlagen Sie dies auch nicht vor. Wenn ein gegebenes Interface keine GUID hat, ist das so gewollt. GUIDs werden ausschließlich von mir vergeben. Füge niemals selbst eine GUID hinzu.
|
||||||
|
|
||||||
|
* Interfaces sind reference counted! Einfaches atomares Locking (z.B. CompareExchange) funktioniert nicht und führt zu bösen Crashes!
|
||||||
|
|
||||||
|
* TThread ist in System.Classes definiert.
|
||||||
|
* TInterlocked ist in System.SyncObjs definiert.
|
||||||
|
|
||||||
|
* Statement-Blöcke werden mit begin..end eingekapselt. (Niemals mit Klammern!)
|
||||||
|
* begin und end stehen am Anfang einer neuen Zeile. then steht nie am Anfang einer neuen Zeile.
|
||||||
|
* RECORDs, die einen Initialize-Operator haben, sind Managed Records. Sie benötigen also kein explizites Create.
|
||||||
|
* Vorwärtsdeklarationen von Records werden in Delphi nicht unterstützt. Die Lösung dafür ist, das benutzende Element im Scope des Records zu definieren.
|
||||||
|
|
||||||
|
# Unit-Tests
|
||||||
|
|
||||||
|
* Unit-Tests basieren auf DUnitX.
|
||||||
|
|
||||||
|
* Verwende in Tests nur statische Strings für Log-Einträge und Asserts. Kein Format(), ToString usw. (Das verursacht Speicherlecks außerhalb des Test-Gültigkeitsbereichs, sodass ein Leak vom Memory Manager gemeldet wird.)
|
||||||
|
|
||||||
|
* Verwende möglichst Assert.AreEqual<T>() anstelle von Assert.AreEqual().
|
||||||
|
|
||||||
|
* Nutze das TestCase-Attribut um Tests zu parametrisieren ausgiebig. Z. B. [TestCase('TestName', 'Parameter1,Parameter2,...')]
|
||||||
|
|
||||||
|
* Neue Test-Units haben den Namen "Test.[unit].[what].pas", wobei [unit] der volle Name der zu testenden Unit ist und [what] ein optionales Wort, falls nur ein spezieller Aspekt der Unit getestet werden soll.
|
||||||
|
|
||||||
|
|
||||||
|
# Kommentare im Code
|
||||||
|
|
||||||
|
* Kommentare sind immer englisch.
|
||||||
|
|
||||||
|
* Vermeide jegliche Kommentare, die Änderungen am Code beschreiben. Z.B. "// changed", "// added", "// removed".
|
||||||
|
|
||||||
|
* Benutze keine HTML-Tags (`<summary>`, etc.)!
|
||||||
|
* Benutze `//` oder `(* *)` und fasse dich extrem kurz. Meistens genügen Einzeiler vor den Deklarationen.
|
||||||
|
|
||||||
|
* Kommentare in der interface-Sektion einer Unit sollen die Schnittstelle dokumentieren. Dokumentiere ausschließlich Elemente, die auch von außen zugänglich sind, und beziehe dich auch nur auf Elemente, die von außen zugänglich sind. Im Interface wird beschrieben, **was** eine Funktion macht. Es wird nicht beschrieben **wie** sie es macht!
|
||||||
|
|
||||||
|
* Kommentare im Implementation-Teil sollten sehr sparsam eingesetzt werden. Sie sind nur nötig, wenn etwas wirklich kompliziertes Beschrieben werden muss und auch nur, wenn sich die Funktion nicht aus dem Quelltext ergibt.
|
||||||
|
|
||||||
|
* Jede Klassen-, Record-, oder Interface-Definition sollte einen sinnvollen Einzeiler haben.
|
||||||
|
|
||||||
|
# Refactoring
|
||||||
|
|
||||||
|
* Umschließe alle Reader- und Writer-Properties innerhalb einer Interface-Definition mit eine Region 'private'. So zum Beispiel:
|
||||||
|
|
||||||
|
```
|
||||||
|
IConverter = interface(IMycProcessor<S>)
|
||||||
|
{$region 'private'}
|
||||||
|
function GetSender: TDataProvider<T>.IDataProvider;
|
||||||
|
{$endregion}
|
||||||
|
property Sender: TDataProvider<T>.IDataProvider read GetSender;
|
||||||
|
end;
|
||||||
|
```
|
||||||
|
|
||||||
|
# Projektplan
|
||||||
|
|
||||||
|
* **Wenn ich dich darum bitte**, erzeuge eine ausführliche Zusammenfassung der Ergebnisse unserer Unterhaltung. Diese möchte ich in Gitea als Issue anlegen.
|
||||||
|
|
||||||
|
- Formatiere in Markdown. Gib als Antwort nur den Projektplan aus (damit ich ihn direkt kopieren kann).
|
||||||
|
- Gliedere in der Reihenfolge: Motivation - Ziel - Ergebnis
|
||||||
|
- Nutze Listen zum Abhaken "- [ ] ...". Gitea erkennt diese Listen als Todo-Marker.
|
||||||
|
|
||||||
|
# Interface helper
|
||||||
|
|
||||||
|
**Interface helper** sind ein Konzept, dass *nicht* explizit in Delphi/Pascal verankert ist. Es werden stattdessen managed records benutzt um ein Interface zu kapseln und die zugrundeliegende Implementierung vollständig zu verbergen.
|
||||||
|
|
||||||
|
- Ein "interface helper" ist ein managed record, das immer nur **genau ein** Interface referenziert.
|
||||||
|
|
||||||
|
- Die Definition des Interface findet sich meist im Scope des helpers (ganz am Anfang mit Default-Visibility).
|
||||||
|
|
||||||
|
- Es verbirgt die verschiedenen Implementierungen des Interface und fungiert als generische "Instanz" des interface.
|
||||||
|
|
||||||
|
- interface helper unterstützen das **null object pattern**. Der Sinn dieses Patterns ist es, nil-Prüfungen überflüssig zu machen und stattdessen ein Null-Objekt mit definiertem "leerem" Verhalten zu haben.
|
||||||
|
|
||||||
|
- Die Implementierungen des Interfaces finden sich oft in "Core"-Klassen, oder im implementation-Teil der Unit. Diese Implementierungen sollen von Benutzern nicht direkt eingebunden werden (außer zum Testen.)
|
||||||
|
|
||||||
|
* Wenn ich dich dazu auffordere sollst du ihn so weit wie möglich selbst erzeugen, oder einen unvollständigen helper ergänzen. Auf jeden Fall enthält ein interface helper:
|
||||||
|
- einen Konstruktor
|
||||||
|
- zwei implicit-operatoren, die vom helper zum interface casten (und umgekehrt)
|
||||||
|
- Wrapper für die Methoden und Properties des Interface.
|
||||||
|
- ein class property "Null".
|
||||||
|
|
||||||
|
* Direkte Wrapper auf Interface-Methoden sind *inline*.
|
||||||
|
|
||||||
|
* Immer wenn ein interface helper für ein interface vorhanden wird, soll er auch benutzt werden. Greife nicht direkt auf die Implementierung zu, lasse den helper das erledigen. Beispiel:
|
||||||
|
|
||||||
|
```
|
||||||
|
type
|
||||||
|
TFuture<T> = record
|
||||||
|
type
|
||||||
|
IFuture = interface
|
||||||
|
function GetValue: T;
|
||||||
|
function GetDone: TState;
|
||||||
|
end;
|
||||||
|
|
||||||
|
strict private
|
||||||
|
class var
|
||||||
|
FNull: IFuture;
|
||||||
|
|
||||||
|
class constructor CreateClass;
|
||||||
|
|
||||||
|
private
|
||||||
|
FFuture: IFuture;
|
||||||
|
function GetDone: TState; inline;
|
||||||
|
function GetValue: T; inline;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(const AFuture: IFuture);
|
||||||
|
|
||||||
|
class operator Initialize(out Dest: TFuture<T>);
|
||||||
|
class operator Implicit(const A: IFuture): TFuture<T>; overload;
|
||||||
|
class operator Implicit(const A: TFuture<T>): IFuture; overload;
|
||||||
|
|
||||||
|
class property Null: IFuture read FNull;
|
||||||
|
|
||||||
|
// Wrapper methods for IFuture
|
||||||
|
property Done: TState read GetDone;
|
||||||
|
property Value: T read GetValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TFuture<T>.Create(const AFuture: IFuture);
|
||||||
|
begin
|
||||||
|
FFuture := AFuture;
|
||||||
|
if not Assigned(FFuture) then
|
||||||
|
FFuture := FNull;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class constructor TFuture<T>.CreateClass;
|
||||||
|
begin
|
||||||
|
FNull := TNullFuture.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TFuture<T>.Implicit(const A: IFuture): TFuture<T>;
|
||||||
|
begin
|
||||||
|
Result.FFuture := A;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TFuture<T>.Implicit(const A: TFuture<T>): IFuture;
|
||||||
|
begin
|
||||||
|
Result := A.FFuture;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TFuture<T>.Initialize(out Dest: TFuture<T>);
|
||||||
|
begin
|
||||||
|
Dest.FFuture := FNull;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFuture<T>.GetDone: TState;
|
||||||
|
begin
|
||||||
|
Result := FFuture.Done;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFuture<T>.GetValue: T;
|
||||||
|
begin
|
||||||
|
Result := FFuture.Value;
|
||||||
|
end;
|
||||||
|
```
|
||||||
|
|
||||||
@@ -0,0 +1,324 @@
|
|||||||
|
unit Myc.Ast.Analysis.Purity;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Analyzes an AST to determine if it is referentially transparent and free of side effects.
|
||||||
|
TPurityAnalyzer = class(TAstVisitor<Boolean>)
|
||||||
|
strict private
|
||||||
|
// --- Safe Leaves / Constructs ---
|
||||||
|
function VisitConstant(const Node: IAstNode): Boolean;
|
||||||
|
function VisitKeyword(const Node: IAstNode): Boolean;
|
||||||
|
function VisitIfExpression(const Node: IAstNode): Boolean;
|
||||||
|
function VisitCondExpression(const Node: IAstNode): Boolean;
|
||||||
|
function VisitBlockExpression(const Node: IAstNode): Boolean;
|
||||||
|
function VisitRecordLiteral(const Node: IAstNode): Boolean;
|
||||||
|
function VisitVariableDeclaration(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// --- Elements ---
|
||||||
|
function VisitRecordField(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// --- Critical Checks ---
|
||||||
|
function VisitIdentifier(const Node: IAstNode): Boolean;
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): Boolean;
|
||||||
|
function VisitRecurNode(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// --- Forbidden Constructs (Side Effects / Unsafe) ---
|
||||||
|
function VisitAssignment(const Node: IAstNode): Boolean;
|
||||||
|
function VisitAddSeriesItem(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// Allocation is considered pure in this context
|
||||||
|
function VisitCreateSeries(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
function VisitIndexer(const Node: IAstNode): Boolean;
|
||||||
|
function VisitMemberAccess(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// Ignored / Irrelevant for Runtime Purity
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): Boolean;
|
||||||
|
function VisitMacroDefinition(const Node: IAstNode): Boolean;
|
||||||
|
function VisitQuasiquote(const Node: IAstNode): Boolean;
|
||||||
|
function VisitUnquote(const Node: IAstNode): Boolean;
|
||||||
|
function VisitUnquoteSplicing(const Node: IAstNode): Boolean;
|
||||||
|
function VisitMacroExpansionNode(const Node: IAstNode): Boolean;
|
||||||
|
function VisitNop(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// Unification: Tuple (for [vectors], arguments, parameters, fields)
|
||||||
|
function VisitTuple(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// Pipe Support
|
||||||
|
function VisitPipe(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
// Helper to check if a node is pure (handling nil gracefully)
|
||||||
|
function IsNodePure(const Node: IAstNode): Boolean;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
class function IsPure(const RootNode: IAstNode): Boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TPurityAnalyzer }
|
||||||
|
|
||||||
|
class function TPurityAnalyzer.IsPure(const RootNode: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
var analyzer := TPurityAnalyzer.Create;
|
||||||
|
try
|
||||||
|
// Use the visitor's central dispatch method
|
||||||
|
Result := analyzer.Visit(RootNode);
|
||||||
|
finally
|
||||||
|
analyzer.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.IsNodePure(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// If a node is nil (e.g. optional else-branch), it's "nothing", which is pure.
|
||||||
|
if not Assigned(Node) then
|
||||||
|
exit(True);
|
||||||
|
|
||||||
|
// Dispatch to registry
|
||||||
|
Result := Visit(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPurityAnalyzer.SetupHandlers;
|
||||||
|
begin
|
||||||
|
// Core
|
||||||
|
Register(akConstant, VisitConstant);
|
||||||
|
Register(akIdentifier, VisitIdentifier);
|
||||||
|
Register(akKeyword, VisitKeyword);
|
||||||
|
|
||||||
|
// Elements
|
||||||
|
Register(akRecordField, VisitRecordField);
|
||||||
|
|
||||||
|
// Structural
|
||||||
|
Register(akIfExpression, VisitIfExpression);
|
||||||
|
Register(akCondExpression, VisitCondExpression);
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
Register(akMacroExpansion, VisitMacroExpansionNode);
|
||||||
|
Register(akBlockExpression, VisitBlockExpression);
|
||||||
|
Register(akVariableDeclaration, VisitVariableDeclaration);
|
||||||
|
Register(akAssignment, VisitAssignment);
|
||||||
|
Register(akMacroDefinition, VisitMacroDefinition);
|
||||||
|
Register(akQuasiquote, VisitQuasiquote);
|
||||||
|
Register(akUnquote, VisitUnquote);
|
||||||
|
Register(akUnquoteSplicing, VisitUnquoteSplicing);
|
||||||
|
Register(akIndexer, VisitIndexer);
|
||||||
|
Register(akMemberAccess, VisitMemberAccess);
|
||||||
|
Register(akRecordLiteral, VisitRecordLiteral);
|
||||||
|
Register(akCreateSeries, VisitCreateSeries);
|
||||||
|
Register(akAddSeriesItem, VisitAddSeriesItem);
|
||||||
|
Register(akRecur, VisitRecurNode);
|
||||||
|
Register(akNop, VisitNop);
|
||||||
|
|
||||||
|
// Unified List Type
|
||||||
|
Register(akTuple, VisitTuple);
|
||||||
|
|
||||||
|
// Pipes
|
||||||
|
Register(akPipe, VisitPipe);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- List / Container Visitors ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitTuple(const Node: IAstNode): Boolean;
|
||||||
|
var
|
||||||
|
T: ITupleNode;
|
||||||
|
begin
|
||||||
|
T := Node.AsTuple;
|
||||||
|
// A tuple is pure if ALL its elements are pure.
|
||||||
|
// Optimization: Use Elements array directly
|
||||||
|
for var item in T.Elements do
|
||||||
|
begin
|
||||||
|
if not IsNodePure(item) then
|
||||||
|
exit(False);
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitRecordField(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Key is usually pure (Keyword), check Value
|
||||||
|
var F := Node.AsRecordField;
|
||||||
|
Result := IsNodePure(F.Key) and IsNodePure(F.Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Safe Leaves ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitConstant(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitKeyword(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitNop(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Identifier: Only local variables are safe ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitIdentifier(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// We only allow access to local variables (ScopeDepth = 0).
|
||||||
|
// Accessing Parent/Upvalues (ScopeDepth > 0) makes the function state-dependent (closure state),
|
||||||
|
// effectively impure regarding referential transparency across different closure instances,
|
||||||
|
// unless we could prove the upvalue is constant (which we don't track yet).
|
||||||
|
var I := Node.AsIdentifier;
|
||||||
|
Result := (I.Address.Kind = akLocalOrParent) and (I.Address.ScopeDepth = 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Function Call: The Core Logic ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitFunctionCall(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
var C := Node.AsFunctionCall;
|
||||||
|
// 1. The target function MUST be marked as Pure (from RTL or previous inference).
|
||||||
|
if not C.IsTargetPure then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
// 2. All arguments (Tuple) must be pure expressions.
|
||||||
|
Result := IsNodePure(C.Arguments);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Recursion ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitRecurNode(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// 'recur' is just control flow. It is pure if its arguments are pure.
|
||||||
|
Result := IsNodePure(Node.AsRecur.Arguments);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Structures: Recursive Checks ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitIfExpression(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
var E := Node.AsIfExpression;
|
||||||
|
Result := IsNodePure(E.Condition) and IsNodePure(E.ThenBranch) and IsNodePure(E.ElseBranch);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitCondExpression(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
var E := Node.AsCondExpression;
|
||||||
|
// All conditions and all branches must be pure
|
||||||
|
for var pair in E.Pairs do
|
||||||
|
begin
|
||||||
|
if not (IsNodePure(pair.Condition) and IsNodePure(pair.Branch)) then
|
||||||
|
Exit(False);
|
||||||
|
end;
|
||||||
|
// And the Else branch
|
||||||
|
Result := IsNodePure(E.ElseBranch);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitBlockExpression(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Delegate to Expression Tuple
|
||||||
|
Result := IsNodePure(Node.AsBlockExpression.Expressions);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitVariableDeclaration(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// 'def x = ...' is locally pure if the initializer is pure.
|
||||||
|
// It mutates the local scope (stack), but that is contained within the function execution.
|
||||||
|
Result := IsNodePure(Node.AsVariableDeclaration.Initializer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitRecordLiteral(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Delegate to Fields Tuple
|
||||||
|
Result := IsNodePure(Node.AsRecordLiteral.Fields);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitIndexer(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Reading from a structure is pure if the indices/base are pure.
|
||||||
|
var I := Node.AsIndexer;
|
||||||
|
Result := IsNodePure(I.Base) and IsNodePure(I.Index);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitMemberAccess(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := IsNodePure(Node.AsMemberAccess.Base);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Forbidden (Impure) ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitAssignment(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Mutation of variables is defined as impure.
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitAddSeriesItem(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Mutation of a series (side effect).
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitCreateSeries(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Creating a NEW object is considered pure in this context,
|
||||||
|
// as it does not mutate existing global state.
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Irrelevant / Nested (Definitions are pure, execution logic checked separately) ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitLambdaExpression(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// Defining a function is a pure operation.
|
||||||
|
// Whether the function itself is pure when executed is determined when *that* function is compiled.
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitMacroDefinition(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := True; // Compile-time construct
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitQuasiquote(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := True; // Structural construction
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitUnquote(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := IsNodePure(Node.AsUnquote.Expression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitUnquoteSplicing(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
Result := IsNodePure(Node.AsUnquoteSplicing.Expression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitMacroExpansionNode(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
// We analyze the already expanded body.
|
||||||
|
Result := IsNodePure(Node.AsMacroExpansion.ExpandedBody);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Pipe Support ---
|
||||||
|
|
||||||
|
function TPurityAnalyzer.VisitPipe(const Node: IAstNode): Boolean;
|
||||||
|
begin
|
||||||
|
var P := Node.AsPipe;
|
||||||
|
// A pipe is pure if its inputs are pure AND its transformation lambda is pure.
|
||||||
|
// P.Inputs is an ITupleNode (recursive Tuple of Tuples), so VisitTuple handles it.
|
||||||
|
Result := IsNodePure(P.Inputs) and IsNodePure(P.Transformation);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,163 @@
|
|||||||
|
unit Myc.Ast.Attributes;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
system.sysutils;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Defines the content type for the LLM schema generation. }
|
||||||
|
TFieldKind = (
|
||||||
|
fkNode, // Node (recursive structure)
|
||||||
|
fkIdentifier, // Identifier ["Id", "name"]
|
||||||
|
fkKeyword, // Keyword literal ["Key", "name"]
|
||||||
|
fkLambda, // Lambda definition ["Fn", [...], body]
|
||||||
|
fkTuple, // Tuple (explicit ["Tuple", [...]] structure)
|
||||||
|
fkString, // Raw String (for identifiers/names)
|
||||||
|
fkValue, // TDataValue (primitive constants like number, string, boolean)
|
||||||
|
fkNullableNode, // Optional Node ('AstNode | null')
|
||||||
|
fkArrayOfNodes, // Raw Array of Nodes (used inside Tuple)
|
||||||
|
fkArrayOfPairs, // Special structure for CondExpr: [[Cond, Branch], ...]
|
||||||
|
fkArrayOfKeys, // Special structure for an array of keywords
|
||||||
|
fkPipeInputs // Specific structure: ["Tuple", [ ["Tuple", [Id, Tuple]], ... ]]
|
||||||
|
);
|
||||||
|
|
||||||
|
{ AstTagAttribute: Defines the JSON Tag for an AST Node. }
|
||||||
|
AstTagAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FTag: string;
|
||||||
|
public
|
||||||
|
constructor Create(const ATag: string);
|
||||||
|
property Tag: string read FTag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstFieldAttribute: Defines a field within the JSON Array. }
|
||||||
|
AstFieldAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FName: string;
|
||||||
|
FKind: TFieldKind;
|
||||||
|
FIndex: Integer;
|
||||||
|
public
|
||||||
|
constructor Create(AIndex: Integer; const AName: string; AKind: TFieldKind);
|
||||||
|
property Index: Integer read FIndex;
|
||||||
|
property Name: string read FName;
|
||||||
|
property Kind: TFieldKind read FKind;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstDocAttribute: Provides semantic documentation for the LLM. }
|
||||||
|
AstDocAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FDescription: string;
|
||||||
|
public
|
||||||
|
constructor Create(const ADescription: string);
|
||||||
|
property Description: string read FDescription;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstScriptExampleAttribute: Provides an example in script syntax.
|
||||||
|
The generator converts this to JSON AST for the LLM prompt. }
|
||||||
|
AstScriptExampleAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FScript: string;
|
||||||
|
public
|
||||||
|
constructor Create(const AScript: string);
|
||||||
|
property Script: string read FScript;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstSignatureAttribute: Defines a specific overload signature for an RTL function. }
|
||||||
|
AstSignatureAttribute = class(TCustomAttribute)
|
||||||
|
private
|
||||||
|
FSignature: string;
|
||||||
|
public
|
||||||
|
constructor Create(const ASignature: string);
|
||||||
|
property Signature: string read FSignature;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Decorates a native function to be exported to the Myc runtime.
|
||||||
|
// 'IsPure' hints the compiler that the function has no side effects.
|
||||||
|
TRtlExportAttribute = class(TCustomAttribute)
|
||||||
|
type
|
||||||
|
TPurity = (Pure, Impure);
|
||||||
|
public
|
||||||
|
Name: string;
|
||||||
|
IsPure: Boolean;
|
||||||
|
constructor Create(const AName: string); overload;
|
||||||
|
constructor Create(const AName: string; APurity: TPurity); overload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Decorates a class function to be exported as a constant value.
|
||||||
|
// The function is invoked once at registration time.
|
||||||
|
TRtlConstAttribute = class(TCustomAttribute)
|
||||||
|
public
|
||||||
|
Name: string;
|
||||||
|
constructor Create(const AName: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ AstTagAttribute }
|
||||||
|
|
||||||
|
constructor AstTagAttribute.Create(const ATag: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FTag := ATag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstFieldAttribute }
|
||||||
|
|
||||||
|
constructor AstFieldAttribute.Create(AIndex: Integer; const AName: string; AKind: TFieldKind);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FIndex := AIndex;
|
||||||
|
FName := AName;
|
||||||
|
FKind := AKind;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstDocAttribute }
|
||||||
|
|
||||||
|
constructor AstDocAttribute.Create(const ADescription: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FDescription := ADescription;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstScriptExampleAttribute }
|
||||||
|
|
||||||
|
constructor AstScriptExampleAttribute.Create(const AScript: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FScript := AScript;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ AstSignatureAttribute }
|
||||||
|
|
||||||
|
constructor AstSignatureAttribute.Create(const ASignature: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FSignature := ASignature;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//==================================================================================================
|
||||||
|
// Attribute Implementations
|
||||||
|
//==================================================================================================
|
||||||
|
|
||||||
|
constructor TRtlExportAttribute.Create(const AName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
Name := AName;
|
||||||
|
IsPure := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TRtlExportAttribute.Create(const AName: string; APurity: TPurity);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
Name := AName;
|
||||||
|
IsPure := APurity = Pure;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TRtlConstAttribute.Create(const AName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
Name := AName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,246 @@
|
|||||||
|
unit Myc.Ast.Compiler.Binder.Upvalues;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
// This visitor analyzes the AST to find all variables that need to be "lifted" or "boxed"
|
||||||
|
// because they are captured by a nested lambda.
|
||||||
|
TUpvalueAnalyzer = class(TAstTransformer)
|
||||||
|
private
|
||||||
|
type
|
||||||
|
// Internal helper to track scopes during analysis without using IScopeDescriptor
|
||||||
|
TAnalysisScope = class
|
||||||
|
private
|
||||||
|
FParent: TAnalysisScope;
|
||||||
|
// Maps Name -> DeclarationNode.
|
||||||
|
// If Value is nil, it means the name is defined (e.g. parameter) but not a candidate for boxing.
|
||||||
|
FDeclarations: TDictionary<string, IVariableDeclarationNode>;
|
||||||
|
public
|
||||||
|
constructor Create(AParent: TAnalysisScope);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Define(const Name: string; const Node: IVariableDeclarationNode);
|
||||||
|
|
||||||
|
// Returns the scope where the symbol is defined and the declaration node (if any)
|
||||||
|
function Resolve(const Name: string; out ScopeDepth: Integer; out Node: IVariableDeclarationNode): Boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
private
|
||||||
|
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
|
||||||
|
FCurrentScope: TAnalysisScope;
|
||||||
|
|
||||||
|
procedure MarkDeclarationForBoxing(const AName: string);
|
||||||
|
|
||||||
|
strict private
|
||||||
|
// Analysis Handlers (IAstNode signature)
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitIdentifier(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function Execute(const ARootNode: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
class function Analyze(const ARootNode: IAstNode): THashSet<IVariableDeclarationNode>; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Generics.Defaults,
|
||||||
|
Myc.Ast.Types;
|
||||||
|
|
||||||
|
{ TUpvalueAnalyzer.TAnalysisScope }
|
||||||
|
|
||||||
|
constructor TUpvalueAnalyzer.TAnalysisScope.Create(AParent: TAnalysisScope);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FParent := AParent;
|
||||||
|
FDeclarations := TDictionary<string, IVariableDeclarationNode>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TUpvalueAnalyzer.TAnalysisScope.Destroy;
|
||||||
|
begin
|
||||||
|
FDeclarations.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUpvalueAnalyzer.TAnalysisScope.Define(const Name: string; const Node: IVariableDeclarationNode);
|
||||||
|
begin
|
||||||
|
FDeclarations.AddOrSetValue(Name, Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TUpvalueAnalyzer.TAnalysisScope.Resolve(const Name: string; out ScopeDepth: Integer; out Node: IVariableDeclarationNode): Boolean;
|
||||||
|
var
|
||||||
|
current: TAnalysisScope;
|
||||||
|
begin
|
||||||
|
ScopeDepth := 0;
|
||||||
|
current := Self;
|
||||||
|
while Assigned(current) do
|
||||||
|
begin
|
||||||
|
if current.FDeclarations.TryGetValue(Name, Node) then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Inc(ScopeDepth);
|
||||||
|
current := current.FParent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Node := nil;
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TUpvalueAnalyzer }
|
||||||
|
|
||||||
|
constructor TUpvalueAnalyzer.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FBoxedDeclarations := THashSet<IVariableDeclarationNode>.Create;
|
||||||
|
// Create a root scope to handle top-level definitions cleanly
|
||||||
|
FCurrentScope := TAnalysisScope.Create(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TUpvalueAnalyzer.Destroy;
|
||||||
|
begin
|
||||||
|
// Unwind scope stack if exception occurred or Execute wasn't fully clean
|
||||||
|
while Assigned(FCurrentScope.FParent) do
|
||||||
|
begin
|
||||||
|
var temp := FCurrentScope;
|
||||||
|
FCurrentScope := FCurrentScope.FParent;
|
||||||
|
temp.Free;
|
||||||
|
end;
|
||||||
|
FCurrentScope.Free;
|
||||||
|
|
||||||
|
FBoxedDeclarations.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUpvalueAnalyzer.SetupHandlers;
|
||||||
|
begin
|
||||||
|
inherited SetupHandlers; // Load default transformer logic
|
||||||
|
|
||||||
|
// Override specific handlers for analysis
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
Register(akIdentifier, VisitIdentifier);
|
||||||
|
Register(akVariableDeclaration, VisitVariableDeclaration);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TUpvalueAnalyzer.Execute(const ARootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := Accept(ARootNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TUpvalueAnalyzer.Analyze(const ARootNode: IAstNode): THashSet<IVariableDeclarationNode>;
|
||||||
|
var
|
||||||
|
analyzer: TUpvalueAnalyzer;
|
||||||
|
begin
|
||||||
|
// Note: AParent (IScopeDescriptor) removed from arguments as this analyzer
|
||||||
|
// builds its own structural view and only cares about boxing internal variables.
|
||||||
|
|
||||||
|
if not Assigned(ARootNode) then
|
||||||
|
exit(THashSet<IVariableDeclarationNode>.Create);
|
||||||
|
|
||||||
|
analyzer := TUpvalueAnalyzer.Create;
|
||||||
|
try
|
||||||
|
analyzer.Execute(ARootNode);
|
||||||
|
Result := analyzer.FBoxedDeclarations;
|
||||||
|
analyzer.FBoxedDeclarations := nil; // Transfer ownership
|
||||||
|
finally
|
||||||
|
analyzer.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TUpvalueAnalyzer.MarkDeclarationForBoxing(const AName: string);
|
||||||
|
var
|
||||||
|
depth: Integer;
|
||||||
|
declNode: IVariableDeclarationNode;
|
||||||
|
begin
|
||||||
|
// Check if the symbol exists in our analysis scopes
|
||||||
|
if FCurrentScope.Resolve(AName, depth, declNode) then
|
||||||
|
begin
|
||||||
|
// If it is found in a parent scope (Depth > 0) AND we have a trackable declaration node for it
|
||||||
|
if (depth > 0) and Assigned(declNode) then
|
||||||
|
begin
|
||||||
|
FBoxedDeclarations.Add(declNode);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TUpvalueAnalyzer.VisitIdentifier(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
// Check if this identifier refers to a variable from an outer scope
|
||||||
|
MarkDeclarationForBoxing(Node.AsIdentifier.Name);
|
||||||
|
|
||||||
|
// Return original node (Analysis pass only)
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TUpvalueAnalyzer.VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
L: ILambdaExpressionNode;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
L := Node.AsLambdaExpression;
|
||||||
|
|
||||||
|
// 1. Enter new analysis scope
|
||||||
|
FCurrentScope := TAnalysisScope.Create(FCurrentScope);
|
||||||
|
try
|
||||||
|
// 2. Register parameters (they mask outer variables)
|
||||||
|
// We pass 'nil' as the node because we currently don't box parameters,
|
||||||
|
// but we must ensure Resolve() finds them so we don't accidentally box a shadowed variable.
|
||||||
|
|
||||||
|
// Optimized: Access Elements array directly
|
||||||
|
var paramElements := L.Parameters.Elements;
|
||||||
|
for i := 0 to High(paramElements) do
|
||||||
|
begin
|
||||||
|
if paramElements[i].Kind = akIdentifier then
|
||||||
|
FCurrentScope.Define(paramElements[i].AsIdentifier.Name, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 3. Visit Body
|
||||||
|
Accept(L.Body); // Recursive call
|
||||||
|
|
||||||
|
// Rebuild if needed (default CoW behavior)
|
||||||
|
Result := Node;
|
||||||
|
finally
|
||||||
|
// 4. Exit scope
|
||||||
|
var temp := FCurrentScope;
|
||||||
|
FCurrentScope := FCurrentScope.FParent;
|
||||||
|
temp.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
V: IVariableDeclarationNode;
|
||||||
|
begin
|
||||||
|
V := Node.AsVariableDeclaration;
|
||||||
|
|
||||||
|
// 1. Visit initializer first (it executes in the CURRENT scope)
|
||||||
|
if Assigned(V.Initializer) then
|
||||||
|
Accept(V.Initializer);
|
||||||
|
|
||||||
|
// 2. Define the variable in the CURRENT scope
|
||||||
|
// Store the Node reference so we can add it to FBoxedDeclarations if captured.
|
||||||
|
FCurrentScope.Define(V.Target.AsIdentifier.Name, V);
|
||||||
|
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,475 @@
|
|||||||
|
unit Myc.Ast.Compiler.Binder;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast.Types,
|
||||||
|
Myc.Ast.Compiler.Binder.Upvalues,
|
||||||
|
Myc.Ast.Identities,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
IAstBinder = interface(IAstVisitor)
|
||||||
|
function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IFunctionDefinitionRegistry = interface
|
||||||
|
procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
|
||||||
|
function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TAstBinder = class(TAstTransformer, IAstBinder)
|
||||||
|
private
|
||||||
|
type
|
||||||
|
TUpvalueMap = TDictionary<TResolvedAddress, Integer>;
|
||||||
|
|
||||||
|
private
|
||||||
|
FCurrentBuilder: IScopeBuilder;
|
||||||
|
FUpvalueStack: TObjectStack<TUpvalueMap>;
|
||||||
|
|
||||||
|
FArgTypes: TArray<IStaticType>;
|
||||||
|
FFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
|
||||||
|
FLog: ICompilerLog;
|
||||||
|
|
||||||
|
FLambdaCounter: Integer;
|
||||||
|
|
||||||
|
function IsValidIdentifier(const Name: string): Boolean;
|
||||||
|
function ResolveSymbol(const Name: string; out Address: TResolvedAddress): Boolean;
|
||||||
|
function CaptureUpvalue(const PhysicalAddress: TResolvedAddress): Integer;
|
||||||
|
|
||||||
|
strict private
|
||||||
|
// Specific Handlers (IAstNode signature)
|
||||||
|
function VisitIdentifier(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitAssignment(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(
|
||||||
|
const AParentLayout: IScopeLayout;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
const AArgTypes: TArray<IStaticType>;
|
||||||
|
const ALog: ICompilerLog
|
||||||
|
);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
|
||||||
|
|
||||||
|
class function Bind(
|
||||||
|
const ParentLayout: IScopeLayout;
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
out Layout: IScopeLayout;
|
||||||
|
const ALog: ICompilerLog;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry = nil;
|
||||||
|
const AArgTypes: TArray<IStaticType> = nil
|
||||||
|
): IAstNode; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Generics.Defaults,
|
||||||
|
System.Character,
|
||||||
|
System.Hash,
|
||||||
|
Myc.Data.Keyword;
|
||||||
|
|
||||||
|
type
|
||||||
|
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
|
||||||
|
public
|
||||||
|
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
|
||||||
|
function GetHashCode(const Value: TResolvedAddress): Integer; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (Left = Right);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
|
||||||
|
begin
|
||||||
|
Result := THashBobJenkins.GetHashValue(Value.Kind, SizeOf(TAddressKind), 0);
|
||||||
|
Result := THashBobJenkins.GetHashValue(Value.ScopeDepth, SizeOf(Integer), Result);
|
||||||
|
Result := THashBobJenkins.GetHashValue(Value.SlotIndex, SizeOf(Integer), Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAstBinder }
|
||||||
|
|
||||||
|
constructor TAstBinder.Create(
|
||||||
|
const AParentLayout: IScopeLayout;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
const AArgTypes: TArray<IStaticType>;
|
||||||
|
const ALog: ICompilerLog
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
inherited Create; // Calls SetupHandlers
|
||||||
|
FCurrentBuilder := TScope.CreateBuilder(AParentLayout);
|
||||||
|
FUpvalueStack := TObjectStack<TUpvalueMap>.Create(True);
|
||||||
|
FUpvalueStack.Push(TUpvalueMap.Create(TResolvedAddressComparer.Create));
|
||||||
|
|
||||||
|
FFunctionRegistry := AFunctionRegistry;
|
||||||
|
FArgTypes := AArgTypes;
|
||||||
|
FLog := ALog;
|
||||||
|
FBoxedDeclarations := nil;
|
||||||
|
FLambdaCounter := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAstBinder.Destroy;
|
||||||
|
begin
|
||||||
|
FUpvalueStack.Free;
|
||||||
|
FBoxedDeclarations.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstBinder.SetupHandlers;
|
||||||
|
begin
|
||||||
|
inherited SetupHandlers; // Loads default transformers (Identity, Lists, etc.)
|
||||||
|
|
||||||
|
// Override specific binding logic
|
||||||
|
Register(akIdentifier, VisitIdentifier);
|
||||||
|
Register(akVariableDeclaration, VisitVariableDeclaration);
|
||||||
|
Register(akAssignment, VisitAssignment);
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TAstBinder.Bind(
|
||||||
|
const ParentLayout: IScopeLayout;
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
out Layout: IScopeLayout;
|
||||||
|
const ALog: ICompilerLog;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry = nil;
|
||||||
|
const AArgTypes: TArray<IStaticType> = nil
|
||||||
|
): IAstNode;
|
||||||
|
begin
|
||||||
|
var binder := TAstBinder.Create(ParentLayout, AFunctionRegistry, AArgTypes, ALog) as IAstBinder;
|
||||||
|
Result := binder.Execute(RootNode, Layout);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
|
||||||
|
begin
|
||||||
|
// Pre-pass to find captured variables
|
||||||
|
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode);
|
||||||
|
|
||||||
|
Result := Accept(RootNode);
|
||||||
|
if not Assigned(Result) then
|
||||||
|
Result := TAst.Block([], nil);
|
||||||
|
|
||||||
|
Layout := FCurrentBuilder.Build;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
|
||||||
|
var
|
||||||
|
c: Char;
|
||||||
|
begin
|
||||||
|
if Name.IsEmpty then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
for c in Name do
|
||||||
|
if not (c.IsLetterOrDigit or (c = '_') or (c = '-') or (c = '#')) then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
c := Name[1];
|
||||||
|
if not (c.IsLetter or (c = '_') or (c = '#')) then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.ResolveSymbol(const Name: string; out Address: TResolvedAddress): Boolean;
|
||||||
|
var
|
||||||
|
layout: IScopeLayout;
|
||||||
|
depth: Integer;
|
||||||
|
slot: Integer;
|
||||||
|
begin
|
||||||
|
layout := FCurrentBuilder;
|
||||||
|
depth := 0;
|
||||||
|
|
||||||
|
while Assigned(layout) do
|
||||||
|
begin
|
||||||
|
slot := layout.FindSlot(Name);
|
||||||
|
if slot >= 0 then
|
||||||
|
begin
|
||||||
|
Address := TResolvedAddress.Create(akLocalOrParent, depth, slot);
|
||||||
|
Result := True;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
layout := layout.Parent;
|
||||||
|
Inc(depth);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.CaptureUpvalue(const PhysicalAddress: TResolvedAddress): Integer;
|
||||||
|
var
|
||||||
|
currentMap: TUpvalueMap;
|
||||||
|
begin
|
||||||
|
currentMap := FUpvalueStack.Peek;
|
||||||
|
if not currentMap.TryGetValue(PhysicalAddress, Result) then
|
||||||
|
begin
|
||||||
|
Result := currentMap.Count;
|
||||||
|
currentMap.Add(PhysicalAddress, Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.VisitIdentifier(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
I: IIdentifierNode;
|
||||||
|
physAddr: TResolvedAddress;
|
||||||
|
upvalueIndex: Integer;
|
||||||
|
identity: INamedIdentity;
|
||||||
|
begin
|
||||||
|
I := Node.AsIdentifier;
|
||||||
|
identity := I.Identity.AsNamed;
|
||||||
|
|
||||||
|
if I.Address.Kind = akUnresolved then
|
||||||
|
begin
|
||||||
|
if not ResolveSymbol(I.Name, physAddr) then
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.AddError(Format('Undefined identifier: "%s"', [I.Name]), Node);
|
||||||
|
Result := Node;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if physAddr.ScopeDepth > 0 then
|
||||||
|
begin
|
||||||
|
upvalueIndex := CaptureUpvalue(physAddr);
|
||||||
|
Result := TAst.Identifier(identity, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex), TTypes.Unknown);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := TAst.Identifier(identity, physAddr, TTypes.Unknown);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
V: IVariableDeclarationNode;
|
||||||
|
slot: Integer;
|
||||||
|
addr: TResolvedAddress;
|
||||||
|
newInit: IAstNode;
|
||||||
|
newIdent: IIdentifierNode;
|
||||||
|
isBoxed: Boolean;
|
||||||
|
identifier: IIdentifierNode;
|
||||||
|
identIdentity: INamedIdentity;
|
||||||
|
begin
|
||||||
|
V := Node.AsVariableDeclaration;
|
||||||
|
identifier := V.Target.AsIdentifier;
|
||||||
|
identIdentity := identifier.Identity.AsNamed;
|
||||||
|
|
||||||
|
if not IsValidIdentifier(identifier.Name) then
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.AddError(Format('Invalid identifier name: "%s".', [identifier.Name]), Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FCurrentBuilder.FindSlot(identifier.Name) >= 0 then
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.AddError(Format('Variable "%s" is already defined in this scope.', [identifier.Name]), Node);
|
||||||
|
|
||||||
|
if Assigned(V.Initializer) then
|
||||||
|
Accept(V.Initializer);
|
||||||
|
|
||||||
|
Result := Node;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
slot := FCurrentBuilder.Define(identifier.Name);
|
||||||
|
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
|
||||||
|
|
||||||
|
if Assigned(V.Initializer) then
|
||||||
|
newInit := Accept(V.Initializer)
|
||||||
|
else
|
||||||
|
newInit := nil;
|
||||||
|
|
||||||
|
newIdent := TAst.Identifier(identIdentity, addr, TTypes.Unknown);
|
||||||
|
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(V);
|
||||||
|
Result := TAst.VarDecl(Node.Identity, newIdent, newInit, TTypes.Unknown, isBoxed);
|
||||||
|
|
||||||
|
if Assigned(FFunctionRegistry) and (newInit <> nil) and (newInit.Kind = akLambdaExpression) then
|
||||||
|
FFunctionRegistry.Register(addr, newInit.AsLambdaExpression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.VisitAssignment(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
A: IAssignmentNode;
|
||||||
|
newIdent: IAstNode;
|
||||||
|
newValue: IAstNode;
|
||||||
|
begin
|
||||||
|
A := Node.AsAssignment;
|
||||||
|
// Manually accept children because we need the results for registry logic
|
||||||
|
newIdent := Accept(A.Target);
|
||||||
|
newValue := Accept(A.Value);
|
||||||
|
|
||||||
|
Result := TAst.Assign(Node.Identity, newIdent, newValue, TTypes.Unknown);
|
||||||
|
|
||||||
|
if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then
|
||||||
|
begin
|
||||||
|
if (newIdent.Kind = akIdentifier) and (newIdent.AsIdentifier.Address.Kind = akLocalOrParent) then
|
||||||
|
FFunctionRegistry.Register(newIdent.AsIdentifier.Address, newValue.AsLambdaExpression);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
L: ILambdaExpressionNode;
|
||||||
|
parentBuilder: IScopeBuilder;
|
||||||
|
paramType: IStaticType;
|
||||||
|
newParams: TArray<IIdentifierNode>;
|
||||||
|
newParamsAsNodes: TArray<IAstNode>;
|
||||||
|
newBody: IAstNode;
|
||||||
|
finalLayout: IScopeLayout;
|
||||||
|
i, slot: Integer;
|
||||||
|
addr: TResolvedAddress;
|
||||||
|
capturedMap: TUpvalueMap;
|
||||||
|
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
|
||||||
|
upvaluesList: TArray<TResolvedAddress>;
|
||||||
|
startCount: Integer;
|
||||||
|
hasNested: Boolean;
|
||||||
|
paramIdentity: INamedIdentity;
|
||||||
|
paramNode: IAstNode;
|
||||||
|
begin
|
||||||
|
L := Node.AsLambdaExpression;
|
||||||
|
startCount := FLambdaCounter;
|
||||||
|
Inc(FLambdaCounter);
|
||||||
|
|
||||||
|
parentBuilder := FCurrentBuilder;
|
||||||
|
FCurrentBuilder := TScope.CreateBuilder(parentBuilder);
|
||||||
|
|
||||||
|
capturedMap := TUpvalueMap.Create(TResolvedAddressComparer.Create);
|
||||||
|
FUpvalueStack.Push(capturedMap);
|
||||||
|
|
||||||
|
try
|
||||||
|
FCurrentBuilder.Define('<self>');
|
||||||
|
|
||||||
|
var paramElements := L.Parameters.Elements;
|
||||||
|
SetLength(newParams, Length(paramElements));
|
||||||
|
|
||||||
|
for i := 0 to High(paramElements) do
|
||||||
|
begin
|
||||||
|
paramNode := paramElements[i];
|
||||||
|
|
||||||
|
if paramNode.Kind <> akIdentifier then
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.AddError('Parameter must be an identifier.', paramNode);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var paramIdent := paramNode.AsIdentifier;
|
||||||
|
var paramName := paramIdent.Name;
|
||||||
|
paramIdentity := paramIdent.Identity.AsNamed;
|
||||||
|
|
||||||
|
if FCurrentBuilder.FindSlot(paramName) >= 0 then
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.AddError(Format('Duplicate parameter name "%s".', [paramName]), Node);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
FCurrentBuilder.Define(paramName);
|
||||||
|
|
||||||
|
slot := FCurrentBuilder.FindSlot(paramName);
|
||||||
|
if slot < 0 then
|
||||||
|
slot := 0;
|
||||||
|
|
||||||
|
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
|
||||||
|
|
||||||
|
paramType := TTypes.Unknown;
|
||||||
|
if (parentBuilder.Parent = nil) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then
|
||||||
|
paramType := FArgTypes[i];
|
||||||
|
|
||||||
|
newParams[i] := TAst.Identifier(paramIdentity, addr, paramType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
newBody := Accept(L.Body);
|
||||||
|
finalLayout := FCurrentBuilder.Build;
|
||||||
|
|
||||||
|
sortedPairs := capturedMap.ToArray;
|
||||||
|
TArray.Sort<TPair<TResolvedAddress, Integer>>(
|
||||||
|
sortedPairs,
|
||||||
|
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
|
||||||
|
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
SetLength(upvaluesList, Length(sortedPairs));
|
||||||
|
for i := 0 to High(sortedPairs) do
|
||||||
|
begin
|
||||||
|
var rawAddr := sortedPairs[i].Key;
|
||||||
|
if rawAddr.Kind = akLocalOrParent then
|
||||||
|
begin
|
||||||
|
Assert(rawAddr.ScopeDepth > 0, 'Logic Error: Trying to capture a local variable.');
|
||||||
|
Dec(rawAddr.ScopeDepth);
|
||||||
|
end;
|
||||||
|
upvaluesList[i] := rawAddr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
finally
|
||||||
|
FCurrentBuilder := parentBuilder;
|
||||||
|
FUpvalueStack.Pop;
|
||||||
|
end;
|
||||||
|
|
||||||
|
hasNested := FLambdaCounter > (startCount + 1);
|
||||||
|
|
||||||
|
// Convert TArray<IIdentifierNode> -> TArray<IAstNode> for Tuple factory
|
||||||
|
SetLength(newParamsAsNodes, Length(newParams));
|
||||||
|
for i := 0 to High(newParams) do
|
||||||
|
newParamsAsNodes[i] := newParams[i];
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
TAst.LambdaExpr(
|
||||||
|
Node.Identity,
|
||||||
|
TAst.Tuple(L.Parameters.Identity, newParamsAsNodes),
|
||||||
|
newBody,
|
||||||
|
finalLayout,
|
||||||
|
nil,
|
||||||
|
upvaluesList,
|
||||||
|
hasNested,
|
||||||
|
L.IsPure
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstBinder.VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
C: IFunctionCallNode;
|
||||||
|
begin
|
||||||
|
C := Node.AsFunctionCall;
|
||||||
|
// 1. Keyword as Function Logic
|
||||||
|
if C.Callee.Kind = akKeyword then
|
||||||
|
begin
|
||||||
|
var args := C.Arguments.Elements;
|
||||||
|
if Length(args) <> 1 then
|
||||||
|
begin
|
||||||
|
if Assigned(FLog) then
|
||||||
|
FLog.AddError(Format('Keyword access :%s requires exactly one argument.', [C.Callee.AsKeyword.Value.Name]), Node);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
var memberAccess := TAst.MemberAccess(Node.Identity, Accept(args[0]), C.Callee.AsKeyword);
|
||||||
|
Result := memberAccess;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 2. Delegate to standard AST transformation (recurse on callee and args)
|
||||||
|
// This reuses logic from TAstTransformer!
|
||||||
|
Result := inherited VisitFunctionCall(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,102 @@
|
|||||||
|
unit Myc.Ast.Compiler.Lowering;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast.Nodes, // Provides EAstException
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast.Types,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Exception specific to AST lowering/rewriting errors
|
||||||
|
ELoweringException = class(EAstException);
|
||||||
|
|
||||||
|
IAstLowerer = interface(IAstVisitor)
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// This transformer runs *after* TypeChecker (Phase 3).
|
||||||
|
// It "lowers" the AST by rewriting complex nodes into simpler ones
|
||||||
|
// that the evaluator can understand (e.g., operator folding).
|
||||||
|
TAstLowerer = class(TAstTransformer, IAstLowerer)
|
||||||
|
private
|
||||||
|
FBinaryOperators: TDictionary<string, TScalar.TBinaryOp>;
|
||||||
|
FUnaryOperators: TDictionary<string, TScalar.TUnaryOp>;
|
||||||
|
protected
|
||||||
|
// Implement Visit methods here when specific lowering logic is added
|
||||||
|
// (e.g. converting operator function calls to specific node types if added in future)
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
class function Lower(const RootNode: IAstNode): IAstNode; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Generics.Defaults,
|
||||||
|
Myc.Data.Keyword;
|
||||||
|
|
||||||
|
{ TAstLowerer }
|
||||||
|
|
||||||
|
constructor TAstLowerer.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
// Operator folding maps (Reserved for future static optimization)
|
||||||
|
FBinaryOperators := TDictionary<string, TScalar.TBinaryOp>.Create;
|
||||||
|
|
||||||
|
FBinaryOperators.Add('+', TScalar.TBinaryOp.Add);
|
||||||
|
FBinaryOperators.Add('-', TScalar.TBinaryOp.Subtract);
|
||||||
|
FBinaryOperators.Add('*', TScalar.TBinaryOp.Multiply);
|
||||||
|
FBinaryOperators.Add('/', TScalar.TBinaryOp.Divide);
|
||||||
|
FBinaryOperators.Add('=', TScalar.TBinaryOp.Equal);
|
||||||
|
FBinaryOperators.Add('<>', TScalar.TBinaryOp.NotEqual);
|
||||||
|
FBinaryOperators.Add('<', TScalar.TBinaryOp.Less);
|
||||||
|
FBinaryOperators.Add('<=', TScalar.TBinaryOp.LessOrEqual);
|
||||||
|
FBinaryOperators.Add('>', TScalar.TBinaryOp.Greater);
|
||||||
|
FBinaryOperators.Add('>=', TScalar.TBinaryOp.GreaterOrEqual);
|
||||||
|
|
||||||
|
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
|
||||||
|
|
||||||
|
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAstLowerer.Destroy;
|
||||||
|
begin
|
||||||
|
FUnaryOperators.Free;
|
||||||
|
FBinaryOperators.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TAstLowerer.Lower(const RootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
var lowerer := TAstLowerer.Create as IAstLowerer;
|
||||||
|
try
|
||||||
|
Result := lowerer.Execute(RootNode);
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
raise ELoweringException.Create('Internal Error during AST Lowering: ' + E.Message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstLowerer.Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
if not Assigned(RootNode) then
|
||||||
|
exit(nil);
|
||||||
|
|
||||||
|
Result := Accept(RootNode);
|
||||||
|
if not Assigned(Result) then
|
||||||
|
Result := TAst.Block([]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,586 @@
|
|||||||
|
unit Myc.Ast.Compiler.Macros;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast.Types,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
EMacroException = class(EAstException);
|
||||||
|
|
||||||
|
IAstMacroExpander = interface(IAstVisitor)
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TMacroEvaluatorProc = reference to function(const Scope: IExecutionScope; const Node: IAstNode): TDataValue;
|
||||||
|
|
||||||
|
// Handles body expansion (Template instantiation)
|
||||||
|
TExpansionVisitor = class(TAstTransformer)
|
||||||
|
strict private
|
||||||
|
FMacroEvaluator: TMacroEvaluatorProc;
|
||||||
|
FMacroScope: IExecutionScope;
|
||||||
|
FRenameMap: TDictionary<string, string>;
|
||||||
|
class var
|
||||||
|
FGensymCounter: Int64;
|
||||||
|
|
||||||
|
function TransformAndSpliceNodes(const ANodes: ITupleNode): TArray<IAstNode>;
|
||||||
|
function Gensym(const ABaseName: string): string;
|
||||||
|
|
||||||
|
// Custom Logic Handlers (IAstNode signature)
|
||||||
|
function VisitUnquote(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitRecordLiteral(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitIdentifier(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(const AMacroScope: IExecutionScope; const AMacroEvaluator: TMacroEvaluatorProc);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
class function Expand(
|
||||||
|
const MacroScope: IExecutionScope;
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
const MacroEvaluator: TMacroEvaluatorProc
|
||||||
|
): IAstNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IMacroRegistry = interface
|
||||||
|
{$region 'private'}
|
||||||
|
function GetParent: IMacroRegistry;
|
||||||
|
{$endregion}
|
||||||
|
procedure Define(const Node: IMacroDefinitionNode);
|
||||||
|
function Find(const Name: string): IMacroDefinitionNode;
|
||||||
|
function CreateChildRegistry: IMacroRegistry;
|
||||||
|
property Parent: IMacroRegistry read GetParent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Handles macro calls in AST
|
||||||
|
TMacroExpander = class(TAstTransformer, IAstMacroExpander)
|
||||||
|
strict private
|
||||||
|
FInitialScope: IExecutionScope;
|
||||||
|
FCurrentMacroRegistry: IMacroRegistry;
|
||||||
|
FMacroEvaluator: TMacroEvaluatorProc;
|
||||||
|
|
||||||
|
procedure EnterMacroScope;
|
||||||
|
procedure ExitMacroScope;
|
||||||
|
|
||||||
|
function VisitMacroDefinition(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitQuasiquote(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitUnquote(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(
|
||||||
|
const ARootRegistry: IMacroRegistry;
|
||||||
|
const AInitialScope: IExecutionScope;
|
||||||
|
const AMacroEvaluator: TMacroEvaluatorProc
|
||||||
|
);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
class function ExpandMacros(
|
||||||
|
const ARootRegistry: IMacroRegistry;
|
||||||
|
const AInitialScope: IExecutionScope;
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
const MacroEvaluator: TMacroEvaluatorProc
|
||||||
|
): IAstNode; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TMacroRegistry = class(TInterfacedObject, IMacroRegistry)
|
||||||
|
private
|
||||||
|
FParent: IMacroRegistry;
|
||||||
|
FMacros: TDictionary<string, IMacroDefinitionNode>;
|
||||||
|
function GetParent: IMacroRegistry;
|
||||||
|
public
|
||||||
|
constructor Create(AParent: IMacroRegistry);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Define(const Node: IMacroDefinitionNode);
|
||||||
|
function Find(const Name: string): IMacroDefinitionNode;
|
||||||
|
function CreateChildRegistry: IMacroRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Generics.Defaults,
|
||||||
|
System.SyncObjs,
|
||||||
|
Myc.Data.Keyword;
|
||||||
|
|
||||||
|
{ TExpansionVisitor }
|
||||||
|
|
||||||
|
constructor TExpansionVisitor.Create(const AMacroScope: IExecutionScope; const AMacroEvaluator: TMacroEvaluatorProc);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FMacroScope := AMacroScope;
|
||||||
|
FMacroEvaluator := AMacroEvaluator;
|
||||||
|
FRenameMap := TDictionary<string, string>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TExpansionVisitor.Destroy;
|
||||||
|
begin
|
||||||
|
FRenameMap.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TExpansionVisitor.SetupHandlers;
|
||||||
|
begin
|
||||||
|
inherited SetupHandlers; // Defaults
|
||||||
|
|
||||||
|
// Register custom handlers
|
||||||
|
Register(akUnquote, VisitUnquote);
|
||||||
|
Register(akUnquoteSplicing, VisitUnquoteSplicing);
|
||||||
|
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
Register(akBlockExpression, VisitBlockExpression);
|
||||||
|
Register(akRecordLiteral, VisitRecordLiteral);
|
||||||
|
Register(akVariableDeclaration, VisitVariableDeclaration);
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
Register(akIdentifier, VisitIdentifier);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.Gensym(const ABaseName: string): string;
|
||||||
|
begin
|
||||||
|
if not FRenameMap.TryGetValue(ABaseName, Result) then
|
||||||
|
begin
|
||||||
|
var count := TInterlocked.Add(FGensymCounter, 1);
|
||||||
|
if count < 0 then
|
||||||
|
count := -count;
|
||||||
|
Result := ABaseName + '#' + count.ToString;
|
||||||
|
FRenameMap.Add(ABaseName, Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TExpansionVisitor.Expand(
|
||||||
|
const MacroScope: IExecutionScope;
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
const MacroEvaluator: TMacroEvaluatorProc
|
||||||
|
): IAstNode;
|
||||||
|
begin
|
||||||
|
var expander := TExpansionVisitor.Create(MacroScope, MacroEvaluator);
|
||||||
|
try
|
||||||
|
Result := expander.Accept(RootNode);
|
||||||
|
finally
|
||||||
|
expander.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: ITupleNode): TArray<IAstNode>;
|
||||||
|
var
|
||||||
|
newList: TList<IAstNode>;
|
||||||
|
nodeToSplice: IAstNode;
|
||||||
|
transformedNode: IAstNode;
|
||||||
|
node: IAstNode;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
newList := TList<IAstNode>.Create;
|
||||||
|
try
|
||||||
|
// Optimization: Access Elements array directly
|
||||||
|
var elements := ANodes.Elements;
|
||||||
|
for i := 0 to High(elements) do
|
||||||
|
begin
|
||||||
|
node := elements[i];
|
||||||
|
if node.Kind = akUnquoteSplicing then
|
||||||
|
begin
|
||||||
|
var spliceExpr := node.AsUnquoteSplicing.Expression;
|
||||||
|
var evaluatedSpliceValue: TDataValue;
|
||||||
|
try
|
||||||
|
evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr);
|
||||||
|
except
|
||||||
|
on E: EAstException do
|
||||||
|
raise;
|
||||||
|
on E: Exception do
|
||||||
|
raise EMacroException.Create('Error during macro splice evaluation: ' + E.Message);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then
|
||||||
|
begin
|
||||||
|
nodeToSplice := evaluatedSpliceValue.AsIntf<IAstNode>;
|
||||||
|
// Unification: Lists are now Tuples.
|
||||||
|
if nodeToSplice.Kind = akTuple then
|
||||||
|
begin
|
||||||
|
var tupleElements := nodeToSplice.AsTuple.Elements;
|
||||||
|
for var k := 0 to High(tupleElements) do
|
||||||
|
newList.Add(tupleElements[k]);
|
||||||
|
end
|
||||||
|
else if nodeToSplice.Kind = akBlockExpression then
|
||||||
|
begin
|
||||||
|
var blkElements := nodeToSplice.AsBlockExpression.Expressions.Elements;
|
||||||
|
for var k := 0 to High(blkElements) do
|
||||||
|
newList.Add(blkElements[k]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Single node splicing
|
||||||
|
newList.Add(nodeToSplice);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (not evaluatedSpliceValue.IsVoid) then
|
||||||
|
newList.Add(TAst.Constant(evaluatedSpliceValue, node.Identity.Location));
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
transformedNode := Self.Accept(node);
|
||||||
|
if Assigned(transformedNode) then
|
||||||
|
newList.Add(transformedNode);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := newList.ToArray;
|
||||||
|
finally
|
||||||
|
newList.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitIdentifier(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
I: IIdentifierNode;
|
||||||
|
newName: string;
|
||||||
|
begin
|
||||||
|
I := Node.AsIdentifier;
|
||||||
|
if FRenameMap.TryGetValue(I.Name, newName) then
|
||||||
|
begin
|
||||||
|
Result := TAst.Identifier(newName, I.Identity.Location);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
V: IVariableDeclarationNode;
|
||||||
|
newTarget, newInit: IAstNode;
|
||||||
|
newName: string;
|
||||||
|
begin
|
||||||
|
V := Node.AsVariableDeclaration;
|
||||||
|
newInit := Accept(V.Initializer);
|
||||||
|
if V.Target.Kind = akIdentifier then
|
||||||
|
begin
|
||||||
|
newName := Gensym(V.Target.AsIdentifier.Name);
|
||||||
|
newTarget := TAst.Identifier(newName, V.Target.Identity.Location);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
newTarget := Accept(V.Target);
|
||||||
|
|
||||||
|
Result := TAst.VarDecl(Node.Identity, newTarget, newInit, TTypes.Unknown, False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
L: ILambdaExpressionNode;
|
||||||
|
newParams: TArray<IAstNode>;
|
||||||
|
newBody: IAstNode;
|
||||||
|
newName: string;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
L := Node.AsLambdaExpression;
|
||||||
|
var paramsElements := L.Parameters.Elements;
|
||||||
|
SetLength(newParams, Length(paramsElements));
|
||||||
|
|
||||||
|
for i := 0 to High(paramsElements) do
|
||||||
|
begin
|
||||||
|
var param := paramsElements[i].AsIdentifier; // Binder ensures params are Identifiers
|
||||||
|
newName := Gensym(param.Name);
|
||||||
|
newParams[i] := TAst.Identifier(newName, param.Identity.Location);
|
||||||
|
end;
|
||||||
|
|
||||||
|
newBody := Accept(L.Body);
|
||||||
|
|
||||||
|
Result := TAst.LambdaExpr(Node.Identity, TAst.Tuple(L.Parameters.Identity, newParams), newBody);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitUnquote(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
U: IUnquoteNode;
|
||||||
|
value: TDataValue;
|
||||||
|
expr: IAstNode;
|
||||||
|
addr: TResolvedAddress;
|
||||||
|
begin
|
||||||
|
U := Node.AsUnquote;
|
||||||
|
expr := U.Expression;
|
||||||
|
if expr.Kind = akIdentifier then
|
||||||
|
begin
|
||||||
|
addr := FMacroScope.Resolve(expr.AsIdentifier.Name);
|
||||||
|
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
|
||||||
|
begin
|
||||||
|
var argValue := FMacroScope.Values[addr];
|
||||||
|
if argValue.Kind = vkInterface then
|
||||||
|
exit(argValue.AsIntf<IAstNode>);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
try
|
||||||
|
value := FMacroEvaluator(FMacroScope, expr);
|
||||||
|
except
|
||||||
|
on E: EAstException do
|
||||||
|
raise;
|
||||||
|
on E: Exception do
|
||||||
|
raise EMacroException.Create('Error during macro evaluation: ' + E.Message);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if value.Kind = vkInterface then
|
||||||
|
exit(value.AsIntf<IAstNode>);
|
||||||
|
|
||||||
|
if value.Kind in [vkScalar, vkText, vkVoid] then
|
||||||
|
Result := TAst.Constant(value, Node.Identity.Location)
|
||||||
|
else
|
||||||
|
raise EMacroException.CreateFmt('Cannot unquote complex runtime value of type %s at compile time.', [value.Kind.ToString]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
raise EMacroException.Create('Unquote-splicing (`~@`) can only appear inside a list/tuple form.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
C: IFunctionCallNode;
|
||||||
|
newArgs: TArray<IAstNode>;
|
||||||
|
transformedCallee: IAstNode;
|
||||||
|
argsTuple: ITupleNode;
|
||||||
|
begin
|
||||||
|
C := Node.AsFunctionCall;
|
||||||
|
transformedCallee := Self.Accept(C.Callee);
|
||||||
|
// Arguments is a Tuple, so we can splice into it
|
||||||
|
newArgs := TransformAndSpliceNodes(C.Arguments);
|
||||||
|
|
||||||
|
// Wrap result array in a TupleNode before creating FunctionCall
|
||||||
|
argsTuple := TAst.Tuple(C.Arguments.Identity, newArgs);
|
||||||
|
|
||||||
|
Result := TAst.FunctionCall(Node.Identity, transformedCallee, argsTuple);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
B: IBlockExpressionNode;
|
||||||
|
newExprs: TArray<IAstNode>;
|
||||||
|
exprsTuple: ITupleNode;
|
||||||
|
begin
|
||||||
|
B := Node.AsBlockExpression;
|
||||||
|
// Expressions is a Tuple
|
||||||
|
newExprs := TransformAndSpliceNodes(B.Expressions);
|
||||||
|
|
||||||
|
exprsTuple := TAst.Tuple(B.Expressions.Identity, newExprs);
|
||||||
|
|
||||||
|
Result := TAst.Block(Node.Identity, exprsTuple);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitRecordLiteral(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
// Delegate to standard transformer to process fields recursively
|
||||||
|
// This calls inherited VisitRecordLiteral(IAstNode) which visits the Fields Tuple
|
||||||
|
Result := inherited VisitRecordLiteral(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMacroExpander }
|
||||||
|
|
||||||
|
constructor TMacroExpander.Create(
|
||||||
|
const ARootRegistry: IMacroRegistry;
|
||||||
|
const AInitialScope: IExecutionScope;
|
||||||
|
const AMacroEvaluator: TMacroEvaluatorProc
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FInitialScope := AInitialScope;
|
||||||
|
FMacroEvaluator := AMacroEvaluator;
|
||||||
|
FCurrentMacroRegistry := ARootRegistry.CreateChildRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMacroExpander.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMacroExpander.SetupHandlers;
|
||||||
|
begin
|
||||||
|
inherited SetupHandlers; // Defaults
|
||||||
|
|
||||||
|
Register(akMacroDefinition, VisitMacroDefinition);
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
Register(akQuasiquote, VisitQuasiquote);
|
||||||
|
Register(akUnquote, VisitUnquote);
|
||||||
|
Register(akUnquoteSplicing, VisitUnquoteSplicing);
|
||||||
|
|
||||||
|
// Wrappers for scope management
|
||||||
|
Register(akBlockExpression, VisitBlockExpression);
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMacroExpander.EnterMacroScope;
|
||||||
|
begin
|
||||||
|
FCurrentMacroRegistry := FCurrentMacroRegistry.CreateChildRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMacroExpander.ExitMacroScope;
|
||||||
|
begin
|
||||||
|
FCurrentMacroRegistry := FCurrentMacroRegistry.Parent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TMacroExpander.ExpandMacros(
|
||||||
|
const ARootRegistry: IMacroRegistry;
|
||||||
|
const AInitialScope: IExecutionScope;
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
const MacroEvaluator: TMacroEvaluatorProc
|
||||||
|
): IAstNode;
|
||||||
|
begin
|
||||||
|
var expander := TMacroExpander.Create(ARootRegistry, AInitialScope, MacroEvaluator) as IAstMacroExpander;
|
||||||
|
Result := expander.Execute(RootNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := Accept(RootNode);
|
||||||
|
if not Assigned(Result) then
|
||||||
|
Result := TAst.Block([], nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
EnterMacroScope;
|
||||||
|
try
|
||||||
|
// Delegate to standard recursive transform
|
||||||
|
Result := inherited VisitBlockExpression(Node);
|
||||||
|
finally
|
||||||
|
ExitMacroScope;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
EnterMacroScope;
|
||||||
|
try
|
||||||
|
// Delegate to standard recursive transform
|
||||||
|
Result := inherited VisitLambdaExpression(Node);
|
||||||
|
finally
|
||||||
|
ExitMacroScope;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitMacroDefinition(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
FCurrentMacroRegistry.Define(Node.AsMacroDefinition);
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
C: IFunctionCallNode;
|
||||||
|
calleeIdentifier: IIdentifierNode;
|
||||||
|
macroDef: IMacroDefinitionNode;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
C := Node.AsFunctionCall;
|
||||||
|
if C.Callee.Kind = akIdentifier then
|
||||||
|
begin
|
||||||
|
calleeIdentifier := C.Callee.AsIdentifier;
|
||||||
|
macroDef := FCurrentMacroRegistry.Find(calleeIdentifier.Name);
|
||||||
|
|
||||||
|
if macroDef <> nil then
|
||||||
|
begin
|
||||||
|
var expansionScope := TScope.CreateScope(FInitialScope, nil, nil);
|
||||||
|
|
||||||
|
// Optimization: Access elements directly
|
||||||
|
var paramsElements := macroDef.Parameters.Elements;
|
||||||
|
var argsElements := C.Arguments.Elements;
|
||||||
|
|
||||||
|
if Length(argsElements) <> Length(paramsElements) then
|
||||||
|
raise EMacroException.CreateFmt('Macro %s expects %d arguments.', [calleeIdentifier.Name, Length(paramsElements)]);
|
||||||
|
|
||||||
|
for i := 0 to High(paramsElements) do
|
||||||
|
begin
|
||||||
|
var paramName := paramsElements[i].AsIdentifier.Name;
|
||||||
|
expansionScope.Define(paramName, TDataValue.FromIntf<IAstNode>(argsElements[i]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, FMacroEvaluator);
|
||||||
|
var macroNode := TAst.MacroExpansionNode(Node.Identity, C, expandedBody);
|
||||||
|
|
||||||
|
Result := Self.Accept(macroNode);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Standard recursion for non-macro calls
|
||||||
|
Result := inherited VisitFunctionCall(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitQuasiquote(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitUnquote(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
raise EMacroException.Create('Unquote (`~`) can only be used inside a quasiquote.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroExpander.VisitUnquoteSplicing(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
raise EMacroException.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMacroRegistry }
|
||||||
|
|
||||||
|
constructor TMacroRegistry.Create(AParent: IMacroRegistry);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FParent := AParent;
|
||||||
|
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMacroRegistry.Destroy;
|
||||||
|
begin
|
||||||
|
FMacros.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroRegistry.GetParent: IMacroRegistry;
|
||||||
|
begin
|
||||||
|
Result := FParent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMacroRegistry.Define(const Node: IMacroDefinitionNode);
|
||||||
|
begin
|
||||||
|
FMacros.AddOrSetValue(Node.Name.Name, Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroRegistry.Find(const Name: string): IMacroDefinitionNode;
|
||||||
|
var
|
||||||
|
current: IMacroRegistry;
|
||||||
|
begin
|
||||||
|
current := Self;
|
||||||
|
while Assigned(current) do
|
||||||
|
begin
|
||||||
|
if (current as TMacroRegistry).FMacros.TryGetValue(Name, Result) then
|
||||||
|
exit;
|
||||||
|
current := current.Parent;
|
||||||
|
end;
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMacroRegistry.CreateChildRegistry: IMacroRegistry;
|
||||||
|
begin
|
||||||
|
Result := TMacroRegistry.Create(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,276 @@
|
|||||||
|
unit Myc.Ast.Compiler.Specializer;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.Generics.Defaults,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast,
|
||||||
|
Myc.Ast.Types,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast.RTL,
|
||||||
|
Myc.Ast.Compiler.Binder;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Exception specific to specialization errors
|
||||||
|
ESpecializerException = class(EAstException);
|
||||||
|
|
||||||
|
IAstSpecializer = interface(IAstVisitor)
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Monomorphization Cache Definitions ---
|
||||||
|
|
||||||
|
TMonoCacheKey = record
|
||||||
|
public
|
||||||
|
Address: TResolvedAddress;
|
||||||
|
ArgTypes: TArray<IStaticType>;
|
||||||
|
Func: TDataValue.TFunc; // Usually nil in key, but part of structure if needed
|
||||||
|
constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
|
||||||
|
end;
|
||||||
|
|
||||||
|
IMonomorphCache = interface
|
||||||
|
function TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
|
||||||
|
procedure Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// This transformer runs *after* TypeChecker.
|
||||||
|
// It specializes all statically resolvable function calls.
|
||||||
|
TStaticSpecializer = class(TAstTransformer, IAstSpecializer)
|
||||||
|
public
|
||||||
|
type
|
||||||
|
TCompileFunc = reference to function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
|
||||||
|
private
|
||||||
|
FMonomorphCache: IMonomorphCache;
|
||||||
|
FFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
FCompileFunc: TCompileFunc;
|
||||||
|
|
||||||
|
function GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
|
||||||
|
|
||||||
|
strict private
|
||||||
|
// Specialization Handler (IAstNode signature)
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(
|
||||||
|
const AMonomorphCache: IMonomorphCache;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
const ACompileFunc: TCompileFunc
|
||||||
|
);
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
class function Specialize(
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
const AMonomorphCache: IMonomorphCache;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
const ACompileFunc: TCompileFunc
|
||||||
|
): IAstNode; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Hash;
|
||||||
|
|
||||||
|
{ TStaticSpecializer }
|
||||||
|
|
||||||
|
constructor TStaticSpecializer.Create(
|
||||||
|
const AMonomorphCache: IMonomorphCache;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
const ACompileFunc: TCompileFunc
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
if not Assigned(AMonomorphCache) then
|
||||||
|
raise ESpecializerException.Create('MonomorphCache cannot be nil.');
|
||||||
|
if not Assigned(AFunctionRegistry) then
|
||||||
|
raise ESpecializerException.Create('FunctionRegistry cannot be nil.');
|
||||||
|
|
||||||
|
FMonomorphCache := AMonomorphCache;
|
||||||
|
FFunctionRegistry := AFunctionRegistry;
|
||||||
|
FCompileFunc := ACompileFunc;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TStaticSpecializer.SetupHandlers;
|
||||||
|
begin
|
||||||
|
inherited SetupHandlers; // Load default transformations
|
||||||
|
// Override FunctionCall logic
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TStaticSpecializer.Specialize(
|
||||||
|
const RootNode: IAstNode;
|
||||||
|
const AMonomorphCache: IMonomorphCache;
|
||||||
|
const AFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
const ACompileFunc: TCompileFunc
|
||||||
|
): IAstNode;
|
||||||
|
begin
|
||||||
|
var specializer := TStaticSpecializer.Create(AMonomorphCache, AFunctionRegistry, ACompileFunc) as IAstSpecializer;
|
||||||
|
Result := specializer.Execute(RootNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TStaticSpecializer.Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := Accept(RootNode);
|
||||||
|
if not Assigned(Result) then
|
||||||
|
Result := TAst.Block([], nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TStaticSpecializer.GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
|
||||||
|
begin
|
||||||
|
Result := TRtlRegistry.GetStaticSpecialization(AName, AArgTypes);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TStaticSpecializer.VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
C: IFunctionCallNode;
|
||||||
|
newCall: IFunctionCallNode;
|
||||||
|
newCallee: IAstNode;
|
||||||
|
newArgs: ITupleNode;
|
||||||
|
i: Integer;
|
||||||
|
calleeIdent: IIdentifierNode;
|
||||||
|
argTypes: TArray<IStaticType>;
|
||||||
|
allTypesKnown: Boolean;
|
||||||
|
funcName: string;
|
||||||
|
key: TMonoCacheKey;
|
||||||
|
specializedMethod: TSpecializedMethod;
|
||||||
|
funcDef: IFunctionDefinition;
|
||||||
|
begin
|
||||||
|
C := Node.AsFunctionCall;
|
||||||
|
|
||||||
|
// 1. Specialize children first (bottom-up) by calling inherited
|
||||||
|
// inherited VisitFunctionCall returns an IAstNode (which is a new IFunctionCallNode if changed)
|
||||||
|
newCall := inherited VisitFunctionCall(Node).AsFunctionCall;
|
||||||
|
newCallee := newCall.Callee;
|
||||||
|
newArgs := newCall.Arguments;
|
||||||
|
|
||||||
|
// 2. Check if this call is a candidate for specialization
|
||||||
|
if newCallee.Kind <> akIdentifier then
|
||||||
|
begin
|
||||||
|
Result := newCall;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
calleeIdent := newCallee.AsIdentifier;
|
||||||
|
funcName := calleeIdent.Name;
|
||||||
|
|
||||||
|
// 3. Check if all argument types are statically known
|
||||||
|
// Optimization: Use Elements array directly
|
||||||
|
var argsElements := newArgs.Elements;
|
||||||
|
allTypesKnown := True;
|
||||||
|
SetLength(argTypes, Length(argsElements));
|
||||||
|
|
||||||
|
for i := 0 to High(argsElements) do
|
||||||
|
begin
|
||||||
|
argTypes[i] := argsElements[i].AsTypedNode.StaticType;
|
||||||
|
if argTypes[i].Kind = stUnknown then
|
||||||
|
begin
|
||||||
|
allTypesKnown := False;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not allTypesKnown then
|
||||||
|
begin
|
||||||
|
Result := newCall;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- At this point, the call is statically resolvable ---
|
||||||
|
|
||||||
|
// 4. Check the Environment (Instance) Cache
|
||||||
|
key := TMonoCacheKey.Create(calleeIdent.Address, argTypes);
|
||||||
|
|
||||||
|
if FMonomorphCache.TryGetFunction(key, specializedMethod) then
|
||||||
|
begin
|
||||||
|
// 4a. Cache Hit (Environment)
|
||||||
|
Result :=
|
||||||
|
TAst.FunctionCall(
|
||||||
|
Node.Identity,
|
||||||
|
newCallee,
|
||||||
|
newArgs,
|
||||||
|
specializedMethod.ReturnType,
|
||||||
|
C.IsTailCall,
|
||||||
|
specializedMethod.Target,
|
||||||
|
specializedMethod.IsPure
|
||||||
|
);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 5. Check the RTL (Global) Bootstrap Cache
|
||||||
|
specializedMethod := GetStaticRtlFunction(funcName, argTypes);
|
||||||
|
if Assigned(specializedMethod.Target) then
|
||||||
|
begin
|
||||||
|
// 5a. Cache Hit (RTL)
|
||||||
|
FMonomorphCache.Add(key, specializedMethod);
|
||||||
|
|
||||||
|
Result :=
|
||||||
|
TAst.FunctionCall(
|
||||||
|
Node.Identity,
|
||||||
|
newCallee,
|
||||||
|
newArgs,
|
||||||
|
specializedMethod.ReturnType,
|
||||||
|
C.IsTailCall,
|
||||||
|
specializedMethod.Target,
|
||||||
|
specializedMethod.IsPure
|
||||||
|
);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 6. Cache Miss (User Code)
|
||||||
|
funcDef := FFunctionRegistry.Resolve(calleeIdent.Address);
|
||||||
|
|
||||||
|
if (funcDef <> nil) then
|
||||||
|
begin
|
||||||
|
// Cannot specialize closures safely without more complex analysis if they have state
|
||||||
|
if funcDef.Kind = akLambdaExpression then
|
||||||
|
begin
|
||||||
|
var lambdaDef := funcDef.AsLambdaExpression;
|
||||||
|
if (Length(lambdaDef.Upvalues) > 0) or (lambdaDef.HasNestedLambdas) then
|
||||||
|
begin
|
||||||
|
Result := newCall;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 6a. Compile func with KNOWN TYPES
|
||||||
|
if not Assigned(FCompileFunc) then
|
||||||
|
raise ESpecializerException.Create('Cannot specialize user function: Compiler callback is missing.');
|
||||||
|
|
||||||
|
var compiled := FCompileFunc(funcDef, argTypes);
|
||||||
|
|
||||||
|
// Safety check: The recursive compiler MUST produce a valid function pointer
|
||||||
|
if not Assigned(compiled.Func) then
|
||||||
|
raise ESpecializerException.CreateFmt('Internal Error: Failed to compile specialization for "%s"', [funcName]);
|
||||||
|
|
||||||
|
// 6b. Store in cache
|
||||||
|
var returnType := compiled.StaticType.AsMethod.Signatures[0].ReturnType;
|
||||||
|
specializedMethod := TSpecializedMethod.Create(compiled.Func, returnType, compiled.IsPure);
|
||||||
|
FMonomorphCache.Add(key, specializedMethod);
|
||||||
|
|
||||||
|
// 6c. Return the new node
|
||||||
|
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, returnType, C.IsTailCall, compiled.Func, compiled.IsPure);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 7. Fallback: Not RTL, Not User-Code -> Dynamic
|
||||||
|
Result := newCall;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMonoCacheKey }
|
||||||
|
|
||||||
|
constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
|
||||||
|
begin
|
||||||
|
Address := AAddress;
|
||||||
|
ArgTypes := AArgTypes;
|
||||||
|
Func := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,362 @@
|
|||||||
|
unit Myc.Ast.Compiler.TCO;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast.Types,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Exception specific to optimization/TCO errors
|
||||||
|
EOptimizerException = class(EAstException);
|
||||||
|
|
||||||
|
IAstTCO = interface(IAstVisitor)
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// This transformer runs *after* the Lowerer (Phase 4/5) and Specializer.
|
||||||
|
// Its sole responsibility is to identify tail calls (TCO)
|
||||||
|
// and set the `IsTailCall` flag on TFunctionCallNode.
|
||||||
|
TAstTCO = class(TAstTransformer, IAstTCO)
|
||||||
|
private
|
||||||
|
FIsTailStack: TStack<Boolean>;
|
||||||
|
FNextIsTail: Boolean;
|
||||||
|
|
||||||
|
strict private
|
||||||
|
// Typed Handlers (IAstNode signature)
|
||||||
|
function VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitIfExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitCondExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitRecurNode(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitMacroExpansionNode(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
function VisitTuple(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
// Intercept dispatch to manage the TCO Stack state
|
||||||
|
function Accept(const Node: IAstNode): IAstNode; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
class function Optimize(const RootNode: IAstNode): IAstNode; static;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TAstTCO }
|
||||||
|
|
||||||
|
constructor TAstTCO.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FIsTailStack := TStack<Boolean>.Create;
|
||||||
|
FNextIsTail := True; // The root expression is in tail position
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAstTCO.Destroy;
|
||||||
|
begin
|
||||||
|
FIsTailStack.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstTCO.SetupHandlers;
|
||||||
|
begin
|
||||||
|
inherited SetupHandlers; // Defaults
|
||||||
|
|
||||||
|
Register(akBlockExpression, VisitBlockExpression);
|
||||||
|
Register(akIfExpression, VisitIfExpression);
|
||||||
|
Register(akCondExpression, VisitCondExpression);
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
Register(akRecur, VisitRecurNode);
|
||||||
|
Register(akMacroExpansion, VisitMacroExpansionNode);
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
Register(akTuple, VisitTuple);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TAstTCO.Optimize(const RootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
var optimizer := TAstTCO.Create as IAstTCO;
|
||||||
|
Result := optimizer.Execute(RootNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.Execute(const RootNode: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := Accept(RootNode);
|
||||||
|
if not Assigned(Result) then
|
||||||
|
Result := TAst.Block([], nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.Accept(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
if (not Assigned(Node)) then
|
||||||
|
exit(nil);
|
||||||
|
|
||||||
|
// Push current context state before visiting children
|
||||||
|
FIsTailStack.Push(FNextIsTail);
|
||||||
|
try
|
||||||
|
// Dispatch to handler (which will call VisitXyz)
|
||||||
|
Result := inherited Accept(Node);
|
||||||
|
finally
|
||||||
|
// Restore context state
|
||||||
|
FNextIsTail := FIsTailStack.Pop;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitBlockExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
B: IBlockExpressionNode;
|
||||||
|
isContextTail: Boolean;
|
||||||
|
newExprs: TArray<IAstNode>;
|
||||||
|
exprsTuple: ITupleNode;
|
||||||
|
i: Integer;
|
||||||
|
item, newItem: IAstNode;
|
||||||
|
hasChanged: Boolean;
|
||||||
|
elements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
B := Node.AsBlockExpression;
|
||||||
|
isContextTail := FIsTailStack.Peek;
|
||||||
|
exprsTuple := B.Expressions;
|
||||||
|
elements := exprsTuple.Elements;
|
||||||
|
|
||||||
|
var count := Length(elements);
|
||||||
|
SetLength(newExprs, count);
|
||||||
|
hasChanged := False;
|
||||||
|
|
||||||
|
var nTail := count - 1;
|
||||||
|
|
||||||
|
for i := 0 to nTail do
|
||||||
|
begin
|
||||||
|
item := elements[i];
|
||||||
|
|
||||||
|
// Only the last expression in the block inherits the tail position status
|
||||||
|
FNextIsTail := isContextTail and (i = nTail);
|
||||||
|
|
||||||
|
newItem := Accept(item);
|
||||||
|
newExprs[i] := newItem;
|
||||||
|
|
||||||
|
if item <> newItem then
|
||||||
|
hasChanged := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not hasChanged then
|
||||||
|
Result := Node
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Create new Tuple for expressions
|
||||||
|
Result := TAst.Block(Node.Identity, TAst.Tuple(B.Expressions.Identity, newExprs), B.StaticType);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitIfExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
I: IIfExpressionNode;
|
||||||
|
isContextTail: Boolean;
|
||||||
|
newCond, newThen, newElse: IAstNode;
|
||||||
|
begin
|
||||||
|
I := Node.AsIfExpression;
|
||||||
|
isContextTail := FIsTailStack.Peek;
|
||||||
|
|
||||||
|
// Condition is never in tail position
|
||||||
|
FNextIsTail := False;
|
||||||
|
newCond := Accept(I.Condition);
|
||||||
|
|
||||||
|
// Then/Else branches ARE in tail position if the IfExpr is
|
||||||
|
FNextIsTail := isContextTail;
|
||||||
|
newThen := Accept(I.ThenBranch);
|
||||||
|
newElse := Accept(I.ElseBranch);
|
||||||
|
|
||||||
|
if (newCond = I.Condition) and (newThen = I.ThenBranch) and (newElse = I.ElseBranch) then
|
||||||
|
Result := Node
|
||||||
|
else
|
||||||
|
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, I.StaticType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitCondExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
C: ICondExpressionNode;
|
||||||
|
isContextTail: Boolean;
|
||||||
|
hasChanged: Boolean;
|
||||||
|
i: Integer;
|
||||||
|
newPairs: TArray<TCondPair>;
|
||||||
|
newElse: IAstNode;
|
||||||
|
newCond, newBranch: IAstNode;
|
||||||
|
begin
|
||||||
|
C := Node.AsCondExpression;
|
||||||
|
isContextTail := FIsTailStack.Peek;
|
||||||
|
hasChanged := False;
|
||||||
|
SetLength(newPairs, Length(C.Pairs));
|
||||||
|
|
||||||
|
for i := 0 to High(C.Pairs) do
|
||||||
|
begin
|
||||||
|
// 1. Condition is never in tail position
|
||||||
|
FNextIsTail := False;
|
||||||
|
newCond := Accept(C.Pairs[i].Condition);
|
||||||
|
|
||||||
|
// 2. Branch IS in tail position (if CondExpr is)
|
||||||
|
FNextIsTail := isContextTail;
|
||||||
|
newBranch := Accept(C.Pairs[i].Branch);
|
||||||
|
|
||||||
|
newPairs[i] := TCondPair.Create(newCond, newBranch);
|
||||||
|
|
||||||
|
if (newCond <> C.Pairs[i].Condition) or (newBranch <> C.Pairs[i].Branch) then
|
||||||
|
hasChanged := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 3. Else Branch IS in tail position
|
||||||
|
FNextIsTail := isContextTail;
|
||||||
|
newElse := Accept(C.ElseBranch);
|
||||||
|
|
||||||
|
if newElse <> C.ElseBranch then
|
||||||
|
hasChanged := True;
|
||||||
|
|
||||||
|
if not hasChanged then
|
||||||
|
Result := Node
|
||||||
|
else
|
||||||
|
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, C.StaticType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitLambdaExpression(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
L: ILambdaExpressionNode;
|
||||||
|
newParams: ITupleNode;
|
||||||
|
newBody: IAstNode;
|
||||||
|
begin
|
||||||
|
L := Node.AsLambdaExpression;
|
||||||
|
// Parameters are not in tail position
|
||||||
|
FNextIsTail := False;
|
||||||
|
newParams := Accept(L.Parameters).AsTuple;
|
||||||
|
|
||||||
|
// The body of a lambda is *always* a tail position (relative to the lambda execution)
|
||||||
|
FNextIsTail := True;
|
||||||
|
newBody := Accept(L.Body);
|
||||||
|
|
||||||
|
if (newParams = L.Parameters) and (newBody = L.Body) then
|
||||||
|
Result := Node
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
TAst.LambdaExpr(
|
||||||
|
Node.Identity,
|
||||||
|
newParams,
|
||||||
|
newBody,
|
||||||
|
L.Layout,
|
||||||
|
L.Descriptor,
|
||||||
|
L.Upvalues,
|
||||||
|
L.HasNestedLambdas,
|
||||||
|
L.IsPure,
|
||||||
|
L.StaticType
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitRecurNode(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
R: IRecurNode;
|
||||||
|
newArgs: ITupleNode;
|
||||||
|
begin
|
||||||
|
R := Node.AsRecur;
|
||||||
|
if not FIsTailStack.Peek then
|
||||||
|
raise EOptimizerException.Create('''recur'' can only be used in a tail position.');
|
||||||
|
|
||||||
|
// Arguments are not in tail position
|
||||||
|
FNextIsTail := False;
|
||||||
|
newArgs := Accept(R.Arguments).AsTuple;
|
||||||
|
|
||||||
|
if newArgs = R.Arguments then
|
||||||
|
Result := Node
|
||||||
|
else
|
||||||
|
Result := TAst.Recur(Node.Identity, newArgs, R.StaticType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitMacroExpansionNode(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
M: IMacroExpansionNode;
|
||||||
|
newBody: IAstNode;
|
||||||
|
begin
|
||||||
|
M := Node.AsMacroExpansion;
|
||||||
|
// Propagate tail call status to the expanded body
|
||||||
|
FNextIsTail := FIsTailStack.Peek;
|
||||||
|
newBody := Accept(M.ExpandedBody);
|
||||||
|
|
||||||
|
if newBody = M.ExpandedBody then
|
||||||
|
Result := Node
|
||||||
|
else
|
||||||
|
Result := TAst.MacroExpansionNode(Node.Identity, M.CallNode, newBody);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitFunctionCall(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
C: IFunctionCallNode;
|
||||||
|
isTailCall: Boolean;
|
||||||
|
newCallee: IAstNode;
|
||||||
|
newArgs: ITupleNode;
|
||||||
|
begin
|
||||||
|
C := Node.AsFunctionCall;
|
||||||
|
isTailCall := FIsTailStack.Peek;
|
||||||
|
|
||||||
|
// Callee/Arguments are not in tail position
|
||||||
|
FNextIsTail := False;
|
||||||
|
|
||||||
|
newCallee := Accept(C.Callee);
|
||||||
|
newArgs := Accept(C.Arguments).AsTuple;
|
||||||
|
|
||||||
|
if (newCallee = C.Callee) and (newArgs = C.Arguments) and (isTailCall = C.IsTailCall) then
|
||||||
|
begin
|
||||||
|
Result := Node;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Use factory to create new node with TCO status
|
||||||
|
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, C.StaticType, isTailCall, C.StaticTarget, C.IsTargetPure);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstTCO.VisitTuple(const Node: IAstNode): IAstNode;
|
||||||
|
var
|
||||||
|
T: ITupleNode;
|
||||||
|
newElements: TArray<IAstNode>;
|
||||||
|
i: Integer;
|
||||||
|
hasChanged: Boolean;
|
||||||
|
savedNextIsTail: Boolean;
|
||||||
|
elements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
T := Node.AsTuple;
|
||||||
|
savedNextIsTail := FNextIsTail; // Zustand sichern
|
||||||
|
|
||||||
|
// Elemente in einem Tupel (Liste, Vektor, Argumente) sind NIEMALS in Tail-Position
|
||||||
|
FNextIsTail := False;
|
||||||
|
|
||||||
|
hasChanged := False;
|
||||||
|
elements := T.Elements;
|
||||||
|
var count := Length(elements);
|
||||||
|
SetLength(newElements, count);
|
||||||
|
|
||||||
|
try
|
||||||
|
for i := 0 to count - 1 do
|
||||||
|
begin
|
||||||
|
newElements[i] := Accept(elements[i]);
|
||||||
|
if newElements[i] <> elements[i] then
|
||||||
|
hasChanged := True;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FNextIsTail := savedNextIsTail;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if hasChanged then
|
||||||
|
Result := TAst.Tuple(Node.Identity, newElements, T.StaticType)
|
||||||
|
else
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,194 @@
|
|||||||
|
unit Myc.Ast.Debugger;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Ast.Evaluator;
|
||||||
|
|
||||||
|
type
|
||||||
|
TDebugEvaluatorVisitor = class(TEvaluatorVisitor)
|
||||||
|
private
|
||||||
|
FLog: TStrings;
|
||||||
|
FIndentLevel: Integer;
|
||||||
|
FShowScope: Boolean;
|
||||||
|
|
||||||
|
procedure Indent;
|
||||||
|
procedure Unindent;
|
||||||
|
procedure AppendLine(const S: string);
|
||||||
|
procedure ShowScope;
|
||||||
|
function GetNodeLogInfo(const Node: IAstNode): string;
|
||||||
|
protected
|
||||||
|
function CreateVisitorFactory: TEvaluatorFactory; override;
|
||||||
|
|
||||||
|
// Central Interceptor for all node types
|
||||||
|
function Visit(const Node: IAstNode): TDataValue; override;
|
||||||
|
|
||||||
|
// Specific overrides for enhanced logging/state observation
|
||||||
|
function VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue; override;
|
||||||
|
function VisitAssignment(const N: IAssignmentNode): TDataValue; override;
|
||||||
|
function VisitFunctionCall(const N: IFunctionCallNode): TDataValue; override;
|
||||||
|
function VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue; override;
|
||||||
|
public
|
||||||
|
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.TypInfo,
|
||||||
|
Myc.Data.Keyword;
|
||||||
|
|
||||||
|
{ TDebugEvaluatorVisitor }
|
||||||
|
|
||||||
|
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer);
|
||||||
|
begin
|
||||||
|
inherited Create(AScope);
|
||||||
|
FLog := ALog;
|
||||||
|
FIndentLevel := AInitialIndent;
|
||||||
|
FShowScope := AShowScope;
|
||||||
|
if FShowScope and (AInitialIndent = 0) then
|
||||||
|
ShowScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
|
||||||
|
begin
|
||||||
|
var currentLog := FLog;
|
||||||
|
var currentShowScope := FShowScope;
|
||||||
|
var currentIndent := FIndentLevel;
|
||||||
|
Result :=
|
||||||
|
function(const AScope: IExecutionScope): IEvaluatorVisitor
|
||||||
|
begin
|
||||||
|
Result := TDebugEvaluatorVisitor.Create(AScope, currentLog, currentShowScope, currentIndent);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.Visit(const Node: IAstNode): TDataValue;
|
||||||
|
var
|
||||||
|
info: string;
|
||||||
|
begin
|
||||||
|
info := GetNodeLogInfo(Node);
|
||||||
|
if info <> '' then
|
||||||
|
begin
|
||||||
|
AppendLine(info + ' {');
|
||||||
|
Indent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
try
|
||||||
|
// Dispatch to inherited logic (which will call our specialized VisitXyz overrides)
|
||||||
|
Result := inherited Visit(Node);
|
||||||
|
finally
|
||||||
|
if info <> '' then
|
||||||
|
begin
|
||||||
|
Unindent;
|
||||||
|
var resStr :=
|
||||||
|
if Result.IsVoid then '(void)'
|
||||||
|
else Result.ToString;
|
||||||
|
AppendLine('} -> ' + resStr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Enhanced Observation Overrides ---
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := inherited VisitVariableDeclaration(N);
|
||||||
|
if FShowScope then
|
||||||
|
ShowScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.VisitAssignment(const N: IAssignmentNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := inherited VisitAssignment(N);
|
||||||
|
if FShowScope then
|
||||||
|
ShowScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.VisitFunctionCall(const N: IFunctionCallNode): TDataValue;
|
||||||
|
begin
|
||||||
|
// Log target purity if statically known
|
||||||
|
if Assigned(N.StaticTarget) and N.IsTargetPure then
|
||||||
|
AppendLine('[Pure Static Call]');
|
||||||
|
Result := inherited VisitFunctionCall(N);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
if Length(N.Upvalues) > 0 then
|
||||||
|
AppendLine(Format('[Capturing %d upvalues]', [Length(N.Upvalues)]));
|
||||||
|
Result := inherited VisitLambdaExpression(N);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// --- Internal Helpers ---
|
||||||
|
|
||||||
|
function TDebugEvaluatorVisitor.GetNodeLogInfo(const Node: IAstNode): string;
|
||||||
|
begin
|
||||||
|
case Node.Kind of
|
||||||
|
akFunctionCall:
|
||||||
|
begin
|
||||||
|
var c := Node.AsFunctionCall;
|
||||||
|
var mode :=
|
||||||
|
if Assigned(c.StaticTarget) then 'STATIC'
|
||||||
|
else 'DYNAMIC';
|
||||||
|
Result := Format('Call (%s, Tail=%s)', [mode, c.IsTailCall.ToString(TUseBoolStrs.True)]);
|
||||||
|
end;
|
||||||
|
akIdentifier: Result := 'ID:' + Node.AsIdentifier.Name;
|
||||||
|
akVariableDeclaration: Result := 'DEF:' + Node.AsVariableDeclaration.Target.AsIdentifier.Name;
|
||||||
|
akAssignment: Result := 'ASSIGN:' + Node.AsAssignment.Target.AsIdentifier.Name;
|
||||||
|
akIfExpression: Result := 'IF';
|
||||||
|
akCondExpression: Result := 'COND';
|
||||||
|
akRecur: Result := 'RECUR';
|
||||||
|
akBlockExpression: Result := 'BLOCK';
|
||||||
|
akLambdaExpression: Result := 'FN';
|
||||||
|
akRecordLiteral: Result := 'RECORD';
|
||||||
|
akPipe: Result := 'PIPE';
|
||||||
|
akIndexer: Result := 'INDEXER';
|
||||||
|
akMemberAccess: Result := 'MEMBER';
|
||||||
|
akTuple: Result := 'TUPLE';
|
||||||
|
akCreateSeries: Result := 'NEW-SERIES';
|
||||||
|
akAddSeriesItem: Result := 'ADD-ITEM';
|
||||||
|
|
||||||
|
else
|
||||||
|
Result := ''; // Silence leaf nodes like Constants and Keywords to reduce noise
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDebugEvaluatorVisitor.Indent;
|
||||||
|
begin
|
||||||
|
Inc(FIndentLevel);
|
||||||
|
end;
|
||||||
|
procedure TDebugEvaluatorVisitor.Unindent;
|
||||||
|
begin
|
||||||
|
Dec(FIndentLevel);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
|
||||||
|
var
|
||||||
|
pad: string;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
pad := '';
|
||||||
|
for i := 0 to FIndentLevel - 1 do
|
||||||
|
pad := pad + ':' + ''.PadLeft(3);
|
||||||
|
FLog.Add(pad + S);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDebugEvaluatorVisitor.ShowScope;
|
||||||
|
var
|
||||||
|
line: string;
|
||||||
|
begin
|
||||||
|
AppendLine(' [Scope State]');
|
||||||
|
for line in Scope.Dump.Split([sLineBreak]) do
|
||||||
|
AppendLine(' ' + line);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,556 @@
|
|||||||
|
unit Myc.Ast.Dumper;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Ast.Visitor,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
// Dumps a bound AST into a human-readable format for debugging purposes.
|
||||||
|
IAstDumper = interface(IAstVisitor)
|
||||||
|
procedure Execute(const RootNode: IAstNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TAstDumper = class(TAstVisitor, IAstDumper)
|
||||||
|
private
|
||||||
|
FOutput: TStrings;
|
||||||
|
FIndent: Integer;
|
||||||
|
procedure Indent;
|
||||||
|
procedure Unindent;
|
||||||
|
procedure Log(const Text: string; const Node: IAstNode = nil); overload;
|
||||||
|
procedure LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil); overload;
|
||||||
|
function FormatAddress(const Addr: TResolvedAddress): string;
|
||||||
|
|
||||||
|
strict private
|
||||||
|
// Internal visit helpers with strict IAstNode signature
|
||||||
|
function VisitConstant(const Node: IAstNode): TVoid;
|
||||||
|
function VisitIdentifier(const Node: IAstNode): TVoid;
|
||||||
|
function VisitKeyword(const Node: IAstNode): TVoid;
|
||||||
|
function VisitIfExpression(const Node: IAstNode): TVoid;
|
||||||
|
function VisitCondExpression(const Node: IAstNode): TVoid;
|
||||||
|
function VisitLambdaExpression(const Node: IAstNode): TVoid;
|
||||||
|
function VisitFunctionCall(const Node: IAstNode): TVoid;
|
||||||
|
function VisitMacroExpansionNode(const Node: IAstNode): TVoid;
|
||||||
|
function VisitRecurNode(const Node: IAstNode): TVoid;
|
||||||
|
function VisitBlockExpression(const Node: IAstNode): TVoid;
|
||||||
|
function VisitVariableDeclaration(const Node: IAstNode): TVoid;
|
||||||
|
function VisitAssignment(const Node: IAstNode): TVoid;
|
||||||
|
function VisitMacroDefinition(const Node: IAstNode): TVoid;
|
||||||
|
function VisitQuasiquote(const Node: IAstNode): TVoid;
|
||||||
|
function VisitUnquote(const Node: IAstNode): TVoid;
|
||||||
|
function VisitUnquoteSplicing(const Node: IAstNode): TVoid;
|
||||||
|
function VisitIndexer(const Node: IAstNode): TVoid;
|
||||||
|
function VisitMemberAccess(const Node: IAstNode): TVoid;
|
||||||
|
function VisitRecordLiteral(const Node: IAstNode): TVoid;
|
||||||
|
function VisitRecordField(const Node: IAstNode): TVoid;
|
||||||
|
function VisitCreateSeries(const Node: IAstNode): TVoid;
|
||||||
|
function VisitAddSeriesItem(const Node: IAstNode): TVoid;
|
||||||
|
function VisitNop(const Node: IAstNode): TVoid;
|
||||||
|
function VisitTuple(const Node: IAstNode): TVoid;
|
||||||
|
function VisitPipe(const Node: IAstNode): TVoid;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure SetupHandlers; override;
|
||||||
|
|
||||||
|
public
|
||||||
|
constructor Create(const AOutput: TStrings);
|
||||||
|
class procedure Dump(const RootNode: IAstNode; const Output: TStrings);
|
||||||
|
procedure Execute(const RootNode: IAstNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Myc.Data.Keyword,
|
||||||
|
Myc.Ast.Types;
|
||||||
|
|
||||||
|
{ TAstDumper }
|
||||||
|
|
||||||
|
class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings);
|
||||||
|
var
|
||||||
|
dumper: TAstDumper;
|
||||||
|
begin
|
||||||
|
if (not Assigned(Output)) or (not Assigned(RootNode)) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
Output.Clear;
|
||||||
|
dumper := TAstDumper.Create(Output);
|
||||||
|
try
|
||||||
|
dumper.Execute(RootNode);
|
||||||
|
finally
|
||||||
|
dumper.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TAstDumper.Create(const AOutput: TStrings);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FOutput := AOutput;
|
||||||
|
FIndent := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstDumper.SetupHandlers;
|
||||||
|
begin
|
||||||
|
Register(akConstant, VisitConstant);
|
||||||
|
Register(akIdentifier, VisitIdentifier);
|
||||||
|
Register(akKeyword, VisitKeyword);
|
||||||
|
Register(akTuple, VisitTuple);
|
||||||
|
Register(akRecordField, VisitRecordField);
|
||||||
|
Register(akIfExpression, VisitIfExpression);
|
||||||
|
Register(akCondExpression, VisitCondExpression);
|
||||||
|
Register(akLambdaExpression, VisitLambdaExpression);
|
||||||
|
Register(akFunctionCall, VisitFunctionCall);
|
||||||
|
Register(akMacroExpansion, VisitMacroExpansionNode);
|
||||||
|
Register(akBlockExpression, VisitBlockExpression);
|
||||||
|
Register(akVariableDeclaration, VisitVariableDeclaration);
|
||||||
|
Register(akAssignment, VisitAssignment);
|
||||||
|
Register(akMacroDefinition, VisitMacroDefinition);
|
||||||
|
Register(akQuasiquote, VisitQuasiquote);
|
||||||
|
Register(akUnquote, VisitUnquote);
|
||||||
|
Register(akUnquoteSplicing, VisitUnquoteSplicing);
|
||||||
|
Register(akIndexer, VisitIndexer);
|
||||||
|
Register(akMemberAccess, VisitMemberAccess);
|
||||||
|
Register(akRecordLiteral, VisitRecordLiteral);
|
||||||
|
Register(akCreateSeries, VisitCreateSeries);
|
||||||
|
Register(akAddSeriesItem, VisitAddSeriesItem);
|
||||||
|
Register(akRecur, VisitRecurNode);
|
||||||
|
Register(akNop, VisitNop);
|
||||||
|
Register(akPipe, VisitPipe);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstDumper.Execute(const RootNode: IAstNode);
|
||||||
|
begin
|
||||||
|
if Assigned(RootNode) then
|
||||||
|
Visit(RootNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstDumper.Indent;
|
||||||
|
begin
|
||||||
|
inc(FIndent, 2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstDumper.Unindent;
|
||||||
|
begin
|
||||||
|
dec(FIndent, 2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstDumper.Log(const Text: string; const Node: IAstNode);
|
||||||
|
var
|
||||||
|
staticType: IStaticType;
|
||||||
|
begin
|
||||||
|
var typeStr := '';
|
||||||
|
if Assigned(Node) and Node.IsTyped then
|
||||||
|
begin
|
||||||
|
staticType := Node.AsTypedNode.StaticType;
|
||||||
|
if Assigned(staticType) then
|
||||||
|
typeStr := Format(' <Type: %s>', [staticType.ToString])
|
||||||
|
else
|
||||||
|
typeStr := ' <Type: nil>';
|
||||||
|
end;
|
||||||
|
FOutput.Add(StringOfChar(' ', FIndent) + Text + typeStr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode);
|
||||||
|
begin
|
||||||
|
Log(Format(Fmt, Args), Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.FormatAddress(const Addr: TResolvedAddress): string;
|
||||||
|
begin
|
||||||
|
case Addr.Kind of
|
||||||
|
akUnresolved: Result := '!! UNRESOLVED !!';
|
||||||
|
akLocalOrParent: Result := Format('LocalOrParent (Depth: %d, Slot: %d)', [Addr.ScopeDepth, Addr.SlotIndex]);
|
||||||
|
akUpvalue: Result := Format('Upvalue (Index: %d)', [Addr.SlotIndex]);
|
||||||
|
else
|
||||||
|
Result := 'Unknown Address Kind';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitConstant(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
LogFmt('Constant: %s', [Node.AsConstant.Value.ToString], Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitIdentifier(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
I: IIdentifierNode;
|
||||||
|
begin
|
||||||
|
I := Node.AsIdentifier;
|
||||||
|
if I.Address.Kind <> akUnresolved then
|
||||||
|
LogFmt('Identifier: %s -> %s', [I.Name, FormatAddress(I.Address)], Node)
|
||||||
|
else
|
||||||
|
LogFmt('Identifier: %s (unbound)', [I.Name], Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitKeyword(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
LogFmt('Keyword: :%s', [Node.AsKeyword.Value.Name], Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitIfExpression(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
E: IIfExpressionNode;
|
||||||
|
begin
|
||||||
|
E := Node.AsIfExpression;
|
||||||
|
Log('IfExpression', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Condition:');
|
||||||
|
Visit(E.Condition);
|
||||||
|
Log('Then:');
|
||||||
|
Visit(E.ThenBranch);
|
||||||
|
if Assigned(E.ElseBranch) then
|
||||||
|
begin
|
||||||
|
Log('Else:');
|
||||||
|
Visit(E.ElseBranch);
|
||||||
|
end;
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitCondExpression(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
E: ICondExpressionNode;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
E := Node.AsCondExpression;
|
||||||
|
LogFmt('CondExpression (%d pairs)', [Length(E.Pairs)], Node);
|
||||||
|
Indent;
|
||||||
|
for i := 0 to High(E.Pairs) do
|
||||||
|
begin
|
||||||
|
LogFmt('Pair %d:', [i]);
|
||||||
|
Indent;
|
||||||
|
Log('Condition:');
|
||||||
|
Visit(E.Pairs[i].Condition);
|
||||||
|
Log('Branch:');
|
||||||
|
Visit(E.Pairs[i].Branch);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
Log('Else:');
|
||||||
|
Visit(E.ElseBranch);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitLambdaExpression(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
E: ILambdaExpressionNode;
|
||||||
|
symbols: TArray<string>;
|
||||||
|
layout: IScopeLayout;
|
||||||
|
slot: Integer;
|
||||||
|
typ: IStaticType;
|
||||||
|
begin
|
||||||
|
E := Node.AsLambdaExpression;
|
||||||
|
LogFmt(
|
||||||
|
'LambdaExpression (HasNested: %s, IsPure: %s)',
|
||||||
|
[E.HasNestedLambdas.ToString(TUseBoolStrs.True), E.IsPure.ToString(TUseBoolStrs.True)],
|
||||||
|
Node
|
||||||
|
);
|
||||||
|
Indent;
|
||||||
|
|
||||||
|
if Assigned(E.Layout) then
|
||||||
|
begin
|
||||||
|
LogFmt('Scope: Layout Slots=%d', [E.Layout.SlotCount]);
|
||||||
|
if Assigned(E.Descriptor) then
|
||||||
|
begin
|
||||||
|
Log('Symbol Table:');
|
||||||
|
Indent;
|
||||||
|
layout := E.Layout;
|
||||||
|
symbols := layout.GetSymbols;
|
||||||
|
TArray.Sort<string>(symbols);
|
||||||
|
for var name in symbols do
|
||||||
|
begin
|
||||||
|
slot := layout.FindSlot(name);
|
||||||
|
typ := E.Descriptor.GetSymbolType(slot);
|
||||||
|
LogFmt('"%s" -> Slot %d (Type: %s)', [name, slot, typ.ToString]);
|
||||||
|
end;
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Log('Parameters:');
|
||||||
|
Indent;
|
||||||
|
Visit(E.Parameters);
|
||||||
|
Unindent;
|
||||||
|
|
||||||
|
if Length(E.Upvalues) > 0 then
|
||||||
|
begin
|
||||||
|
LogFmt('Captured Upvalues (%d):', [Length(E.Upvalues)]);
|
||||||
|
Indent;
|
||||||
|
for var addr in E.Upvalues do
|
||||||
|
Log(FormatAddress(addr));
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Log('Body:');
|
||||||
|
Visit(E.Body);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitFunctionCall(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
C: IFunctionCallNode;
|
||||||
|
argTypes: TArray<string>;
|
||||||
|
i: Integer;
|
||||||
|
args: ITupleNode;
|
||||||
|
argsElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
C := Node.AsFunctionCall;
|
||||||
|
args := C.Arguments;
|
||||||
|
argsElements := args.Elements;
|
||||||
|
|
||||||
|
LogFmt(
|
||||||
|
'FunctionCall (IsTailCall: %s, StaticTarget: %s, IsTargetPure: %s)',
|
||||||
|
[
|
||||||
|
C.IsTailCall.ToString(TUseBoolStrs.True),
|
||||||
|
Assigned(C.StaticTarget).ToString(TUseBoolStrs.True),
|
||||||
|
C.IsTargetPure.ToString(TUseBoolStrs.True)
|
||||||
|
],
|
||||||
|
Node
|
||||||
|
);
|
||||||
|
|
||||||
|
if Assigned(C.StaticTarget) then
|
||||||
|
begin
|
||||||
|
Indent;
|
||||||
|
SetLength(argTypes, Length(argsElements));
|
||||||
|
for i := 0 to High(argsElements) do
|
||||||
|
begin
|
||||||
|
if argsElements[i].IsTyped then
|
||||||
|
argTypes[i] := argsElements[i].AsTypedNode.StaticType.ToString
|
||||||
|
else
|
||||||
|
argTypes[i] := 'Untyped';
|
||||||
|
end;
|
||||||
|
LogFmt('ResolvedSig: Method(%s): %s', [string.Join(', ', argTypes), C.StaticType.ToString]);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Indent;
|
||||||
|
Log('Callee:');
|
||||||
|
Visit(C.Callee);
|
||||||
|
LogFmt('Arguments (%d):', [Length(argsElements)]);
|
||||||
|
Visit(args);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitMacroExpansionNode(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
M: IMacroExpansionNode;
|
||||||
|
begin
|
||||||
|
M := Node.AsMacroExpansion;
|
||||||
|
Log('MacroExpansion', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Original Call:');
|
||||||
|
Visit(M.CallNode);
|
||||||
|
Log('Expanded Body:');
|
||||||
|
Visit(M.ExpandedBody);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitRecurNode(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('Recur', Node);
|
||||||
|
Indent;
|
||||||
|
Visit(Node.AsRecur.Arguments);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitBlockExpression(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('BlockExpression', Node);
|
||||||
|
Indent;
|
||||||
|
Visit(Node.AsBlockExpression.Expressions);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitVariableDeclaration(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
V: IVariableDeclarationNode;
|
||||||
|
begin
|
||||||
|
V := Node.AsVariableDeclaration;
|
||||||
|
LogFmt('VariableDeclaration (IsBoxed: %s)', [V.IsBoxed.ToString(TUseBoolStrs.True)], Node);
|
||||||
|
Indent;
|
||||||
|
Visit(V.Target);
|
||||||
|
if Assigned(V.Initializer) then
|
||||||
|
begin
|
||||||
|
Log('Initializer:');
|
||||||
|
Visit(V.Initializer);
|
||||||
|
end;
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitAssignment(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
A: IAssignmentNode;
|
||||||
|
begin
|
||||||
|
A := Node.AsAssignment;
|
||||||
|
Log('Assignment', Node);
|
||||||
|
Indent;
|
||||||
|
Visit(A.Target);
|
||||||
|
Log('Value:');
|
||||||
|
Visit(A.Value);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitMacroDefinition(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
M: IMacroDefinitionNode;
|
||||||
|
begin
|
||||||
|
M := Node.AsMacroDefinition;
|
||||||
|
Log('MacroDefinition', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Name:');
|
||||||
|
Visit(M.Name);
|
||||||
|
Log('Parameters:');
|
||||||
|
Visit(M.Parameters);
|
||||||
|
Log('Body:');
|
||||||
|
Visit(M.Body);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitQuasiquote(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('Quasiquote', Node);
|
||||||
|
Indent;
|
||||||
|
Visit(Node.AsQuasiquote.Expression);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitUnquote(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('Unquote', Node);
|
||||||
|
Indent;
|
||||||
|
Visit(Node.AsUnquote.Expression);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitUnquoteSplicing(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('UnquoteSplicing', Node);
|
||||||
|
Indent;
|
||||||
|
Visit(Node.AsUnquoteSplicing.Expression);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitIndexer(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
I: IIndexerNode;
|
||||||
|
begin
|
||||||
|
I := Node.AsIndexer;
|
||||||
|
Log('Indexer', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Base:');
|
||||||
|
Visit(I.Base);
|
||||||
|
Log('Index:');
|
||||||
|
Visit(I.Index);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitMemberAccess(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
M: IMemberAccessNode;
|
||||||
|
begin
|
||||||
|
M := Node.AsMemberAccess;
|
||||||
|
Log('MemberAccess', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Base:');
|
||||||
|
Visit(M.Base);
|
||||||
|
Log('Member:');
|
||||||
|
Visit(M.Member);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitRecordLiteral(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
R: IRecordLiteralNode;
|
||||||
|
begin
|
||||||
|
R := Node.AsRecordLiteral;
|
||||||
|
LogFmt('RecordLiteral (%d fields)', [Length(R.Fields.Elements)], Node);
|
||||||
|
Indent;
|
||||||
|
Visit(R.Fields);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitRecordField(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
F: IRecordFieldNode;
|
||||||
|
begin
|
||||||
|
F := Node.AsRecordField;
|
||||||
|
LogFmt('Field :%s', [F.Key.Value.Name]);
|
||||||
|
Indent;
|
||||||
|
Visit(F.Value);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitCreateSeries(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('CreateSeries', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Definition:');
|
||||||
|
Visit(Node.AsCreateSeries.DefinitionNode);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitAddSeriesItem(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
A: IAddSeriesItemNode;
|
||||||
|
begin
|
||||||
|
A := Node.AsAddSeriesItem;
|
||||||
|
Log('AddSeriesItem', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Series:');
|
||||||
|
Visit(A.Series);
|
||||||
|
Log('Value:');
|
||||||
|
Visit(A.Value);
|
||||||
|
if Assigned(A.Lookback) then
|
||||||
|
begin
|
||||||
|
Log('Lookback:');
|
||||||
|
Visit(A.Lookback);
|
||||||
|
end;
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitNop(const Node: IAstNode): TVoid;
|
||||||
|
begin
|
||||||
|
Log('Nop', Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitTuple(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
T: ITupleNode;
|
||||||
|
i: Integer;
|
||||||
|
elements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
T := Node.AsTuple;
|
||||||
|
elements := T.Elements;
|
||||||
|
LogFmt('Tuple (%d elements)', [Length(elements)], Node);
|
||||||
|
Indent;
|
||||||
|
for i := 0 to High(elements) do
|
||||||
|
begin
|
||||||
|
LogFmt('Item %d:', [i]);
|
||||||
|
Indent;
|
||||||
|
Visit(elements[i]);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstDumper.VisitPipe(const Node: IAstNode): TVoid;
|
||||||
|
var
|
||||||
|
P: IPipeNode;
|
||||||
|
begin
|
||||||
|
P := Node.AsPipe;
|
||||||
|
Log('Pipe', Node);
|
||||||
|
Indent;
|
||||||
|
Log('Inputs (Tuple of Tuples):');
|
||||||
|
Visit(P.Inputs);
|
||||||
|
Log('Transformation:');
|
||||||
|
Visit(P.Transformation);
|
||||||
|
Unindent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,590 @@
|
|||||||
|
unit Myc.Ast.Environment;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.Generics.Defaults,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Ast,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast.RTL,
|
||||||
|
Myc.Ast.Types,
|
||||||
|
Myc.Ast.Compiler.Macros,
|
||||||
|
Myc.Ast.Compiler.Binder,
|
||||||
|
Myc.Ast.Compiler.TypeChecker,
|
||||||
|
Myc.Ast.Compiler.Specializer,
|
||||||
|
Myc.Ast.Compiler.TCO,
|
||||||
|
Myc.Ast.Analysis.Purity;
|
||||||
|
|
||||||
|
type
|
||||||
|
IEnvironment = interface;
|
||||||
|
IExecutionStrategy = interface;
|
||||||
|
|
||||||
|
IExecutionStrategy = interface
|
||||||
|
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IEnvironment = interface
|
||||||
|
{$region 'private'}
|
||||||
|
function GetRootScope: IExecutionScope;
|
||||||
|
function GetMacroRegistry: IMacroRegistry;
|
||||||
|
function GetMonomorphCache: IMonomorphCache;
|
||||||
|
function GetFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
{$endregion}
|
||||||
|
|
||||||
|
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
||||||
|
|
||||||
|
function ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
function Bind(
|
||||||
|
const Node: IAstNode;
|
||||||
|
out Layout: IScopeLayout;
|
||||||
|
const AArgTypes: TArray<IStaticType>;
|
||||||
|
const Log: ICompilerLog
|
||||||
|
): IAstNode;
|
||||||
|
|
||||||
|
function Specialize(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
function Compile(
|
||||||
|
const Node: IFunctionDefinition;
|
||||||
|
const ArgTypes: TArray<IStaticType> = [];
|
||||||
|
const Log: ICompilerLog = nil
|
||||||
|
): ILambdaExpressionNode;
|
||||||
|
function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
|
||||||
|
|
||||||
|
function CreateEnvironment: IEnvironment;
|
||||||
|
|
||||||
|
property RootScope: IExecutionScope read GetRootScope;
|
||||||
|
|
||||||
|
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
|
||||||
|
property MonomorphCache: IMonomorphCache read GetMonomorphCache;
|
||||||
|
property FunctionRegistry: IFunctionDefinitionRegistry read GetFunctionRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Interface Helper for IEnvironment
|
||||||
|
TAstEnvironment = record
|
||||||
|
private
|
||||||
|
FEnvironment: IEnvironment;
|
||||||
|
function GetRootScope: IExecutionScope; inline;
|
||||||
|
function GetMacroRegistry: IMacroRegistry; inline;
|
||||||
|
public
|
||||||
|
constructor Create(const AEnvironment: IEnvironment);
|
||||||
|
|
||||||
|
class function Construct(const Scope: IExecutionScope): TAstEnvironment; static;
|
||||||
|
|
||||||
|
class operator Implicit(const A: IEnvironment): TAstEnvironment;
|
||||||
|
class operator Implicit(const A: TAstEnvironment): IEnvironment;
|
||||||
|
|
||||||
|
function CreateEnvironment: TAstEnvironment;
|
||||||
|
|
||||||
|
procedure SetStandardMode;
|
||||||
|
procedure SetDebugMode(ALog: TStrings; AShowScope: Boolean);
|
||||||
|
|
||||||
|
function ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
function Bind(const Node: IAstNode; const AArgTypes: TArray<IStaticType>; const Log: ICompilerLog): IAstNode;
|
||||||
|
function Specialize(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
function Compile(
|
||||||
|
const Node: IAstNode;
|
||||||
|
const Params: TArray<IIdentifierNode> = [];
|
||||||
|
const ArgTypes: TArray<IStaticType> = []
|
||||||
|
): ILambdaExpressionNode; overload;
|
||||||
|
function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): ILambdaExpressionNode; overload;
|
||||||
|
function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
|
||||||
|
|
||||||
|
function Run(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []; const Args: TArray<TDataValue> = []): TDataValue;
|
||||||
|
|
||||||
|
// UPDATED: Now supports Documentation
|
||||||
|
procedure Define(const Name: String; const AScript: IAstNode; const Doc: string = '');
|
||||||
|
|
||||||
|
property Environment: IEnvironment read FEnvironment;
|
||||||
|
property RootScope: IExecutionScope read GetRootScope;
|
||||||
|
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Hash,
|
||||||
|
Myc.Ast.Evaluator,
|
||||||
|
Myc.Ast.Debugger;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
|
||||||
|
public
|
||||||
|
function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
|
||||||
|
function GetHashCode(const Value: TMonoCacheKey): Integer; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TMonomorphCache = class(TInterfacedObject, IMonomorphCache)
|
||||||
|
private
|
||||||
|
FMonomorphCache: TDictionary<TMonoCacheKey, TSpecializedMethod>;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
function TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
|
||||||
|
procedure Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TStandardExecutionStrategy }
|
||||||
|
TStandardExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
|
||||||
|
public
|
||||||
|
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDebugExecutionStrategy }
|
||||||
|
TDebugExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
|
||||||
|
private
|
||||||
|
FLog: TStrings;
|
||||||
|
FShowScope: Boolean;
|
||||||
|
public
|
||||||
|
constructor Create(ALog: TStrings; AShowScope: Boolean);
|
||||||
|
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TFunctionDefinitionRegistry = class(TInterfacedObject, IFunctionDefinitionRegistry)
|
||||||
|
private
|
||||||
|
FMap: TDictionary<TResolvedAddress, IFunctionDefinition>;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
|
||||||
|
function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TEnvironment }
|
||||||
|
TEnvironment = class(TInterfacedObject, IEnvironment)
|
||||||
|
private
|
||||||
|
FRootScope: IExecutionScope;
|
||||||
|
FMacroRegistry: IMacroRegistry;
|
||||||
|
FExecutionStrategy: IExecutionStrategy;
|
||||||
|
FMonomorphCache: IMonomorphCache;
|
||||||
|
FFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
function GetRootScope: IExecutionScope;
|
||||||
|
function GetMacroRegistry: IMacroRegistry;
|
||||||
|
function GetMonomorphCache: IMonomorphCache;
|
||||||
|
function GetFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
public
|
||||||
|
constructor Create(
|
||||||
|
const ARootScope: IExecutionScope;
|
||||||
|
const AMacroRegistry: IMacroRegistry;
|
||||||
|
const AExecutionStrategy: IExecutionStrategy
|
||||||
|
);
|
||||||
|
function CreateEnvironment: IEnvironment;
|
||||||
|
|
||||||
|
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
||||||
|
|
||||||
|
function ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
function Bind(
|
||||||
|
const Node: IAstNode;
|
||||||
|
out Layout: IScopeLayout;
|
||||||
|
const ArgTypes: TArray<IStaticType>;
|
||||||
|
const Log: ICompilerLog
|
||||||
|
): IAstNode;
|
||||||
|
|
||||||
|
function Specialize(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
function Compile(
|
||||||
|
const Node: IFunctionDefinition;
|
||||||
|
const ArgTypes: TArray<IStaticType>;
|
||||||
|
const Log: ICompilerLog = nil
|
||||||
|
): ILambdaExpressionNode;
|
||||||
|
function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAstEnvironment }
|
||||||
|
|
||||||
|
constructor TAstEnvironment.Create(const AEnvironment: IEnvironment);
|
||||||
|
begin
|
||||||
|
FEnvironment := AEnvironment;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.Bind(const Node: IAstNode; const AArgTypes: TArray<IStaticType>; const Log: ICompilerLog): IAstNode;
|
||||||
|
var
|
||||||
|
layout: IScopeLayout;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.Bind(Node, layout, AArgTypes, Log);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstEnvironment.SetStandardMode;
|
||||||
|
begin
|
||||||
|
FEnvironment.SetExecutionStrategy(TStandardExecutionStrategy.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstEnvironment.SetDebugMode(ALog: TStrings; AShowScope: Boolean);
|
||||||
|
begin
|
||||||
|
FEnvironment.SetExecutionStrategy(TDebugExecutionStrategy.Create(ALog, AShowScope));
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TAstEnvironment.Implicit(const A: IEnvironment): TAstEnvironment;
|
||||||
|
begin
|
||||||
|
Result.FEnvironment := A;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class operator TAstEnvironment.Implicit(const A: TAstEnvironment): IEnvironment;
|
||||||
|
begin
|
||||||
|
Result := A.FEnvironment;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.Compile(
|
||||||
|
const Node: IAstNode;
|
||||||
|
const Params: TArray<IIdentifierNode> = [];
|
||||||
|
const ArgTypes: TArray<IStaticType> = []
|
||||||
|
): ILambdaExpressionNode;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.Compile(TAst.LambdaExpr(Params, Node), ArgTypes);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): ILambdaExpressionNode;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.Compile(Node, ArgTypes);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TAstEnvironment.Construct(const Scope: IExecutionScope): TAstEnvironment;
|
||||||
|
var
|
||||||
|
RootScope: IExecutionScope;
|
||||||
|
begin
|
||||||
|
// Initialize root scope with library registration
|
||||||
|
RootScope := Scope;
|
||||||
|
if RootScope = nil then
|
||||||
|
RootScope := TAst.CreateScope(nil, nil, True);
|
||||||
|
|
||||||
|
Result.Create(TEnvironment.Create(RootScope, TMacroRegistry.Create(nil), TStandardExecutionStrategy.Create));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.CreateEnvironment: TAstEnvironment;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.CreateEnvironment;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode; const Doc: string);
|
||||||
|
begin
|
||||||
|
var compiled := Compile(AScript);
|
||||||
|
var linked := Link(compiled);
|
||||||
|
// Pass the documentation to the scope
|
||||||
|
RootScope.Define(Name, linked.Func([]), compiled.StaticType, Doc);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.ExpandMacros(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.GetRootScope: IExecutionScope;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.GetRootScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.GetMacroRegistry: IMacroRegistry;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.GetMacroRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.Link(Node, Log);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.Run(
|
||||||
|
const ANode: IAstNode;
|
||||||
|
const Params: TArray<IIdentifierNode> = [];
|
||||||
|
const Args: TArray<TDataValue> = []
|
||||||
|
): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Link(Compile(ANode, Params)).Func(Args);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAstEnvironment.Specialize(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := FEnvironment.Specialize(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TStandardExecutionStrategy }
|
||||||
|
|
||||||
|
function TStandardExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
|
||||||
|
begin
|
||||||
|
Result := TEvaluatorVisitor.Create(AScope);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDebugExecutionStrategy }
|
||||||
|
|
||||||
|
constructor TDebugExecutionStrategy.Create(ALog: TStrings; AShowScope: Boolean);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FLog := ALog;
|
||||||
|
FShowScope := AShowScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDebugExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
|
||||||
|
begin
|
||||||
|
Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFunctionDefinitionRegistry }
|
||||||
|
|
||||||
|
constructor TFunctionDefinitionRegistry.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FMap := TDictionary<TResolvedAddress, IFunctionDefinition>.Create(TResolvedAddressComparer.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TFunctionDefinitionRegistry.Destroy;
|
||||||
|
begin
|
||||||
|
FMap.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TFunctionDefinitionRegistry.Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
|
||||||
|
begin
|
||||||
|
FMap.AddOrSetValue(Address, ADef);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFunctionDefinitionRegistry.Resolve(const Address: TResolvedAddress): IFunctionDefinition;
|
||||||
|
begin
|
||||||
|
FMap.TryGetValue(Address, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TEnvironment }
|
||||||
|
|
||||||
|
constructor TEnvironment.Create(
|
||||||
|
const ARootScope: IExecutionScope;
|
||||||
|
const AMacroRegistry: IMacroRegistry;
|
||||||
|
const AExecutionStrategy: IExecutionStrategy
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FRootScope := ARootScope;
|
||||||
|
FMacroRegistry := AMacroRegistry;
|
||||||
|
FExecutionStrategy := AExecutionStrategy;
|
||||||
|
FMonomorphCache := TMonomorphCache.Create;
|
||||||
|
FFunctionRegistry := TFunctionDefinitionRegistry.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.GetMonomorphCache: IMonomorphCache;
|
||||||
|
begin
|
||||||
|
Result := FMonomorphCache;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.Bind(
|
||||||
|
const Node: IAstNode;
|
||||||
|
out Layout: IScopeLayout;
|
||||||
|
const ArgTypes: TArray<IStaticType>;
|
||||||
|
const Log: ICompilerLog
|
||||||
|
): IAstNode;
|
||||||
|
begin
|
||||||
|
// 1. Bind (produces Layout and Bound AST with Addresses)
|
||||||
|
var boundAst := TAstBinder.Bind(FRootScope.Descriptor.Layout, Node, Layout, Log, FFunctionRegistry, ArgTypes);
|
||||||
|
|
||||||
|
// 2. Check Types (produces Typed AST with Descriptors baked into nodes)
|
||||||
|
Result := TTypeChecker.CheckTypes(boundAst, Layout, FRootScope, Log);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.GetMacroRegistry: IMacroRegistry;
|
||||||
|
begin
|
||||||
|
Result := FMacroRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.GetRootScope: IExecutionScope;
|
||||||
|
begin
|
||||||
|
Result := FRootScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TEnvironment.SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
||||||
|
begin
|
||||||
|
FExecutionStrategy := AStrategy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.CreateEnvironment: IEnvironment;
|
||||||
|
begin
|
||||||
|
Result := TEnvironment.Create(TAst.CreateScope(FRootScope), TMacroRegistry.Create(FMacroRegistry), FExecutionStrategy);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.Compile(
|
||||||
|
const Node: IFunctionDefinition;
|
||||||
|
const ArgTypes: TArray<IStaticType>;
|
||||||
|
const Log: ICompilerLog = nil
|
||||||
|
): ILambdaExpressionNode;
|
||||||
|
var
|
||||||
|
layout: IScopeLayout;
|
||||||
|
lg: ICompilerLog;
|
||||||
|
begin
|
||||||
|
lg :=
|
||||||
|
if Assigned(Log) then Log
|
||||||
|
else TCompilerLog.Create as ICompilerLog;
|
||||||
|
|
||||||
|
// 1. Expand Macros
|
||||||
|
var expanded := ExpandMacros(Node);
|
||||||
|
|
||||||
|
// 2. Bind & TypeCheck (accumulating errors)
|
||||||
|
var typedNode := Bind(expanded, layout, ArgTypes, lg);
|
||||||
|
|
||||||
|
// 3. Check for compilation errors
|
||||||
|
if lg.HasErrors then
|
||||||
|
raise ECompilationFailed.Create(lg.GetEntries);
|
||||||
|
|
||||||
|
var specialized := Specialize(typedNode);
|
||||||
|
|
||||||
|
Result := specialized.AsLambdaExpression;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
|
||||||
|
var
|
||||||
|
descriptor: IScopeDescriptor;
|
||||||
|
funcType: IStaticType;
|
||||||
|
finalFunc: TDataValue.TFunc;
|
||||||
|
isPure: Boolean;
|
||||||
|
begin
|
||||||
|
descriptor := Node.Descriptor;
|
||||||
|
|
||||||
|
// Descriptor might be nil if Bind failed badly, but HasErrors check above covers that.
|
||||||
|
Assert(Assigned(descriptor));
|
||||||
|
|
||||||
|
funcType := Node.StaticType;
|
||||||
|
|
||||||
|
var tcoOptimized := TAstTCO.Optimize(Node).AsLambdaExpression;
|
||||||
|
|
||||||
|
// 5. Purity Inference
|
||||||
|
isPure := TPurityAnalyzer.IsPure(tcoOptimized.Body);
|
||||||
|
|
||||||
|
// 6. Generate Visitor/Closure
|
||||||
|
var visitor := FExecutionStrategy.CreateVisitor(descriptor.CreateScope(FRootScope));
|
||||||
|
var closure := tcoOptimized.Accept(visitor);
|
||||||
|
|
||||||
|
finalFunc :=
|
||||||
|
function(const Args: TArray<TDataValue>): TDataValue
|
||||||
|
begin
|
||||||
|
Result := closure.AsMethod()(Args);
|
||||||
|
TEvaluatorVisitor.HandleTCO(Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := TCompiledFunction.Create(finalFunc, funcType, isPure);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
var cExecutionStrategy := FExecutionStrategy;
|
||||||
|
|
||||||
|
// The Glue: This callback performs the full compilation pipeline for a macro argument expression.
|
||||||
|
var macroEvaluator: TMacroEvaluatorProc :=
|
||||||
|
function(const Scope: IExecutionScope; const ANode: IAstNode): TDataValue
|
||||||
|
var
|
||||||
|
tmpLayout: IScopeLayout;
|
||||||
|
evaluator: IEvaluatorVisitor;
|
||||||
|
boundSubAst: IAstNode;
|
||||||
|
scratchScope: IExecutionScope;
|
||||||
|
tempLog: ICompilerLog;
|
||||||
|
begin
|
||||||
|
// Create temporary log for the macro context
|
||||||
|
tempLog := TCompilerLog.Create;
|
||||||
|
|
||||||
|
// 1. Binding
|
||||||
|
boundSubAst := TAstBinder.Bind(Scope.Descriptor.Layout, ANode, tmpLayout, tempLog);
|
||||||
|
|
||||||
|
if tempLog.HasErrors then
|
||||||
|
raise EMacroException.Create('Macro Argument Error: ' + tempLog.GetEntries[0].Message);
|
||||||
|
|
||||||
|
// 2. Scope Matching
|
||||||
|
scratchScope := TScope.CreateScope(Scope, nil, nil);
|
||||||
|
|
||||||
|
// 3. Execution
|
||||||
|
evaluator := cExecutionStrategy.CreateVisitor(scratchScope);
|
||||||
|
Result := evaluator.Execute(boundSubAst);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := TMacroExpander.ExpandMacros(FMacroRegistry, FRootScope, Node, macroEvaluator);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.GetFunctionRegistry: IFunctionDefinitionRegistry;
|
||||||
|
begin
|
||||||
|
Result := FFunctionRegistry;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.Specialize(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
TStaticSpecializer.Specialize(
|
||||||
|
Node,
|
||||||
|
FMonomorphCache,
|
||||||
|
FFunctionRegistry,
|
||||||
|
function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction
|
||||||
|
begin
|
||||||
|
Result := Link(Compile(Node, ArgTypes));
|
||||||
|
end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMonoCacheKeyComparer }
|
||||||
|
|
||||||
|
function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
if not (Left.Address = Right.Address) then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
for i := 0 to High(Left.ArgTypes) do
|
||||||
|
begin
|
||||||
|
if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
|
||||||
|
exit(False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
hash: Integer;
|
||||||
|
typeHash: Integer;
|
||||||
|
adr: TResolvedAddress;
|
||||||
|
begin
|
||||||
|
adr := Value.Address;
|
||||||
|
|
||||||
|
hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
|
||||||
|
hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
|
||||||
|
hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);
|
||||||
|
|
||||||
|
for i := 0 to High(Value.ArgTypes) do
|
||||||
|
begin
|
||||||
|
if Assigned(Value.ArgTypes[i]) then
|
||||||
|
typeHash := Value.ArgTypes[i].GetHashCode
|
||||||
|
else
|
||||||
|
typeHash := 0;
|
||||||
|
|
||||||
|
hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := hash;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMonomorphCache.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FMonomorphCache := TDictionary<TMonoCacheKey, TSpecializedMethod>.Create(TMonoCacheKeyComparer.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMonomorphCache.Destroy;
|
||||||
|
begin
|
||||||
|
FMonomorphCache.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMonomorphCache.Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
|
||||||
|
begin
|
||||||
|
FMonomorphCache.Add(Key, Func);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMonomorphCache.TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
|
||||||
|
begin
|
||||||
|
Result := FMonomorphCache.TryGetValue(Key, Func);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,642 @@
|
|||||||
|
unit Myc.Ast.Evaluator;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
Myc.Data.Scalar,
|
||||||
|
Myc.Data.Value,
|
||||||
|
Myc.Data.Keyword,
|
||||||
|
Myc.Ast.Nodes,
|
||||||
|
Myc.Ast.Scope,
|
||||||
|
Myc.Ast;
|
||||||
|
|
||||||
|
type
|
||||||
|
EEvaluatorException = class(EAstException);
|
||||||
|
TEvaluatorFactory = reference to function(const AScope: IExecutionScope): IEvaluatorVisitor;
|
||||||
|
|
||||||
|
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor)
|
||||||
|
private
|
||||||
|
FScope: IExecutionScope;
|
||||||
|
protected
|
||||||
|
// Haupt-Dispatch-Methode
|
||||||
|
function Visit(const Node: IAstNode): TDataValue; virtual;
|
||||||
|
function CreateVisitorFactory: TEvaluatorFactory; virtual;
|
||||||
|
|
||||||
|
// Besuchermethoden
|
||||||
|
function VisitConstant(const N: IConstantNode): TDataValue; virtual;
|
||||||
|
function VisitIdentifier(const N: IIdentifierNode): TDataValue; virtual;
|
||||||
|
function VisitKeyword(const N: IKeywordNode): TDataValue; virtual;
|
||||||
|
function VisitTuple(const N: ITupleNode): TDataValue; virtual;
|
||||||
|
|
||||||
|
function VisitIfExpression(const N: IIfExpressionNode): TDataValue; virtual;
|
||||||
|
function VisitCondExpression(const N: ICondExpressionNode): TDataValue; virtual;
|
||||||
|
function VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue; virtual;
|
||||||
|
function VisitFunctionCall(const N: IFunctionCallNode): TDataValue; virtual;
|
||||||
|
function VisitBlockExpression(const N: IBlockExpressionNode): TDataValue; virtual;
|
||||||
|
function VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue; virtual;
|
||||||
|
function VisitAssignment(const N: IAssignmentNode): TDataValue; virtual;
|
||||||
|
function VisitIndexer(const N: IIndexerNode): TDataValue; virtual;
|
||||||
|
function VisitMemberAccess(const N: IMemberAccessNode): TDataValue; virtual;
|
||||||
|
function VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue; virtual;
|
||||||
|
function VisitCreateSeries(const N: ICreateSeriesNode): TDataValue; virtual;
|
||||||
|
function VisitAddSeriesItem(const N: IAddSeriesItemNode): TDataValue; virtual;
|
||||||
|
function VisitRecurNode(const N: IRecurNode): TDataValue; virtual;
|
||||||
|
function VisitPipe(const N: IPipeNode): TDataValue; virtual;
|
||||||
|
|
||||||
|
function IsTruthy(const AValue: TDataValue): Boolean; inline;
|
||||||
|
public
|
||||||
|
constructor Create(const AScope: IExecutionScope);
|
||||||
|
function Execute(const RootNode: IAstNode): TDataValue;
|
||||||
|
class procedure HandleTCO(var ResultValue: TDataValue); static;
|
||||||
|
property Scope: IExecutionScope read FScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.TypInfo,
|
||||||
|
System.Generics.Defaults,
|
||||||
|
Myc.Data.Decimal,
|
||||||
|
Myc.Data.Series,
|
||||||
|
Myc.Data.Stream,
|
||||||
|
Myc.Ast.Types;
|
||||||
|
|
||||||
|
type
|
||||||
|
TThunk = record
|
||||||
|
Callee: TDataValue;
|
||||||
|
Args: TArray<TDataValue>;
|
||||||
|
Recur: Boolean;
|
||||||
|
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
|
||||||
|
begin
|
||||||
|
Callee := ACallee;
|
||||||
|
Args := AArgs;
|
||||||
|
Recur := ARecur;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FScope := AScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.Visit(const Node: IAstNode): TDataValue;
|
||||||
|
begin
|
||||||
|
// Der Hot-Path: Direkter Dispatch ohne Umweg über ungenutzte Methoden.
|
||||||
|
case Node.Kind of
|
||||||
|
akConstant: Result := VisitConstant(Node.AsConstant);
|
||||||
|
akIdentifier: Result := VisitIdentifier(Node.AsIdentifier);
|
||||||
|
akKeyword: Result := VisitKeyword(Node.AsKeyword);
|
||||||
|
akTuple: Result := VisitTuple(Node.AsTuple);
|
||||||
|
akIfExpression: Result := VisitIfExpression(Node.AsIfExpression);
|
||||||
|
akCondExpression: Result := VisitCondExpression(Node.AsCondExpression);
|
||||||
|
akLambdaExpression: Result := VisitLambdaExpression(Node.AsLambdaExpression);
|
||||||
|
akFunctionCall: Result := VisitFunctionCall(Node.AsFunctionCall);
|
||||||
|
akBlockExpression: Result := VisitBlockExpression(Node.AsBlockExpression);
|
||||||
|
akVariableDeclaration: Result := VisitVariableDeclaration(Node.AsVariableDeclaration);
|
||||||
|
akAssignment: Result := VisitAssignment(Node.AsAssignment);
|
||||||
|
akIndexer: Result := VisitIndexer(Node.AsIndexer);
|
||||||
|
akMemberAccess: Result := VisitMemberAccess(Node.AsMemberAccess);
|
||||||
|
akRecordLiteral: Result := VisitRecordLiteral(Node.AsRecordLiteral);
|
||||||
|
akCreateSeries: Result := VisitCreateSeries(Node.AsCreateSeries);
|
||||||
|
akAddSeriesItem: Result := VisitAddSeriesItem(Node.AsAddSeriesItem);
|
||||||
|
akRecur: Result := VisitRecurNode(Node.AsRecur);
|
||||||
|
akPipe: Result := VisitPipe(Node.AsPipe);
|
||||||
|
akMacroExpansion: Result := Visit(Node.AsMacroExpansion.ExpandedBody);
|
||||||
|
akNop: Result := TDataValue.Void;
|
||||||
|
else
|
||||||
|
Result := TDataValue.Void;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
|
||||||
|
begin
|
||||||
|
while (ResultValue.Kind = vkGeneric) do
|
||||||
|
begin
|
||||||
|
var thunk := ResultValue.AsGeneric<TThunk>;
|
||||||
|
var callee := thunk.Callee.AsMethod();
|
||||||
|
ResultValue := callee(thunk.Args);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.Execute(const RootNode: IAstNode): TDataValue;
|
||||||
|
begin
|
||||||
|
if not Assigned(RootNode) then
|
||||||
|
exit(TDataValue.Void);
|
||||||
|
try
|
||||||
|
Result := Visit(RootNode);
|
||||||
|
HandleTCO(Result);
|
||||||
|
except
|
||||||
|
on E: EAstException do
|
||||||
|
raise;
|
||||||
|
on E: Exception do
|
||||||
|
raise EEvaluatorException.Create('Runtime: ' + E.Message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
|
||||||
|
begin
|
||||||
|
if (AValue.Kind <> vkScalar) then
|
||||||
|
exit(false);
|
||||||
|
case AValue.AsScalar.Kind of
|
||||||
|
TScalar.TKind.Ordinal, TScalar.TKind.Keyword, TScalar.TKind.Boolean: Result := AValue.AsScalar.Value.AsInt64 <> 0;
|
||||||
|
TScalar.TKind.Float, TScalar.TKind.DateTime: Result := AValue.AsScalar.Value.AsDouble <> 0.0;
|
||||||
|
else
|
||||||
|
Result := false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory;
|
||||||
|
begin
|
||||||
|
Result := function(const AScope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitConstant(const N: IConstantNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := N.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitKeyword(const N: IKeywordNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := TDataValue(TScalar.FromKeyword(N.Value));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitIdentifier(const N: IIdentifierNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := FScope[N.Address];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitTuple(const N: ITupleNode): TDataValue;
|
||||||
|
var
|
||||||
|
elements: TArray<TDataValue>;
|
||||||
|
i: Integer;
|
||||||
|
astElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
astElements := N.Elements;
|
||||||
|
SetLength(elements, Length(astElements));
|
||||||
|
for i := 0 to High(astElements) do
|
||||||
|
elements[i] := Visit(astElements[i]);
|
||||||
|
|
||||||
|
// Uses the implicit operator: TArray<TDataValue> -> TDataValue (vkTuple)
|
||||||
|
Result := elements;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitLambdaExpression(const N: ILambdaExpressionNode): TDataValue;
|
||||||
|
var
|
||||||
|
capturedCells: TArray<IValueCell>;
|
||||||
|
i: Integer;
|
||||||
|
closureScope: IExecutionScope;
|
||||||
|
visitorFactory: TEvaluatorFactory;
|
||||||
|
paramsElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
if Length(N.Upvalues) > 0 then
|
||||||
|
begin
|
||||||
|
SetLength(capturedCells, Length(N.Upvalues));
|
||||||
|
for i := 0 to High(N.Upvalues) do
|
||||||
|
capturedCells[i] := FScope.Capture(N.Upvalues[i]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
capturedCells := nil;
|
||||||
|
|
||||||
|
closureScope :=
|
||||||
|
if N.HasNestedLambdas then FScope
|
||||||
|
else nil;
|
||||||
|
visitorFactory := CreateVisitorFactory();
|
||||||
|
|
||||||
|
var descriptor := N.Descriptor;
|
||||||
|
paramsElements := N.Parameters.Elements;
|
||||||
|
|
||||||
|
var [unsafe] closure: TDataValue.TFunc;
|
||||||
|
closure :=
|
||||||
|
function(const ArgValues: TArray<TDataValue>): TDataValue
|
||||||
|
var
|
||||||
|
lambdaScope: IExecutionScope;
|
||||||
|
bodyVisitor: IAstVisitor;
|
||||||
|
k: Integer;
|
||||||
|
begin
|
||||||
|
if (Length(ArgValues) <> Length(paramsElements)) then
|
||||||
|
raise EEvaluatorException.Create('Arg mismatch');
|
||||||
|
lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells);
|
||||||
|
|
||||||
|
// Self-reference for recursion (Slot 0)
|
||||||
|
lambdaScope.SetValues(TResolvedAddress.Create(akLocalOrParent, 0, 0), TDataValue(closure));
|
||||||
|
|
||||||
|
for k := 0 to High(paramsElements) do
|
||||||
|
begin
|
||||||
|
// Parameters are guaranteed to be Identifiers by the Binder
|
||||||
|
var paramNode := paramsElements[k].AsIdentifier;
|
||||||
|
lambdaScope[paramNode.Address] := ArgValues[k];
|
||||||
|
end;
|
||||||
|
|
||||||
|
bodyVisitor := visitorFactory(lambdaScope);
|
||||||
|
Result := bodyVisitor.Visit(N.Body);
|
||||||
|
end;
|
||||||
|
Result := TDataValue(closure);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitFunctionCall(const N: IFunctionCallNode): TDataValue;
|
||||||
|
var
|
||||||
|
calleeValue: TDataValue;
|
||||||
|
argValues: TArray<TDataValue>;
|
||||||
|
i: Integer;
|
||||||
|
argsElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
argsElements := N.Arguments.Elements;
|
||||||
|
SetLength(argValues, Length(argsElements));
|
||||||
|
for i := 0 to High(argsElements) do
|
||||||
|
argValues[i] := Visit(argsElements[i]);
|
||||||
|
|
||||||
|
if Assigned(N.StaticTarget) then
|
||||||
|
begin
|
||||||
|
Result := N.StaticTarget(argValues);
|
||||||
|
if not N.IsTailCall then
|
||||||
|
HandleTCO(Result);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
calleeValue := Visit(N.Callee);
|
||||||
|
if (calleeValue.Kind <> vkMethod) then
|
||||||
|
raise EEvaluatorException.Create('Not a function');
|
||||||
|
|
||||||
|
if N.IsTailCall then
|
||||||
|
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, false))
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Result := (calleeValue.AsMethod)(argValues);
|
||||||
|
HandleTCO(Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitRecurNode(const N: IRecurNode): TDataValue;
|
||||||
|
var
|
||||||
|
argValues: TArray<TDataValue>;
|
||||||
|
i: Integer;
|
||||||
|
argsElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
argsElements := N.Arguments.Elements;
|
||||||
|
SetLength(argValues, Length(argsElements));
|
||||||
|
for i := 0 to High(argsElements) do
|
||||||
|
argValues[i] := Visit(argsElements[i]);
|
||||||
|
|
||||||
|
// The "self" function is always at Slot 0
|
||||||
|
var callee := FScope[TResolvedAddress.Create(akLocalOrParent, 0, 0)];
|
||||||
|
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(callee, argValues, true));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitBlockExpression(const N: IBlockExpressionNode): TDataValue;
|
||||||
|
var
|
||||||
|
exprs: TArray<IAstNode>;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
exprs := N.Expressions.Elements;
|
||||||
|
Result := TDataValue.Void;
|
||||||
|
for i := 0 to High(exprs) do
|
||||||
|
Result := Visit(exprs[i]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitIfExpression(const N: IIfExpressionNode): TDataValue;
|
||||||
|
begin
|
||||||
|
if IsTruthy(Visit(N.Condition)) then
|
||||||
|
Result := Visit(N.ThenBranch)
|
||||||
|
else if Assigned(N.ElseBranch) then
|
||||||
|
Result := Visit(N.ElseBranch)
|
||||||
|
else
|
||||||
|
Result := TDataValue.Void;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitCondExpression(const N: ICondExpressionNode): TDataValue;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
for i := 0 to High(N.Pairs) do
|
||||||
|
if IsTruthy(Visit(N.Pairs[i].Condition)) then
|
||||||
|
exit(Visit(N.Pairs[i].Branch));
|
||||||
|
Result := Visit(N.ElseBranch);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitVariableDeclaration(const N: IVariableDeclarationNode): TDataValue;
|
||||||
|
var
|
||||||
|
ident: IIdentifierNode;
|
||||||
|
begin
|
||||||
|
if Assigned(N.Initializer) then
|
||||||
|
Result := Visit(N.Initializer)
|
||||||
|
else
|
||||||
|
Result := TDataValue.Void;
|
||||||
|
|
||||||
|
ident := N.Target.AsIdentifier;
|
||||||
|
if N.IsBoxed then
|
||||||
|
FScope.DefineBoxed(ident.Address.SlotIndex, Result)
|
||||||
|
else
|
||||||
|
FScope[ident.Address] := Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitAssignment(const N: IAssignmentNode): TDataValue;
|
||||||
|
begin
|
||||||
|
Result := Visit(N.Value);
|
||||||
|
FScope[N.Target.AsIdentifier.Address] := Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitIndexer(const N: IIndexerNode): TDataValue;
|
||||||
|
var
|
||||||
|
base: TDataValue;
|
||||||
|
begin
|
||||||
|
base := Visit(N.Base);
|
||||||
|
if base.IsVoid then
|
||||||
|
exit(TDataValue.Void);
|
||||||
|
|
||||||
|
case base.Kind of
|
||||||
|
vkSeries:
|
||||||
|
begin
|
||||||
|
var idx := Visit(N.Index);
|
||||||
|
var i: Integer := idx.AsScalar.Value.AsInt64;
|
||||||
|
var series := base.AsSeries;
|
||||||
|
if (i < 0) or (i >= series.Count) then
|
||||||
|
raise EEvaluatorException.CreateFmt('Series index %d out of bounds (series contains %d items).', [i, series.Count]);
|
||||||
|
Result := base.AsSeries[i];
|
||||||
|
end;
|
||||||
|
vkRecordSeries:
|
||||||
|
begin
|
||||||
|
var rs := base.AsRecordSeries;
|
||||||
|
|
||||||
|
if N.Index.Kind = akKeyword then
|
||||||
|
begin
|
||||||
|
Result := rs.Fields[TKeywordRegistry.GetKeyword(Visit(N.Index).AsScalar.Value.AsInt64)];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
var idx := Visit(N.Index);
|
||||||
|
var i: Integer := idx.AsScalar.Value.AsInt64;
|
||||||
|
var vals: TArray<TScalar.TValue>;
|
||||||
|
SetLength(vals, rs.Def.Count);
|
||||||
|
for var k := 0 to rs.Def.Count - 1 do
|
||||||
|
begin
|
||||||
|
var series := rs.Fields[rs.Def.Keywords[k]];
|
||||||
|
if (i < 0) or (i >= series.Count) then
|
||||||
|
raise EEvaluatorException.CreateFmt(
|
||||||
|
'Record index %d out of bounds (series <%s> contains %d items).',
|
||||||
|
[i, rs.Keywords[k].Name, series.Count]);
|
||||||
|
vals[k] := series[i].Value;
|
||||||
|
end;
|
||||||
|
Result := TScalarRecord.Create(rs.Def, vals);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
vkTuple:
|
||||||
|
begin
|
||||||
|
var idx := Visit(N.Index);
|
||||||
|
var i: Integer := idx.AsScalar.Value.AsInt64;
|
||||||
|
var tpl := base.AsTuple;
|
||||||
|
if (i < 0) or (i >= tpl.Count) then
|
||||||
|
raise EEvaluatorException.Create('Tuple index out of bounds');
|
||||||
|
Result := tpl.Items[i];
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
raise EEvaluatorException.Create('Indexer error');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitMemberAccess(const N: IMemberAccessNode): TDataValue;
|
||||||
|
var
|
||||||
|
base: TDataValue;
|
||||||
|
begin
|
||||||
|
base := Visit(N.Base);
|
||||||
|
if base.IsVoid then
|
||||||
|
exit(TDataValue.Void);
|
||||||
|
case base.Kind of
|
||||||
|
vkRecordSeries: Result := base.AsRecordSeries.Fields[N.Member.Value];
|
||||||
|
vkScalarRecord: Result := base.AsScalarRecord.Fields[N.Member.Value];
|
||||||
|
vkRecord: Result := base.AsRecord.Fields[N.Member.Value];
|
||||||
|
// vkStream: Result := base.AsStream.Def.Fields[N.Member.Value];
|
||||||
|
else
|
||||||
|
raise EEvaluatorException.Create('Member error');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitRecordLiteral(const N: IRecordLiteralNode): TDataValue;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
fieldsElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
fieldsElements := N.Fields.Elements;
|
||||||
|
if Assigned(N.ScalarDefinition) then
|
||||||
|
begin
|
||||||
|
var vals: TArray<TScalar.TValue>;
|
||||||
|
SetLength(vals, Length(fieldsElements));
|
||||||
|
for i := 0 to High(fieldsElements) do
|
||||||
|
begin
|
||||||
|
var field := fieldsElements[i].AsRecordField;
|
||||||
|
vals[i] := Visit(field.Value).AsScalar.Value;
|
||||||
|
end;
|
||||||
|
Result := TScalarRecord.Create(N.ScalarDefinition, vals);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
var fields: TArray<TPair<IKeyword, TDataValue>>;
|
||||||
|
SetLength(fields, Length(fieldsElements));
|
||||||
|
for i := 0 to High(fieldsElements) do
|
||||||
|
begin
|
||||||
|
var field := fieldsElements[i].AsRecordField;
|
||||||
|
fields[i] := TPair<IKeyword, TDataValue>.Create(field.Key.Value, Visit(field.Value));
|
||||||
|
end;
|
||||||
|
Result := TGenericRecord<TDataValue>.Create(fields);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitCreateSeries(const N: ICreateSeriesNode): TDataValue;
|
||||||
|
var
|
||||||
|
defNode: IAstNode;
|
||||||
|
kind: TScalar.TKind;
|
||||||
|
fields: TArray<TPair<IKeyword, TScalar.TKind>>;
|
||||||
|
i: Integer;
|
||||||
|
tupleElements: TArray<IAstNode>;
|
||||||
|
entry: TArray<IAstNode>;
|
||||||
|
k: IKeyword;
|
||||||
|
t: TScalar.TKind;
|
||||||
|
begin
|
||||||
|
// 1. If TypeChecker ran, we have the Definition ready (Fast Path)
|
||||||
|
if Assigned(N.RecordDefinition) then
|
||||||
|
Exit(TScalarRecordSeries.Create(N.RecordDefinition));
|
||||||
|
|
||||||
|
defNode := N.DefinitionNode;
|
||||||
|
|
||||||
|
// 2. Simple Series (Keyword) e.g. (new-series :Float)
|
||||||
|
if defNode.Kind = akKeyword then
|
||||||
|
begin
|
||||||
|
kind := TScalar.StringToKind(defNode.AsKeyword.Value.Name);
|
||||||
|
Exit(TScalarSeries.Create(kind));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 3. Record Series (Tuple of [Key Type]) - Dynamic Parsing Fallback
|
||||||
|
// e.g. (new-series [[:Price :Float] [:Vol :Ordinal]])
|
||||||
|
if defNode.Kind = akTuple then
|
||||||
|
begin
|
||||||
|
tupleElements := defNode.AsTuple.Elements;
|
||||||
|
SetLength(fields, Length(tupleElements));
|
||||||
|
|
||||||
|
for i := 0 to High(tupleElements) do
|
||||||
|
begin
|
||||||
|
// Each element MUST be a tuple of 2 elements [Key, Type]
|
||||||
|
if tupleElements[i].Kind <> akTuple then
|
||||||
|
raise EEvaluatorException.Create('Invalid record definition: Expected vector [Key Type].');
|
||||||
|
|
||||||
|
entry := tupleElements[i].AsTuple.Elements;
|
||||||
|
if Length(entry) <> 2 then
|
||||||
|
raise EEvaluatorException.Create('Invalid record definition entry: Expected 2 elements.');
|
||||||
|
|
||||||
|
if (entry[0].Kind <> akKeyword) or (entry[1].Kind <> akKeyword) then
|
||||||
|
raise EEvaluatorException.Create('Invalid record definition: Key and Type must be keywords.');
|
||||||
|
|
||||||
|
k := entry[0].AsKeyword.Value;
|
||||||
|
t := TScalar.StringToKind(entry[1].AsKeyword.Value.Name);
|
||||||
|
fields[i] := TPair<IKeyword, TScalar.TKind>.Create(k, t);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var def := TKeywordMappingRegistry<TScalar.TKind>.Intern(fields);
|
||||||
|
Exit(TScalarRecordSeries.Create(def));
|
||||||
|
end;
|
||||||
|
|
||||||
|
raise EEvaluatorException.Create('Invalid CreateSeries definition node.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitAddSeriesItem(const N: IAddSeriesItemNode): TDataValue;
|
||||||
|
begin
|
||||||
|
var lb: Int64 := -1;
|
||||||
|
if Assigned(N.Lookback) then
|
||||||
|
lb := Visit(N.Lookback).AsScalar.Value.AsInt64;
|
||||||
|
|
||||||
|
var series := FScope[N.Series.Address];
|
||||||
|
|
||||||
|
case series.Kind of
|
||||||
|
vkSeries: raise EEvaluatorException.Create(N.Series.Name + ' is read-only. Use a record series instead.');
|
||||||
|
vkRecordSeries:
|
||||||
|
begin
|
||||||
|
var rec := Visit(N.Value);
|
||||||
|
case rec.Kind of
|
||||||
|
vkScalarRecord: series.AsRecordSeries.Add(rec.AsScalarRecord, lb);
|
||||||
|
vkRecord:
|
||||||
|
begin
|
||||||
|
// Type inference didn't manage to infer static record type.
|
||||||
|
var r := rec.AsRecord;
|
||||||
|
var vals: TArray<TScalar.TValue>;
|
||||||
|
SetLength(vals, r.Count);
|
||||||
|
for var i := 0 to r.Count - 1 do
|
||||||
|
begin
|
||||||
|
if r[i].Kind <> vkScalar then
|
||||||
|
raise EEvaluatorException.Create('Scalar record expected.');
|
||||||
|
vals[i] := r[i].AsScalar.Value;
|
||||||
|
end;
|
||||||
|
series.AsRecordSeries.Add(vals);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
raise EEvaluatorException.Create('Adding ' + rec.Kind.ToString + ' to record series not allowed.');
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
raise EEvaluatorException.Create('Record series expected.');
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := TDataValue.Void;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEvaluatorVisitor.VisitPipe(const N: IPipeNode): TDataValue;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
sources: TArray<IStream>;
|
||||||
|
config: TPipeConfig;
|
||||||
|
inputVal: TDataValue;
|
||||||
|
lambdaFunc: TDataValue.TFunc;
|
||||||
|
|
||||||
|
inputsElements: TArray<IAstNode>;
|
||||||
|
entryTuple: ITupleNode;
|
||||||
|
entryElements: TArray<IAstNode>;
|
||||||
|
sourceId: IIdentifierNode;
|
||||||
|
selectorsElements: TArray<IAstNode>;
|
||||||
|
begin
|
||||||
|
inputsElements := N.Inputs.Elements;
|
||||||
|
|
||||||
|
SetLength(sources, Length(inputsElements));
|
||||||
|
SetLength(config, Length(inputsElements));
|
||||||
|
|
||||||
|
for i := 0 to High(inputsElements) do
|
||||||
|
begin
|
||||||
|
// Unpack: [Source, [Selectors]]
|
||||||
|
// Note: Structure is guaranteed by TypeChecker
|
||||||
|
entryTuple := inputsElements[i].AsTuple;
|
||||||
|
entryElements := entryTuple.Elements;
|
||||||
|
|
||||||
|
sourceId := entryElements[0].AsIdentifier;
|
||||||
|
selectorsElements := entryElements[1].AsTuple.Elements;
|
||||||
|
|
||||||
|
// Resolve Source Stream from Scope
|
||||||
|
// The Binder has already linked sourceId to its variable address
|
||||||
|
inputVal := FScope[sourceId.Address];
|
||||||
|
|
||||||
|
if (inputVal.Kind <> vkStream) then
|
||||||
|
raise EEvaluatorException.Create(Format('Variable "%s" is not a Stream.', [sourceId.Name]));
|
||||||
|
|
||||||
|
sources[i] := inputVal.AsStream;
|
||||||
|
var srcDef := sources[i].Def;
|
||||||
|
|
||||||
|
// Build Selectors Config
|
||||||
|
SetLength(config[i], Length(selectorsElements));
|
||||||
|
for var k := 0 to High(selectorsElements) do
|
||||||
|
begin
|
||||||
|
var key := selectorsElements[k].AsKeyword.Value;
|
||||||
|
var idx := srcDef.IndexOf(key);
|
||||||
|
// Index check already done in TypeChecker, but good for safety
|
||||||
|
if idx < 0 then
|
||||||
|
raise EEvaluatorException.Create(Format('Field :%s not found in stream.', [key.Name]));
|
||||||
|
|
||||||
|
config[i][k] := TScalarRecordField.Create(key, srcDef[idx]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Compile the transformation function
|
||||||
|
lambdaFunc := Visit(N.Transformation).AsMethod();
|
||||||
|
|
||||||
|
var outputDef: IScalarRecordDefinition;
|
||||||
|
|
||||||
|
case N.StaticType.Kind of
|
||||||
|
stVoid:
|
||||||
|
// This is an endpoint. The lambda returns nothing. So we produce "nothing".
|
||||||
|
outputDef := TScalarRecord.TRegistry.Empty;
|
||||||
|
stRecord, stRecordSeries:
|
||||||
|
// Allow both stRecord and stRecordSeries (as TypeChecker correctly assigns stRecordSeries for Pipe nodes)
|
||||||
|
outputDef := N.StaticType.AsRecord.Definition;
|
||||||
|
else
|
||||||
|
raise EEvaluatorException.Create('Pipe requires Type Checking to determine output structure (RecordDefinition).');
|
||||||
|
end;
|
||||||
|
|
||||||
|
var pipeAdapter: TPipeStream.TPipeLambda :=
|
||||||
|
function(const S: array of ISeries; out R: array of TScalar.TValue): Boolean
|
||||||
|
var
|
||||||
|
args: TArray<TDataValue>;
|
||||||
|
res: TDataValue;
|
||||||
|
k: Integer;
|
||||||
|
begin
|
||||||
|
SetLength(args, Length(S));
|
||||||
|
for k := 0 to High(S) do
|
||||||
|
args[k] := S[k];
|
||||||
|
|
||||||
|
res := lambdaFunc(args);
|
||||||
|
|
||||||
|
if res.IsVoid then
|
||||||
|
exit(False);
|
||||||
|
|
||||||
|
var rec := res.AsScalarRecord;
|
||||||
|
for k := 0 to rec.Count - 1 do
|
||||||
|
R[k] := rec.Items[k].Value;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//TODO Lookback not evaluated in script!
|
||||||
|
Result := TPipeStream.Create(config, outputDef, sources, pipeAdapter, 1000, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user