From e8524a170f17cb1769cf1e459134d7203ed7fbe5 Mon Sep 17 00:00:00 2001 From: ProgramSnail Date: Sun, 26 Oct 2025 23:29:03 +0300 Subject: [PATCH] fix wrong gets usage, caching will require more changes --- escher.hs | 43 +++++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 16 deletions(-) diff --git a/escher.hs b/escher.hs index 617fb7e..38a7ad3 100644 --- a/escher.hs +++ b/escher.hs @@ -8,6 +8,8 @@ import qualified Data.Set as Set import Data.List (inits) import Data.Maybe (fromMaybe, isJust, maybeToList) +import Debug.Trace (trace) + data Value = BoolV Bool | IntV Int | ListV [Value] @@ -347,9 +349,12 @@ splitGoalStep goal selector = do let r = splitGoal goal selector trySolveGoal :: Expr -> Goal -> SyntState Bool trySolveGoal expr goal = do doesMatch <- gets $ matchGoal goal expr if doesMatch then do - modify $ \st -> st { syntSolvedGoals = Map.insert goal expr $ syntSolvedGoals st, - syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st } + modify $ \st -> st { syntSolvedGoals = Map.insert goal expr $ syntSolvedGoals st --, + -- syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st + } return True + -- trace ("goal solved: " ++ show goal) -- TODO: trace + -- return True else return False isGoalSolved :: Goal -> SyntState Bool @@ -362,14 +367,16 @@ goalSolution goal = gets (Map.lookup goal . syntSolvedGoals) -- returns found expr -- NOTE: goals expected to be resolved resolveStep :: (Expr, Expr, Expr) -> Resolver -> SyntState Expr +-- resolveStep r _ | trace ("resolution: " ++ show r) False = undefined -- TODO: trace resolveStep (ifCond, ifDoThen, ifDoElse) r = do let expr = IfE { ifCond, ifDoThen, ifDoElse } let goal = resolverGoal r modify $ \st -> st { syntSolvedGoals = Map.insert goal expr $ syntSolvedGoals st, - syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st, + -- syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st, syntExprs = (expr, []) : syntExprs st } return expr tryResolve :: Resolver -> SyntState (Maybe Expr) +-- tryResolve r | trace ("try resolution: " ++ show r) False = undefined -- TODO tryResolve r = do condSol <- goalSolution $ resolverCond r thenSol <- goalSolution $ resolverThen r elseSol <- goalSolution $ resolverElse r @@ -388,11 +395,12 @@ remakeSynt newInputs newOutputs = do st <- get modify (\st' -> st' { syntExprs = syntExprs st }) -- clear goal tree up to root, add example, calculate exprs on input (could be recursive ?) -saturateStep :: Expr -> SyntState Bool +-- returns new example +saturateStep :: Expr -> SyntState [[Value]] saturateStep expr = do (newInputs, newOutputs) <- gets $ \st -> unzip $ foldl (searchEx st) [] (syntExamples st) - let isExFound = not $ null newInputs - when isExFound $ remakeSynt newInputs newOutputs - return isExFound + let exFound = not . null $ newInputs + when exFound $ remakeSynt newInputs newOutputs + return newInputs where searchEx st [] input = case eval (confBySynt input expr st) expr of NewExamples exs -> exs _ -> [] @@ -484,11 +492,10 @@ initSynt :: Oracle -> [([Value], Value)] -> SyntState () initSynt oracle goals = put $ createSynt oracle goals stepOnAddedExpr :: Expr -> SyntState (Maybe Expr) -stepOnAddedExpr expr = do exFound <- saturateStep expr - - if exFound - then do -- redo prev exprs (including current) +stepOnAddedExpr expr = do newEx <- saturateStep expr + if not . null $ newEx then do -- redo prev exprs (including current) st <- get + -- trace ("exFound: " ++ show newEx) $ -- TODO: trace stepOnAddedExprs $ map fst $ syntExprs st else do -- try resolve goals & resolvers, generate new resolvers maybeResult <- terminateStep expr @@ -496,16 +503,20 @@ stepOnAddedExpr expr = do exFound <- saturateStep expr exprOutputs <- calcExprOutputs expr -- NOTE: now done in fowardStep -- when (foldl (compareExprOutputs exprOutputs) True $ map fst $ syntExprs st) $ modify $ \st -> st { syntExprs = tail $ syntExprs st } - gets (foldM_ (const $ trySolveGoal expr) False . syntUnsolvedGoals) -- solve existing goals - gets (foldM_ (const tryResolve) Nothing . syntResolvers) -- resolve existing goals + unsolvedGoals <- gets syntUnsolvedGoals + foldM_ (const $ trySolveGoal expr) False unsolvedGoals -- solve existing goals + resolvers <- gets syntResolvers + foldM_ (const tryResolve) Nothing resolvers -- resolve existing goals modify $ \st -> foldl (splitGoalsFold expr exprOutputs) st $ Set.toList $ syntUnsolvedGoals st - return Nothing + gets $ \st -> syntRoot st `Map.lookup` syntSolvedGoals st where splitGoalsFold expr outputs st goal@(Goal expected) = let matches = zipWith matchResult outputs expected in if not $ any (fromMaybe False) matches then st else let matchesBool = map (fromMaybe True) matches in execState (do r <- splitGoalStep goal matchesBool - gets (foldM_ (const $ flip trySolveGoal $ resolverCond r) False . map fst . syntExprs) - gets (foldM_ (const $ flip trySolveGoal $ resolverElse r) False . map fst . syntExprs) + exprs <- gets syntExprs + foldM_ (const $ flip trySolveGoal $ resolverCond r) False $ map fst exprs + exprs <- gets syntExprs + foldM_ (const $ flip trySolveGoal $ resolverElse r) False $ map fst exprs -- TODO: replace with always solve goal trySolveGoal expr (resolverThen r)) st matchResult :: Result Value -> Maybe Value -> Maybe Bool -- Nothing for unimportant matches marked as Nothing