st/prog_synthesis
1
0
Fork 0
mirror of https://codeberg.org/ProgramSnail/prog_synthesis.git synced 2025-12-05 21:18:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

structural rec comparasion, syntesis step parts, no deduplication & tests

Browse source
This commit is contained in:
ProgramSnail 2025-10-21 16:45:45 +03:00
parent 372d38d813
commit d06c1a93f9
1 changed files with 18 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

24
escher.hs
View file

@ -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