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

empty list type check fix, add typecheck to forward step (no tests yet)

Browse source
This commit is contained in:
ProgramSnail 2025-11-05 02:36:33 +03:00
parent edc6c373b0
commit 753ca23cbc
2 changed files with 23 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

16
escher/Main.hs
View file

@ -10,7 +10,7 @@ import Data.Set (Set)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.List (inits) import Data.List (inits)
import Data.Maybe (fromMaybe, isJust, maybeToList) import Data.Maybe (fromMaybe, isJust, maybeToList, isNothing)
import Debug.Trace (trace) import Debug.Trace (trace)
import TypeCheck import TypeCheck
@ -54,12 +54,14 @@ matchAnyOutputs outputs = do exprs <- gets syntExprs
-- generate next step of exprs, remove copies -- generate next step of exprs, remove copies
forwardStep :: Expr -> [Expr] -> SyntState (Maybe Expr) forwardStep :: Expr -> [Expr] -> SyntState (Maybe Expr)
forwardStep comp args = do let expr = fillHoles comp args forwardStep comp args = do let expr = fillHoles comp args
outputs <- calcExprOutputs expr typeConf <- gets $ oracleTypes . syntOracle
matchedExisting <- gets $ evalState (matchAnyOutputs outputs) if isNothing $ checkType typeConf expr then return Nothing else do
-- TODO: all RecErrors example could be useful on future cases ? outputs <- calcExprOutputs expr
if any isFatalError outputs || all isRecError outputs || matchedExisting then return Nothing else do matchedExisting <- gets $ evalState (matchAnyOutputs outputs)
modify $ \st -> st { syntExprs = (expr, []) : syntExprs st} -- TODO: all RecErrors example could be useful on future cases ?
return $ Just expr if any isFatalError outputs || all isRecError outputs || matchedExisting then return Nothing else do
modify $ \st -> st { syntExprs = (expr, []) : syntExprs st}
return $ Just expr
splitGoal :: Goal -> [Bool] -> Resolver splitGoal :: Goal -> [Bool] -> Resolver
splitGoal resolverGoal@(Goal outputs) selector | length outputs == length selector = splitGoal resolverGoal@(Goal outputs) selector | length outputs == length selector =

19
escher/TypeCheck.hs
View file

@ -18,6 +18,11 @@ isList x | ListT {} <- typeOf x = True
isTree x | TreeT {} <- typeOf x = True isTree x | TreeT {} <- typeOf x = True
| otherwise = False | otherwise = False
simpleUnify :: Type -> Type -> Maybe Type
simpleUnify AnyT u = Just u
simpleUnify t AnyT = Just t
simpleUnify _ _ = Nothing
checkType :: TypeConf -> Expr -> Maybe Type checkType :: TypeConf -> Expr -> Maybe Type
checkType conf (left :&&: right) = do BoolT <- checkType conf left checkType conf (left :&&: right) = do BoolT <- checkType conf left
BoolT <- checkType conf right BoolT <- checkType conf right
@ -49,18 +54,22 @@ checkType conf ZeroE = return IntT
checkType conf (Div2E e) = do IntT <- checkType conf e checkType conf (Div2E e) = do IntT <- checkType conf e
return IntT return IntT
checkType conf (TailE e) = do ListT t <- checkType conf e checkType conf (TailE e) = do ListT t <- checkType conf e
guard $ t /= AnyT -- NOTE: can't take tail from list that is provem empty (?)
-- TODO: check that AnyT is only for empty list & no bad consequences
return $ ListT t return $ ListT t
checkType conf (HeadE e) = do ListT t <- checkType conf e checkType conf (HeadE e) = do ListT t <- checkType conf e
guard $ t /= AnyT -- NOTE: can't take elem from list that is provem empty (?)
-- TODO: check that AnyT is only for empty list & no bad consequences
return t return t
checkType conf (left :++: right) = do ListT t <- checkType conf left checkType conf (left :++: right) = do ListT t <- checkType conf left
ListT u <- checkType conf right ListT u <- checkType conf right
guard $ t == u w <- simpleUnify t u
return $ ListT t return $ ListT w
checkType conf (left ::: right) = do t <- checkType conf left checkType conf (left ::: right) = do t <- checkType conf left
ListT u <- checkType conf right ListT u <- checkType conf right
guard $ t == u w <- simpleUnify t u
return $ ListT t return $ ListT w
checkType conf EmptyListE = return $ ListT AnyT -- TODO FIXME: deal with AnyT checkType conf EmptyListE = return $ ListT AnyT -- NOTE: ListT AnyT - type of generic empty list
checkType conf (IsLeafE e) = do TreeT _ <- checkType conf e checkType conf (IsLeafE e) = do TreeT _ <- checkType conf e
return BoolT return BoolT
checkType conf (TreeValE e) = do TreeT t <- checkType conf e checkType conf (TreeValE e) = do TreeT t <- checkType conf e