mirror of
https://codeberg.org/ProgramSnail/prog_synthesis.git
synced 2025-12-06 05:28:42 +00:00
new saturate step archetecture: call saturate only at the end, speedup
This commit is contained in:
ProgramSnail
parent
15cbf78ed5
commit
75dafdab5e
3 changed files with 73 additions and 43 deletions
100
escher/Main.hs
100
escher/Main.hs
|
|
@ -14,16 +14,22 @@ import Data.Maybe (fromMaybe, isJust, maybeToList, isNothing)
|
|||
|
||||
import Debug.Trace (trace)
|
||||
import TypeCheck
|
||||
import qualified Data.List as List
|
||||
|
||||
|
||||
syntEval :: [Value] -> Expr -> SyntState (Result Value)
|
||||
syntEval input expr = do cache <- gets syntCache
|
||||
conf <- gets $ confBySynt input expr
|
||||
conf <- gets $ confBySynt input expr False
|
||||
return $ eval conf expr
|
||||
|
||||
syntEvalEx :: [Value] -> Expr -> SyntState (Result Value)
|
||||
syntEvalEx input expr = do cache <- gets syntCache
|
||||
conf <- gets $ confBySynt input expr True
|
||||
return $ eval conf expr
|
||||
|
||||
syntCacheEval :: [Value] -> Expr -> SyntState (Result Value)
|
||||
syntCacheEval input expr = do cache <- gets syntCache
|
||||
conf <- gets $ confBySynt input expr
|
||||
conf <- gets $ confBySynt input expr False
|
||||
let (result, cache') = cachedEval cache conf expr
|
||||
modify $ \st -> st {syntCache = cache'}
|
||||
return result
|
||||
|
|
@ -44,7 +50,7 @@ matchGoal (Goal goal) expr = do examples <- gets syntExamples
|
|||
|
||||
calcExprOutputs :: Expr -> SyntState [Result Value]
|
||||
calcExprOutputs expr = do examples <- gets syntExamples
|
||||
mapM (`syntEval` expr) examples
|
||||
mapM (`syntEval` expr) examples -- OR: syntCacheEval (slower?)
|
||||
|
||||
calcTemporaryExprOutputs :: Expr -> SyntState [Result Value]
|
||||
calcTemporaryExprOutputs expr = do examples <- gets syntExamples
|
||||
|
|
@ -88,7 +94,10 @@ splitGoal resolverGoal@(Goal outputs) selector | length outputs == length select
|
|||
splitGoalStep :: Goal -> [Bool] -> SyntState Resolver
|
||||
splitGoalStep goal selector = do let r = splitGoal goal selector
|
||||
resolvers <- gets syntResolvers
|
||||
unless (r `elem` resolvers) $ -- do not add existing resolvers -- do not add existing resolvers
|
||||
unless (r `elem` resolvers) $ -- do not add existing resolvers -- do not add existing resolvers -- do not add existing resolvers -- do not add existing resolvers
|
||||
-- do not add existing resolvers
|
||||
-- do not add existing resolvers
|
||||
-- do not add existing resolvers -- do not add existing resolvers
|
||||
-- do not add existing resolvers
|
||||
modify $ \st -> st { syntUnsolvedGoals = Set.insert (resolverCond r) $
|
||||
Set.insert (resolverThen r) $
|
||||
|
|
@ -153,38 +162,54 @@ saturateStep expr = do examples <- gets syntExamples
|
|||
let exFound = not . null $ newInputs
|
||||
when exFound $ remakeSynt newInputs newOutputs
|
||||
return newInputs
|
||||
where searchEx [] input = do output <- syntEval input expr
|
||||
return $ case output of
|
||||
NewExamples exs -> exs
|
||||
_ -> []
|
||||
searchEx exs _ = return exs
|
||||
where searchEx prevExs input = do output <- syntEvalEx input expr
|
||||
return $ List.union prevExs $ case output of -- union ??
|
||||
NewExamples exs -> exs
|
||||
_ -> []
|
||||
|
||||
-- try to find terminating expr
|
||||
terminateStep :: Expr -> SyntState (Maybe Expr)
|
||||
terminateStep expr = do rootGoal <- gets syntRoot
|
||||
gets $ Map.lookup rootGoal . syntSolvedGoals
|
||||
-- NOTE: Goal should be already solved earlier
|
||||
-- doesMatch <- matchGoal rootGoal expr
|
||||
-- return $ if doesMatch then Just expr else Nothing
|
||||
terminateStep :: SyntState (Maybe Expr)
|
||||
terminateStep = do rootGoal <- gets syntRoot
|
||||
-- TODO: move try solve goal there ??
|
||||
gets $ Map.lookup rootGoal . syntSolvedGoals
|
||||
-- NOTE: Goal should be already solved earlier
|
||||
-- doesMatch <- matchGoal rootGoal expr
|
||||
-- return $ if doesMatch then Just expr else Nothing
|
||||
|
||||
-- TODO: FIXME
|
||||
tryTerminate :: Expr -> SyntState (Maybe Expr)
|
||||
tryTerminate expr = do maybeResult <- terminateStep
|
||||
if isJust maybeResult
|
||||
then do
|
||||
newEx <- saturateStep expr
|
||||
if not . null $ newEx
|
||||
then do
|
||||
-- redo prev exprs (including current)
|
||||
st <- get
|
||||
trace ("Reboot on new examples: " ++ show newEx) $
|
||||
stepOnAddedExprs $ map fst $ syntExprs st
|
||||
else return maybeResult
|
||||
else return Nothing
|
||||
|
||||
stepOnAddedExpr :: Expr -> SyntState (Maybe Expr)
|
||||
stepOnAddedExpr expr = do newEx <- saturateStep expr
|
||||
if not . null $ newEx then do -- redo prev exprs (including current)
|
||||
st <- get
|
||||
-- trace ("exFound: " ++ show newEx) $ -- TMP: trace
|
||||
stepOnAddedExprs $ map fst $ syntExprs st
|
||||
else do -- try resolve goals & resolvers, generate new resolvers
|
||||
maybeResult <- terminateStep expr
|
||||
if isJust maybeResult then return maybeResult else do
|
||||
exprOutputs <- calcExprOutputs expr
|
||||
-- NOTE: now done in fowardStep
|
||||
-- when (foldl (compareExprOutputs exprOutputs) True $ map fst $ syntExprs st) $ modify $ \st -> st { syntExprs = tail $ syntExprs st }
|
||||
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 [syntRoot st] -- TODO: use Set.toList $ syntUnsolvedGoals st ?
|
||||
gets $ \st -> syntRoot st `Map.lookup` syntSolvedGoals st
|
||||
stepOnAddedExpr expr = do rootGoal <- gets syntRoot
|
||||
trySolveGoal expr rootGoal
|
||||
maybeResult <- tryTerminate expr
|
||||
if isJust maybeResult
|
||||
then return maybeResult
|
||||
else do
|
||||
-- try resolve goals & resolvers, generate new resolvers
|
||||
exprOutputs <- calcExprOutputs expr
|
||||
-- NOTE: now done in fowardStep
|
||||
-- when (foldl (compareExprOutputs exprOutputs) True $ map fst $ syntExprs st) $ modify $ \st -> st { syntExprs = tail $ syntExprs st }
|
||||
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 [syntRoot st] -- TODO: use Set.toList $ syntUnsolvedGoals st ?
|
||||
tryTerminate expr
|
||||
-- NOTE: replaced by tryTerminate
|
||||
-- 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
|
||||
|
|
@ -253,7 +278,7 @@ mainExamples = [[ListV [IntV 1, IntV 2, IntV 3]]]
|
|||
|
||||
allExamples :: [[Value]]
|
||||
-- allExamples = [[ListV [IntV 2, IntV 3]], [ListV [IntV 3]], [ListV []]]
|
||||
allExamples = [[ListV [IntV 1, IntV 2, IntV 3]], [ListV [IntV 2, IntV 3]], [ListV [IntV 3]], [ListV []]]
|
||||
allExamples = [[ListV [IntV 0, IntV 1, IntV 2, IntV 3]], [ListV [IntV 2, IntV 3]], [ListV [IntV 3]], [ListV []]]
|
||||
|
||||
listOracleOf :: OracleFunc -> Type -> Oracle
|
||||
listOracleOf f t = Oracle { oracleTypes = TypeConf { typeConfInput = [ListT IntT],
|
||||
|
|
@ -275,7 +300,8 @@ reverseExpr = IfE { ifCond = IsEmptyE (InputE 0),
|
|||
reverseConf :: Conf
|
||||
reverseConf = Conf { confInput = head allExamples,
|
||||
confOracle = listOracleOf reverseOracle $ ListT IntT,
|
||||
confExamples = allExamples }
|
||||
confExamples = allExamples,
|
||||
confTryFindExamples = True }
|
||||
|
||||
--- stutter
|
||||
|
||||
|
|
@ -293,7 +319,8 @@ stutterExpr = IfE { ifCond = IsEmptyE (InputE 0),
|
|||
stutterConf :: Conf
|
||||
stutterConf = Conf { confInput = head allExamples,
|
||||
confOracle = listOracleOf stutterOracle $ ListT IntT,
|
||||
confExamples = allExamples }
|
||||
confExamples = allExamples,
|
||||
confTryFindExamples = True }
|
||||
|
||||
--- length
|
||||
|
||||
|
|
@ -309,7 +336,8 @@ lengthExpr = IfE { ifCond = IsEmptyE (InputE 0),
|
|||
lengthConf :: Conf
|
||||
lengthConf = Conf { confInput = head allExamples,
|
||||
confOracle = listOracleOf lengthOracle IntT,
|
||||
confExamples = allExamples }
|
||||
confExamples = allExamples,
|
||||
confTryFindExamples = True }
|
||||
|
||||
---
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue