GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

the code for def rules now uses proper graph update to preserve lazyness

Browse Source
This commit is contained in:
kr.angelov
2014-09-05 11:53:02 +00:00
parent 5e5ad8f2db
commit d7dc541f74
7 changed files with 67 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/compiler/GF/Compile/GenerateBC.hs
View File

@@ -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)

2
src/runtime/c/pgf/data.h
View File

@@ -121,11 +121,13 @@ typedef enum {
PGF_INSTR_SET_VALUE,
PGF_INSTR_SET_ARG_VAR,
PGF_INSTR_SET_FREE_VAR,
PGF_INSTR_SET_PAD,
PGF_INSTR_PUSH_VALUE,
PGF_INSTR_PUSH_ARG_VAR,
PGF_INSTR_PUSH_FREE_VAR,
PGF_INSTR_TAIL_CALL,
PGF_INSTR_FAIL,
PGF_INSTR_UPDATE,
PGF_INSTR_RET
} PgfInstruction;

2
src/runtime/c/pgf/evaluator.c
View File

@@ -40,7 +40,7 @@ typedef struct {
PgfLiteral lit;
} PgfValueLit;
static PgfClosure*
PgfClosure*
pgf_evaluate_indirection(PgfEvalState* state, PgfClosure* closure)
{
PgfIndirection* indir = (PgfIndirection*) closure;

3
src/runtime/c/pgf/evaluator.h
View File

@@ -23,6 +23,9 @@ typedef struct {
PgfClosure* args[];
} PgfValue;
PgfClosure*
pgf_evaluate_indirection(PgfEvalState* state, PgfClosure* closure);
PgfClosure*
pgf_evaluate_value(PgfEvalState* state, PgfClosure* closure);

39
src/runtime/c/pgf/jit.c
View File

@@ -405,6 +405,13 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
jit_ldxi_p(JIT_V0, JIT_V1, offsetof(PgfValue, absfun));
break;
}
case PGF_INSTR_EVAL_FREE_VAR: {
size_t index = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "EVAL_FREE_VAR %d\n", index);
#endif
break;
}
case PGF_INSTR_CASE: {
PgfCId id = pgf_read_cid(rdr, rdr->opool);
int target = pgf_read_int(rdr);
@@ -572,6 +579,27 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
curr_offset++;
break;
}
case PGF_INSTR_SET_FREE_VAR: {
size_t index = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "SET_FREE_VAR %d\n", index);
#endif
jit_getarg_p(JIT_V0, closure_arg);
jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*));
jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
curr_offset++;
break;
}
case PGF_INSTR_SET_PAD: {
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "SET_PAD\n");
#endif
jit_movi_p(JIT_V0, NULL);
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
@@ -649,6 +677,17 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
gu_printf(out, err, "FAIL\n");
#endif
break;
case PGF_INSTR_UPDATE: {
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "UPDATE\n");
#endif
jit_getarg_p(JIT_V0, closure_arg);
jit_movi_p(JIT_V2, pgf_evaluate_indirection);
jit_stxi_p(0, JIT_V0, JIT_V2);
jit_stxi_p(sizeof(PgfClosure), JIT_V0, JIT_V1);
break;
}
case PGF_INSTR_RET: {
size_t count = pgf_read_int(rdr);

14
src/runtime/haskell/PGF/Binary.hs
View File

@@ -153,12 +153,14 @@ instance Binary Instr where
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
put (SET_PAD ) = putWord8 17
put (PUSH_VALUE n) = putWord8 18 >> put n
put (PUSH_ARG_VAR n) = putWord8 19 >> put n
put (PUSH_FREE_VAR n)= putWord8 20 >> put n
put (TAIL_CALL id) = putWord8 21 >> put id
put (FAIL ) = putWord8 22
put (UPDATE ) = putWord8 23
put (RET n) = putWord8 24 >> put n
instance Binary Type where

5
src/runtime/haskell/PGF/ByteCode.hs
View File

@@ -23,12 +23,13 @@ data Instr
| SET_VALUE {-# UNPACK #-} !Int
| SET_ARG_VAR {-# UNPACK #-} !Int
| SET_FREE_VAR {-# UNPACK #-} !Int
| SET_PAD
| PUSH_VALUE {-# UNPACK #-} !Int
| PUSH_ARG_VAR {-# UNPACK #-} !Int
| PUSH_FREE_VAR {-# UNPACK #-} !Int
| TAIL_CALL CId
| UPDATE
| FAIL
| UPDATE
| RET {-# UNPACK #-} !Int
ppCode :: Int -> [[Instr]] -> Doc
@@ -52,11 +53,13 @@ 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 (SET_PAD ) = text "SET_PAD"
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 (UPDATE ) = text "UPDATE"
ppInstr (RET n) = text "RET " <+> int n
ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)