Compare commits

422 Commits

Author SHA1 Message Date
Michael Schimmel 6b41c0c418 Shared series in Pipes 2026-02-16 22:41:57 +01:00
Michael Schimmel c73668643f Pipe Optimization 2026-02-14 18:34:15 +01:00
Michael Schimmel cb8fd44d6f Pipe Optimization 2026-02-14 18:00:20 +01:00
Michael Schimmel dc46a2dd2d Pipes refactoring, Fixes in type checker 2026-02-13 23:34:39 +01:00
Michael Schimmel 19cdb2f004 Streams refactoring 2026-01-25 02:42:30 +01:00
Michael Schimmel 76c3ad9835 Streams refactoring 2026-01-25 02:03:23 +01:00
Michael Schimmel 4daa05efda Streams refactoring 2026-01-25 01:44:36 +01:00
Michael Schimmel ca1d9b95f7 DataStream updated 2026-01-21 16:13:45 +01:00
Michael Schimmel b90d29f2bc DataStream updated 2026-01-21 16:05:59 +01:00
Michael Schimmel ef4583c2ae DataStream updated 2026-01-21 14:09:26 +01:00
Michael Schimmel ceb6f13833 Gemini-Gem 2026-01-19 10:23:08 +01:00
Michael Schimmel b3ca67428d Small refactorings 2026-01-13 23:51:41 +01:00
Michael Schimmel 2cc5e53394 Replaced Count-Node by RTL-Function 2026-01-13 23:17:32 +01:00
Michael Schimmel 1258f79347 Fixed Div0-Error 2026-01-13 23:15:18 +01:00
Michael Schimmel 758e4eaa0e typo 2026-01-13 18:21:08 +01:00
Michael Schimmel 629dbc97ca Extended math RTL 2026-01-13 18:08:52 +01:00
Michael Schimmel 1c6a6fe5a0 RTL refactoring 2026-01-13 17:01:33 +01:00
Michael Schimmel 1429278765 Refactoring streams and fixin various bugs 2026-01-13 16:23:33 +01:00
Michael Schimmel 717a648ad4 RTL: Sqrt & Pow 2026-01-13 11:36:59 +01:00
Michael Schimmel c58da94128 RTL: Sqrt & Pow 2026-01-13 11:28:11 +01:00
Michael Schimmel 3c5d51f6a8 Gemini Test 2026-01-13 10:25:33 +01:00
Michael Schimmel 1387131f57 Gemini Test 2026-01-09 12:04:00 +01:00
Michael Schimmel f35dafeac2 Gemini Test 2026-01-08 17:50:29 +01:00
Michael Schimmel 0efce47972 Gemini Test 2026-01-08 17:50:11 +01:00
Michael Schimmel a62ba89bca Gemini Test 2026-01-08 14:13:41 +01:00
Michael Schimmel a25fec38f8 Json Schema WIP 2026-01-07 15:14:54 +01:00
Michael Schimmel 108b47e059 Script Refactoring 2026-01-07 11:20:48 +01:00
Michael Schimmel 0d3ccd1c63 Script Refactoring, ParseGet reads record fields 2026-01-07 00:28:38 +01:00
Michael Schimmel 8a29cf7f74 Json Schema for LLMs 2026-01-06 20:55:11 +01:00
Michael Schimmel 4618573d6c Json Schema for LLMs 2026-01-06 19:56:27 +01:00
Michael Schimmel 60952494c1 Json Schema for LLMs 2026-01-06 18:02:05 +01:00
Michael Schimmel 51d0b8d9b7 Fix in RTL-Core 2026-01-06 16:50:48 +01:00
Michael Schimmel 74a5c30ae0 Ast Schema 2026-01-06 14:48:22 +01:00
Michael Schimmel 7313848538 Ast Schema 2026-01-06 14:37:22 +01:00
Michael Schimmel 3b3966b2f7 new-Series with tuple record def 2026-01-06 13:38:06 +01:00
Michael Schimmel fb2fc8f6f9 Refactoring 2026-01-06 12:10:12 +01:00
Michael Schimmel da59fbdf3f ITupleNode signature change 2026-01-06 11:39:42 +01:00
Michael Schimmel 40ed51aef8 ITupleNode signature change 2026-01-06 11:37:18 +01:00
Michael Schimmel 264314cd93 Pipe Parameter is now a Tuple 2026-01-05 00:13:51 +01:00
Michael Schimmel 242ec9a56e AST list refactoring 2026-01-04 22:41:44 +01:00
Michael Schimmel 2a7e6626ad Tuples 2026-01-04 18:59:16 +01:00
Michael Schimmel 991b998cb1 Tuples 2026-01-04 18:48:04 +01:00
Michael Schimmel a4afae6f39 Tuples 2026-01-04 17:06:59 +01:00
Michael Schimmel 8914d59607 Refactoring Keyword mapping, introducing tuples 2026-01-04 15:29:26 +01:00
Michael Schimmel 700088b5c5 Refactoring Keyword mapping, introducing tuples 2026-01-04 15:21:46 +01:00
Michael Schimmel 0a7a6ea2d0 Refactoring Keyword mapping, introducing tuples 2026-01-04 15:07:02 +01:00
Michael Schimmel f1733c41a0 Generic Visitors 2026-01-04 11:47:00 +01:00
Michael Schimmel 22674b962b Generic Visitors 2026-01-03 19:14:18 +01:00
Michael Schimmel db74b83e11 Generic Visitors 2026-01-02 14:29:16 +01:00
Michael Schimmel 2e0db2682f Generic Visitors 2026-01-02 14:18:46 +01:00
Michael Schimmel 13d8a21de7 Generic Visitors 2026-01-02 13:54:27 +01:00
Michael Schimmel 2395cb1e70 Generic Visitor Pattern 2026-01-02 13:29:33 +01:00
Michael Schimmel b7d0222ec2 Pipe testing 2026-01-02 13:13:51 +01:00
Michael Schimmel d5d71afdaa Pipe testing 2025-12-26 17:20:00 +01:00
Michael Schimmel 185f8273dd Pipes and test scripts 2025-12-26 13:47:10 +01:00
Michael Schimmel 8b765487ae Implementing Pipes 2025-12-21 16:30:09 +01:00
Michael Schimmel ac96a105a5 Optional types and null propagation 2025-12-21 15:20:59 +01:00
Michael Schimmel e7fdbc3312 Adding Pipes 2025-12-20 13:40:29 +01:00
Michael Schimmel 8960a5683e Adding Pipes 2025-12-18 13:09:47 +01:00
Michael Schimmel 34b4466a15 Adding Pipes 2025-12-18 11:58:41 +01:00
Michael Schimmel 8bde31a478 Adding Pipes 2025-12-18 11:21:18 +01:00
Michael Schimmel 0b015fe4e7 Reverting Ast Stream 2025-12-17 12:41:26 +01:00
Michael Schimmel 363c9596fc Producer pattern in data types 2025-12-16 10:45:41 +01:00
Michael Schimmel 3c7723f3d2 Data pipeline refactoring 2025-12-14 17:47:07 +01:00
Michael Schimmel f0567a32a1 Data pipeline refactoring 2025-12-14 12:06:29 +01:00
Michael Schimmel f88fe9f5ef Refacoring data pipeline 2025-12-14 12:03:16 +01:00
Michael Schimmel 8beb5d95b2 Broker example 2025-12-14 09:00:02 +01:00
Michael Schimmel e84ecfa2d2 RTL custom interface types as records, added callbacks (marshalled using virtual interfaces) 2025-12-12 02:28:25 +01:00
Michael Schimmel 8c60949ec9 RTL custom interface types as records 2025-12-11 14:31:25 +01:00
Michael Schimmel 18dde168fd RTL custom interface types as records 2025-12-11 14:22:09 +01:00
Michael Schimmel 3ed5a4011f DataFeed Refactoring 2025-12-10 22:30:53 +01:00
Michael Schimmel a3f6f4af26 Fix in DataFeed 2025-12-10 12:19:49 +01:00
Michael Schimmel 235de7a7c5 IScalarRecord 2025-12-09 14:05:00 +01:00
Michael Schimmel 5376f8924a IScalarRecord 2025-12-09 13:55:09 +01:00
Michael Schimmel 76c92fa355 Keyword mapping refactoring 2025-12-09 13:12:37 +01:00
Michael Schimmel f8dc5b945c Keyword mapping refactoring 2025-12-09 12:59:36 +01:00
Michael Schimmel 43afbd6050 DataFeed-Producer 2025-12-09 11:12:56 +01:00
Michael Schimmel e56bf7ee7d DataFeed-Producer 2025-12-09 11:03:06 +01:00
Michael Schimmel 9a4f477cfd DataFeed-Producer 2025-12-08 20:25:54 +01:00
Michael Schimmel 59692bc211 Renaming 2025-12-08 10:55:57 +01:00
Michael Schimmel d5ec91d9b3 Renaming 2025-12-08 10:55:12 +01:00
Michael Schimmel 7aa0056799 Renaming 2025-12-08 10:54:22 +01:00
Michael Schimmel 95de9a155e Extracted TDynamicRecord 2025-12-08 10:21:25 +01:00
Michael Schimmel 1d13d0cdaa Ast ternary expr replaced by cond expr 2025-12-07 12:06:29 +01:00
Michael Schimmel 91c4d57aaf Ast UI handlers split into separate units 2025-12-06 20:36:33 +01:00
Michael Schimmel f03d250d2b Operator-Visualization in Ast editor 2025-12-06 19:48:15 +01:00
Michael Schimmel e0ceeeb7b0 Ast editor custom draw 2025-12-06 19:38:17 +01:00
Michael Schimmel 872c15ac51 Ast editor custom draw 2025-12-06 19:21:36 +01:00
Michael Schimmel e40f56eaeb Ast editor custom draw 2025-12-06 17:32:04 +01:00
Michael Schimmel 9ed563bcc1 Ast visitor refactoring 2025-12-04 11:28:40 +01:00
Michael Schimmel a7290550e7 Ast node delete 2025-12-01 14:09:33 +01:00
Michael Schimmel 656375de99 Focus & cursor movement in UI 2025-12-01 13:19:07 +01:00
Michael Schimmel 68a97e6985 docs 2025-12-01 10:20:10 +01:00
Michael Schimmel 5c738c95bc Undo/Redo 2025-12-01 10:14:33 +01:00
Michael Schimmel 438baa3609 Visual AST editing with drag'n'drop 1s Version 2025-11-30 16:00:00 +01:00
Michael Schimmel cd0f2ffde3 Ast editor rename 2025-11-29 20:42:01 +01:00
Michael Schimmel 851f56c63f Ast list nodes 2025-11-29 18:59:16 +01:00
Michael Schimmel 250f950a68 UI refactoring 2025-11-29 16:43:52 +01:00
Michael Schimmel 521d0ac28f Ast editor rondtrip 2025-11-28 16:07:47 +01:00
Michael Schimmel 0b4201fe9b Ast editor unit refactoring 2025-11-28 14:03:49 +01:00
Michael Schimmel 833ce8aada Ast editor unit refactoring 2025-11-28 13:45:33 +01:00
Michael Schimmel 13b2ef3bf0 Docs 2025-11-28 13:14:32 +01:00
Michael Schimmel 65342c99aa AST Identities 2025-11-25 20:19:43 +01:00
Michael Schimmel 874c0d9adf AST Identities 2025-11-25 19:51:06 +01:00
Michael Schimmel aff4cec7d5 AST Identities 2025-11-25 19:41:26 +01:00
Michael Schimmel 0b7a60e338 AST Identities 2025-11-25 18:45:47 +01:00
Michael Schimmel 85ef043b04 Compiler errors 2025-11-25 18:11:04 +01:00
Michael Schimmel 0a1df4e9fe Compiler exceptions 2025-11-25 15:51:04 +01:00
Michael Schimmel 4e508d90a5 Compiler exceptions 2025-11-25 15:27:57 +01:00
Michael Schimmel d84509c034 Tests for Parser 2025-11-25 14:40:04 +01:00
Michael Schimmel 29c36c7ae0 Tests for AST Binder 2025-11-25 13:29:05 +01:00
Michael Schimmel c8e0c78e3f DateTime unit test 2025-11-23 22:44:56 +01:00
Michael Schimmel 2f87444827 Integrated Boolean and DateTime as core types 2025-11-23 22:34:10 +01:00
Michael Schimmel bcd20df29e Resolved cyclic dependencies between environment and compiler stages 2025-11-23 18:04:20 +01:00
Michael Schimmel d334ffdc73 Resolved cyclic dependencies between environment and compiler stages 2025-11-23 17:55:47 +01:00
Michael Schimmel 7c761e86e5 Simplified macro expansion 2025-11-23 17:19:56 +01:00
Michael Schimmel 738e595f95 Resolved circular depependancy between macro expander and binder 2025-11-23 15:40:14 +01:00
Michael Schimmel 30933072a4 Ki Gem 2025-11-23 14:44:28 +01:00
Michael Schimmel a052dfb20f AST testing 2025-11-23 00:24:43 +01:00
Michael Schimmel c5167b8550 AST testing 2025-11-22 17:02:16 +01:00
Michael Schimmel 240f794211 AST function purity analysis 2025-11-22 14:49:24 +01:00
Michael Schimmel 61b6a1742b Fixed some glitches from last refactoring 2025-11-21 17:49:06 +01:00
Michael Schimmel 58c44079f7 Refactor Compiler Pipeline: Decouple Scope Layout from Runtime Descriptor
- **Architecture:** Split `IScopeDescriptor` into `IScopeLayout` (Binder/Structure) and immutable `IScopeDescriptor` (Runtime/Types).
- **Binder:** Now produces `IScopeLayout` via `IScopeBuilder`. Restored Upvalue tracking and Lambda nesting detection.
- **TypeChecker:** Introduced `TTypeContext` to track types during traversal. Now produces the final `IScopeDescriptor`.
- **Evaluator:** Adapted to new `ILambdaExpressionNode` structure.
- **Fixes:** Resolved `Scope depth mismatch` in TypeChecker and `AccessViolation` in Evaluator due to lost parent scopes.
2025-11-21 12:01:14 +01:00
Michael Schimmel ae10f4eee0 Static specialization done 2025-11-19 21:22:01 +01:00
Michael Schimmel d0d1053faf Static specialization WIP
Fix in ScopeDescriptor 2
2025-11-19 16:01:14 +01:00
Michael Schimmel 3ae1ed8f48 Static specialization WIP
Fix in ScopeDescriptor
2025-11-19 15:47:09 +01:00
Michael Schimmel 138e7ac454 Static specialization WIP 2025-11-19 14:38:40 +01:00
Michael Schimmel c129c1a3ae Static specialization 2025-11-11 11:58:08 +01:00
Michael Schimmel 8a6c866a9c Planning static specialization 2025-11-10 10:00:08 +01:00
Michael Schimmel 7aa406f27b Macro hygiene 2025-11-09 18:22:09 +01:00
Michael Schimmel d849f65f2d Handle Nop properly 2025-11-08 16:20:48 +01:00
Michael Schimmel be5f36e04a Ast environment refactoring 2025-11-08 16:00:37 +01:00
Michael Schimmel 93dc19497c Ast environment refactoring 2025-11-08 15:57:12 +01:00
Michael Schimmel c16f47c6d5 Fix in Testcase 2025-11-08 10:45:04 +01:00
Michael Schimmel c0f871ce02 Ast environments 2025-11-07 19:40:35 +01:00
Michael Schimmel 4ccf3bb5fd Macros refactoring 2025-11-06 17:41:07 +01:00
Michael Schimmel 6851f745d4 Unit compiler namespaces 2025-11-05 21:50:36 +01:00
Michael Schimmel 5003cfd899 Finished node immutability 2025-11-05 18:33:29 +01:00
Michael Schimmel 1f0eef7698 Node immutability improved 2025-11-05 18:13:43 +01:00
Michael Schimmel 0915d6d90d Resolved dependency between AST nodes and scope 2025-11-05 16:52:40 +01:00
Michael Schimmel b98e7d98e6 Refactoring node to be immutable 2025-11-05 15:24:54 +01:00
Michael Schimmel 25984fe61a Refactoring node to be immutable 2025-11-05 15:15:12 +01:00
Michael Schimmel 218bd9f506 Refactoring 2025-11-05 13:48:10 +01:00
Michael Schimmel c0a689d2bc Refactoring for immutable nodes 2025-11-05 13:21:17 +01:00
Michael Schimmel 9bd2d6f7ab Imutability for macro nodes 2025-11-05 12:19:34 +01:00
Michael Schimmel 60358365cd Fixed macro def expansion 2025-11-05 10:39:15 +01:00
Michael Schimmel edd3e83377 Fixed macro expansion 2025-11-05 10:03:27 +01:00
Michael Schimmel 980919525b Immutable infered types 2025-11-04 22:10:11 +01:00
Michael Schimmel f73c0c67b8 AST type infer SoC 2025-11-04 20:35:34 +01:00
Michael Schimmel d82a75aba6 Making AST node inmmutable - WIP 2025-11-04 20:12:12 +01:00
Michael Schimmel 48ccb23060 Refactoring 2025-11-04 18:22:06 +01:00
Michael Schimmel 2b8a3effed Visualizer node aggregates
Fix in macro expander
2025-11-04 17:45:47 +01:00
Michael Schimmel 2fd85be923 Tag 2025-11-03 11:11:43 +01:00
Michael Schimmel ec76b78b39 Nop-Node 2025-11-03 00:35:23 +01:00
Michael Schimmel eb42a4ef3b Refactoring 2025-11-02 22:44:01 +01:00
Michael Schimmel 92cfe94463 Fixed quasiquote expansinon 2025-11-02 20:04:56 +01:00
Michael Schimmel ea39a57b77 Binder refactoring, Monster refactoring 2025-11-02 19:38:52 +01:00
Michael Schimmel 8f29212cba Binder refactoring - extracted TCO - WIP 2025-11-01 15:44:56 +01:00
Michael Schimmel 915deb4dc0 Binder refactoring - extracted lowering 2025-11-01 14:56:38 +01:00
Michael Schimmel 734b7b1d5e Binder refactoring - extracted type checking 2025-11-01 14:14:17 +01:00
Michael Schimmel 6826b75c19 Binder refactoring - extracted type checking 2025-11-01 14:04:45 +01:00
Michael Schimmel 4687ecb9ca Binder refactoring - extracted macro expander 2025-11-01 13:36:10 +01:00
Michael Schimmel 6ab51816d1 Binder refactoring 2025-11-01 13:09:29 +01:00
Michael Schimmel 3869c98652 Refactoring 2025-11-01 13:00:22 +01:00
Michael Schimmel df12db2595 Refactoring 2025-11-01 12:35:19 +01:00
Michael Schimmel 957171f089 Keywords as basic scalar type
Script enhancements
2025-11-01 00:56:59 +01:00
Michael Schimmel 689dede600 Keywords as basic scalar type 2025-10-31 21:15:08 +01:00
Michael Schimmel 8abec8e98f Keywords 2025-10-31 18:12:53 +01:00
Michael Schimmel 0526ec8a24 Keywords 2025-10-30 20:27:44 +01:00
Michael Schimmel 798aa08f02 Keywords 2025-10-30 18:00:58 +01:00
Michael Schimmel dfe1f04333 Keywords 2025-10-30 15:23:34 +01:00
Michael Schimmel 1394314a57 New visualizer 2025-10-30 13:48:14 +01:00
Michael Schimmel b0d87fdc69 New visualizer 2025-10-30 13:26:50 +01:00
Michael Schimmel f1735e2678 New visualizer 2025-10-29 23:07:49 +01:00
Michael Schimmel a47cd3f1f4 New visualizer 2025-10-26 21:43:11 +01:00
Michael Schimmel e95a920dc7 New visualizer 2025-10-26 18:06:45 +01:00
Michael Schimmel e379e6694c AST Types 2025-10-26 09:58:42 +01:00
Michael Schimmel 85f2e02893 AST Types 2025-10-25 19:19:55 +02:00
Michael Schimmel 5a289492a3 AST Types 2025-10-25 18:33:38 +02:00
Michael Schimmel 28e4d94b97 ASt Types 2025-10-25 16:23:16 +02:00
Michael Schimmel a706483f28 ASt Types 2025-10-25 15:58:18 +02:00
Michael Schimmel f2d9e1d9b0 Fix float parsing issue 2025-10-25 15:21:22 +02:00
Michael Schimmel dd72401ab5 Developing State handling 2025-10-22 13:26:51 +02:00
Michael Schimmel 03465e21d2 Accessing RTL symbols 2025-10-09 10:55:35 +02:00
Michael Schimmel b4a3595ae4 Accessing RTL symbols 2025-10-09 10:54:37 +02:00
Michael Schimmel e0c4cf7ee4 Accessing RTL symbols 2025-10-07 13:21:25 +02:00
Michael Schimmel 51265ce945 Fixed weak self method pointer bug
Better formatting of function calls in pretty printer
2025-10-07 10:42:53 +02:00
Michael Schimmel 039a7c4b3e Ast binding refactoring 2025-10-06 20:07:19 +02:00
Michael Schimmel 0edb9b800b Macro expander integrated in binder 2025-10-05 15:02:45 +02:00
Michael Schimmel 0d73a13051 Macro expander integrated in binder 2025-10-05 02:45:13 +02:00
Michael Schimmel 54bf350c70 Macro expander integrated in binder 2025-10-04 22:41:01 +02:00
Michael Schimmel 7c48e9e203 Macro expander integrated in binder 2025-10-04 19:05:50 +02:00
Michael Schimmel d9219474e0 1st full macro expander 2025-10-03 19:46:30 +02:00
Michael Schimmel bb0ecda6be added macro quoting nodes 2025-10-03 14:17:34 +02:00
Michael Schimmel fd97799b7b added macrodef 2025-10-03 13:49:12 +02:00
Michael Schimmel d47c1417f5 Comment in AST script 2025-10-03 11:53:02 +02:00
Michael Schimmel ecbe39abac Fixed closure upvalue scoping 2025-09-30 17:50:34 +02:00
Michael Schimmel 1fd7fb9da9 Fixed closure upvalue scoping 2025-09-30 17:41:21 +02:00
Michael Schimmel 1c1bd4cdca Fixed closure upvalue scoping 2025-09-30 17:25:28 +02:00
Michael Schimmel 1ac605ee57 Atomic operations for TDataValue 2025-09-30 13:07:21 +02:00
Michael Schimmel 9010bb1890 Preparing for atomic data values 2025-09-30 11:34:35 +02:00
Michael Schimmel 4de6bf9bcd Refactoring 2025-09-30 11:08:45 +02:00
Michael Schimmel 18904f17d1 Fixed unit tests 2025-09-29 12:18:44 +02:00
Michael Schimmel 2b34046efc Fixed unit tests 2025-09-29 12:00:56 +02:00
Michael Schimmel 823ea0e8f1 Fixed parser error in fn def 2025-09-29 11:41:01 +02:00
Michael Schimmel e1a46da6f8 Fix in Recur Node declaration 2025-09-29 11:23:39 +02:00
Michael Schimmel 624af31243 Added user library 2025-09-24 10:03:10 +02:00
Michael Schimmel 5a1919ec07 Added Wildcards and -fc to PasIntfExtract 2025-09-24 08:38:26 +02:00
Michael Schimmel 411fd0a3ce Unit rename 2025-09-23 12:54:46 +02:00
Michael Schimmel 46d40cfbca Fix in Scripting 2025-09-23 12:51:55 +02:00
Michael Schimmel 2f2c93d56e Fix in Scripting 2025-09-23 10:32:14 +02:00
Michael Schimmel c573628fe5 Major refactoring, split Bound Ast from source Ast 2025-09-22 19:56:51 +02:00
Michael Schimmel 8041f7355f Scripting refinement 2025-09-21 12:51:06 +02:00
Michael Schimmel 36fe827b00 Scripting refinement 2025-09-21 11:09:55 +02:00
Michael Schimmel 00f5861148 Global data value refactoring + 1st scripting version 2025-09-20 18:30:32 +02:00
Michael Schimmel 09bd25b318 Streamlining data values 2025-09-20 12:51:52 +02:00
Michael Schimmel 7621849bfb RECUR keyword added 2025-09-20 12:23:37 +02:00
Michael Schimmel 81dd69bf49 RECUR keyword added 2025-09-20 12:06:51 +02:00
Michael Schimmel e03155179a Anonymous recursions 2025-09-19 23:53:48 +02:00
Michael Schimmel 28558614f0 RTL enhancements 2025-09-19 15:10:24 +02:00
Michael Schimmel c31985935c RTL enhancements 2025-09-19 15:05:20 +02:00
Michael Schimmel abbce15362 Tail call optimization 2025-09-19 11:53:16 +02:00
Michael Schimmel 9be22dea3a Refactoring 2025-09-19 09:23:43 +02:00
Michael Schimmel ef16003971 Refactoring 2025-09-19 09:03:02 +02:00
Michael Schimmel 565742275c Momory hole fixed 2025-09-18 20:37:15 +02:00
Michael Schimmel d12c6c966c Fix in Upvalue-Logic 2025-09-18 20:11:12 +02:00
Michael Schimmel 5f110e4408 Ast RTL: Map, Reduce, Where, Any 2025-09-18 16:09:51 +02:00
Michael Schimmel 1be9591a61 Streamlining dataflow 2025-09-18 14:23:19 +02:00
Michael Schimmel 2c55a120f1 RTL and Data value refactoring and defered values 2025-09-18 13:35:25 +02:00
Michael Schimmel 4d380c8f98 Refactoring Binder 2025-09-17 15:20:14 +02:00
Michael Schimmel 0cb6f6e85e Refactoring Binder 2025-09-17 14:25:23 +02:00
Michael Schimmel ea5879520a Refactoring Binder 2025-09-17 13:34:48 +02:00
Michael Schimmel b972b05a07 Ast control refactoring 2025-09-16 19:18:40 +02:00
Michael Schimmel 230c4b51bf Ast control refactoring 2025-09-16 13:14:33 +02:00
Michael Schimmel 5796f88da4 Ast Editor 2025-09-16 12:54:49 +02:00
Michael Schimmel 469f2dc1f2 Moved operator helpers 2025-09-16 11:38:16 +02:00
Michael Schimmel f5c7121e26 Scalar operators 2025-09-15 17:13:45 +02:00
Michael Schimmel a83d3bf9fc Scalar operators 2025-09-15 16:44:40 +02:00
Michael Schimmel 101dbec760 Scalar operators 2025-09-15 16:10:01 +02:00
Michael Schimmel 3ad004a895 Extended data value type descriptions 2025-09-15 12:42:06 +02:00
Michael Schimmel e78ef0a3ea Optimizing captures in Scope 2025-09-15 12:12:23 +02:00
Michael Schimmel c913f9dbc5 Scope Index optimized 2025-09-15 10:39:39 +02:00
Michael Schimmel d731048b41 AST Debugger 2025-09-13 20:40:18 +02:00
Michael Schimmel 0f9eb36ab8 AST Debugger 2025-09-13 14:22:02 +02:00
Michael Schimmel bdc8886057 AST Refactoring 2025-09-13 14:21:39 +02:00
Michael Schimmel be6665ad6e AST Refactoring 2025-09-12 22:45:29 +02:00
Michael Schimmel a36ca2c7e3 TDecimal fix 2025-09-12 16:21:45 +02:00
Michael Schimmel 17c5b90ecf TDecimal fix 2025-09-12 15:42:02 +02:00
Michael Schimmel 3c8be92b4a TDecimal fix 2025-09-12 15:30:45 +02:00
Michael Schimmel d37862186c TDataValue as new global variant type 2025-09-12 13:20:00 +02:00
Michael Schimmel 646ffe92bb TDataValue as new global variant type 2025-09-12 11:18:32 +02:00
Michael Schimmel 695e854cc3 Ast JSON 2025-09-12 08:51:52 +02:00
Michael Schimmel 9b359eb75b Fix in AsRecord 2025-09-08 19:27:37 +02:00
Michael Schimmel a9cc9633a2 Beginning Editor 2025-09-08 18:59:04 +02:00
Michael Schimmel 7e4ecb2ff9 Refactoring 2025-09-08 11:53:10 +02:00
Michael Schimmel 6b77391e91 Refactoring + Panning in Workspace 2025-09-05 21:00:07 +02:00
Michael Schimmel f2357a543e Scope cells refactoring 2025-09-05 12:58:43 +02:00
Michael Schimmel 100646c7d8 Scope cells refactoring 2025-09-05 12:46:24 +02:00
Michael Schimmel edf8329b28 OHLC 2025-09-05 12:28:26 +02:00
Michael Schimmel 82a7b349b7 gemini.md 2025-09-05 11:49:04 +02:00
Michael Schimmel aa3c218f44 Closure upvalues 2025-09-04 23:59:33 +02:00
Michael Schimmel 4a8075fecf Binding 2025-09-04 21:17:23 +02:00
Michael Schimmel bb74d408da Binding 2025-09-04 19:50:05 +02:00
Michael Schimmel c6a71aa8be Binding 2025-09-04 18:46:05 +02:00
Michael Schimmel faa447fd91 Binding 2025-09-04 17:33:10 +02:00
Michael Schimmel 9c90a92b04 Ast Binding 2025-09-04 01:41:09 +02:00
Michael Schimmel de052cab64 Ast Binding 2025-09-04 00:19:11 +02:00
Michael Schimmel a5fd079875 Ast Refactoring 2025-09-03 22:55:43 +02:00
Michael Schimmel 48bc763e41 Sample SMA strategy 2025-09-03 19:32:46 +02:00
Michael Schimmel 696fb2f9a0 Sample SMA strategy 2025-09-03 19:21:31 +02:00
Michael Schimmel 6b9dcee417 Sample SMA strategy 2025-09-03 13:41:24 +02:00
Michael Schimmel 3e4ca283c9 Ast Refactoring 2025-09-03 09:47:16 +02:00
Michael Schimmel eb7902d9e8 Ast development 2025-09-02 17:49:30 +02:00
Michael Schimmel a83bbf4f54 Ast series indexer 2025-09-02 16:58:52 +02:00
Michael Schimmel 375e64411b AST development 2025-09-01 19:24:22 +02:00
Michael Schimmel 3b3d94291d AST development 2025-09-01 12:55:22 +02:00
Michael Schimmel d5f2763aa2 AST development 2025-09-01 11:11:38 +02:00
Michael Schimmel 7c531c1207 AST development 2025-08-30 16:52:09 +02:00
Michael Schimmel d033bd9405 AST development 2025-08-30 16:10:49 +02:00
Michael Schimmel f00676a935 AST development 2025-08-30 15:39:35 +02:00
Michael Schimmel 59e71b6d7b dirs 2025-08-30 01:39:08 +02:00
Michael Schimmel c7a865d12e Ast Playground 1. visualization 2025-08-30 01:38:40 +02:00
Michael Schimmel d2c00c6033 AST refactoring 2025-08-29 10:01:03 +02:00
Michael Schimmel fa9328a183 AST refactoring 2025-08-29 09:44:17 +02:00
Michael Schimmel 5593761551 AST refactoring 2025-08-29 00:27:17 +02:00
Michael Schimmel 5451f4fed9 AST refactoring 2025-08-28 16:56:26 +02:00
Michael Schimmel 9a5f2c1b1d AST refactoring 2025-08-28 16:26:48 +02:00
Michael Schimmel 9419f5cd03 AST refactoring 2025-08-28 15:14:08 +02:00
Michael Schimmel 6fcf8c26c8 Data POD 2025-08-28 14:21:15 +02:00
Michael Schimmel 77d2cb3f92 Data POD 2025-08-28 13:32:54 +02:00
Michael Schimmel f4b5882080 Scalar 64bit decimal type 2025-08-28 12:30:13 +02:00
Michael Schimmel bb0e2fd5af AST-Playground 2025-08-28 00:56:20 +02:00
Michael Schimmel 3268748c03 Types-JSON 2025-08-27 18:33:25 +02:00
Michael Schimmel afb8f459c6 Types-JSON 2025-08-27 18:00:01 +02:00
Michael Schimmel dc4066097c Types added to Tuples 2025-08-27 16:05:13 +02:00
Michael Schimmel 284fb95985 AST 2025-08-27 15:16:13 +02:00
Michael Schimmel 644b3fa8fd Vector type 2025-08-27 15:15:47 +02:00
Michael Schimmel 3daf55a355 New type system 2025-08-26 16:45:12 +02:00
Michael Schimmel 54d470b2f8 New type system 2025-08-26 15:49:28 +02:00
Michael Schimmel e9608a746a New type system 2025-08-26 14:57:35 +02:00
Michael Schimmel 8e8f139785 New type system 2025-08-26 14:42:14 +02:00
Michael Schimmel 769497887f New type system 2025-08-26 14:39:05 +02:00
Michael Schimmel 267aef65d8 New type system - Decimals 2025-08-26 13:55:10 +02:00
Michael Schimmel 1ff603bd10 New type system - Decimals 2025-08-26 13:47:38 +02:00
Michael Schimmel c434a151dd New type system 2025-08-26 12:44:29 +02:00
Michael Schimmel 262ee8ff69 New type system 2025-08-26 12:44:10 +02:00
Michael Schimmel d2f7b01911 Type System 2025-08-26 12:06:47 +02:00
Michael Schimmel 5adbe67d0b Type System 2025-08-26 11:06:35 +02:00
Michael Schimmel e4681e2bf7 Aura types 2025-08-25 20:18:38 +02:00
Michael Schimmel b4a5e30b45 Method type 2025-08-25 19:27:37 +02:00
Michael Schimmel c0fd594008 Indicator with new types 2025-08-25 19:27:13 +02:00
Michael Schimmel e329cbe598 Indicator with new types 2025-08-25 18:30:02 +02:00
Michael Schimmel 947060566d Data Types 2025-08-25 18:00:15 +02:00
Michael Schimmel 42110e8471 Data Types 2025-08-25 15:31:15 +02:00
Michael Schimmel c9e28a946d Data Types 2025-08-25 14:48:06 +02:00
Michael Schimmel ce653c83b1 Data Types next 2025-08-25 14:01:22 +02:00
Michael Schimmel 27f1cc5486 Data Types 2025-08-25 10:26:48 +02:00
Michael Schimmel 75675b8dc1 Testing TValue as Params 2025-07-28 00:55:39 +02:00
Michael Schimmel 1ddc295c9d Testing TValue as Params 2025-07-27 23:12:48 +02:00
Michael Schimmel 78e89f345e Generic indicator factory 2025-07-27 21:58:15 +02:00
Michael Schimmel 7842c3bd87 Generic indicator factory 2025-07-27 20:31:25 +02:00
Michael Schimmel ecee8b37bc Generic indicator factory 2025-07-27 16:41:54 +02:00
Michael Schimmel 791f629a10 Generic indicator factory 2025-07-27 14:05:54 +02:00
Michael Schimmel 86001b654f Generic indicator factory 2025-07-27 11:42:27 +02:00
Michael Schimmel 468adcf203 Testing data processing 2025-07-27 08:39:16 +02:00
Michael Schimmel aa53a88953 Unit refactoring
Fixed massive heap corruption bug in TDataRecord
2025-07-25 11:54:53 +02:00
Michael Schimmel 6b18d95570 Renamed again 2025-07-25 09:27:53 +02:00
Michael Schimmel e20e359919 DataPoint renamed to DataFlow 2025-07-25 08:58:05 +02:00
Michael Schimmel b217be6f01 Memory hole in Data-Join fixed 2025-07-25 08:37:08 +02:00
Michael Schimmel ff5b379fde Memory hole in Data-Join fixed 2025-07-24 13:07:29 +02:00
Michael Schimmel 4859c49738 Identifiers refactored to Producer-Consumer-Pattern 2025-07-24 10:15:18 +02:00
Michael Schimmel 6a114f77c5 Refactoring identifiers 2025-07-24 07:59:41 +02:00
Michael Schimmel 7b2446b220 DataFlow refactoring 2025-07-23 20:14:24 +02:00
Michael Schimmel b623be13fa TSeries optimized + Unit tests 2025-07-23 14:46:49 +02:00
Michael Schimmel d1d3393392 TestStrategy refactored 2025-07-22 18:04:15 +02:00
Michael Schimmel e6d41260f9 New Test-Startegy 2025-07-22 17:21:59 +02:00
Michael Schimmel c530f2fc0b Reworking DataRecords and DataFlow 2025-07-22 15:49:29 +02:00
Michael Schimmel 5b8b475da7 Reworking DataRecords and DataFlow 2025-07-22 14:44:48 +02:00
Michael Schimmel bf4ef71cba Refactoring DataFlow, 1st Generic Data records working 2025-07-22 01:13:01 +02:00
Michael Schimmel dd50049b06 DataRecord 2025-07-20 20:21:55 +02:00
Michael Schimmel 6010f61953 DataRecord almost finished 2025-07-19 14:24:04 +02:00
Michael Schimmel 57319a55c1 Optimizing DataRecord 2025-07-18 01:50:41 +02:00
Michael Schimmel c203871c9f Optimizing DataRecord 2025-07-18 01:30:28 +02:00
Michael Schimmel d2c47843a7 DataRecord 2025-07-17 23:00:56 +02:00
Michael Schimmel a896b7fcf0 Directory-Monitor... experimentell... klappt nicht so recht mit UNC-Pfaden :( 2025-07-17 16:21:13 +02:00
Michael Schimmel 208006c896 Directory-Monitor 2025-07-17 10:30:08 +02:00
Michael Schimmel 0b891c6def Strategy as a function test 2025-07-17 01:40:42 +02:00
Michael Schimmel b3359a4d73 TLazy + Data-Endpoints refactoring 2025-07-17 00:48:46 +02:00
Michael Schimmel abad66ae52 Removed bottleneck in DataStream 2025-07-16 22:27:53 +02:00
Michael Schimmel 120c62083e Concurrent DataStream-Chunks 2025-07-16 16:03:10 +02:00
Michael Schimmel 342eb07c42 Fixed concurrent processing 2025-07-16 14:12:07 +02:00
Michael Schimmel bc75f08477 Work in Progress 2025-07-15 20:29:19 +02:00
Michael Schimmel 8ebcd81561 TSeries + DataEndpoint 2025-07-15 11:44:44 +02:00
Michael Schimmel 1a07468ad8 Notify list refactoring 2025-07-15 09:46:16 +02:00
Michael Schimmel ce0cba720a Unit refactoring 2025-07-15 09:13:40 +02:00
Michael Schimmel 3e0628ad57 Polished DataProvider & Converter, RTTI field access 2025-07-15 02:11:13 +02:00
Michael Schimmel 1a2b6cf8a0 Polished DataProvider & Converter, RTTI field access 2025-07-15 01:56:44 +02:00
Michael Schimmel 4247fde7cd Old DataStream removed 2025-07-14 19:55:16 +02:00
Michael Schimmel d9a82365d3 Streamlining main app
Bugfix in Chart -> StrokeJoint set to Bevel
2025-07-14 19:52:40 +02:00
Michael Schimmel 6f0b927a05 TTicker 2025-07-14 16:44:29 +02:00
Michael Schimmel d0ad547aa3 Units renamed & Chart refactored 2025-07-14 15:07:36 +02:00
Michael Schimmel 661faba75c Test 2025-07-13 21:55:33 +02:00
Michael Schimmel 87a3a505b1 Fix 2025-07-13 21:52:23 +02:00
Michael Schimmel 4d67d9acbe Chart X grid, standard timeframes 2025-07-13 21:49:42 +02:00
Michael Schimmel 840904e42d Chart panels 2025-07-13 16:57:58 +02:00
Michael Schimmel 6e5c0de876 Added some standard indicators 2025-07-13 16:22:46 +02:00
Michael Schimmel f6fff24f10 Concurrent data processing 2025-07-13 14:20:30 +02:00
Michael Schimmel 9ce608ba09 Chart: Mutable parameters 2025-07-13 11:46:02 +02:00
Michael Schimmel e75cb2ecb3 Chart data logic separation 2025-07-13 10:04:47 +02:00
Michael Schimmel 956c47ba36 Fix chart left data range fail 2025-07-12 22:20:23 +02:00
Michael Schimmel a06640665a Chart now solid 2025-07-12 21:19:11 +02:00
Michael Schimmel 45ff69fd92 Code-Formatting 2025-07-12 17:10:01 +02:00
Michael Schimmel ce915e503a Code Formatting 2025-07-12 16:59:27 +02:00
Michael Schimmel 1b0f93c633 Chart Panning+Zooming 2025-07-12 16:58:34 +02:00
Michael Schimmel 4727db1a01 Process.Update for synchronization 2025-07-12 12:11:16 +02:00
Michael Schimmel cf17e06e32 Process.Update for synchronization 2025-07-12 11:38:23 +02:00
Michael Schimmel 021ff61774 Processor-Result 2025-07-11 12:00:36 +02:00
Michael Schimmel 487169afe0 Implementing first "strategy" for proof of concept 2025-07-11 11:06:18 +02:00
Michael Schimmel 644b6074d6 Chart 2025-07-03 21:27:10 +02:00
Michael Schimmel 58ce84e567 Chart Control V1 2025-07-02 14:49:33 +02:00
Michael Schimmel b453236b1e 1st Aura Project Layout 2025-06-28 12:43:19 +02:00
Michael Schimmel 9802c8c924 Refactoring 2025-06-25 15:38:45 +02:00
Michael Schimmel 10b653e16f TaskManager refactoring 2025-06-25 15:00:51 +02:00
Michael Schimmel e2a262bc5a Fixed protected mutable Exchange 2025-06-25 10:45:55 +02:00
Michael Schimmel dce0d83e18 ProtectedMutable 2025-06-25 10:44:33 +02:00
Michael Schimmel e1159e883b Writeables revised
Read-ahead for DataStream Processing
2025-06-25 10:07:00 +02:00
Michael Schimmel f791667264 parallel PathData creation 2025-06-24 21:40:06 +02:00
Michael Schimmel 13c41d01b5 TaskManager.RunTask() & TFuture.Chain(Proc) 2025-06-24 20:17:04 +02:00
Michael Schimmel a65a5f2b0a TWriteable<T> 2025-06-24 19:11:29 +02:00
Michael Schimmel 3797507d95 Bugfix in TEvent, DataServer Push-Mode 2025-06-24 18:32:32 +02:00
Michael Schimmel 35413f5966 GUI Signals 2025-06-24 14:37:38 +02:00
Michael Schimmel 3048c28fe3 DataSeries.Copy 2025-06-24 12:42:28 +02:00
Michael Schimmel 6077d094f7 Chart visible in View 2025-06-24 12:02:49 +02:00
Michael Schimmel 9022f60376 Bugfix Race Condition in Notifier List 2025-06-24 11:31:29 +02:00
Michael Schimmel ed8619650c Code formatting 2025-06-24 11:18:10 +02:00
Michael Schimmel fdea3cf26a Notifier-Subscription-List robustness 2025-06-24 11:17:29 +02:00
Michael Schimmel 6ea0f94e36 Refactoring IState - ISignal 2025-06-24 09:24:37 +02:00
Michael Schimmel a3da63ad6a DataPoint 2025-06-24 08:11:46 +02:00
Michael Schimmel 6c7cc2569b DataProvider 2025-06-23 12:09:26 +02:00
Michael Schimmel a9aff8c41a AuraTrader Sample 2025-06-17 21:49:09 +02:00
Michael Schimmel f81337c98d Data file handling 2025-06-15 20:07:18 +02:00
Michael Schimmel 2c56f6e750 Data file handling 2025-06-15 17:29:56 +02:00
Michael Schimmel bbd9d1752a Pascal Interface Extract 2025-06-13 16:13:03 +02:00
Michael Schimmel ba8dd7b464 Prompt Update 2025-06-13 13:26:40 +02:00
Michael Schimmel 4d67e587ba # 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.
2025-06-13 10:50:40 +02:00
Michael Schimmel 8ca85473d7 TSeries 2025-06-11 13:38:24 +02:00
Michael Schimmel 7f6672db24 TSeries 2025-06-11 13:33:46 +02:00
Michael Schimmel d282d2c40d TDataPoint<T> review 2025-06-11 08:53:30 +02:00
Michael Schimmel 3cfca1f167 Blockly review 2025-06-11 01:33:52 +02:00
Michael Schimmel b8a530254d Blockly review 2025-06-11 00:17:58 +02:00
Michael Schimmel 7516bd3d9d Blockly test 2025-06-10 22:31:16 +02:00
Michael Schimmel 0e598d595e Test-Apps für Gemini Api und Blockly 2025-06-10 17:08:09 +02:00
Michael Schimmel 312be15cc8 implementing DataStream 2025-06-07 23:53:45 +02:00
Michael Schimmel 776067d0a8 Refactoring DataStream 2025-06-07 16:41:46 +02:00
Michael Schimmel 590e98d614 DataCache 2025-06-07 14:51:39 +02:00
Michael Schimmel 1f02733071 Refactoring 2025-06-07 12:28:50 +02:00
Michael Schimmel 2cdae3d3f6 Streamlining DataServer 2025-06-07 10:12:41 +02:00
Michael Schimmel 031b99acc8 DataServer
Bugfix in DataSeries
2025-06-06 23:24:08 +02:00
Michael Schimmel a6c0c3d6b3 DataSeries refactoring 2025-06-06 13:20:18 +02:00
Michael Schimmel e7f381bc46 TFuture<T>.Result --> TFuture<T>.Value 2025-06-06 12:50:59 +02:00
Michael Schimmel 98de7176c3 DataServer 1st Version 2025-06-06 12:43:51 +02:00
Michael Schimmel f70cfe0ec1 TMutable 2025-06-06 01:34:44 +02:00
224 changed files with 93710 additions and 2482 deletions
+1
View File
@@ -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
+58
View File
@@ -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.
+306
View File
@@ -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
+32
View File
@@ -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)) ...))
)
)
+578
View File
@@ -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
}
}
}
]
}
}
}
+20
View File
@@ -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
+224
View File
@@ -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&lt;T&gt;" ID="ID_1288547800" CREATED="1749198026579" MODIFIED="1749198040009"/>
</node>
<node TEXT="Ausgänge" ID="ID_661812861" CREATED="1749198022539" MODIFIED="1749198024513">
<node TEXT="Mutable&lt;T&gt;" 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 &quot;sinnvolle&quot; 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.
+387
View File
@@ -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.
+237
View File
@@ -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
+746
View File
@@ -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.
+74
View File
@@ -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.
+503
View File
@@ -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.
+189
View File
@@ -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.
+12
View File
@@ -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.
+30
View File
@@ -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.
+15
View File
@@ -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.
+95
View File
@@ -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.
+90
View File
@@ -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
+314
View File
@@ -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.
+74
View File
@@ -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.
+163
View File
@@ -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>
+108
View File
@@ -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>
+38
View File
@@ -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>
+380
View File
@@ -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);
}
};
+116
View File
@@ -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 */
}
+57
View File
@@ -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.
+46
View File
@@ -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.
+43
View File
@@ -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.
+44
View File
@@ -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.
+16
View File
@@ -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.
+98
View File
@@ -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.
+89
View File
@@ -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.
+66
View File
@@ -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. |
---
+68
View File
@@ -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.
+128
View File
@@ -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
View File
@@ -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
View File
@@ -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.
-----
+41
View File
@@ -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.
+111
View File
@@ -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.
+70
View File
@@ -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.
+119
View File
@@ -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.
+32
View File
@@ -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.
+105
View File
@@ -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.
+58
View File
@@ -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.
+134
View File
@@ -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.
+49
View File
@@ -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.
+110
View File
@@ -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.
+20
View File
@@ -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.
+196
View File
@@ -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
+400
View File
@@ -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.
+822
View File
@@ -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.
+197
View File
@@ -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>
+212
View File
@@ -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.
+254
View File
@@ -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.
+10
View File
@@ -0,0 +1,10 @@
unit ApiKey;
interface
const
Value = 'AIzaSyALccoMxn0_wcHswavhu5rzdglLeH6gVlI';
implementation
end.
+16
View File
@@ -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.
+52
View File
@@ -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
+228
View File
@@ -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.
+1
View File
@@ -0,0 +1 @@
T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -c -dirs T:\Myc\dirs.txt -fc T:\Myc\Src\Ast\Myc.Ast*
+1
View File
@@ -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.
+1
View File
@@ -0,0 +1 @@
T:\Myc\IntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -c -dirs T:\Myc\dirs.txt -fc T:\Myc\Src\Ast\Myc.Fmx.*
+66
View File
@@ -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.
+895
View File
@@ -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
View File
File diff suppressed because it is too large Load Diff
+7
View File
@@ -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
View File
@@ -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;
```
-2
View File
@@ -1,2 +0,0 @@
# MycLib
+324
View File
@@ -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.
+163
View File
@@ -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.
+475
View File
@@ -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.
+102
View File
@@ -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.
+586
View File
@@ -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.
+276
View File
@@ -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.
+362
View File
@@ -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
+194
View File
@@ -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.
+556
View File
@@ -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.
+590
View File
@@ -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.
+642
View File
@@ -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