Macro hygiene
This commit is contained in:
File diff suppressed because one or more lines are too long
+45
-31
@@ -29,47 +29,40 @@ object Form1: TForm1
|
|||||||
Text = 'Test 2'
|
Text = 'Test 2'
|
||||||
OnClick = Test2ButtonClick
|
OnClick = Test2ButtonClick
|
||||||
end
|
end
|
||||||
object PrettyPrintButton: TButton
|
|
||||||
Position.X = 24.000000000000000000
|
|
||||||
Position.Y = 479.000000000000000000
|
|
||||||
TabOrder = 3
|
|
||||||
Text = 'Print'
|
|
||||||
OnClick = PrettyPrintButtonClick
|
|
||||||
end
|
|
||||||
object RecursionButton: TButton
|
object RecursionButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 92.000000000000000000
|
Position.Y = 92.000000000000000000
|
||||||
Size.Width = 80.000000000000000000
|
Size.Width = 80.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 4
|
TabOrder = 3
|
||||||
Text = 'Recursion'
|
Text = 'Recursion'
|
||||||
OnClick = RecursionButtonClick
|
OnClick = RecursionButtonClick
|
||||||
end
|
end
|
||||||
object ShowScopeBox: TCheckBox
|
object ShowScopeBox: TCheckBox
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 452.000000000000000000
|
Position.Y = 452.000000000000000000
|
||||||
TabOrder = 5
|
TabOrder = 4
|
||||||
Text = 'Scope'
|
Text = 'Scope'
|
||||||
end
|
end
|
||||||
object FibonacciButton: TButton
|
object FibonacciButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 122.000000000000000000
|
Position.Y = 122.000000000000000000
|
||||||
TabOrder = 7
|
TabOrder = 6
|
||||||
Text = 'Fibonacci'
|
Text = 'Fibonacci'
|
||||||
OnClick = FibonacciButtonClick
|
OnClick = FibonacciButtonClick
|
||||||
end
|
end
|
||||||
object CrerateTriggerExampleButton: TButton
|
object CrerateTriggerExampleButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 168.000000000000000000
|
Position.Y = 168.000000000000000000
|
||||||
TabOrder = 8
|
TabOrder = 7
|
||||||
Text = 'TriggerTest'
|
Text = 'TriggerTest'
|
||||||
OnClick = CreateTriggerExampleButtonClick
|
OnClick = CreateTriggerExampleButtonClick
|
||||||
end
|
end
|
||||||
object DoTriggerButton: TButton
|
object DoTriggerButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 198.000000000000000000
|
Position.Y = 198.000000000000000000
|
||||||
TabOrder = 9
|
TabOrder = 8
|
||||||
Text = 'Trigger!'
|
Text = 'Trigger!'
|
||||||
OnClick = DoTriggerButtonClick
|
OnClick = DoTriggerButtonClick
|
||||||
object DoTrigger2Button: TButton
|
object DoTrigger2Button: TButton
|
||||||
@@ -85,7 +78,7 @@ object Form1: TForm1
|
|||||||
Size.Width = 80.000000000000000000
|
Size.Width = 80.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 10
|
TabOrder = 9
|
||||||
Text = 'Clear'
|
Text = 'Clear'
|
||||||
OnClick = ClearButtonClick
|
OnClick = ClearButtonClick
|
||||||
end
|
end
|
||||||
@@ -95,84 +88,84 @@ object Form1: TForm1
|
|||||||
Size.Width = 80.000000000000000000
|
Size.Width = 80.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 12
|
TabOrder = 11
|
||||||
Text = 'Series'
|
Text = 'Series'
|
||||||
OnClick = SeriesTestButtonClick
|
OnClick = SeriesTestButtonClick
|
||||||
end
|
end
|
||||||
object OHLCButton: TButton
|
object OHLCButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 288.000000000000000000
|
Position.Y = 288.000000000000000000
|
||||||
TabOrder = 13
|
TabOrder = 12
|
||||||
Text = 'OHLC'
|
Text = 'OHLC'
|
||||||
OnClick = OHLCButtonClick
|
OnClick = OHLCButtonClick
|
||||||
end
|
end
|
||||||
object DebugBox: TCheckBox
|
object DebugBox: TCheckBox
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 439.000000000000000000
|
Position.Y = 436.000000000000000000
|
||||||
TabOrder = 14
|
TabOrder = 13
|
||||||
Text = 'Debug'
|
Text = 'Debug'
|
||||||
OnChange = DebugBoxChange
|
OnChange = DebugBoxChange
|
||||||
end
|
end
|
||||||
object FromJSONButton: TButton
|
object FromJSONButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 569.000000000000000000
|
Position.Y = 569.000000000000000000
|
||||||
TabOrder = 15
|
TabOrder = 14
|
||||||
Text = 'From JSON'
|
Text = 'From JSON'
|
||||||
OnClick = FromJSONButtonClick
|
OnClick = FromJSONButtonClick
|
||||||
end
|
end
|
||||||
object ToJSONButton: TButton
|
object ToJSONButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 599.000000000000000000
|
Position.Y = 599.000000000000000000
|
||||||
TabOrder = 16
|
TabOrder = 15
|
||||||
Text = 'To JSON'
|
Text = 'To JSON'
|
||||||
OnClick = ToJSONButtonClick
|
OnClick = ToJSONButtonClick
|
||||||
end
|
end
|
||||||
object ExternalFuncButton: TButton
|
object ExternalFuncButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 318.000000000000000000
|
Position.Y = 318.000000000000000000
|
||||||
TabOrder = 17
|
TabOrder = 16
|
||||||
Text = 'External Func'
|
Text = 'External Func'
|
||||||
OnClick = ExternalFuncButtonClick
|
OnClick = ExternalFuncButtonClick
|
||||||
end
|
end
|
||||||
object InnerLambdaButton: TButton
|
object InnerLambdaButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 348.000000000000000000
|
Position.Y = 348.000000000000000000
|
||||||
TabOrder = 18
|
TabOrder = 17
|
||||||
Text = 'Inner Lambda'
|
Text = 'Inner Lambda'
|
||||||
OnClick = InnerLambdaButtonClick
|
OnClick = InnerLambdaButtonClick
|
||||||
end
|
end
|
||||||
object DumpButton: TButton
|
object DumpButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 509.000000000000000000
|
Position.Y = 509.000000000000000000
|
||||||
TabOrder = 19
|
TabOrder = 18
|
||||||
Text = 'Dump'
|
Text = 'Dump'
|
||||||
OnClick = DumpButtonClick
|
OnClick = DumpButtonClick
|
||||||
end
|
end
|
||||||
object FailingUpvalueButton: TButton
|
object FailingUpvalueButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 378.000000000000000000
|
Position.Y = 378.000000000000000000
|
||||||
TabOrder = 21
|
TabOrder = 20
|
||||||
Text = 'Upvalue'
|
Text = 'Upvalue'
|
||||||
OnClick = FailingUpvalueButtonClick
|
OnClick = FailingUpvalueButtonClick
|
||||||
end
|
end
|
||||||
object TailCallButten: TButton
|
object TailCallButten: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 406.000000000000000000
|
Position.Y = 406.000000000000000000
|
||||||
TabOrder = 22
|
TabOrder = 21
|
||||||
Text = 'Tail calls'
|
Text = 'Tail calls'
|
||||||
OnClick = TailCallButtenClick
|
OnClick = TailCallButtenClick
|
||||||
end
|
end
|
||||||
object SaveUserLibButton: TButton
|
object SaveUserLibButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 629.000000000000000000
|
Position.Y = 629.000000000000000000
|
||||||
TabOrder = 23
|
TabOrder = 22
|
||||||
Text = 'Save Lib'
|
Text = 'Save Lib'
|
||||||
OnClick = SaveUserLibButtonClick
|
OnClick = SaveUserLibButtonClick
|
||||||
end
|
end
|
||||||
object LoadUserLibButton: TButton
|
object LoadUserLibButton: TButton
|
||||||
Position.X = 24.000000000000000000
|
Position.X = 24.000000000000000000
|
||||||
Position.Y = 659.000000000000000000
|
Position.Y = 659.000000000000000000
|
||||||
TabOrder = 24
|
TabOrder = 23
|
||||||
Text = 'LoadLib'
|
Text = 'LoadLib'
|
||||||
OnClick = LoadUserLibButtonClick
|
OnClick = LoadUserLibButtonClick
|
||||||
end
|
end
|
||||||
@@ -187,7 +180,7 @@ object Form1: TForm1
|
|||||||
Size.Width = 113.000000000000000000
|
Size.Width = 113.000000000000000000
|
||||||
Size.Height = 184.000000000000000000
|
Size.Height = 184.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 25
|
TabOrder = 24
|
||||||
OnChange = RTLListViewChange
|
OnChange = RTLListViewChange
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
@@ -197,6 +190,22 @@ object Form1: TForm1
|
|||||||
Size.Height = 609.000000000000000000
|
Size.Height = 609.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 3
|
TabOrder = 3
|
||||||
|
object CompilerStageBox: TComboBox
|
||||||
|
Anchors = [akRight, akBottom]
|
||||||
|
Items.Strings = (
|
||||||
|
'Unbound'
|
||||||
|
'Expanded'
|
||||||
|
'Bound'
|
||||||
|
'Lowered')
|
||||||
|
ItemIndex = 0
|
||||||
|
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
|
end
|
||||||
object Memo1: TMemo
|
object Memo1: TMemo
|
||||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
@@ -236,10 +245,15 @@ object Form1: TForm1
|
|||||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||||
DataDetectorTypes = []
|
DataDetectorTypes = []
|
||||||
Lines.Strings = (
|
Lines.Strings = (
|
||||||
'(do'
|
'(do '
|
||||||
'(defmacro test [body] `(fn [] ~body ))'
|
' (defmacro test [body] `(fn [] ~body ))'
|
||||||
'(defmacro test2 [body] `(fn [] ~body ))'
|
' (defmacro test2 [body] `(fn [] ~body ))'
|
||||||
'(test2 "hi")'
|
' (test2 "hi")'
|
||||||
|
''
|
||||||
|
' (def debug-mode :true)'
|
||||||
|
' '
|
||||||
|
' (stopwatch '
|
||||||
|
' (if debug-mode (print "Debug an")))'
|
||||||
')')
|
')')
|
||||||
StyledSettings = [Size, Style, FontColor]
|
StyledSettings = [Size, Style, FontColor]
|
||||||
TextSettings.Font.Family = 'Consolas'
|
TextSettings.Font.Family = 'Consolas'
|
||||||
|
|||||||
+30
-26
@@ -39,7 +39,8 @@ uses
|
|||||||
FMX.ListView.Appearances,
|
FMX.ListView.Appearances,
|
||||||
FMX.ListView.Adapters.Base,
|
FMX.ListView.Adapters.Base,
|
||||||
FMX.ListView,
|
FMX.ListView,
|
||||||
Myc.Ast.Environment; // Added Environment
|
Myc.Ast.Environment,
|
||||||
|
FMX.ListBox; // Added Environment
|
||||||
|
|
||||||
type
|
type
|
||||||
// A test record
|
// A test record
|
||||||
@@ -57,7 +58,6 @@ type
|
|||||||
Memo1: TMemo;
|
Memo1: TMemo;
|
||||||
Test1Button: TButton;
|
Test1Button: TButton;
|
||||||
Test2Button: TButton;
|
Test2Button: TButton;
|
||||||
PrettyPrintButton: TButton;
|
|
||||||
RecursionButton: TButton;
|
RecursionButton: TButton;
|
||||||
ShowScopeBox: TCheckBox;
|
ShowScopeBox: TCheckBox;
|
||||||
FibonacciButton: TButton;
|
FibonacciButton: TButton;
|
||||||
@@ -82,8 +82,10 @@ type
|
|||||||
LoadUserLibButton: TButton;
|
LoadUserLibButton: TButton;
|
||||||
SaveUserLibButton: TButton;
|
SaveUserLibButton: TButton;
|
||||||
RTLListView: TListView;
|
RTLListView: TListView;
|
||||||
|
CompilerStageBox: TComboBox;
|
||||||
procedure InnerLambdaButtonClick(Sender: TObject);
|
procedure InnerLambdaButtonClick(Sender: TObject);
|
||||||
procedure ClearButtonClick(Sender: TObject);
|
procedure ClearButtonClick(Sender: TObject);
|
||||||
|
procedure CompilerStageBoxChange(Sender: TObject);
|
||||||
procedure FormCreate(Sender: TObject);
|
procedure FormCreate(Sender: TObject);
|
||||||
procedure CreateTriggerExampleButtonClick(Sender: TObject);
|
procedure CreateTriggerExampleButtonClick(Sender: TObject);
|
||||||
procedure DebugBoxChange(Sender: TObject);
|
procedure DebugBoxChange(Sender: TObject);
|
||||||
@@ -95,7 +97,6 @@ type
|
|||||||
procedure FibonacciButtonClick(Sender: TObject);
|
procedure FibonacciButtonClick(Sender: TObject);
|
||||||
procedure FlowOnlyBoxChange(Sender: TObject);
|
procedure FlowOnlyBoxChange(Sender: TObject);
|
||||||
procedure OHLCButtonClick(Sender: TObject);
|
procedure OHLCButtonClick(Sender: TObject);
|
||||||
procedure PrettyPrintButtonClick(Sender: TObject);
|
|
||||||
procedure RecursionButtonClick(Sender: TObject);
|
procedure RecursionButtonClick(Sender: TObject);
|
||||||
procedure SeriesTestButtonClick(Sender: TObject);
|
procedure SeriesTestButtonClick(Sender: TObject);
|
||||||
procedure Test1ButtonClick(Sender: TObject);
|
procedure Test1ButtonClick(Sender: TObject);
|
||||||
@@ -205,6 +206,11 @@ begin
|
|||||||
FWorkspace.Repaint;
|
FWorkspace.Repaint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.CompilerStageBoxChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ShowVizualization(14, 14);
|
||||||
|
end;
|
||||||
|
|
||||||
function TForm1.CreateEnvironment: TAstEnvironment;
|
function TForm1.CreateEnvironment: TAstEnvironment;
|
||||||
begin
|
begin
|
||||||
if DebugBox.IsChecked then
|
if DebugBox.IsChecked then
|
||||||
@@ -361,6 +367,7 @@ begin
|
|||||||
.AsMacroDefinition
|
.AsMacroDefinition
|
||||||
);
|
);
|
||||||
|
|
||||||
|
CompilerStageBox.BringToFront;
|
||||||
ClearButtonClick(Self);
|
ClearButtonClick(Self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -585,12 +592,6 @@ begin
|
|||||||
try
|
try
|
||||||
var unboundAst := converter.Deserialize(jsonObj);
|
var unboundAst := converter.Deserialize(jsonObj);
|
||||||
|
|
||||||
// Set strategy based on UI
|
|
||||||
if DebugBox.IsChecked then
|
|
||||||
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
|
|
||||||
else
|
|
||||||
FEnvironment.SetStandardMode;
|
|
||||||
|
|
||||||
// Run the full pipeline
|
// Run the full pipeline
|
||||||
FCurrExec := FEnvironment.Compile(unboundAst);
|
FCurrExec := FEnvironment.Compile(unboundAst);
|
||||||
|
|
||||||
@@ -718,21 +719,6 @@ begin
|
|||||||
UpdateScript;
|
UpdateScript;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
|
|
||||||
begin
|
|
||||||
Memo1.Lines.Clear;
|
|
||||||
Memo1.Lines.Add('--- AST Pretty Print ---');
|
|
||||||
|
|
||||||
// We print the *compiled* AST
|
|
||||||
if not Assigned(FCurrExec) then
|
|
||||||
begin
|
|
||||||
Memo1.Lines.Add('No AST has been generated yet.');
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Memo1.Lines.Add(TAstScript.Print(FCurrUnboundAst));
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TForm1.RecursionButtonClick(Sender: TObject);
|
procedure TForm1.RecursionButtonClick(Sender: TObject);
|
||||||
var
|
var
|
||||||
root: IAstNode;
|
root: IAstNode;
|
||||||
@@ -1270,9 +1256,10 @@ begin
|
|||||||
|
|
||||||
Memo1.Lines.Clear;
|
Memo1.Lines.Clear;
|
||||||
try
|
try
|
||||||
|
FCurrUnboundAst := TAstScript.Parse(ScriptMemo.Lines.Text);
|
||||||
try
|
try
|
||||||
// Execute the entire script block when it changes
|
// Execute the entire script block when it changes
|
||||||
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text));
|
var result := ExecuteAst(FCurrUnboundAst);
|
||||||
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
|
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
|
||||||
finally
|
finally
|
||||||
ShowVizualization(14, 14);
|
ShowVizualization(14, 14);
|
||||||
@@ -1295,7 +1282,24 @@ procedure TForm1.ShowVizualization(X, Y: Single);
|
|||||||
begin
|
begin
|
||||||
FWorkspace.DeleteChildren;
|
FWorkspace.DeleteChildren;
|
||||||
|
|
||||||
FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
|
if FCurrUnboundAst = nil then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
var ast := FCurrUnboundAst;
|
||||||
|
|
||||||
|
if CompilerStageBox.ItemIndex > 0 then
|
||||||
|
ast := FEnvironment.Environment.ExpandMacros(ast);
|
||||||
|
|
||||||
|
if CompilerStageBox.ItemIndex > 1 then
|
||||||
|
begin
|
||||||
|
var desc: IScopeDescriptor;
|
||||||
|
ast := FEnvironment.Environment.Bind(ast, desc);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if CompilerStageBox.ItemIndex > 2 then
|
||||||
|
ast := FEnvironment.Environment.Lower(ast);
|
||||||
|
|
||||||
|
FWorkspace.Build(ast, TPointF.Create(X, Y));
|
||||||
//
|
//
|
||||||
// if FCurrExec <> nil then
|
// if FCurrExec <> nil then
|
||||||
// begin
|
// begin
|
||||||
|
|||||||
@@ -0,0 +1,16 @@
|
|||||||
|
### Projektplan: Hybrid-Makro-System
|
||||||
|
**Datum:** 06.11.2025 14:39
|
||||||
|
|
||||||
|
#### Motivation
|
||||||
|
Die Implementierung von `stopwatch` als RTL-Funktion war unzureichend, da der Zugriff auf andere Laufzeit-Symbole (wie `print`) einen langsamen Laufzeit-Lookup (`FindSymbolAddress`) erfordert hätte. Die Umwandlung in ein Makro löst das Bindungs-Problem, wirft aber das Problem der Makro-Hygiene auf. Explizite Lösungen (wie `gensym` oder `$`-Suffixe) sind syntaktisch zu komplex, unleserlich und/oder unzureichend.
|
||||||
|
|
||||||
|
#### Ziel
|
||||||
|
Entwicklung eines impliziten, automatischen Makro-Systems. Dieses System muss **hygienisch für Definitionen** sein (um Kollisionen bei internen Variablen wie `start-time` zu verhindern), aber **unhygienisch für freie Symbole** (um kontext-abhängige Makros, die z.B. `*debug-mode*` lesen, zu ermöglichen).
|
||||||
|
|
||||||
|
Die Komplexität der Hygiene soll vollständig vom Makro-Autor in den Makro-Expander (`TExpansionVisitor`) verlagert werden.
|
||||||
|
|
||||||
|
#### Ergebnis
|
||||||
|
Ein Makro-System, bei dem:
|
||||||
|
1. **Automatische Hygiene:** Alle *Definitionen* (`def`, `fn`-Parameter etc.) innerhalb eines Makro-Templates (`quasiquote`) automatisch und eindeutig umbenannt werden (z.B. `start-time` -> `start-time_123`). Dies löst das Verschachtelungs- und Kollisionsproblem (`stopwatch` in `stopwatch`).
|
||||||
|
2. **Unhygienische Freie Symbole:** Alle *freien Symbole* (z.B. `print`, `timestamp`, `*debug-mode*`), die im Makro-Template *verwendet*, aber *nicht definiert* werden, unberührt bleiben. Diese werden (unhygienisch) vom `TAstBinder` im *Aufruf-Scope* des Benutzers aufgelöst.
|
||||||
|
|
||||||
@@ -0,0 +1,119 @@
|
|||||||
|
# White Paper: A Hybrid Approach to Macro Hygiene
|
||||||
|
|
||||||
|
**Date:** 09.11.2025
|
||||||
|
**Status:** Final
|
||||||
|
|
||||||
|
## 1\. Executive Summary
|
||||||
|
|
||||||
|
The macro system is a cornerstone of the compiler, enabling powerful syntactic abstraction. However, designing a macro system requires solving the fundamental conflict between **safety** (preventing accidental variable conflicts) and **power** (allowing macros to interact with their calling context).
|
||||||
|
|
||||||
|
This document outlines the rationale for the implemented hybrid macro system. This system is designed to provide the best of both worlds without burdening the macro author with manual hygiene management (such as `gensym` or special syntax).
|
||||||
|
|
||||||
|
Our system operates on two simple, deterministic rules:
|
||||||
|
|
||||||
|
1. **Automatic Hygiene for Definitions:** All symbols *defined* within a macro template are automatically renamed to be unique, preventing conflicts with user code or nested macro calls.
|
||||||
|
2. **Unhygienic Fallback for Free Symbols:** All *free symbols* (those used but not defined within the template) are left untouched. They are resolved by the binder in the **call-site scope** (the scope where the macro was invoked).
|
||||||
|
|
||||||
|
This hybrid model ensures that internal macro variables are always safe, while simultaneously permitting powerful, context-aware macros.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 2\. The Core Challenge: Safety vs. Context
|
||||||
|
|
||||||
|
A macro, by definition, injects code into a foreign scope. This creates two distinct, opposing requirements.
|
||||||
|
|
||||||
|
### Scenario A: The Need for Safety (Hygienic Definitions)
|
||||||
|
|
||||||
|
This is the classic hygiene problem. A macro must manage its own internal state without interfering with the user's code.
|
||||||
|
|
||||||
|
Consider a simple `stopwatch` macro:
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(* Macro Definition *)
|
||||||
|
(defmacro stopwatch [body]
|
||||||
|
`(do
|
||||||
|
(def start-time (timestamp))
|
||||||
|
(def result ~body)
|
||||||
|
(print "Time: " (- (timestamp) start-time))
|
||||||
|
result))
|
||||||
|
|
||||||
|
(* User Code *)
|
||||||
|
(def start-time "Important User Data")
|
||||||
|
(stopwatch (expensive-call))
|
||||||
|
(print start-time)
|
||||||
|
```
|
||||||
|
|
||||||
|
A naive (fully unhygienic) expansion would redefine the user's `start-time` variable, corrupting their program. This is unacceptable. The macro's internal variables (`start-time`, `result`) must be **hygienic**—that is, isolated from the call-site scope.
|
||||||
|
|
||||||
|
### Scenario B: The Need for Context (Unhygienic Free Symbols)
|
||||||
|
|
||||||
|
Macros derive their power from interacting with the context in which they are called. A macro may need to read variables from the user's scope.
|
||||||
|
|
||||||
|
Consider a `debug-print` macro:
|
||||||
|
|
||||||
|
```lisp
|
||||||
|
(* Macro Definition *)
|
||||||
|
(defmacro debug-print [msg]
|
||||||
|
`(if *debug-mode*
|
||||||
|
(print msg)))
|
||||||
|
|
||||||
|
(* User Code *)
|
||||||
|
(do
|
||||||
|
(def *debug-mode* true) ; User-defined context variable
|
||||||
|
(debug-print "Test message")
|
||||||
|
)
|
||||||
|
```
|
||||||
|
|
||||||
|
In this case, the macro *must* access the user's `*debug-mode*` variable from the call-site scope. A "fully hygienic" system (which binds *all* symbols to the macro's *definition-site scope*) would fail, as it would be unable to see the user's local `*debug-mode*` variable.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 3\. Rejected Alternatives
|
||||||
|
|
||||||
|
To solve this conflict, several common designs were considered and rejected for failing one of the two core scenarios.
|
||||||
|
|
||||||
|
* **Fully Unhygienic (The `$` Suffix):** This approach makes all symbols unhygienic by default and requires the author to manually mark internal variables (e.g., `start-time$`) for special handling. This inverts the desired default (safety) and fails to solve nested macro conflicts.
|
||||||
|
* **Fully Hygienic (Strict Academic):** This system binds *all* symbols (defined or free) to the macro's definition-site scope. This perfectly solves Scenario A but makes Scenario B impossible.
|
||||||
|
* **Explicit Gensym (The Lisp Way):** This requires the macro author to manually generate unique symbols (`(let [start-sym (gensym)] ...)`). This is syntactically complex, error-prone, and places an unnecessary burden on the author.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 4\. The Implemented Solution: Hybrid Hygiene
|
||||||
|
|
||||||
|
Our system resolves the conflict by treating definitions and free variables differently. The logic is handled entirely by the macro expander, requiring no special syntax from the macro author.
|
||||||
|
|
||||||
|
### Rule 1: Automatic Renaming of Definitions
|
||||||
|
|
||||||
|
When the macro expander processes a template, it performs a pre-pass to identify all symbols being *defined*. This includes `def` forms, `fn` parameters, and `let` bindings.
|
||||||
|
|
||||||
|
* For each defined symbol (e.g., `start-time`), the expander generates a unique, internal-only name (e.g., `start-time_G123`).
|
||||||
|
* It stores this in an expansion-local rename map.
|
||||||
|
* It then replaces all occurrences of that symbol *within the template* with the new name.
|
||||||
|
|
||||||
|
This automatically and transparently solves **Scenario A**. The `stopwatch` macro's `start-time` becomes `start-time_G123` and cannot possibly conflict with the user's `start-time`. This also solves the nested macro problem, as each expansion generates new unique names.
|
||||||
|
|
||||||
|
### Rule 2: Unhygienic Fallback for Free Symbols
|
||||||
|
|
||||||
|
Any symbol in the macro template that is *not* part of a definition (a "free symbol") is left untouched by the expander.
|
||||||
|
|
||||||
|
* In `stopwatch`, the symbols `do`, `timestamp`, `print`, and `-` are free symbols.
|
||||||
|
* In `debug-print`, the symbols `if`, `*debug-mode*`, and `print` are free symbols.
|
||||||
|
|
||||||
|
The expander passes these symbols directly to the next compiler stage (the binder). The binder then resolves them, as it would any normal code, within the **call-site scope**.
|
||||||
|
|
||||||
|
This solves **Scenario B**. The binder finds `*debug-mode*` in the user's `do` block, exactly as intended.
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
## 5\. Conclusion and Trade-Offs
|
||||||
|
|
||||||
|
This hybrid design provides "implicit hygiene" for the common case (internal variables) while defaulting to "unhygienic" behavior for external symbols, which provides maximum power and flexibility.
|
||||||
|
|
||||||
|
The primary trade-off of this design is that **typographical errors in free symbols are caught late**.
|
||||||
|
|
||||||
|
For example, if the `stopwatch` macro misspelled `print` as `prnit`:
|
||||||
|
|
||||||
|
1. The expander would see `prnit` as a free symbol (Rule 2) and leave it untouched.
|
||||||
|
2. The binder would then fail to find `prnit` in the *user's* call-site scope.
|
||||||
|
|
||||||
|
The resulting error (`Undefined symbol: prnit`) will point to the user's code where `stopwatch` was *called*, not the macro *definition*. This is a minor, acceptable trade-off for a system that achieves both safety and power without syntactic overhead.
|
||||||
@@ -0,0 +1,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.
|
||||||
@@ -30,7 +30,18 @@ type
|
|||||||
private
|
private
|
||||||
FEvaluate: TEvaluateProc;
|
FEvaluate: TEvaluateProc;
|
||||||
FMacroScope: IExecutionScope;
|
FMacroScope: IExecutionScope;
|
||||||
|
FRenameMap: TDictionary<string, string>; // [*] Hygiene Rename Map (Rule 1)
|
||||||
|
FDefinitionDescriptor: IScopeDescriptor; // [*] Template Scope (Rule 1)
|
||||||
|
class var
|
||||||
|
FGensymCounter: Int64;
|
||||||
|
|
||||||
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
|
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
|
||||||
|
|
||||||
|
// [*] Gensym helper
|
||||||
|
function Gensym(const ABaseName: string): string;
|
||||||
|
// [*] Scope management for template
|
||||||
|
procedure EnterScope;
|
||||||
|
procedure ExitScope;
|
||||||
protected
|
protected
|
||||||
// Override the new IAstNode-returning methods
|
// Override the new IAstNode-returning methods
|
||||||
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
||||||
@@ -38,8 +49,19 @@ type
|
|||||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||||
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
||||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
|
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
|
||||||
|
|
||||||
|
// [*] Hygiene implementation (Rule 1)
|
||||||
|
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
|
||||||
|
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
||||||
|
|
||||||
|
// [*] Hygiene implementation (Rule 1, 2, 3)
|
||||||
|
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
|
||||||
public
|
public
|
||||||
|
// [*] Updated constructor
|
||||||
constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
|
constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
|
||||||
|
destructor Destroy; override; // [*] Added
|
||||||
|
|
||||||
|
// [*] Updated static helper
|
||||||
class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode;
|
class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -62,6 +84,8 @@ type
|
|||||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
|
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
|
||||||
// Finds and expands macro calls
|
// Finds and expands macro calls
|
||||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||||
|
|
||||||
|
// [*] Do not traverse into quasiquotes (they are handled by TExpansionVisitor)
|
||||||
function VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode; override;
|
function VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode; override;
|
||||||
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
||||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
|
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
|
||||||
@@ -93,6 +117,7 @@ implementation
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
System.Generics.Defaults,
|
System.Generics.Defaults,
|
||||||
|
System.SyncObjs,
|
||||||
Myc.Ast.Compiler.Binder,
|
Myc.Ast.Compiler.Binder,
|
||||||
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
|
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
|
||||||
Myc.Data.Keyword;
|
Myc.Data.Keyword;
|
||||||
@@ -104,6 +129,43 @@ begin
|
|||||||
inherited Create;
|
inherited Create;
|
||||||
FMacroScope := AMacroScope;
|
FMacroScope := AMacroScope;
|
||||||
FEvaluate := AEvaluate;
|
FEvaluate := AEvaluate;
|
||||||
|
|
||||||
|
// [*] Initialize hygiene tools
|
||||||
|
FRenameMap := TDictionary<string, string>.Create;
|
||||||
|
|
||||||
|
// Create a descriptor for the *template* scope, parented to nil.
|
||||||
|
// It only tracks template-internal definitions for shadowing.
|
||||||
|
FDefinitionDescriptor := TScope.CreateDescriptor(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TExpansionVisitor.Destroy;
|
||||||
|
begin
|
||||||
|
FRenameMap.Free;
|
||||||
|
// FDefinitionDescriptor is an interface
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TExpansionVisitor.EnterScope;
|
||||||
|
begin
|
||||||
|
// [*] Create a new nested definition scope
|
||||||
|
FDefinitionDescriptor := TScope.CreateDescriptor(FDefinitionDescriptor);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TExpansionVisitor.ExitScope;
|
||||||
|
begin
|
||||||
|
// [*] Revert to parent definition scope
|
||||||
|
FDefinitionDescriptor := FDefinitionDescriptor.Parent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.Gensym(const ABaseName: string): string;
|
||||||
|
begin
|
||||||
|
if not FRenameMap.TryGetValue(ABaseName, Result) then
|
||||||
|
begin
|
||||||
|
var count := TInterlocked.Add(FGensymCounter, 1);
|
||||||
|
inc(count);
|
||||||
|
Result := ABaseName + '_' + count.ToString;
|
||||||
|
FRenameMap.Add(ABaseName, Result);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
class function TExpansionVisitor.Expand(
|
class function TExpansionVisitor.Expand(
|
||||||
@@ -154,7 +216,7 @@ begin
|
|||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
// Use the IAstNode-returning Accept helper
|
// [*] Use the IAstNode-returning Accept helper (hygienic transform)
|
||||||
transformedNode := Self.Accept(node);
|
transformedNode := Self.Accept(node);
|
||||||
if Assigned(transformedNode) then
|
if Assigned(transformedNode) then
|
||||||
newList.Add(transformedNode);
|
newList.Add(transformedNode);
|
||||||
@@ -166,12 +228,92 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
|
||||||
|
var
|
||||||
|
newName: string;
|
||||||
|
begin
|
||||||
|
// [*] Hygiene Rule 1: Check for local rename
|
||||||
|
// Is this symbol defined *within the template* (and thus renamed)?
|
||||||
|
if FRenameMap.TryGetValue(Node.Name, newName) then
|
||||||
|
begin
|
||||||
|
// Yes, replace it with the hygienic name (e.g. 'start-time$1')
|
||||||
|
// We use TTypes.Unknown because the Binder/TypeChecker run *after* this.
|
||||||
|
Result := TAst.Identifier(newName, TTypes.Unknown);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// [*] Hygiene Rule 2 & 3: Free Symbol (Hygienic 'print' or Unhygienic '*debug-mode*')
|
||||||
|
// No, it's a free symbol. Leave it as-is.
|
||||||
|
// The TAstBinder will resolve it later, either in the
|
||||||
|
// macro's definition scope (Rule 2) or the caller's scope (Rule 3).
|
||||||
|
Result := Node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
|
||||||
|
var
|
||||||
|
newName: string;
|
||||||
|
newIdent: IIdentifierNode;
|
||||||
|
newInit: IAstNode;
|
||||||
|
begin
|
||||||
|
// [*] Hygiene Rule 1: This is a definition within the template.
|
||||||
|
|
||||||
|
// 1. Visit initializer *before* defining the var
|
||||||
|
// (so initializer can't see the var it's defining)
|
||||||
|
newInit := Accept(Node.Initializer);
|
||||||
|
|
||||||
|
// 2. Generate hygienic name
|
||||||
|
newName := Gensym(Node.Identifier.Name);
|
||||||
|
FDefinitionDescriptor.Define(newName);
|
||||||
|
|
||||||
|
// 3. Create new identifier node (type is unknown)
|
||||||
|
newIdent := TAst.Identifier(newName, TTypes.Unknown);
|
||||||
|
|
||||||
|
// 4. Create new VarDecl node
|
||||||
|
Result := TAst.VarDecl(newIdent, newInit, TTypes.Unknown);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TExpansionVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||||
|
var
|
||||||
|
newParams: TArray<IIdentifierNode>;
|
||||||
|
newBody: IAstNode;
|
||||||
|
newName: string;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
// [*] Hygiene Rule 1: Lambda parameters are definitions.
|
||||||
|
|
||||||
|
// 1. Enter a new definition scope for the template
|
||||||
|
EnterScope;
|
||||||
|
try
|
||||||
|
// 2. Rename parameters
|
||||||
|
SetLength(newParams, Length(Node.Parameters));
|
||||||
|
for i := 0 to High(Node.Parameters) do
|
||||||
|
begin
|
||||||
|
newName := Gensym(Node.Parameters[i].Name);
|
||||||
|
FDefinitionDescriptor.Define(newName);
|
||||||
|
newParams[i] := TAst.Identifier(newName, TTypes.Unknown);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 3. Visit body recursively in the new scope
|
||||||
|
newBody := Accept(Node.Body);
|
||||||
|
|
||||||
|
finally
|
||||||
|
// 4. Exit definition scope
|
||||||
|
ExitScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// 5. Create new Lambda node (type is unknown)
|
||||||
|
Result := TAst.LambdaExpr(newParams, newBody, nil, nil, False, TTypes.Unknown);
|
||||||
|
end;
|
||||||
|
|
||||||
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
||||||
var
|
var
|
||||||
value: TDataValue;
|
value: TDataValue;
|
||||||
expr: IAstNode;
|
expr: IAstNode;
|
||||||
symbol: TResolvedSymbol;
|
symbol: TResolvedSymbol;
|
||||||
begin
|
begin
|
||||||
|
// [*] This node *stops* the hygienic transformation.
|
||||||
|
// It reverts to the previous compile-time evaluation logic.
|
||||||
|
|
||||||
expr := Node.Expression;
|
expr := Node.Expression;
|
||||||
|
|
||||||
// Check if we are unquoting a macro parameter (simple identifier)
|
// Check if we are unquoting a macro parameter (simple identifier)
|
||||||
@@ -220,7 +362,9 @@ var
|
|||||||
newArgs: TArray<IAstNode>;
|
newArgs: TArray<IAstNode>;
|
||||||
transformedCallee: IAstNode;
|
transformedCallee: IAstNode;
|
||||||
begin
|
begin
|
||||||
|
// [*] Callee must be transformed hygienically
|
||||||
transformedCallee := Self.Accept(Node.Callee); // Calls IAstNode helper
|
transformedCallee := Self.Accept(Node.Callee); // Calls IAstNode helper
|
||||||
|
// [*] Arguments must be transformed and allow splicing
|
||||||
newArgs := TransformAndSpliceNodes(Node.Arguments);
|
newArgs := TransformAndSpliceNodes(Node.Arguments);
|
||||||
Result := TAst.FunctionCall(transformedCallee, newArgs);
|
Result := TAst.FunctionCall(transformedCallee, newArgs);
|
||||||
end;
|
end;
|
||||||
@@ -229,6 +373,7 @@ function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode
|
|||||||
var
|
var
|
||||||
newExprs: TArray<IAstNode>;
|
newExprs: TArray<IAstNode>;
|
||||||
begin
|
begin
|
||||||
|
// [*] Expressions must be transformed and allow splicing
|
||||||
newExprs := TransformAndSpliceNodes(Node.Expressions);
|
newExprs := TransformAndSpliceNodes(Node.Expressions);
|
||||||
Result := TAst.Block(newExprs);
|
Result := TAst.Block(newExprs);
|
||||||
end;
|
end;
|
||||||
@@ -237,6 +382,7 @@ function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): I
|
|||||||
begin
|
begin
|
||||||
// Record literals do not support splicing.
|
// Record literals do not support splicing.
|
||||||
// We just use the default TAstTransformer implementation which visits child values.
|
// We just use the default TAstTransformer implementation which visits child values.
|
||||||
|
// [*] This will correctly call VisitIdentifier for keys/values.
|
||||||
Result := inherited VisitRecordLiteral(Node);
|
Result := inherited VisitRecordLiteral(Node);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -361,6 +507,7 @@ begin
|
|||||||
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i])); // Use FromIntf
|
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i])); // Use FromIntf
|
||||||
|
|
||||||
// 3. Create the evaluation callback (TEvaluateProc)
|
// 3. Create the evaluation callback (TEvaluateProc)
|
||||||
|
// It must use the FInitialScope (for globals) and the expansionScope (for args)
|
||||||
var evaluatorProc: TEvaluateProc;
|
var evaluatorProc: TEvaluateProc;
|
||||||
evaluatorProc :=
|
evaluatorProc :=
|
||||||
function(const ANodeToEvaluate: IAstNode): TDataValue
|
function(const ANodeToEvaluate: IAstNode): TDataValue
|
||||||
@@ -371,6 +518,7 @@ begin
|
|||||||
boundSubAst: IAstNode;
|
boundSubAst: IAstNode;
|
||||||
begin
|
begin
|
||||||
// This is the compile-time evaluation (Binder + Evaluator)
|
// This is the compile-time evaluation (Binder + Evaluator)
|
||||||
|
// [*] It must bind against the *expansion* scope, not the initial scope
|
||||||
boundSubAst := TAstBinder.Bind(expansionScope.CreateDescriptor, ANodeToEvaluate, subDescriptor);
|
boundSubAst := TAstBinder.Bind(expansionScope.CreateDescriptor, ANodeToEvaluate, subDescriptor);
|
||||||
|
|
||||||
// Create eval scope from the new descriptor, parented to the expansion scope
|
// Create eval scope from the new descriptor, parented to the expansion scope
|
||||||
@@ -381,6 +529,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
// 4. Expand the macro body using the TExpansionVisitor
|
// 4. Expand the macro body using the TExpansionVisitor
|
||||||
|
// [*] FInitialScope removed from call
|
||||||
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, evaluatorProc);
|
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, evaluatorProc);
|
||||||
|
|
||||||
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
|
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
|
||||||
@@ -393,17 +542,21 @@ end;
|
|||||||
|
|
||||||
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
|
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
|
||||||
begin
|
begin
|
||||||
Result := Accept(Node.Expression);
|
// [*] Do not traverse into nested quasiquotes.
|
||||||
|
// TExpansionVisitor handles them when (if) they are unquoted.
|
||||||
|
Result := Node;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TMacroExpander.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
function TMacroExpander.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
||||||
begin
|
begin
|
||||||
Result := Accept(Node.Expression);
|
// [*] Standalone unquote (outside a quasiquote) is a syntax error.
|
||||||
|
raise Exception.Create('Unquote (`~`) can only be used inside a quasiquote (` `) template.');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TMacroExpander.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
|
function TMacroExpander.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
|
||||||
begin
|
begin
|
||||||
Result := Accept(Node.Expression);
|
// [*] Standalone unquote-splicing (outside a quasiquote) is a syntax error.
|
||||||
|
raise Exception.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote (` `) template.');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
@@ -42,6 +42,10 @@ type
|
|||||||
|
|
||||||
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
||||||
|
|
||||||
|
function ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||||
|
function Lower(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
|
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
|
||||||
|
|
||||||
function CreateEnvironment: IEnvironment;
|
function CreateEnvironment: IEnvironment;
|
||||||
@@ -73,6 +77,7 @@ type
|
|||||||
|
|
||||||
procedure Define(const Name: String; const AScript: IAstNode);
|
procedure Define(const Name: String; const AScript: IAstNode);
|
||||||
|
|
||||||
|
property Environment: IEnvironment read FEnvironment;
|
||||||
property RootScope: IExecutionScope read GetRootScope;
|
property RootScope: IExecutionScope read GetRootScope;
|
||||||
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
|
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
|
||||||
end;
|
end;
|
||||||
@@ -140,8 +145,11 @@ type
|
|||||||
|
|
||||||
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
|
||||||
|
|
||||||
function Compile(const ANode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; overload;
|
function ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc; overload;
|
function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||||
|
function Lower(const Node: IAstNode): IAstNode;
|
||||||
|
|
||||||
|
function Compile(const Node: IAstNode; const Params: TArray<IIdentifierNode>): TDataValue.TFunc;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// --- Factory Implementations ---
|
// --- Factory Implementations ---
|
||||||
@@ -299,6 +307,14 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||||
|
begin
|
||||||
|
var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor);
|
||||||
|
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
|
||||||
|
|
||||||
|
Result := typedAst;
|
||||||
|
end;
|
||||||
|
|
||||||
function TEnvironment.GetMacroRegistry: IMacroRegistry;
|
function TEnvironment.GetMacroRegistry: IMacroRegistry;
|
||||||
begin
|
begin
|
||||||
Result := FMacroRegistry;
|
Result := FMacroRegistry;
|
||||||
@@ -319,44 +335,21 @@ begin
|
|||||||
Result := TEnvironment.Create(TScope.CreateScope(FRootScope, nil, nil), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
|
Result := TEnvironment.Create(TScope.CreateScope(FRootScope, nil, nil), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TEnvironment.Compile(const ANode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
function TEnvironment.Compile(const Node: IAstNode; const Params: TArray<IIdentifierNode>): TDataValue.TFunc;
|
||||||
begin
|
|
||||||
// Step 1: Expand macros
|
|
||||||
var cExecutionStrategy := FExecutionStrategy;
|
|
||||||
var expandedAst :=
|
|
||||||
TMacroExpander.ExpandMacros(
|
|
||||||
FMacroRegistry,
|
|
||||||
FRootScope,
|
|
||||||
ANode,
|
|
||||||
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := cExecutionStrategy.CreateVisitor(Scope); end
|
|
||||||
);
|
|
||||||
|
|
||||||
// Step 2: Bind names
|
|
||||||
var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, expandedAst, Descriptor);
|
|
||||||
|
|
||||||
// Step 3: Check types
|
|
||||||
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
|
|
||||||
|
|
||||||
// Step 4: Lowering
|
|
||||||
var loweredAst := TAstLowerer.Lower(typedAst);
|
|
||||||
|
|
||||||
// Step 5: TCO
|
|
||||||
var compiledAst := TAstTCO.Optimize(loweredAst);
|
|
||||||
|
|
||||||
Result := compiledAst;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TEnvironment.Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
|
|
||||||
var
|
var
|
||||||
desc: IScopeDescriptor;
|
desc: IScopeDescriptor;
|
||||||
begin
|
begin
|
||||||
var prg := TAst.LambdaExpr(Params, ANode);
|
var prg := TAst.LambdaExpr(Params, Node);
|
||||||
|
|
||||||
var compiled := Compile(prg, desc);
|
var expanded := ExpandMacros(prg);
|
||||||
|
var bound := Bind(expanded, desc);
|
||||||
|
var lowered := Lower(bound);
|
||||||
|
|
||||||
|
var tcoOptimized := TAstTCO.Optimize(lowered);
|
||||||
|
|
||||||
var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
|
var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
|
||||||
|
|
||||||
var func := compiled.Accept(visitor).AsMethod;
|
var func := tcoOptimized.Accept(visitor).AsMethod;
|
||||||
|
|
||||||
Result :=
|
Result :=
|
||||||
function(const Args: TArray<TDataValue>): TDataValue
|
function(const Args: TArray<TDataValue>): TDataValue
|
||||||
@@ -366,4 +359,21 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.ExpandMacros(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
var cExecutionStrategy := FExecutionStrategy;
|
||||||
|
Result :=
|
||||||
|
TMacroExpander.ExpandMacros(
|
||||||
|
FMacroRegistry,
|
||||||
|
FRootScope,
|
||||||
|
Node,
|
||||||
|
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := cExecutionStrategy.CreateVisitor(Scope); end
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TEnvironment.Lower(const Node: IAstNode): IAstNode;
|
||||||
|
begin
|
||||||
|
Result := TAstLowerer.Lower(Node);
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
Reference in New Issue
Block a user