From 614f4b2dc921c8bad392a28c38af24a02a3e1acc Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Fri, 15 Mar 2024 09:11:26 +0100 Subject: [PATCH] 'reset' for delimited continuations --- src/compiler/api/GF/Compile/Compute/Concrete.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/compiler/api/GF/Compile/Compute/Concrete.hs b/src/compiler/api/GF/Compile/Compute/Concrete.hs index f97c086a2..9235fb81f 100644 --- a/src/compiler/api/GF/Compile/Compute/Concrete.hs +++ b/src/compiler/api/GF/Compile/Compute/Concrete.hs @@ -6,7 +6,7 @@ module GF.Compile.Compute.Concrete ( normalForm, normalStringForm , Value(..), Thunk, ThunkState(..), Env, Scope, showValue , MetaThunks, Constraint, Globals(..), ConstValue(..) - , EvalM(..), runEvalM, runEvalOneM, evalError, evalWarn + , EvalM(..), runEvalM, runEvalOneM, reset, evalError, evalWarn , eval, apply, force, value2term, patternMatch, stdPredef , unsafeIOToEvalM , newThunk, newEvaluatedThunk @@ -755,6 +755,13 @@ runEvalOneM gr f = Check $ \(es,ws) -> Success [] ws -> Fail (pp "The evaluation produced no results") (es,ws) Success (x:_) ws -> Success x (es,ws) +reset :: EvalM s a -> EvalM s [a] +reset (EvalM f) = EvalM $ \gl k mt d r ws -> do + res <- f gl (\x mt d xs ws -> return (Success (x:xs) ws)) mt d [] ws + case res of + Fail msg ws -> return (Fail msg ws) + Success xs ws -> k (reverse xs) mt d r ws + evalError :: Message -> EvalM s a evalError msg = EvalM (\gr k _ _ r msgs -> return (Fail msg msgs))