From d06c1a93f9c7a5e4d296b6ecebd5d64f61945b42 Mon Sep 17 00:00:00 2001
From: ProgramSnail <purpurebacterium@yandex.ru>
Date: Tue, 21 Oct 2025 16:45:45 +0300
Subject: [PATCH] structural rec comparasion, syntesis step parts, no
 deduplication & tests

---
 escher.hs | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

diff --git a/escher.hs b/escher.hs
index f2962ae..fb24172 100644
--- a/escher.hs
+++ b/escher.hs
@@ -1,4 +1,4 @@
-import Control.Monad (guard, liftM, when, foldM)
+import Control.Monad (guard, liftM, when, foldM, foldM_)
 import Control.Applicative
 import Control.Monad.State as State
 import Data.Map (Map)
@@ -105,6 +105,14 @@ isInt = (== IntT) . typeOf
 isList = (== ListT) . typeOf
 isTree = (== TreeT) . typeOf
 
+-- TODO: check
+structuralLess :: Value -> Value -> Bool
+structuralLess (BoolV left) (BoolV right) = left < right
+structuralLess (IntV left) (IntV right) = left < right && left > 0 -- ??
+structuralLess (ListV left) (ListV right) = left < right
+structuralLess (TreeV left) (TreeV right) = left < right
+structuralLess _ _ = False
+
 eval :: Conf -> Expr -> Result Value
 eval conf (left :&&: right) = do BoolV leftB <- eval conf left
                                  BoolV rightB <- eval conf right
@@ -159,7 +167,7 @@ eval conf (CreateLeafE e) = do v <- eval conf e
 eval conf (IfE {ifCond, ifDoThen, ifDoElse}) = do BoolV condB <- eval conf ifCond
                                                   if condB then eval conf ifDoThen else eval conf ifDoElse
 eval conf (SelfE e) = do ListV newInput <- eval conf e
-                         guard $ length newInput < length (confInput conf)
+                         guard $ and $ zipWith structuralLess newInput (confInput conf) -- ??
                          if newInput `notElem` confExamples conf then
                            (case confOracle conf newInput of
                              Just expectedV -> NewExamples [(newInput, expectedV)]
@@ -268,8 +276,8 @@ splitGoalStep goal selector = do st <- get
                                           syntResolvers = r : syntResolvers st }
 
 -- TODO: use expr evaluated outputs ?
-trySolveGoal :: Goal -> Expr -> SyntState Bool
-trySolveGoal goal expr = do st <- get
+trySolveGoal :: Expr -> Goal -> SyntState Bool
+trySolveGoal expr goal = do st <- get
                             if matchGoal goal st expr then do
                               put st { syntSolvedGoals = Map.insert goal expr $ syntSolvedGoals st,
                                        syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st }
@@ -403,6 +411,9 @@ createSynt oracle goals = let root = Goal $ map (Just . snd) goals in
 initSynt :: Oracle -> [([Value], Value)] -> SyntState ()
 initSynt oracle goals = put $ createSynt oracle goals
 
+calcExprOutputs :: Expr -> SyntState [Result Value]
+calcExprOutputs expr = gets (\st -> map (\input -> eval (confBySynt input expr st) expr) $ syntExamples st)
+
 stepOnAddedExpr :: Expr -> SyntState (Maybe Expr)
 stepOnAddedExpr expr = do exFound <- saturateStep expr
                           st <- get
@@ -410,8 +421,9 @@ stepOnAddedExpr expr = do exFound <- saturateStep expr
                              maybeResult <- terminateStep expr
                              if isJust maybeResult then return maybeResult else do
                                let exprOutputs = map (\input -> eval (confBySynt input expr st) expr) $ syntExamples st
-                               -- TODO: solve existing goals
-                               -- TODO: resolve existing goals
+                               -- TODO: remove copies
+                               gets (foldM_ (const $ trySolveGoal expr) False . syntUnsolvedGoals) -- solve existing goals
+                               gets (foldM_ (const tryResolve) False . syntResolvers)-- resolve existing goals
                                put $ foldl (splitGoalsFold exprOutputs) st $ Set.toList $ syntUnsolvedGoals st
                                return Nothing
   where splitGoalsFold outputs st goal@(Goal expected) = let matches = zipWith matchResult outputs expected in