mirror of
https://codeberg.org/ProgramSnail/prog_synthesis.git
synced 2025-12-06 21:48:43 +00:00
structural rec comparasion, syntesis step parts, no deduplication & tests
This commit is contained in:
parent
372d38d813
commit
d06c1a93f9
1 changed files with 18 additions and 6 deletions
24
escher.hs
24
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.Applicative
|
||||||
import Control.Monad.State as State
|
import Control.Monad.State as State
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
|
|
@ -105,6 +105,14 @@ isInt = (== IntT) . typeOf
|
||||||
isList = (== ListT) . typeOf
|
isList = (== ListT) . typeOf
|
||||||
isTree = (== TreeT) . 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 -> Expr -> Result Value
|
||||||
eval conf (left :&&: right) = do BoolV leftB <- eval conf left
|
eval conf (left :&&: right) = do BoolV leftB <- eval conf left
|
||||||
BoolV rightB <- eval conf right
|
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
|
eval conf (IfE {ifCond, ifDoThen, ifDoElse}) = do BoolV condB <- eval conf ifCond
|
||||||
if condB then eval conf ifDoThen else eval conf ifDoElse
|
if condB then eval conf ifDoThen else eval conf ifDoElse
|
||||||
eval conf (SelfE e) = do ListV newInput <- eval conf e
|
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
|
if newInput `notElem` confExamples conf then
|
||||||
(case confOracle conf newInput of
|
(case confOracle conf newInput of
|
||||||
Just expectedV -> NewExamples [(newInput, expectedV)]
|
Just expectedV -> NewExamples [(newInput, expectedV)]
|
||||||
|
|
@ -268,8 +276,8 @@ splitGoalStep goal selector = do st <- get
|
||||||
syntResolvers = r : syntResolvers st }
|
syntResolvers = r : syntResolvers st }
|
||||||
|
|
||||||
-- TODO: use expr evaluated outputs ?
|
-- TODO: use expr evaluated outputs ?
|
||||||
trySolveGoal :: Goal -> Expr -> SyntState Bool
|
trySolveGoal :: Expr -> Goal -> SyntState Bool
|
||||||
trySolveGoal goal expr = do st <- get
|
trySolveGoal expr goal = do st <- get
|
||||||
if matchGoal goal st expr then do
|
if matchGoal goal st expr then do
|
||||||
put st { syntSolvedGoals = Map.insert goal expr $ syntSolvedGoals st,
|
put st { syntSolvedGoals = Map.insert goal expr $ syntSolvedGoals st,
|
||||||
syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals 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 -> [([Value], Value)] -> SyntState ()
|
||||||
initSynt oracle goals = put $ createSynt oracle goals
|
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 -> SyntState (Maybe Expr)
|
||||||
stepOnAddedExpr expr = do exFound <- saturateStep expr
|
stepOnAddedExpr expr = do exFound <- saturateStep expr
|
||||||
st <- get
|
st <- get
|
||||||
|
|
@ -410,8 +421,9 @@ stepOnAddedExpr expr = do exFound <- saturateStep expr
|
||||||
maybeResult <- terminateStep expr
|
maybeResult <- terminateStep expr
|
||||||
if isJust maybeResult then return maybeResult else do
|
if isJust maybeResult then return maybeResult else do
|
||||||
let exprOutputs = map (\input -> eval (confBySynt input expr st) expr) $ syntExamples st
|
let exprOutputs = map (\input -> eval (confBySynt input expr st) expr) $ syntExamples st
|
||||||
-- TODO: solve existing goals
|
-- TODO: remove copies
|
||||||
-- TODO: resolve existing goals
|
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
|
put $ foldl (splitGoalsFold exprOutputs) st $ Set.toList $ syntUnsolvedGoals st
|
||||||
return Nothing
|
return Nothing
|
||||||
where splitGoalsFold outputs st goal@(Goal expected) = let matches = zipWith matchResult outputs expected in
|
where splitGoalsFold outputs st goal@(Goal expected) = let matches = zipWith matchResult outputs expected in
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue