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