Fixes list and name lookup bugs

This commit is contained in:
2025-05-26 17:40:06 -05:00
parent 6780b242b1
commit b96a3f2ef0
3 changed files with 19 additions and 9 deletions

View File

@ -127,7 +127,9 @@ hashToTerm conn hashText =
nameToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
nameToTerm conn nameText =
queryMaybeOne conn (selectStoredTermFields <> " WHERE names = ? ORDER BY created_at DESC LIMIT 1") (Only nameText)
queryMaybeOne conn
(selectStoredTermFields <> " WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC LIMIT 1")
(nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)
listStoredTerms :: Connection -> IO [StoredTerm]
listStoredTerms conn =
@ -172,8 +174,8 @@ termVersions :: Connection -> String -> IO [(Text, T, Integer)]
termVersions conn name = do
let nameText = T.pack name
results <- query conn
"SELECT hash, term_data, created_at FROM terms WHERE names = ? ORDER BY created_at DESC"
(Only nameText)
("SELECT hash, term_data, created_at FROM terms WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC")
(nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)
catMaybes <$> mapM (\(hashVal, termDataVal, timestamp) -> do
maybeT <- tryDeserializeTerm termDataVal

View File

@ -137,6 +137,7 @@ elimLambda = go
| lambdaList term = elimLambda $ lambdaListResult term
| nestedLambda term = nestedLambdaResult term
| application term = applicationResult term
| isSList term = slistTransform term
| otherwise = term
etaReduction (SLambda [v] (SApp f (SVar x Nothing))) = v == x && not (isFree v f)
@ -157,18 +158,26 @@ elimLambda = go
nestedLambda (SLambda (_:_) _) = True
nestedLambda _ = False
nestedLambdaResult (SLambda (v:vs) body)
| null vs = toSKI v (elimLambda body)
| otherwise = elimLambda (SLambda [v] (SLambda vs body))
| null vs = toSKI v (go body) -- Changed elimLambda to go
| otherwise = go (SLambda [v] (SLambda vs body)) -- Changed elimLambda to go
application (SApp _ _) = True
application _ = False
applicationResult (SApp f g) = SApp (elimLambda f) (elimLambda g)
applicationResult (SApp f g) = SApp (go f) (go g) -- Changed elimLambda to go
isSList (SList _) = True
isSList _ = False
slistTransform :: TricuAST -> TricuAST
slistTransform (SList xs) = foldr (\m r -> SApp (SApp TLeaf (go m)) r) TLeaf xs
slistTransform ast = ast -- Should not be reached if isSList is the guard
toSKI x (SVar y Nothing)
| x == y = _I
| otherwise = SApp _K (SVar y Nothing)
toSKI x (SApp m n) = SApp (SApp _S (toSKI x m)) (toSKI x n)
toSKI x (SLambda [y] body) = toSKI x (toSKI y body)
toSKI x (SLambda [y] body) = toSKI x (toSKI y body) -- This should ideally not happen if lambdas are fully eliminated first
toSKI _ sl@(SList _) = SApp _K (go sl) -- Ensure SList itself is transformed if somehow passed to toSKI directly
toSKI _ term = SApp _K term
_S = parseSingle "t (t (t t t)) t"
@ -178,7 +187,7 @@ elimLambda = go
_TRI = parseSingle "t (t (t t (t (t (t t t))))) t"
triageBody a b c = SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a Nothing)) (SVar b Nothing))) (SVar c Nothing)
composeBody f g x = SApp (SVar f Nothing) (SVar g Nothing)
composeBody f g x = SApp (SVar f Nothing) (SVar g Nothing) -- Note: This might not be the standard B combinator body f(g x)
isFree :: String -> TricuAST -> Bool
isFree x = Set.member x . freeVars

View File

@ -65,7 +65,6 @@ main = do
Repl -> do
putStrLn "Welcome to the tricu REPL"
putStrLn "You may exit with `CTRL+D` or the `!exit` command."
putStrLn "Try typing `!` with tab completion for more commands."
repl
Evaluate { file = filePaths, form = form } -> do
result <- case filePaths of