full support for recursive def rules in the C runtime

11 files changed, 492 insertions, 345 deletions

diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs
index 488368887..bab6cd4f4 100644
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -6,21 +6,19 @@ import GF.Data.Operations
 import PGF(CId,utf8CId)
 import PGF.Internal(Instr(..))
 import qualified Data.Map as Map
-import Data.List(mapAccumL)
+import Data.List(nub)
 
-generateByteCode :: SourceGrammar -> Int -> [L Equation] -> [Instr]
+generateByteCode :: SourceGrammar -> Int -> [L Equation] -> [[Instr]]
 generateByteCode gr arity eqs =
-  compileEquations gr arity is (map (\(L _ (ps,t)) -> ([],ps,t)) eqs)
+  let (bs,instrs) = compileEquations gr arity is (map (\(L _ (ps,t)) -> ([],ps,t)) eqs) [ENTER:instrs]
+  in reverse bs
   where
     is = push_is (arity-1) arity []
 
-compileEquations :: SourceGrammar -> Int -> [Int] -> [([(Ident,Int)],[Patt],Term)] -> [Instr]
-compileEquations gr st _  []            = [FAIL]
-compileEquations gr st [] ((vs,[],t):_) =
-  let (heap,instrs) = compileBody gr st vs t 0 []
-  in (if heap > 0 then (ALLOC heap :) else id)
-     (instrs ++ [RET st])
-compileEquations gr st (i:is) eqs       = whilePP eqs Map.empty
+compileEquations :: SourceGrammar -> Int -> [Int] -> [([(Ident,Int)],[Patt],Term)] -> [[Instr]] -> ([[Instr]],[Instr])
+compileEquations gr st _  []            bs = (bs,[FAIL])
+compileEquations gr st [] ((vs,[],t):_) bs = compileBody gr st vs [] t bs []
+compileEquations gr st (i:is) eqs       bs = whilePP eqs Map.empty
   where
     whilePP []                           cns     = mkCase cns []
     whilePP ((vs, PP c ps' : ps, t):eqs) cns     = whilePP eqs (Map.insertWith (++) (Q c,length ps') [(vs,ps'++ps,t)] cns)
@@ -32,54 +30,118 @@ compileEquations gr st (i:is) eqs       = whilePP eqs Map.empty
     whilePV []                           cns vrs = mkCase cns (reverse vrs)
     whilePV ((vs, PV x     : ps, t):eqs) cns vrs = whilePV eqs cns (((x,i):vs,ps,t) : vrs)
     whilePV ((vs, PW       : ps, t):eqs) cns vrs = whilePV eqs cns ((      vs,ps,t) : vrs)
-    whilePV eqs                          cns vrs = mkCase cns (reverse vrs) ++ compileEquations gr st (i:is) eqs
+    whilePV eqs                          cns vrs = let (bs1,instrs1) = mkCase cns (reverse vrs)
+                                                       (bs2,instrs2) = compileEquations gr st (i:is) eqs (instrs2:bs1)
+                                                   in (bs2,instrs1)
 
-    mkCase cns vrs
-      | Map.null cns = compileEquations gr st is vrs
-      | otherwise    = EVAL (st-i-1) :
-                       concat [compileBranch t n eqs | ((t,n),eqs) <- Map.toList cns] ++
-                       compileEquations gr st is vrs
+    mkCase cns vrs =
+      case Map.toList cns of
+        []       -> compileEquations gr st is vrs bs
+        (cn:cns) -> let (bs1,instrs1) = compileBranch0 cn bs
+                        bs2 = foldr compileBranch bs1 cns
+                        (bs3,instrs3) = compileEquations gr st is vrs (instrs3:bs2)
+                    in (bs3,instrs1)
 
-    compileBranch t n eqs =
+    compileBranch0 ((t,n),eqs) bs =
       let case_instr = 
             case t of
               (Q (_,id)) -> CASE (i2i id)
               (EInt n)   -> CASE_INT n
               (K s)      -> CASE_STR s
               (EFloat d) -> CASE_FLT d
-          instrs = compileEquations gr (st+n) (push_is st n is) eqs
-      in case_instr (length instrs) : instrs
+          (bs1,instrs) = compileEquations gr (st+n) (push_is st n is) eqs bs
+      in (bs1, EVAL_ARG_VAR (st-i-1) : case_instr (length bs1) : instrs)
 
-compileBody gr st vs (App e1 e2) h0 es = compileBody gr st vs e1 h0 (e2:es)
-compileBody gr st vs (Q (m,id))  h0 es = case lookupAbsDef gr m id of
-                                           Ok (Just _,Just _) 
-                                              -> let ((h1,st1),iis) = mapAccumL (compileArg gr st vs) (h0,st) (reverse es)
-                                                     (is1,is2,is3) = unzip3 iis
-                                                 in (h1,concat is3 ++ is2 ++ [TAIL_CALL (i2i id)])
-                                           _  -> let h1 = h0 + 2 + length es
-                                                     ((h2,st1),iis)  = mapAccumL (compileArg gr st vs) (h1,st) es
-                                                     (is1,is2,is3) = unzip3 iis
-                                                 in (h2,PUT_CONSTR (i2i id) : concat (is1:is3))
-compileBody gr st vs (QC qid)    h0 es = compileBody gr st vs (Q qid) h0 es
-compileBody gr st vs (Vr x)      h0 es = case lookup x vs of
-                                           Just i  -> let ((h1,st1),iis)  = mapAccumL (compileArg gr st vs) (h0,st) (reverse es)
-                                                          (is1,is2,is3) = unzip3 iis
-                                                      in (h1,concat is3 ++ is2 ++ [EVAL (st-i-1)])
-                                           Nothing -> error "compileBody: unknown variable"
-compileBody gr st vs (EInt n)    h0 _  = let h1 = h0 + 2
-                                         in (h1,[PUT_INT n])
-compileBody gr st vs (K s)       h0 _  = let h1 = h0 + 1 + (length s + 4) `div` 4
-                                         in (h1,[PUT_STR s])
-compileBody gr st vs (EFloat d)  h0 _  = let h1 = h0 + 3
-                                         in (h1,[PUT_FLT d])
+    compileBranch ((t,n),eqs) bs =
+      let case_instr =
+            case t of
+              (Q (_,id)) -> CASE (i2i id)
+              (EInt n)   -> CASE_INT n
+              (K s)      -> CASE_STR s
+              (EFloat d) -> CASE_FLT d
+          (bs1,instrs) = compileEquations gr (st+n) (push_is st n is) eqs ((case_instr (length bs1) : instrs) : bs)
+      in bs1
+
+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]))
+
+compileFun gr st avs fvs (App e1 e2) h0 bs es =
+  compileFun gr st avs fvs e1 h0 bs (e2:es)
+compileFun gr st avs fvs (Q (m,id))  h0 bs es =
+  case lookupAbsDef gr m id of
+    Ok (_,Just _)
+       -> let (h1,bs1,is1,is2,is3) = compileArgs gr st st avs fvs h0 bs (reverse es)
+          in (h1,bs1,is3 ++ is2 ++ [TAIL_CALL (i2i id)])
+    _  -> let h1 = h0 + 2 + length es
+              (h2,bs2,is1,is2,is3) = compileArgs gr st st avs fvs h1 bs es
+          in (h2,bs2,PUT_CONSTR (i2i id) : is1 ++ is3)
+compileFun gr st avs fvs (QC qid)    h0 bs es =
+  compileFun gr st avs fvs (Q qid) h0 bs es
+compileFun gr st avs fvs (Vr x)      h0 bs es =
+  let (h1,bs1,is1,is2,is3)  = compileArgs gr st st avs fvs h0 bs (reverse es)
+      i = case lookup x avs of
+            Just i  -> EVAL_ARG_VAR (st-i-1)
+            Nothing -> case lookup x fvs of
+                         Just i  -> EVAL_FREE_VAR i
+                         Nothing -> error "compileFun: unknown variable"
+  in (h1,bs1,is3 ++ is2 ++ [i])
+compileFun gr st avs fvs (EInt n)    h0 bs _  =
+  let h1 = h0 + 2
+  in (h1,bs,[PUT_INT n])
+compileFun gr st avs fvs (K s)       h0 bs _  =
+  let h1 = h0 + 1 + (length s + 4) `div` 4
+  in (h1,bs,[PUT_STR s])
+compileFun gr st avs fvs (EFloat d)  h0 bs _  =
+  let h1 = h0 + 3
+  in (h1,bs,[PUT_FLT d])
+
+compileArgs gr st st0 avs fvs h0 bs []     =
+  (h0,bs,[],[],[])
+compileArgs gr st st0 avs fvs h0 bs (e:es) =
+  (h2,bs2,i1:is1,i2:is2,is++is3)
+  where 
+    (h1,bs1,i1,i2,is)    = compileArg gr st st0 avs fvs e h0 bs []
+    (h2,bs2,is1,is2,is3) = compileArgs gr st (st0+1) avs fvs h1 bs1 es
+
+compileArg gr st st0 avs fvs (App e1 e2) h0 bs es = compileArg gr st st0 avs fvs e1 h0 bs (e2:es)
+compileArg gr st st0 avs fvs e@(Q(m,id)) h0 bs es =
+  case lookupAbsDef gr m id of
+    Ok (_,Just _)
+       -> if null es
+            then let h1 = h0 + 2
+                 in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_FUN (i2i id)])
+            else let es_fvs = nub (foldr freeVars [] es)
+                     h1 = h0 + 1 + length es_fvs
+                     (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)
+    _  -> 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)
+compileArg gr st st0 avs fvs (QC qid)    h0 bs es = compileArg gr st st0 avs fvs (Q qid) h0 bs es
+compileArg gr st st0 avs fvs (Vr x)      h0 bs es =
+  let (i1,i2) = compileVar st st0 avs fvs x
+  in (h0,bs,i1,i2,[])
+compileArg gr st st0 avs fvs (EInt n)    h0 bs _  = 
+  let h1 = h0 + 2
+  in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_INT n])
+compileArg gr st st0 avs fvs (K s)       h0 bs _  =
+  let h1 = h0 + 1 + (length s + 4) `div` 4
+  in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_STR s])
+compileArg gr st st0 avs fvs (EFloat d)  h0 bs _  =
+  let h1 = h0 + 3
+  in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_FLT d])
+
+compileVar st st0 avs fvs x =
+  case lookup x avs of
+    Just i  -> (SET_ARG_VAR (st-i-1),PUSH_ARG_VAR (st0-i-1))
+    Nothing -> case lookup x fvs of
+                 Just i  -> (SET_FREE_VAR i,PUSH_FREE_VAR i)
+                 Nothing -> error "compileVar: unknown variable"
 
-compileArg gr st vs (h0,st0) (Vr x) =
-  case lookup x vs of
-    Just i  -> ((h0,st0+1),(SET_VARIABLE (st-i-1),PUSH_VARIABLE (st0-i-1),[]))
-    Nothing -> error "compileFunArg: unknown variable"
-compileArg gr st vs (h0,st0) e =
-  let (h1,is2) = compileBody gr st vs e h0 []
-  in ((h1,st0+1),(SET_VALUE h0,PUSH_VALUE h0,is2))
+freeVars (App e1 e2) vs = (freeVars e1 . freeVars e2) vs
+freeVars (Vr x)      vs = x:vs
+freeVars _           vs = vs
 
 i2i :: Ident -> CId
 i2i = utf8CId . ident2utf8
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index c5a04230b..b8a79af52 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -146,8 +146,8 @@ mkContext scope hyps = mapAccumL (\scope (bt,x,ty) -> let ty' = mkType scope ty
                                                            else (x:scope,(bt,i2i x,ty'))) scope hyps 
 
 mkDef gr arity (Just eqs) = Just ([C.Equ ps' (mkExp scope' e) | L _ (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]
-                              ,generateByteCode gr arity eqs
-                              )
+                                 ,generateByteCode gr arity eqs
+                                 )
 mkDef gr arity Nothing    = Nothing
 
 mkArrity (Just a) ty = a
diff --git a/src/compiler/GF/Compile/PGFtoJS.hs b/src/compiler/GF/Compile/PGFtoJS.hs
index 2195ce431..1a3d81a89 100644
--- a/src/compiler/GF/Compile/PGFtoJS.hs
+++ b/src/compiler/GF/Compile/PGFtoJS.hs
@@ -32,7 +32,7 @@ pgf2js pgf =
 abstract2js :: String -> Abstr -> JS.Expr
 abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
 
-absdef2js :: (CId,(Type,Int,Maybe ([Equation],[M.Instr]),Double)) -> JS.Property
+absdef2js :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> JS.Property
 absdef2js (f,(typ,_,_,_)) =
   let (args,cat) = M.catSkeleton typ in 
     JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])
diff --git a/src/compiler/GF/Compile/PGFtoPython.hs b/src/compiler/GF/Compile/PGFtoPython.hs
index 1fee9c8c5..72b4f1ff8 100644
--- a/src/compiler/GF/Compile/PGFtoPython.hs
+++ b/src/compiler/GF/Compile/PGFtoPython.hs
@@ -39,7 +39,7 @@ pgf2python pgf = ("# -*- coding: utf-8 -*-" ++++
       abs = abstract pgf
       cncs = concretes pgf
 
-pyAbsdef :: (Type, Int, Maybe ([Equation], [M.Instr]), Double) -> String
+pyAbsdef :: (Type, Int, Maybe ([Equation], [[M.Instr]]), Double) -> String
 pyAbsdef (typ, _, _, _) = pyTuple 0 id [pyCId cat, pyList 0 pyCId args]
     where (args, cat) = M.catSkeleton typ 
 
diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h
index bbf3351cb..f2e646a50 100644
--- a/src/runtime/c/pgf/data.h
+++ b/src/runtime/c/pgf/data.h
@@ -104,21 +104,26 @@ typedef struct {
 } PgfAbstr;
 
 typedef enum {
-  PGF_INSTR_EVAL,
+  PGF_INSTR_ENTER,
+  PGF_INSTR_EVAL_ARG_VAR,
+  PGF_INSTR_EVAL_FREE_VAR,
   PGF_INSTR_CASE,
   PGF_INSTR_CASE_INT,
   PGF_INSTR_CASE_STR,
   PGF_INSTR_CASE_FLT,
   PGF_INSTR_ALLOC,
   PGF_INSTR_PUT_CONSTR,
+  PGF_INSTR_PUT_FUN,
   PGF_INSTR_PUT_CLOSURE,
   PGF_INSTR_PUT_INT,
   PGF_INSTR_PUT_STR,
   PGF_INSTR_PUT_FLT,
   PGF_INSTR_SET_VALUE,
-  PGF_INSTR_SET_VARIABLE,
+  PGF_INSTR_SET_ARG_VAR,
+  PGF_INSTR_SET_FREE_VAR,
   PGF_INSTR_PUSH_VALUE,
-  PGF_INSTR_PUSH_VARIABLE,
+  PGF_INSTR_PUSH_ARG_VAR,
+  PGF_INSTR_PUSH_FREE_VAR,
   PGF_INSTR_TAIL_CALL,
   PGF_INSTR_FAIL,
   PGF_INSTR_RET
diff --git a/src/runtime/c/pgf/jit.c b/src/runtime/c/pgf/jit.c
index 0efaa7fd2..24e9ee0d8 100644
--- a/src/runtime/c/pgf/jit.c
+++ b/src/runtime/c/pgf/jit.c
@@ -14,7 +14,7 @@ struct PgfJitState {
 	jit_insn *buf;
 	char *save_ip_ptr;
 	GuBuf* call_patches;
-	GuBuf* label_patches;
+	GuBuf* segment_patches;
 };
 
 #define _jit (rdr->jit_state->jit)
@@ -25,9 +25,10 @@ typedef struct {
 } PgfCallPatch;
 
 typedef struct {
-	size_t label;
+	size_t segment;
 	jit_insn *ref;
-} PgfLabelPatch;
+	bool is_abs;
+} PgfSegmentPatch;
 
 // Between two calls to pgf_jit_make_space we are not allowed
 // to emit more that JIT_CODE_WINDOW bytes. This is not quite
@@ -78,7 +79,7 @@ pgf_new_jit(PgfReader* rdr)
 {
 	PgfJitState* state = gu_new(PgfJitState, rdr->tmp_pool);
 	state->call_patches  = gu_new_buf(PgfCallPatch,  rdr->tmp_pool);
-	state->label_patches = gu_new_buf(PgfLabelPatch, rdr->tmp_pool);
+	state->segment_patches = gu_new_buf(PgfSegmentPatch, rdr->tmp_pool);
 	state->buf = NULL;
 	state->save_ip_ptr = NULL;
 	return state;
@@ -333,282 +334,345 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 
 	absfun->function = jit_get_ip().ptr;
 
-	jit_prolog(2);
-
-	int es_arg = jit_arg_p();
-	int closure_arg = jit_arg_p();
-
-	size_t n_instrs = pgf_read_len(rdr);
+	size_t n_segments = pgf_read_len(rdr);
 	gu_return_on_exn(rdr->err, );
-	
-	size_t curr_offset = 0;
-	size_t curr_label  = 0;
-
-	gu_buf_flush(rdr->jit_state->label_patches);
-
-	for (size_t i = 0; i < n_instrs; i++) {
-		size_t labels_count = gu_buf_length(rdr->jit_state->label_patches);
-		if (labels_count > 0) {
-			PgfLabelPatch* patch = 
-				gu_buf_index(rdr->jit_state->label_patches, PgfLabelPatch, labels_count-1);
-			if (patch->label == curr_label) {
-				jit_patch(patch->ref);
-				gu_buf_trim_n(rdr->jit_state->label_patches, 1);
+
+	gu_buf_flush(rdr->jit_state->segment_patches);
+
+	int es_arg = 0;
+	int closure_arg = 0;
+
+	for (size_t segment = 0; segment < n_segments; segment++) {
+		size_t n_instrs = pgf_read_len(rdr);
+		gu_return_on_exn(rdr->err, );
+		
+		size_t curr_offset = 0;
+
+		size_t n_patches = gu_buf_length(rdr->jit_state->segment_patches);
+		if (n_patches > 0) {
+			PgfSegmentPatch* patch = 
+				gu_buf_index(rdr->jit_state->segment_patches, PgfSegmentPatch, n_patches-1);
+			if (patch->segment == segment) {
+				if (patch->is_abs)
+					jit_patch_movi(patch->ref,jit_get_ip().ptr);
+				else
+					jit_patch(patch->ref);
+				gu_buf_trim_n(rdr->jit_state->segment_patches, 1);
 			}
 		}
 
 #ifdef PGF_JIT_DEBUG
-   	    gu_printf(out, err, "%04d ", curr_label);
+		gu_printf(out, err, "%03d ", segment);
 #endif
-		curr_label++;
 
-		uint8_t opcode = pgf_read_tag(rdr);
-		switch (opcode) {
-		case PGF_INSTR_EVAL: {
-			size_t index = pgf_read_int(rdr);
+		for (size_t label = 0; label < n_instrs; label++) {
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "EVAL         %d\n", index);
+			if (label > 0)
+				gu_printf(out, err, "    ");
 #endif
 
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-			jit_prepare(1);
-			jit_pusharg_p(JIT_V0);
-			jit_finish(gu_buf_last);
-			jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
-			jit_prepare(2);
-			jit_pusharg_p(JIT_V0);
-			jit_getarg_p(JIT_V2, es_arg);
-			jit_pusharg_p(JIT_V2);
-			jit_ldr_p(JIT_V0, JIT_V0);
-			jit_finishr(JIT_V0);
-			jit_retval_p(JIT_V1);
-			jit_ldxi_p(JIT_V0, JIT_V1, offsetof(PgfValue, absfun));
-			break;
-		}
-		case PGF_INSTR_CASE: {
-			PgfCId id  = pgf_read_cid(rdr, rdr->opool);
-			int offset = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "CASE         %s %04d\n", id, curr_label+offset);
-#endif
-			jit_insn *jump= 
-				jit_bnei_i(jit_forward(), JIT_V0, (int) jit_forward());
-
-			PgfLabelPatch label_patch;
-			label_patch.label = curr_label+offset;
-			label_patch.ref   = jump;
-			gu_buf_push(rdr->jit_state->label_patches, PgfLabelPatch, label_patch);
-
-			PgfCallPatch call_patch;
-			call_patch.cid = id;
-			call_patch.ref = jump-6;
-			gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, call_patch);
-
-			jit_prepare(2);
-			jit_pusharg_p(JIT_V1);
-			jit_getarg_p(JIT_V2, es_arg);
-			jit_pusharg_p(JIT_V2);
-			jit_finish(pgf_evaluate_save_variables);
-			break;
-		}
-		case PGF_INSTR_CASE_INT: {
-			int n = pgf_read_int(rdr);
-			int offset = pgf_read_int(rdr);
+			uint8_t opcode = pgf_read_tag(rdr);
+			switch (opcode) {
+			case PGF_INSTR_ENTER: {
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "CASE_INT     %d %04d\n", n, curr_label+offset);
+				gu_printf(out, err, "ENTER\n");
 #endif
-			break;
-		}
-		case PGF_INSTR_CASE_STR: {
-			GuString s = pgf_read_string(rdr);
-			int offset = pgf_read_int(rdr);
+
+				jit_prolog(2);
+				es_arg = jit_arg_p();
+				closure_arg = jit_arg_p();
+				break;
+			}
+			case PGF_INSTR_EVAL_ARG_VAR: {
+				size_t index = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "CASE_STR     %s %04d\n", s, curr_label+offset);
+				gu_printf(out, err, "EVAL_ARG_VAR %d\n", index);
 #endif
-			break;
-		}
-		case PGF_INSTR_CASE_FLT: {
-			double d = pgf_read_double(rdr);
-			int offset = pgf_read_int(rdr);
+
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+				jit_prepare(1);
+				jit_pusharg_p(JIT_V0);
+				jit_finish(gu_buf_last);
+				jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
+				jit_prepare(2);
+				jit_pusharg_p(JIT_V0);
+				jit_getarg_p(JIT_V2, es_arg);
+				jit_pusharg_p(JIT_V2);
+				jit_ldr_p(JIT_V0, JIT_V0);
+				jit_finishr(JIT_V0);
+				jit_retval_p(JIT_V1);
+				jit_ldxi_p(JIT_V0, JIT_V1, offsetof(PgfValue, absfun));
+				break;
+			}
+			case PGF_INSTR_CASE: {
+				PgfCId id  = pgf_read_cid(rdr, rdr->opool);
+				int target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "CASE_FLT     %f %04d\n", d, curr_label+offset);
+				gu_printf(out, err, "CASE         %s %03d\n", id, target);
 #endif
-			break;
-		}
-		case PGF_INSTR_ALLOC: {
-			size_t size = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "ALLOC        %d\n", size);
-#endif
-			jit_prepare(2);
-			jit_movi_ui(JIT_V0, size*sizeof(void*));
-			jit_pusharg_ui(JIT_V0);
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,pool));
-			jit_pusharg_p(JIT_V0);
-			jit_finish(gu_malloc);
-			jit_retval_p(JIT_V1);
-			
-			curr_offset = 0;
-			break;
-		}
-		case PGF_INSTR_PUT_CONSTR: {
-			PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
+				jit_insn *jump= 
+					jit_bnei_i(jit_forward(), JIT_V0, (int) jit_forward());
+
+				PgfSegmentPatch label_patch;
+				label_patch.segment = target;
+				label_patch.ref     = jump;
+				label_patch.is_abs  = false;
+				gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, label_patch);
+
+				PgfCallPatch call_patch;
+				call_patch.cid = id;
+				call_patch.ref = jump-6;
+				gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, call_patch);
+
+				jit_prepare(2);
+				jit_pusharg_p(JIT_V1);
+				jit_getarg_p(JIT_V2, es_arg);
+				jit_pusharg_p(JIT_V2);
+				jit_finish(pgf_evaluate_save_variables);
+				break;
+			}
+			case PGF_INSTR_CASE_INT: {
+				int n      = pgf_read_int(rdr);
+				int target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUT_CONSTR   %s\n", id);
+				gu_printf(out, err, "CASE_INT     %d %03d\n", n, target);
+#endif
+				break;
+			}
+			case PGF_INSTR_CASE_STR: {
+				GuString s = pgf_read_string(rdr);
+				int target = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "CASE_STR     %s %03d\n", s, target);
+#endif
+				break;
+			}
+			case PGF_INSTR_CASE_FLT: {
+				double d   = pgf_read_double(rdr);
+				int target = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "CASE_FLT     %f %03d\n", d, target);
+#endif
+				break;
+			}
+			case PGF_INSTR_ALLOC: {
+				size_t size = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "ALLOC        %d\n", size);
+#endif
+				jit_prepare(2);
+				jit_movi_ui(JIT_V0, size*sizeof(void*));
+				jit_pusharg_ui(JIT_V0);
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,pool));
+				jit_pusharg_p(JIT_V0);
+				jit_finish(gu_malloc);
+				jit_retval_p(JIT_V1);
+				
+				curr_offset = 0;
+				break;
+			}
+			case PGF_INSTR_PUT_CONSTR: {
+				PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "PUT_CONSTR   %s\n", id);
 #endif
 
-			jit_movi_p(JIT_V0, pgf_evaluate_value);
-			jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
-			curr_offset++;
-			
-			PgfCallPatch patch;
-			patch.cid = id;
-			patch.ref = jit_movi_p(JIT_V0, jit_forward());
-			jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
-			curr_offset++;
+				jit_movi_p(JIT_V0, pgf_evaluate_value);
+				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+				curr_offset++;
+				
+				PgfCallPatch patch;
+				patch.cid = id;
+				patch.ref = jit_movi_p(JIT_V0, jit_forward());
+				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+				curr_offset++;
 
-			gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);
-			break;
-		}
-		case PGF_INSTR_PUT_CLOSURE: {
-			size_t addr = pgf_read_int(rdr);
+				gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);
+				break;
+			}
+			case PGF_INSTR_PUT_FUN: {
+				PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUT_CLOSURE  %d\n", addr);
+				gu_printf(out, err, "PUT_FUN      %s\n", id);
 #endif
-			break;
-		}
-		case PGF_INSTR_PUT_INT: {
-			size_t n = pgf_read_int(rdr);
+				
+				PgfCallPatch patch;
+				patch.cid = id;
+				patch.ref = jit_movi_p(JIT_V0, jit_forward());
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfAbsFun,function));
+				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+				curr_offset++;
+
+				gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);
+				break;
+			}
+			case PGF_INSTR_PUT_CLOSURE: {
+				size_t target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUT_INT      %d\n", n);
+				gu_printf(out, err, "PUT_CLOSURE  %03d\n", target);
 #endif
-			break;
-		}
-		case PGF_INSTR_PUT_STR: {
-			size_t addr = pgf_read_int(rdr);
+
+				PgfSegmentPatch patch;
+				patch.segment = target;
+				patch.ref     = jit_movi_p(JIT_V0, jit_forward());
+				patch.is_abs  = true;
+				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+				curr_offset++;
+				
+				gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, patch);
+				break;
+			}
+			case PGF_INSTR_PUT_INT: {
+				size_t n = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUT_STR      %d\n", addr);
+				gu_printf(out, err, "PUT_INT      %d\n", n);
 #endif
-			break;
-		}
-		case PGF_INSTR_PUT_FLT: {
-			size_t addr = pgf_read_int(rdr);
+				break;
+			}
+			case PGF_INSTR_PUT_STR: {
+				size_t addr = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUT_FLT      %d\n", addr);
+				gu_printf(out, err, "PUT_STR      %d\n", addr);
 #endif
-			
-			break;
-		}
-		case PGF_INSTR_SET_VALUE: {
-			size_t offset = pgf_read_int(rdr);
+				break;
+			}
+			case PGF_INSTR_PUT_FLT: {
+				size_t addr = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "SET_VALUE    %d\n", offset);
+				gu_printf(out, err, "PUT_FLT      %d\n", addr);
 #endif
-			jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
-			jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
-			curr_offset++;
-			break;
-		}
-		case PGF_INSTR_SET_VARIABLE: {
-			size_t index = pgf_read_int(rdr);
+				
+				break;
+			}
+			case PGF_INSTR_SET_VALUE: {
+				size_t offset = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "SET_VALUE    %d\n", offset);
+#endif
+				jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+				curr_offset++;
+				break;
+			}
+			case PGF_INSTR_SET_ARG_VAR: {
+				size_t index = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "SET_VARIABLE %d\n", index);
+				gu_printf(out, err, "SET_ARG_VAR  %d\n", index);
 #endif
 
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-			jit_prepare(1);
-			jit_pusharg_p(JIT_V0);
-			jit_finish(gu_buf_last);
-			jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
-			jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
-			curr_offset++;
-			break;
-		}
-		case PGF_INSTR_PUSH_VALUE: {
-			size_t offset = pgf_read_int(rdr);
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+				jit_prepare(1);
+				jit_pusharg_p(JIT_V0);
+				jit_finish(gu_buf_last);
+				jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
+				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+				curr_offset++;
+				break;
+			}
+			case PGF_INSTR_PUSH_VALUE: {
+				size_t offset = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUSH_VALUE    %d\n", offset);
+				gu_printf(out, err, "PUSH_VALUE   %d\n", offset);
 #endif
 
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-			jit_prepare(1);
-			jit_pusharg_p(JIT_V0);
-			jit_finish(gu_buf_extend);
-			if (offset == 0) {
-				jit_str_p(JIT_RET, JIT_V1);
-			} else {
-				jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+				jit_prepare(1);
+				jit_pusharg_p(JIT_V0);
+				jit_finish(gu_buf_extend);
+				if (offset == 0) {
+					jit_str_p(JIT_RET, JIT_V1);
+				} else {
+					jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+					jit_str_p(JIT_RET, JIT_V0);
+				}
+				break;
+			}
+			case PGF_INSTR_PUSH_ARG_VAR: {
+				size_t index = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "PUSH_ARG_VAR %d\n", index);
+#endif
+
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+				jit_prepare(1);
+				jit_pusharg_p(JIT_V0);
+				jit_finish(gu_buf_extend);
+				jit_ldxi_p(JIT_V0, JIT_RET, -(index+1)*sizeof(PgfClosure*));
 				jit_str_p(JIT_RET, JIT_V0);
+				break;
 			}
-			break;
-		}
-		case PGF_INSTR_PUSH_VARIABLE: {
-			size_t index = pgf_read_int(rdr);
+			case PGF_INSTR_PUSH_FREE_VAR: {
+				size_t index = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "PUSH_VARIABLE %d\n", index);
+				gu_printf(out, err, "PUSH_FREE_VAR %d\n", index);
 #endif
 
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-			jit_prepare(1);
-			jit_pusharg_p(JIT_V0);
-			jit_finish(gu_buf_extend);
-			jit_ldxi_p(JIT_V0, JIT_RET, -(index+1)*sizeof(PgfClosure*));
-			jit_str_p(JIT_RET, JIT_V0);
-			break;
-		}
-		case PGF_INSTR_TAIL_CALL: {
-			PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
-#ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "TAIL_CALL    %s\n", id);
-#endif
-			
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_getarg_p(JIT_V1, closure_arg);
-			jit_prepare(2);
-			jit_pusharg_p(JIT_V1);
-			jit_pusharg_p(JIT_V0);
-
-			PgfCallPatch patch;
-			patch.cid = id;
-			patch.ref = jit_movi_p(JIT_V0, jit_forward());
-			gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);			
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfAbsFun,function));
-
-			jit_finishr(JIT_V0);
-			jit_retval_p(JIT_V1);
-			break;
-		}
-		case PGF_INSTR_FAIL:
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+				jit_prepare(1);
+				jit_pusharg_p(JIT_V0);
+				jit_finish(gu_buf_extend);
+				jit_getarg_p(JIT_V0, closure_arg);				
+				jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*));
+				jit_str_p(JIT_RET, JIT_V0);
+				break;
+			}
+			case PGF_INSTR_TAIL_CALL: {
+				PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "FAIL\n");
+				gu_printf(out, err, "TAIL_CALL    %s\n", id);
 #endif
-			break;
-		case PGF_INSTR_RET: {
-		    size_t count = pgf_read_int(rdr);
+				
+				jit_getarg_p(JIT_V0, es_arg);
+				jit_getarg_p(JIT_V1, closure_arg);
+				jit_prepare(2);
+				jit_pusharg_p(JIT_V1);
+				jit_pusharg_p(JIT_V0);
 
+				PgfCallPatch patch;
+				patch.cid = id;
+				patch.ref = jit_movi_p(JIT_V0, jit_forward());
+				gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);			
+				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfAbsFun,function));
+
+				jit_finishr(JIT_V0);
+				jit_retval_p(JIT_V1);
+				break;
+			}
+			case PGF_INSTR_FAIL:
 #ifdef PGF_JIT_DEBUG
-			gu_printf(out, err, "RET          %d\n", count);
+				gu_printf(out, err, "FAIL\n");
 #endif
+				break;
+			case PGF_INSTR_RET: {
+				size_t count = pgf_read_int(rdr);
 
-			jit_prepare(2);
-			jit_movi_ui(JIT_V0, count);
-			jit_pusharg_p(JIT_V0);
-			jit_getarg_p(JIT_V0, es_arg);
-			jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-			jit_pusharg_p(JIT_V0);
-			jit_finish(gu_buf_trim_n);
+#ifdef PGF_JIT_DEBUG
+				gu_printf(out, err, "RET          %d\n", count);
+#endif
 
-			jit_movr_p(JIT_RET, JIT_V1);
-			jit_ret();
-			break;
-		}
-		default:
-			gu_impossible();
+				if (count > 0) {
+					jit_prepare(2);
+					jit_movi_ui(JIT_V0, count);
+					jit_pusharg_p(JIT_V0);
+					jit_getarg_p(JIT_V0, es_arg);
+					jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+					jit_pusharg_p(JIT_V0);
+					jit_finish(gu_buf_trim_n);
+				}
+
+				jit_movr_p(JIT_RET, JIT_V1);
+				jit_ret();
+				break;
+			}
+			default:
+				gu_impossible();
+			}
 		}
 	}
 }
diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index b5c301e3b..2064e9a3b 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -136,24 +136,29 @@ instance Binary Equation where
   get = liftM2 Equ get get

 

 instance Binary Instr where

-  put (EVAL         n) = putWord8 0  >> put n

-  put (CASE id l     ) = putWord8 1  >> put (id,l)

-  put (CASE_INT n l  ) = putWord8 2  >> put (n,l)

-  put (CASE_STR s l  ) = putWord8 3  >> put (s,l)

-  put (CASE_FLT d l  ) = putWord8 4  >> put (d,l)

-  put (ALLOC        n) = putWord8 5  >> put n

-  put (PUT_CONSTR  id) = putWord8 6  >> put id

-  put (PUT_CLOSURE  l) = putWord8 7  >> put l

-  put (PUT_INT      n) = putWord8 8  >> put n

-  put (PUT_STR      s) = putWord8 9  >> put s

-  put (PUT_FLT      d) = putWord8 10 >> put d

-  put (SET_VALUE    n) = putWord8 11 >> put n

-  put (SET_VARIABLE n) = putWord8 12 >> put n

-  put (PUSH_VALUE    n)= putWord8 13 >> put n

-  put (PUSH_VARIABLE n)= putWord8 14 >> put n

-  put (TAIL_CALL   id) = putWord8 15 >> put id

-  put (FAIL          ) = putWord8 16

-  put (RET          n) = putWord8 17 >> put n

+  put (ENTER         ) = putWord8 0

+  put (EVAL_ARG_VAR n) = putWord8 1  >> put n

+  put (EVAL_FREE_VAR n)= putWord8 2  >> put n

+  put (CASE id l     ) = putWord8 3  >> put (id,l)

+  put (CASE_INT n l  ) = putWord8 4  >> put (n,l)

+  put (CASE_STR s l  ) = putWord8 5  >> put (s,l)

+  put (CASE_FLT d l  ) = putWord8 6  >> put (d,l)

+  put (ALLOC        n) = putWord8 7  >> put n

+  put (PUT_CONSTR  id) = putWord8 8  >> put id

+  put (PUT_FUN     id) = putWord8 9  >> put id

+  put (PUT_CLOSURE  l) = putWord8 10  >> put l

+  put (PUT_INT      n) = putWord8 11  >> put n

+  put (PUT_STR      s) = putWord8 12  >> put s

+  put (PUT_FLT      d) = putWord8 13 >> put d

+  put (SET_VALUE    n) = putWord8 14 >> put n

+  put (SET_ARG_VAR  n) = putWord8 15 >> put n

+  put (SET_FREE_VAR n) = putWord8 16 >> put n

+  put (PUSH_VALUE   n) = putWord8 17 >> put n

+  put (PUSH_ARG_VAR n) = putWord8 18 >> put n

+  put (PUSH_FREE_VAR n)= putWord8 19 >> put n

+  put (TAIL_CALL   id) = putWord8 20 >> put id

+  put (FAIL          ) = putWord8 21

+  put (RET          n) = putWord8 22 >> put n

 

 

 instance Binary Type where

diff --git a/src/runtime/haskell/PGF/ByteCode.hs b/src/runtime/haskell/PGF/ByteCode.hs
index bcf21ed9b..2e317d4c0 100644
--- a/src/runtime/haskell/PGF/ByteCode.hs
+++ b/src/runtime/haskell/PGF/ByteCode.hs
@@ -6,46 +6,57 @@ import Text.PrettyPrint
 type CodeLabel = Int
 
 data Instr
-  = EVAL   {-# UNPACK #-} !Int
+  = ENTER
+  | EVAL_ARG_VAR   {-# UNPACK #-} !Int
+  | EVAL_FREE_VAR  {-# UNPACK #-} !Int
   | CASE CId     {-# UNPACK #-} !CodeLabel
   | CASE_INT Int    {-# UNPACK #-} !CodeLabel
   | CASE_STR String {-# UNPACK #-} !CodeLabel
   | CASE_FLT Double {-# UNPACK #-} !CodeLabel
   | ALLOC  {-# UNPACK #-} !Int
   | PUT_CONSTR CId
+  | PUT_FUN CId
   | PUT_CLOSURE   {-# UNPACK #-} !CodeLabel
   | PUT_INT {-# UNPACK #-} !Int
   | PUT_STR String
   | PUT_FLT {-# UNPACK #-} !Double
-  | SET_VALUE {-# UNPACK #-} !Int
-  | SET_VARIABLE    {-# UNPACK #-} !Int
-  | PUSH_VALUE {-# UNPACK #-} !Int
-  | PUSH_VARIABLE    {-# UNPACK #-} !Int
+  | SET_VALUE      {-# UNPACK #-} !Int
+  | SET_ARG_VAR    {-# UNPACK #-} !Int
+  | SET_FREE_VAR   {-# UNPACK #-} !Int
+  | PUSH_VALUE     {-# UNPACK #-} !Int
+  | PUSH_ARG_VAR   {-# UNPACK #-} !Int
+  | PUSH_FREE_VAR  {-# UNPACK #-} !Int
   | TAIL_CALL    CId
+  | UPDATE
   | FAIL
   | RET {-# UNPACK #-} !Int
 
-ppCode :: CodeLabel -> [Instr] -> Doc
-ppCode l []     = empty
-ppCode l (i:is) = ppLabel l <+> ppInstr l i $$ ppCode (l+1) is
+ppCode :: Int -> [[Instr]] -> Doc
+ppCode l []       = empty
+ppCode l (is:iss) = ppLabel l <+> vcat (map ppInstr is) $$ ppCode (l+1) iss
 
-ppInstr l (EVAL         n) = text "EVAL        " <+> int n
-ppInstr l (CASE id o     ) = text "CASE        " <+> ppCId id <+> ppLabel (l+o+1)
-ppInstr l (CASE_INT n o  ) = text "CASE_INT    " <+> int n <+> ppLabel (l+o+1)
-ppInstr l (CASE_STR s o  ) = text "CASE_STR    " <+> text (show s) <+> ppLabel (l+o+1)
-ppInstr l (CASE_FLT d o  ) = text "CASE_FLT    " <+> double d <+> ppLabel (l+o+1)
-ppInstr l (ALLOC        n) = text "ALLOC       " <+> int n
-ppInstr l (PUT_CONSTR  id) = text "PUT_CONSTR  " <+> ppCId id
-ppInstr l (PUT_CLOSURE  c) = text "PUT_CLOSURE " <+> ppLabel c
-ppInstr l (PUT_INT n     ) = text "PUT_INT     " <+> int n
-ppInstr l (PUT_STR s     ) = text "PUT_STR     " <+> text (show s)
-ppInstr l (PUT_FLT d     ) = text "PUT_FLT     " <+> double d
-ppInstr l (SET_VALUE    n) = text "SET_VALUE   " <+> int n
-ppInstr l (SET_VARIABLE n) = text "SET_VARIABLE" <+> int n
-ppInstr l (PUSH_VALUE   n) = text "PUSH_VALUE  " <+> int n
-ppInstr l (PUSH_VARIABLE n)= text "PUSH_VARIABLE"<+> int n
-ppInstr l (TAIL_CALL   id) = text "TAIL_CALL   " <+> ppCId id
-ppInstr l (FAIL          ) = text "FAIL"
-ppInstr l (RET          n) = text "RET         " <+> int n
+ppInstr (ENTER          ) = text "ENTER"
+ppInstr (EVAL_ARG_VAR  n) = text "EVAL_ARG_VAR " <+> int n
+ppInstr (EVAL_FREE_VAR n) = text "EVAL_FREE_VAR" <+> int n
+ppInstr (CASE id l      ) = text "CASE         " <+> ppCId id <+> ppLabel l
+ppInstr (CASE_INT n l   ) = text "CASE_INT     " <+> int n <+> ppLabel l
+ppInstr (CASE_STR str l ) = text "CASE_STR     " <+> text (show str) <+> ppLabel l
+ppInstr (CASE_FLT d l   ) = text "CASE_FLT     " <+> double d <+> ppLabel l
+ppInstr (ALLOC         n) = text "ALLOC        " <+> int n
+ppInstr (PUT_CONSTR   id) = text "PUT_CONSTR   " <+> ppCId id
+ppInstr (PUT_FUN      id) = text "PUT_FUN      " <+> ppCId id
+ppInstr (PUT_CLOSURE   l) = text "PUT_CLOSURE  " <+> ppLabel l
+ppInstr (PUT_INT n      ) = text "PUT_INT      " <+> int n
+ppInstr (PUT_STR str    ) = text "PUT_STR      " <+> text (show str)
+ppInstr (PUT_FLT d      ) = text "PUT_FLT      " <+> double d
+ppInstr (SET_VALUE     n) = text "SET_VALUE    " <+> int n
+ppInstr (SET_ARG_VAR   n) = text "SET_ARG_VAR  " <+> int n
+ppInstr (SET_FREE_VAR  n) = text "SET_FREE_VAR " <+> int n
+ppInstr (PUSH_VALUE    n) = text "PUSH_VALUE   " <+> int n
+ppInstr (PUSH_ARG_VAR  n) = text "PUSH_ARG_VAR " <+> int n
+ppInstr (PUSH_FREE_VAR n) = text "PUSH_FREE_VAR" <+> int n
+ppInstr (TAIL_CALL    id) = text "TAIL_CALL    " <+> ppCId id
+ppInstr (FAIL           ) = text "FAIL"
+ppInstr (RET           n) = text "RET          " <+> int n
 
-ppLabel l = text (let s = show l in replicate (4-length s) '0' ++ s)
+ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)
diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index 76dbc616a..e9263cc1c 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -28,11 +28,11 @@ data PGF = PGF {
 
 data Abstr = Abstr {
   aflags  :: Map.Map CId Literal,                            -- ^ value of a flag
-  funs    :: Map.Map CId (Type,Int,Maybe ([Equation],[Instr]),Double),-- ^ type, arrity and definition of function + probability
-  cats    :: Map.Map CId ([Hypo],[(Double, CId)],Double)              -- ^ 1. context of a category
-                                                                      --   2. functions of a category. The functions are stored
-                                                                      --      in decreasing probability order.
-                                                                      --   3. probability
+  funs    :: Map.Map CId (Type,Int,Maybe ([Equation],[[Instr]]),Double),-- ^ type, arrity and definition of function + probability
+  cats    :: Map.Map CId ([Hypo],[(Double, CId)],Double)                -- ^ 1. context of a category
+                                                                        --   2. functions of a category. The functions are stored
+                                                                        --      in decreasing probability order.
+                                                                        --   3. probability
   }
 
 data Concr = Concr {
diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs
index 0b4ccc554..80a615e67 100644
--- a/src/runtime/haskell/PGF/Expr.hs
+++ b/src/runtime/haskell/PGF/Expr.hs
@@ -325,8 +325,8 @@ data Value
   | VClosure Env Expr

   | VImplArg Value

 

-type Sig = ( Map.Map CId (Type,Int,Maybe ([Equation],[Instr]),Double) -- type and def of a fun

-           , Int -> Maybe Expr                                      -- lookup for metavariables

+type Sig = ( Map.Map CId (Type,Int,Maybe ([Equation],[[Instr]]),Double) -- type and def of a fun

+           , Int -> Maybe Expr                                          -- lookup for metavariables

            )

 type Env = [Value]

 

diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs
index 1aabce09d..a9985cdeb 100644
--- a/src/runtime/haskell/PGF/Printer.hs
+++ b/src/runtime/haskell/PGF/Printer.hs
@@ -29,13 +29,13 @@ ppFlag flag value = text "flag" <+> ppCId flag <+> char '=' <+> ppLit value <+>
 ppCat :: CId -> ([Hypo],[(Double,CId)],Double) -> Doc
 ppCat c (hyps,_,_) = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) <+> char ';'
 
-ppFun :: CId -> (Type,Int,Maybe ([Equation],[Instr]),Double) -> Doc
+ppFun :: CId -> (Type,Int,Maybe ([Equation],[[Instr]]),Double) -> Doc
 ppFun f (t,_,Just (eqs,code),_) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$
-                                  if null eqs
-                                    then empty
-                                    else text "def" <+> vcat [let scope = foldl pattScope [] patts
-                                                                  ds    = map (ppPatt 9 scope) patts
-                                                              in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs] $$
+                                  (if null eqs
+                                     then empty
+                                     else text "def" <+> vcat [let scope = foldl pattScope [] patts
+                                                                   ds    = map (ppPatt 9 scope) patts
+                                                               in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs]) $$
                                   ppCode 0 code
 ppFun f (t,_,Nothing,_)         = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'