diff --git a/CLAUDE.md b/CLAUDE.md index e3b73550..1ea0e7cc 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -46,7 +46,6 @@ dotnet test --filter "FullyQualifiedName~TestName" - **StackContext** hierarchy: Abstract execution context (stack frames) with implementations: - `FunctionContext`: Interpreted bytecode execution - `CilFunctionContext`: JIT-compiled native execution - - `CoroutineContext`, `CooperativeContext`: Concurrency support - **Instruction Set** (`Instruction.cs`): Stack-based opcodes (load, store, call, jump, operators) - **PValue** (`PValue.cs`): Universal value container `(object Value, PType Type)` with dynamic dispatch diff --git a/Prexonite/Commands/Lazy/AsThunkCommand.cs b/Prexonite/Commands/Lazy/AsThunkCommand.cs index a40f2d5f..3a678e86 100644 --- a/Prexonite/Commands/Lazy/AsThunkCommand.cs +++ b/Prexonite/Commands/Lazy/AsThunkCommand.cs @@ -3,8 +3,7 @@ namespace Prexonite.Commands.Lazy; /// -/// Turns values in WHNF into thunks and leaves existing thunks alone. This helps -/// building functions that can be callled with both strict and lazy arguments. +/// Wraps values in already-evaluated thunks and leaves existing thunks alone. /// public class AsThunkCommand : PCommand, ICilCompilerAware { diff --git a/Prexonite/Commands/Lazy/ThunkCommand.cs b/Prexonite/Commands/Lazy/ThunkCommand.cs index a7c51a19..010439e4 100644 --- a/Prexonite/Commands/Lazy/ThunkCommand.cs +++ b/Prexonite/Commands/Lazy/ThunkCommand.cs @@ -1,4 +1,3 @@ -using System.Diagnostics; using Prexonite.Compiler.Cil; namespace Prexonite.Commands.Lazy; @@ -58,75 +57,27 @@ void ICilCompilerAware.ImplementInCil(CompilerState state, Instruction ins) } } +/// +/// Represents a value that is computed at most once, on first access. +/// public class Thunk : IIndirectCall, IObject { - struct BlackHole - { - readonly bool _isActive; - readonly int _threadId; - readonly ManualResetEvent _evaluationDone; - - BlackHole(int threadId) - { - _isActive = true; - _threadId = threadId; - _evaluationDone = new(false); - } - - public static BlackHole Active(int threadId) - { - return new(threadId); - } - - public BlackHole Inactivate() - { - _evaluationDone?.Set(); - return _inactive(); - } - - static BlackHole _inactive() - { - return new(); - } - - public bool Trap() - { - if (_isActive) - { - if (_threadId == Thread.CurrentThread.ManagedThreadId) - { - throw new PrexoniteException("Thunk is already being evaluated!"); - } - else - { - _evaluationDone.WaitOne(Timeout.Infinite, true); - return true; - } - } - return false; - } - } - - BlackHole _blackHole; - - (PValue Expr, PValue[] Parameters)? impl; - - PValue? _value; - Exception? _exception; + readonly object _initializationLock = new(); + PValue? _expression; + PValue[]? _parameters; + readonly PValue? _value; + Lazy? _evaluation; #region Construction Thunk(PValue expr, PValue[] parameters) { - impl = ( - expr ?? throw new ArgumentNullException(nameof(expr)), - parameters ?? throw new ArgumentNullException(nameof(parameters)) - ); + _expression = expr ?? throw new ArgumentNullException(nameof(expr)); + _parameters = parameters ?? throw new ArgumentNullException(nameof(parameters)); } Thunk(PValue value) { - impl = null; _value = value ?? throw new ArgumentNullException(nameof(value)); } @@ -146,10 +97,34 @@ public static Thunk NewExpression(PValue expr, PValue[] parameters) public PValue Force(StackContext sctx) { - return ((IIndirectCall)this).IndirectCall(sctx); + if (sctx == null) + throw new ArgumentNullException(nameof(sctx)); + + if (_value is { } value) + return value; + + var evaluation = Volatile.Read(ref _evaluation); + if (evaluation == null) + { + lock (_initializationLock) + { + evaluation = _evaluation; + if (evaluation == null) + { + evaluation = new( + () => _evaluate(sctx), + LazyThreadSafetyMode.ExecutionAndPublication + ); + Volatile.Write(ref _evaluation, evaluation); + } + } + } + + return evaluation.Value; } - public bool IsEvaluated => _value != null; + public bool IsEvaluated => + _value != null || Volatile.Read(ref _evaluation)?.IsValueCreated == true; public bool TryDynamicCall( StackContext sctx, @@ -176,105 +151,30 @@ public bool TryDynamicCall( #endregion - IEnumerable _cooperativeForce(StackContext sctx, Action setReturnValue) + PValue _evaluate(StackContext sctx) { - if (sctx == null) - throw new ArgumentNullException(nameof(sctx)); + var expression = _expression; + var parameters = _parameters; + if (expression == null || parameters == null) + throw new InvalidOperationException("Thunk expression is not available."); - while (true) + try { - //Check if evaluation resulted in exception - if (_exception != null) - throw _exception; - - //Check if value is available - if (_value != null) - break; - - //Prevent infinite loops - if (_blackHole.Trap()) - continue; //If we have been trapped, check exception again - - //Tag thunk as being evaluated - _blackHole = BlackHole.Active(Thread.CurrentThread.ManagedThreadId); - - Debug.Indent(); - //We need to save stack space here, so try to invoke via IStackAware - // Since most expressions are closures, this has a high success rate - if (impl is { Expr.Value: IStackAware stackAware, Parameters: { } parameters }) - { - //Exception handler defined in creation of cooperative context - var exprCtx = stackAware.CreateStackContext(sctx, parameters); - sctx.ParentEngine.Stack.AddLast(exprCtx); - yield return true; - _value = exprCtx.ReturnValue; - } - else if (impl is { Expr: var expr, Parameters: var dynParameters }) - { - try - { - _value = expr.IndirectCall(sctx, dynParameters.AsSpan()); - } - catch (Exception ex) - { - _blackHole = _blackHole.Inactivate(); - _value = PType.Null; - _exception = ex; - throw; - } - } - else - { - throw new PrexoniteException("Thunk must have an implementation or a a value."); - } - Debug.Unindent(); - - if (_value.Value is Thunk t) - { - //Assimilate nested thunk - _blackHole = t._blackHole; - impl = t.impl; - _value = t._value; - _exception = t._exception; - } - else - { - //Release expression - impl = null; - _blackHole = _blackHole.Inactivate(); - break; - } + var result = expression.IndirectCall(sctx, parameters.AsSpan()); + while (result.Value is Thunk nested) + result = nested.Force(sctx); + return result; + } + finally + { + // Lazy caches both values and exceptions, so the factory inputs are no longer needed. + _expression = null; + _parameters = null; } - - setReturnValue(_value); } - [SuppressMessage("ReSharper", "AccessToModifiedClosure")] PValue IIndirectCall.IndirectCall(StackContext sctx, params ReadOnlySpan args) { - CooperativeContext coopCtx = null!; - coopCtx = new(sctx, f => _cooperativeForce(coopCtx, f)) - { - ExceptionHandler = ex => - { - _blackHole = _blackHole.Inactivate(); - _value = PType.Null; - _exception = ex; - return false; - }, - }; - - if (sctx is FunctionContext fctx) - { - //Turn CLR call into Prexonite stack call - fctx._UseVirtualMachineStackInstead(); - sctx.ParentEngine.Stack.AddLast(coopCtx); - return PType.Null; - } - else - { - //Traditional implementation using the managed stack - return sctx.ParentEngine.Process(coopCtx); - } + return Force(sctx); } } diff --git a/Prexonite/Continuation.cs b/Prexonite/Continuation.cs deleted file mode 100644 index 495450c2..00000000 --- a/Prexonite/Continuation.cs +++ /dev/null @@ -1,102 +0,0 @@ -namespace Prexonite; - -public class Continuation : Closure -{ - public int EntryOffset { get; } - - public SymbolTable State { get; } - - public PValue[] Stack { get; } - - public Continuation(FunctionContext fctx) - : base(fctx.Implementation, _getSharedVariables(fctx)) - { - EntryOffset = fctx.Pointer; //Pointer must already be incremented - State = new(fctx.LocalVariables.Count); - foreach (var variable in fctx.LocalVariables) - State[variable.Key] = variable.Value.Value; - var stack = new PValue[fctx.StackSize]; - for (var i = 0; i < stack.Length; i++) - stack[i] = fctx.Pop(); - Stack = stack; - _populateStack(fctx); - } - - void _populateStack(FunctionContext fctx) - { - for (var i = Stack.Length - 1; i >= 0; i--) - { - fctx.Push(Stack[i]); - } - } - - static PVariable[] _getSharedVariables(FunctionContext fctx) - { - var metaTable = fctx.Implementation.Meta; - if (!(metaTable.TryGetValue(PFunction.SharedNamesKey, out var entry) && entry.IsList)) - { - return []; - } - var sharedNames = entry.List; - var sharedVariables = new PVariable[sharedNames.Length]; - for (var i = 0; i < sharedNames.Length; i++) - { - var name = sharedNames[i].Text; - sharedVariables[i] = - fctx.LocalVariables[name] - ?? throw new PrexoniteException( - "Continuation references non-existent shared variable '" + name + "'." - ); - } - return sharedVariables; - } - - public override PValue IndirectCall(StackContext sctx, params ReadOnlySpan args) - { - if (sctx == null) - throw new ArgumentNullException(nameof(sctx)); - - var fctx = CreateFunctionContext(sctx, args.ToArray()); - - //run the continuation - return sctx.ParentEngine.Process(fctx); - } - - public override FunctionContext CreateFunctionContext(StackContext sctx, PValue[] args) - { - PValue returnValue; - if (args.Length < 1) - returnValue = PType.Null.CreatePValue(); - else - returnValue = args[0]; - - var fctx = base.CreateFunctionContext(sctx, args); - - //restore state - fctx.Pointer = EntryOffset; - - _populateStack(fctx); - - foreach (var variable in State) - { - var v = fctx.LocalVariables[variable.Key]; - if (v == null) - { - throw new PrexoniteException( - "Continuation references non-existent local variable '" + variable.Key + "'." - ); - } - v.Value = variable.Value; - } - - //insert the value returned by the called function - fctx.Push(returnValue); - - return fctx; - } - - public override string ToString() - { - return "Continuation(" + Function.Id + ")"; - } -} diff --git a/Prexonite/CooperativeContext.cs b/Prexonite/CooperativeContext.cs deleted file mode 100644 index f736ae35..00000000 --- a/Prexonite/CooperativeContext.cs +++ /dev/null @@ -1,124 +0,0 @@ -using System.Diagnostics; - -namespace Prexonite; - -/// -/// Integrates suspendable .NET managed code into the Prexonite stack via the IEnumerator interface. -/// -public class CooperativeContext : StackContext, IDisposable -{ - public override string ToString() - { - return $"Cooperative managed method({_existingMethod})"; - } - - public CooperativeContext(StackContext sctx, Func, IEnumerable> methodCtor) - { - if (sctx == null) - throw new ArgumentNullException(nameof(sctx)); - - _methodCtor = methodCtor ?? throw new ArgumentNullException(nameof(methodCtor)); - ParentEngine = sctx.ParentEngine; - ParentApplication = sctx.ParentApplication; - ImportedNamespaces = sctx.ImportedNamespaces; - } - - IEnumerator method - { - [DebuggerStepThrough] - get - { - if (_existingMethod != null) - { - return _existingMethod; - } - else if (_methodCtor != null) - { - _existingMethod = _methodCtor(v => _returnValue = v).GetEnumerator(); - _methodCtor = null; - return _existingMethod; - } - else - { - throw new PrexoniteException("Can only execute the method once."); - } - } - } - - Func, IEnumerable>? _methodCtor; - IEnumerator? _existingMethod; - - PValue? _returnValue; - - /// - /// Represents the engine this context is part of. - /// - public override Engine ParentEngine { get; } - - /// - /// The parent application. - /// - public override Application ParentApplication { get; } - - public override SymbolCollection ImportedNamespaces { get; } - - /// - /// Indicates whether the context still has code/work to do. - /// - /// True if the context has additional work to perform in the next cycle, False if it has finished it's work and can be removed from the stack - protected override bool PerformNextCycle(StackContext? lastContext) - { - return method.MoveNext() && method.Current; - } - - /// - /// Tries to handle the supplied exception. - /// - /// The exception to be handled. - /// True if the exception has been handled, false otherwise. - public override bool TryHandleException(Exception exc) - { - if (ExceptionHandler != null) - return ExceptionHandler(exc); - else - return false; - } - - public Func? ExceptionHandler { get; set; } - - /// - /// Represents the return value of the context. - /// Just providing a value here does not mean that it gets consumed by the caller. - /// If the context does not provide a return value, this property should return null (not NullPType). - /// - public override PValue ReturnValue => _returnValue ?? PType.Null.CreatePValue(); - - #region IDisposable - - bool disposed; - - public void Dispose() - { - GC.SuppressFinalize(this); - _dispose(true); - } - - void _dispose(bool disposing) - { - if (!disposed) - { - if (disposing) - { - _existingMethod?.Dispose(); - } - } - disposed = true; - } - - ~CooperativeContext() - { - _dispose(false); - } - - #endregion -} diff --git a/Prexonite/FunctionContext.cs b/Prexonite/FunctionContext.cs index 8619b672..324e33ff 100644 --- a/Prexonite/FunctionContext.cs +++ b/Prexonite/FunctionContext.cs @@ -193,10 +193,7 @@ public void Push(PValue? val) message: $"Stack-overflow in Prexonite code: {this}" ); - if (_useVirtualStackInstead) - _useVirtualStackInstead = false; - else - _stack.Push(val ?? NullPType.CreateValue()); + _stack.Push(val ?? NullPType.CreateValue()); } [DebuggerStepThrough] @@ -252,21 +249,6 @@ public bool Step(StackContext lastContext) return _performNextCycle(lastContext, true); } - /// - /// - /// - bool _useVirtualStackInstead; - - /// - /// When the function context calls into managed code, that code can push itself onto the virtual machine stack and then use this - /// method to instruct the calling function context to use the result of the virtual machine stack successor instead. (The return value of the managed code is discarded) - /// - internal void _UseVirtualMachineStackInstead() - { - _useVirtualStackInstead = true; - _fetchReturnValue = true; - } - /// /// Implementation of . /// diff --git a/PrexoniteTests/Tests/ThunkTests.cs b/PrexoniteTests/Tests/ThunkTests.cs index 291152c0..e4031825 100644 --- a/PrexoniteTests/Tests/ThunkTests.cs +++ b/PrexoniteTests/Tests/ThunkTests.cs @@ -1,16 +1,13 @@ using System.Collections.Generic; using NUnit.Framework; using Prexonite; +using Prexonite.Commands.Lazy; +using Prexonite.Types; namespace PrexoniteTests.Tests; public abstract class ThunkTests : VMTestsBase { - protected ThunkTests() - { - CompileToCil = false; - } - [Test] public void SingularThunk() { @@ -146,6 +143,54 @@ function main(value) Expect(new List { true, 42, false, true, 42, true }, 42); } + [Test] + public void ThunkMemoizesItsValue() + { + Compile( + """ + + function main() + { + var calls = 0; + var value = thunk(() => { calls++; return 42; }); + return [value.evaluated,value.force,value.evaluated,value.force,calls]; + } + + """ + ); + + Expect(new List { false, 42, true, 42, 1 }); + } + + [Test] + public void ThunkMemoizesExceptions() + { + var calls = 0; + var expected = new InvalidOperationException("Expected failure."); + var expression = new PValue( + new ProvidedFunction( + (_, _) => + { + calls++; + throw expected; + } + ), + PType.Object[typeof(IIndirectCall)] + ); + var thunk = Thunk.NewExpression(expression, []); + + Assert.That( + Assert.Throws(() => thunk.Force(sctx)), + Is.SameAs(expected) + ); + Assert.That( + Assert.Throws(() => thunk.Force(sctx)), + Is.SameAs(expected) + ); + Assert.That(calls, Is.EqualTo(1)); + Assert.That(thunk.IsEvaluated, Is.False); + } + [Test] public void RemovedKeywordsAreOrdinaryIdentifiers() { @@ -165,4 +210,14 @@ function main(value) Expect(42, 42); } + + sealed class ProvidedFunction(ProvidedFunctionImpl function) : IIndirectCall + { + public PValue IndirectCall(StackContext sctx, params ReadOnlySpan args) + { + return function(sctx, args); + } + } + + delegate PValue ProvidedFunctionImpl(StackContext sctx, ReadOnlySpan args); } diff --git a/Prx/Program.cs b/Prx/Program.cs index 21c14f21..d5c6e0f4 100644 --- a/Prx/Program.cs +++ b/Prx/Program.cs @@ -181,7 +181,7 @@ out f f = (PFunction)carg.Value!; rctx = f.CreateFunctionContext(e, rargs); } - else if (clrType == typeof(Closure) && clrType != typeof(Continuation)) + else if (clrType == typeof(Closure)) { var c = (Closure)carg.Value!; rctx = c.CreateFunctionContext(sctx, rargs);