summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@gmail.com>2014-10-08 12:57:29 +0000
committerkr.angelov <kr.angelov@gmail.com>2014-10-08 12:57:29 +0000
commit9c2f71b07a5de7d6d4d13dc3c72d9b9ddc2f37dc (patch)
treecc468098d8b2f567121b860662311b9eb8d18492 /src/compiler/GF/Compile
parent67781996b639e9c31acd4a25b229222139686f07 (diff)
now we statically allocate closures for all top-level functions and all nullary constructors. closures are dynamically allocated only for CAFs. this reduces memory use and time to allocate dynamic closures
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/GenerateBC.hs14
1 files changed, 9 insertions, 5 deletions
diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs
index 8e96a54e1..b749a40e1 100644
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -17,7 +17,9 @@ generateByteCode gr arity eqs =
b = if arity == 0 || null eqs
then instrs
else CHECK_ARGS arity:instrs
- in reverse bs
+ in case bs of
+ [[FAIL]] -> [] -- in the runtime this is a more efficient variant of [[FAIL]]
+ _ -> reverse bs
where
is = push_is (arity-1) arity []
@@ -100,8 +102,10 @@ compileFun gr arity st vs (Q (m,id)) h0 bs args =
is1 = setArgs st args
diff = c_arity-n_args
in if diff <= 0
- then let h1 = h0 + 2 + n_args
- in (h1,bs,PUT_CONSTR (i2i id):is1++[EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
+ then if n_args == 0
+ then (h0,bs,[EVAL (GLOBAL (i2i id)) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
+ else let h1 = h0 + 2 + n_args
+ in (h1,bs,PUT_CONSTR (i2i id):is1++[EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
else let h1 = h0 + 1 + n_args
is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]
b = CHECK_ARGS diff : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [EVAL (HEAP h0) (TailCall diff (diff+1) (diff+1))]
@@ -135,11 +139,11 @@ compileArg gr st vs (Q(m,id)) h0 bs =
_ -> let Ok ty = lookupFunType gr m id
(ctxt,_,_) = typeForm ty
c_arity = length ctxt
- h1 = h0 + 2
in if c_arity == 0
- then (h1,bs,HEAP h0,[PUT_CONSTR (i2i id)])
+ then (h0,bs,GLOBAL (i2i id),[])
else let is2 = [SET (ARG_VAR (i+1)) | i <- [0..c_arity-1]]
b = CHECK_ARGS c_arity : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [EVAL (HEAP h0) (TailCall c_arity (c_arity+1) (c_arity+1))]
+ h1 = h0 + 2
in (h1,b:bs,HEAP h0,[PUT_CLOSURE (length bs),SET_PAD])
compileArg gr st vs (QC qid) h0 bs =
compileArg gr st vs (Q qid) h0 bs