st/prog_synthesis
1
0
Fork 0
mirror of https://codeberg.org/ProgramSnail/prog_synthesis.git synced 2025-12-07 05:58:43 +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

4
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,6 +54,8 @@ 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
typeConf <- gets $ oracleTypes . syntOracle
if isNothing $ checkType typeConf expr then return Nothing else do
outputs <- calcExprOutputs expr outputs <- calcExprOutputs expr
matchedExisting <- gets $ evalState (matchAnyOutputs outputs) matchedExisting <- gets $ evalState (matchAnyOutputs outputs)
-- TODO: all RecErrors example could be useful on future cases ? -- TODO: all RecErrors example could be useful on future cases ?

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