Fixes list and name lookup bugs
This commit is contained in:
@ -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
|
||||
|
19
src/Eval.hs
19
src/Eval.hs
@ -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
|
||||
|
@ -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
|
||||
|
Reference in New Issue
Block a user