summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile/GenerateBC.hs
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@gmail.com>2014-09-05 11:53:02 +0000
committerkr.angelov <kr.angelov@gmail.com>2014-09-05 11:53:02 +0000
commit4d28c7632e83aed413c22001ec0821971f58f14d (patch)
treed7c13e926b38f5b8aa6be1275a323e9b55a49c62 /src/compiler/GF/Compile/GenerateBC.hs
parent86b5f78c579ce5fcc9c96370644c41c35a421070 (diff)
the code for def rules now uses proper graph update to preserve lazyness
Diffstat (limited to 'src/compiler/GF/Compile/GenerateBC.hs')
-rw-r--r--src/compiler/GF/Compile/GenerateBC.hs14
1 files changed, 10 insertions, 4 deletions
diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs
index bab6cd4f4..0e26994fe 100644
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -64,7 +64,10 @@ compileEquations gr st (i:is) eqs bs = whilePP eqs Map.empty
compileBody gr st avs fvs e bs es =
let (heap,bs1,instrs) = compileFun gr st avs fvs e 0 bs es
- in (bs1,(if heap > 0 then (ALLOC heap :) else id) (instrs ++ [RET st]))
+ in (bs1,((if heap > 0 then (ALLOC heap :) else id) .
+ (instrs ++) .
+ (if st == 0 then (UPDATE :) else id))
+ [RET st])
compileFun gr st avs fvs (App e1 e2) h0 bs es =
compileFun gr st avs fvs e1 h0 bs (e2:es)
@@ -110,11 +113,14 @@ compileArg gr st st0 avs fvs e@(Q(m,id)) h0 bs es =
Ok (_,Just _)
-> if null es
then let h1 = h0 + 2
- in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_FUN (i2i id)])
+ in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_FUN (i2i id),SET_PAD])
else let es_fvs = nub (foldr freeVars [] es)
- h1 = h0 + 1 + length es_fvs
+ h1 = h0 + 1 + length is
(bs1,b) = compileBody gr 0 [] (zip es_fvs [0..]) e bs es
- in (h1,(ENTER:b):bs1,SET_VALUE h0,PUSH_VALUE h0,PUT_CLOSURE (length bs) : map (fst . compileVar st st0 avs fvs) es_fvs)
+ is = if null es_fvs
+ then [SET_PAD]
+ else map (fst . compileVar st st0 avs fvs) es_fvs
+ in (h1,(ENTER:b):bs1,SET_VALUE h0,PUSH_VALUE h0,PUT_CLOSURE (length bs) : is)
_ -> let h1 = h0 + 2 + length es
(h2,bs2,is1,is2,is3) = compileArgs gr st st avs fvs h1 bs es
in (h2,bs2,SET_VALUE h0,PUSH_VALUE h0,PUT_CONSTR (i2i id) : is1 ++ is3)