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

@@ -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