Pipes refactoring, Fixes in type checker
This commit is contained in:
Michael Schimmel
File diff suppressed because one or more lines are too long
@@ -8,6 +8,7 @@ object Form1: TForm1
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
DesignerMasterStyle = 0
|
||||
object Panel1: TPanel
|
||||
Align = MostLeft
|
||||
@@ -286,4 +287,20 @@ object Form1: TForm1
|
||||
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
|
||||
|
||||
+62
-22
@@ -38,6 +38,7 @@ uses
|
||||
Myc.Ast,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Data.Decimal,
|
||||
Myc.Data.Stream,
|
||||
Myc.Ast.Script,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast.Environment,
|
||||
@@ -92,6 +93,9 @@ type
|
||||
CompilerStageBox: TComboBox;
|
||||
SaveTestBtn: TButton;
|
||||
SaveScriptButton: TButton;
|
||||
Timer1: TTimer;
|
||||
WatchLabel: TLabel;
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure InnerLambdaButtonClick(Sender: TObject);
|
||||
procedure ClearButtonClick(Sender: TObject);
|
||||
procedure CompilerStageBoxChange(Sender: TObject);
|
||||
@@ -118,14 +122,17 @@ type
|
||||
procedure LoadUserLibButtonClick(Sender: TObject);
|
||||
procedure RTLListViewChange(Sender: TObject);
|
||||
procedure SaveScriptButtonClick(Sender: TObject);
|
||||
procedure Timer1Timer(Sender: TObject);
|
||||
private
|
||||
FCurrUnboundAst: IAstNode;
|
||||
FCurrCompiled: ILambdaExpressionNode;
|
||||
FCurrExec: TCompiledFunction;
|
||||
FCurrLambda: ILambdaExpressionNode;
|
||||
FCurrCompiled: TCompiledFunction;
|
||||
FCurrExec: TDataValue;
|
||||
FEnvironment: TAstEnvironment;
|
||||
FAstEditor: TAstEditor; // Die Komponente (Facade)
|
||||
FScriptUpdate: Boolean;
|
||||
FTriggerTest: TAstEnvironment;
|
||||
FSim: IFinanceSimulator;
|
||||
|
||||
procedure AstEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
|
||||
@@ -152,12 +159,18 @@ uses
|
||||
Myc.Trade.Broker,
|
||||
System.Diagnostics, // For TStopwatch
|
||||
System.TimeSpan,
|
||||
Myc.Data.Keyword,
|
||||
Myc.Ast.Json, // For TAstJson serialization
|
||||
System.IOUtils, // For TFile
|
||||
Myc.Ast.Dumper; // Needed for DumpButtonClick
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FSim := nil;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
// 1. Initialize Environment
|
||||
@@ -262,6 +275,28 @@ begin
|
||||
end
|
||||
);
|
||||
|
||||
Scope.Define(
|
||||
'watch',
|
||||
function(const Args: TArray<TDataValue>): TDataValue
|
||||
var
|
||||
str: TStringBuilder;
|
||||
begin
|
||||
str := TStringBuilder.Create;
|
||||
try
|
||||
for var i := 0 to High(Args) do
|
||||
begin
|
||||
if Args[i].Kind = vkText then
|
||||
str.Append(Args[i].AsText)
|
||||
else
|
||||
str.Append(Args[i].ToString);
|
||||
end;
|
||||
WatchLabel.Text := str.ToString;
|
||||
finally
|
||||
str.Free;
|
||||
end;
|
||||
end
|
||||
);
|
||||
|
||||
Scope.Define(
|
||||
'timestamp',
|
||||
function(const Args: TArray<TDataValue>): TDataValue
|
||||
@@ -291,13 +326,11 @@ begin
|
||||
CompilerStageBox.BringToFront;
|
||||
ClearButtonClick(Self);
|
||||
|
||||
FSim := TFinanceSimulator.Create;
|
||||
FSim.CreateOHLCSeries(FEnvironment.RootScope, 'dax');
|
||||
|
||||
if FileExists(SrcName) then
|
||||
ScriptMemo.Lines.LoadFromFile(SrcName);
|
||||
|
||||
// Memo1.Lines.Add(TAstSchema.GenerateFullSystemPrompt(FEnvironment.RootScope));
|
||||
|
||||
// "Dieses JSON-Objekt betest du in das Feld response_schema (Gemini) oder json_schema (OpenAI) ein."
|
||||
// Memo1.Lines.Add(TAstSchema.GenerateFullSchema.ToJSON);
|
||||
end;
|
||||
|
||||
procedure TForm1.ShowVizualization;
|
||||
@@ -313,7 +346,7 @@ end;
|
||||
function TForm1.ExecuteAst(const ANode: IAstNode): TDataValue;
|
||||
begin
|
||||
FCurrUnboundAst := ANode;
|
||||
FCurrExec := Default(TCompiledFunction);
|
||||
FCurrCompiled := Default(TCompiledFunction);
|
||||
|
||||
if DebugBox.IsChecked then
|
||||
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
|
||||
@@ -323,17 +356,18 @@ begin
|
||||
try
|
||||
// Use Compile directly. Errors will be raised as ECompilationFailed.
|
||||
// We catch them to print to log, but allow flow to continue so UI can be updated.
|
||||
FCurrCompiled := FEnvironment.Compile(ANode);
|
||||
FCurrExec := FEnvironment.Link(FCurrCompiled);
|
||||
FCurrLambda := FEnvironment.Compile(ANode);
|
||||
FCurrCompiled := FEnvironment.Link(FCurrLambda);
|
||||
|
||||
if Assigned(FCurrExec.Func) then
|
||||
if Assigned(FCurrCompiled.Func) then
|
||||
begin
|
||||
Memo1.Lines.Add(
|
||||
Format('Compiled. Signature: %s, IsPure=%s', [FCurrExec.StaticType.ToString, BoolToStr(FCurrExec.IsPure, true)])
|
||||
Format('Compiled. Signature: %s, IsPure=%s', [FCurrCompiled.StaticType.ToString, BoolToStr(FCurrCompiled.IsPure, true)])
|
||||
);
|
||||
end;
|
||||
|
||||
Result := FCurrExec.Func([]);
|
||||
FCurrExec := FCurrCompiled.Func([]);
|
||||
Result := FCurrExec;
|
||||
|
||||
except
|
||||
on E: ECompilationFailed do
|
||||
@@ -354,7 +388,7 @@ begin
|
||||
end;
|
||||
on E: Exception do
|
||||
begin
|
||||
FCurrExec.Func := nil;
|
||||
FCurrCompiled.Func := nil;
|
||||
Memo1.Lines.Add('--- RUNTIME ERROR ---');
|
||||
Memo1.Lines.Add(E.ClassName + ': ' + E.Message);
|
||||
Result := TDataValue.Void;
|
||||
@@ -617,8 +651,8 @@ begin
|
||||
|
||||
Memo1.Lines.Add('--- Naive recursive fib with AST---');
|
||||
|
||||
FCurrCompiled := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
|
||||
var fibExec := TestEnv.Link(FCurrCompiled).Func;
|
||||
FCurrLambda := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
|
||||
var fibExec := TestEnv.Link(FCurrLambda).Func;
|
||||
|
||||
sw := TStopwatch.StartNew;
|
||||
result := fibExec([]);
|
||||
@@ -781,8 +815,8 @@ begin
|
||||
|
||||
// Die Pipeline nutzt den Environment-Helper (Managed Record)
|
||||
// Compile akzeptiert IAstNode und erzeugt intern ein Lambda
|
||||
FCurrCompiled := FEnvironment.Compile(FCurrUnboundAst);
|
||||
FCurrExec := FEnvironment.Link(FCurrCompiled);
|
||||
FCurrLambda := FEnvironment.Compile(FCurrUnboundAst);
|
||||
FCurrCompiled := FEnvironment.Link(FCurrLambda);
|
||||
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('AST deserialized and bound successfully from JSON.');
|
||||
@@ -1196,8 +1230,8 @@ end;
|
||||
procedure TForm1.Test1ButtonClick(Sender: TObject);
|
||||
begin
|
||||
FCurrUnboundAst := TAstScript.Parse('(do (print txt))');
|
||||
FCurrCompiled := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]);
|
||||
var fn := FEnvironment.Link(FCurrCompiled).Func;
|
||||
FCurrLambda := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]);
|
||||
var fn := FEnvironment.Link(FCurrLambda).Func;
|
||||
fn(['Hello World']);
|
||||
FEnvironment.RootScope.Define('fn', fn);
|
||||
UpdateScript;
|
||||
@@ -1280,14 +1314,14 @@ begin
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- AST Dump ---');
|
||||
|
||||
if FCurrCompiled = nil then
|
||||
if FCurrLambda = nil then
|
||||
begin
|
||||
Memo1.Lines.Add('No compiled AST available.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Dump the raw unbound AST first
|
||||
TAstDumper.Dump(FCurrCompiled, Memo1.Lines);
|
||||
TAstDumper.Dump(FCurrLambda, Memo1.Lines);
|
||||
end;
|
||||
|
||||
procedure TForm1.SaveScriptButtonClick(Sender: TObject);
|
||||
@@ -1295,6 +1329,12 @@ begin
|
||||
ScriptMemo.Lines.SaveToFile(SrcName);
|
||||
end;
|
||||
|
||||
procedure TForm1.Timer1Timer(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FSim) then
|
||||
FSim.AddRandomCandle(FEnvironment.RootScope, 'dax');
|
||||
end;
|
||||
|
||||
initialization
|
||||
TAst.RegisterLibrary(RegisterBroker);
|
||||
|
||||
|
||||
+27
-134
@@ -1,139 +1,32 @@
|
||||
(do
|
||||
;; ===========================================================================
|
||||
;; 1. DEFINITIONEN
|
||||
;; ===========================================================================
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Factory: create-wma
|
||||
;; Berechnet WMA. Wartet, bis das Fenster voll ist.
|
||||
;; Phase 1: Warten (< len)
|
||||
;; Phase 2: Init (= len) -> Loop berechnung
|
||||
;; Phase 3: Slide (> len) -> O(1) berechnung
|
||||
;; ---------------------------------------------------------------------------
|
||||
(def create-wma
|
||||
(fn [len]
|
||||
(do
|
||||
(def prev-w-sum 0.0)
|
||||
(def prev-s-sum 0.0)
|
||||
(def weight-div (/ (* len (+ len 1)) 2))
|
||||
|
||||
(fn [src]
|
||||
(do
|
||||
(def cnt (count src))
|
||||
|
||||
;; PHASE 1: Nicht genug Daten
|
||||
(if (< cnt len)
|
||||
NaN
|
||||
|
||||
;; Genug Daten vorhanden
|
||||
(if (= cnt len)
|
||||
;; PHASE 2: Initialisierung (Das Fenster ist gerade voll geworden)
|
||||
;; Wir müssen einmalig die Basis-Summen berechnen.
|
||||
(do
|
||||
(def init-w 0.0)
|
||||
(def init-s 0.0)
|
||||
|
||||
;; Loop über die Elemente 0 bis len-1
|
||||
((fn [i]
|
||||
(if (< i len)
|
||||
(do
|
||||
(def val (get src i))
|
||||
;; Gewichtung: Index 0 ist das neueste -> Gewicht 'len'
|
||||
(assign init-w (+ init-w (* (- len i) val)))
|
||||
(assign init-s (+ init-s val))
|
||||
(recur (+ i 1)))
|
||||
)) 0)
|
||||
|
||||
;; State speichern
|
||||
(assign prev-w-sum init-w)
|
||||
(assign prev-s-sum init-s)
|
||||
(/ init-w weight-div))
|
||||
|
||||
;; PHASE 3: Sliding Window (O(1))
|
||||
;; Wir haben bereits einen gültigen State aus dem vorherigen Schritt.
|
||||
(do
|
||||
(def val-new (get src 0)) ; Neuster Wert
|
||||
(def val-out (get src len)) ; Wert der rausfällt
|
||||
|
||||
;; Update Formeln
|
||||
(def w-sum (+ prev-w-sum (- (* len val-new) prev-s-sum)))
|
||||
(def s-sum (+ (- prev-s-sum val-out) val-new))
|
||||
|
||||
;; State speichern
|
||||
(assign prev-w-sum w-sum)
|
||||
(assign prev-s-sum s-sum)
|
||||
(/ w-sum weight-div))
|
||||
)
|
||||
)
|
||||
))
|
||||
)))
|
||||
|
||||
;; --- HMA Factory ---
|
||||
(def create-hma
|
||||
(fn [len]
|
||||
(do
|
||||
(def half-len (round (/ len 2)))
|
||||
(def sqrt-len (round (sqrt len)))
|
||||
|
||||
(def wma-half (create-wma half-len))
|
||||
(def wma-full (create-wma len))
|
||||
(def wma-smooth (create-wma sqrt-len))
|
||||
|
||||
(def diff-series (new-series [[:val :Float]]))
|
||||
|
||||
(fn [src]
|
||||
(do
|
||||
(def v1 (wma-half src))
|
||||
(def v2 (wma-full src))
|
||||
|
||||
;; WICHTIG: Wir dürfen erst weitermachen, wenn BEIDE WMAs gültig sind.
|
||||
;; Da v2 das längere Fenster (len) braucht, diktiert es den Takt.
|
||||
(def diff (- (* 2 v1) v2))
|
||||
(if (not (is-NaN diff))
|
||||
(add-item diff-series {:val diff}))
|
||||
|
||||
;; Glättung auf dem Resultat
|
||||
(wma-smooth (.val diff-series))
|
||||
))
|
||||
)))
|
||||
|
||||
;; --- Repeat Macro ---
|
||||
(defmacro repeat [n body]
|
||||
`((fn [cnt]
|
||||
(if (> cnt 0)
|
||||
(do
|
||||
~body
|
||||
(recur (- cnt 1)))))
|
||||
~n))
|
||||
|
||||
;; ===========================================================================
|
||||
;; 2. SIMULATION
|
||||
;; ===========================================================================
|
||||
|
||||
(def hma-length 14)
|
||||
(def simulation-steps 500)
|
||||
|
||||
(def hma-calc (create-hma hma-length))
|
||||
(def prices (new-series [[:close :Float]]))
|
||||
(def current-price 100.0)
|
||||
|
||||
(print "Step | Price | HMA(14)")
|
||||
(print "-----|----------|----------")
|
||||
|
||||
(repeat simulation-steps
|
||||
(def med (pipe [[dax [:Close :Open]]]
|
||||
(fn [cs os]
|
||||
(do
|
||||
;; Random Walk
|
||||
(assign current-price (+ current-price (- (random) 0.5)))
|
||||
(add-item prices {:close current-price})
|
||||
|
||||
;; Berechnung
|
||||
;; Nutzung von Member Access (.close), da es eine Record-Series ist
|
||||
(def hma-val (hma-calc (.close prices)))
|
||||
|
||||
;; Ausgabe
|
||||
(if (not (is-NaN hma-val))
|
||||
(print (count prices) " |" current-price " | " hma-val)
|
||||
)
|
||||
(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)) ...))
|
||||
)
|
||||
|
||||
)
|
||||
Reference in New Issue
Block a user