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

fix the evaluation for Prod

Browse Source
This commit is contained in:
krangelov
2021-10-14 10:24:20 +02:00
parent 45ee985fda
commit 5ee960ed7c
1 changed files with 10 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/compiler/GF/Compile/Compute/Concrete.hs
View File

@@ -352,12 +352,16 @@ value2term i (VClosure env (Abs b x t)) = do
v <- eval ((x,tnk):env) t [] v <- eval ((x,tnk):env) t []
t <- value2term (i+1) v t <- value2term (i+1) v
return (Abs b (identS ('v':show i)) t) return (Abs b (identS ('v':show i)) t)
value2term i (VProd b x v1 env t2) = do value2term i (VProd b x v1 env t2)
t1 <- value2term i v1 | x == identW = do t1 <- value2term i v1
tnk <- newGen i v2 <- eval env t2 []
v2 <- eval ((x,tnk):env) t2 [] t2 <- value2term i v2
t2 <- value2term (i+1) v2 return (Prod b x t1 t2)
return (Prod b x t1 t2) | otherwise = do t1 <- value2term i v1
tnk <- newGen i
v2 <- eval ((x,tnk):env) t2 []
t2 <- value2term (i+1) v2
return (Prod b (identS ('v':show i)) t1 t2)
value2term i (VRecType lbls) = do value2term i (VRecType lbls) = do
lbls <- mapM (\(lbl,v) -> fmap ((,) lbl) (value2term i v)) lbls lbls <- mapM (\(lbl,v) -> fmap ((,) lbl) (value2term i v)) lbls
return (RecType lbls) return (RecType lbls)