James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Explicit local bindings for let/where

Browse Source
This commit is contained in:
James Eversole
2026-07-08 10:27:42 -05:00
parent c6c1ef1fe1
commit 34aee3bf93
6 changed files with 60 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/Eval.hs
View File

@@ -75,6 +75,7 @@ evalTricu env x = go env (reorderDefs env (map recoverParams x))
evalASTSync :: Env -> TricuAST -> T
evalASTSync env term = case term of
SLambda _ _ -> evalASTSync env (elimLambda term)
SLet name val body -> evalASTSync env (SApp (SLambda [name] body) val)
SVar name Nothing -> case Map.lookup name env of
Just v -> v
Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
@@ -108,6 +109,7 @@ annotatedBinders (DefPhantom _ : rest) = annotatedBinders rest
elimLambda :: TricuAST -> TricuAST
elimLambda = go
where
go (SLet name val body) = go (SApp (SLambda [name] body) val)
go term
| etaReduction term = go (etaReduceResult term)
| triagePattern term = _TRI
@@ -190,6 +192,8 @@ freeVars (SVar v Nothing) = Set.singleton v
freeVars (SVar v (Just _)) = Set.singleton v
freeVars (SApp t u) = Set.union (freeVars t) (freeVars u)
freeVars (SLambda vs body) = Set.difference (freeVars body) (Set.fromList vs)
freeVars (SLet name val body) =
Set.union (freeVars val) (Set.delete name (freeVars body))
freeVars (SDef _ params body) = Set.difference (freeVars body) (Set.fromList params)
freeVars (SDefAnn _ args _ body) = Set.difference (freeVars body) (Set.fromList (annotatedBinders args))
freeVars (TStem t) = freeVars t
@@ -297,6 +301,7 @@ findVarNames ast = case ast of
SVar name _ -> [name]
SApp a b -> findVarNames a ++ findVarNames b
SLambda args body -> findVarNames body \\ args
SLet name val body -> findVarNames val ++ (findVarNames body \\ [name])
SDef name args body -> name : (findVarNames body \\ args)
SDefAnn name args _ body -> name : (findVarNames body \\ annotatedBinders args)
_ -> []
@@ -317,6 +322,7 @@ toDB env = \case
SInt n -> BInt n
SList xs -> BList (map (toDB env) xs)
SEmpty -> BEmpty
SLet name val body -> toDB env (SApp (SLambda [name] body) val)
SDef{} -> error "toDB: unexpected SDef at this stage"
SDefAnn{} -> error "toDB: unexpected SDefAnn at this stage"
SImport _ _ -> BEmpty