msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Don't evaluate builtins with free variables as arguments

Browse Source
This commit is contained in:
Eve
2025-01-26 01:14:25 +01:00
parent d9ed763ace
commit 3b58ccbeef
1 changed files with 11 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
src/compiler/api/GF/Compile/Compute/Concrete.hs
View File

@@ -207,14 +207,19 @@ eval env (S t1 t2) vs = do v1 <- eval env t1 []
eval env (Let (x,(_,t1)) t2) vs = do tnk <- newThunk env t1 eval env (Let (x,(_,t1)) t2) vs = do tnk <- newThunk env t1
eval ((x,tnk):env) t2 vs eval ((x,tnk):env) t2 vs
eval env (Q q@(m,id)) vs eval env (Q q@(m,id)) vs
| m == cPredef = do vs' <- mapM force vs | m == cPredef = do vs' <- mapM force vs -- FIXME this does not allow for partial application!
res <- evalPredef id vs' if any isVar vs'
case res of then return (VApp q vs)
Const res -> return res else do res <- evalPredef id vs'
RunTime -> return (VApp q vs) case res of
NonExist -> return (VApp (cPredef,cNonExist) []) Const res -> return res
RunTime -> return (VApp q vs)
NonExist -> return (VApp (cPredef,cNonExist) [])
| otherwise = do t <- getResDef q | otherwise = do t <- getResDef q
eval env t vs eval env t vs
where
isVar (VGen _ _) = True
isVar _ = False
eval env (QC q) vs = return (VApp q vs) eval env (QC q) vs = return (VApp q vs)
eval env (C t1 t2) [] = do v1 <- eval env t1 [] eval env (C t1 t2) [] = do v1 <- eval env t1 []
v2 <- eval env t2 [] v2 <- eval env t2 []