unify.c compiles

parent 0bc0d8b4
......@@ -7,13 +7,13 @@ int _logical_ = 0;
SCM make_logical()
{
SCM ret;
SCM_NEWSMOB(ret,GP_MK_FRAME_UNBD(gp_type),(void *)0);
return ret
ret = SCM_NEWSMOB(ret,GP_MK_FRAME_UNBD(gp_type),(void *)0);
return ret;
}
SCM logical_lookup(SCM x SCM s)
SCM logical_lookup(SCM x, SCM s)
{
SCM l = s;
SCM l = SCM_CDR(s);
if(!GP(x))
return x;
retry:
......
......@@ -326,8 +326,10 @@ static inline SCM gp_store_state()
if(gp_ci == gp_cstack)
{
return scm_cons(PTR2NUM(gp_si),
scm_cons(SCM_I_MAKINUM(0), SCM_EOL));
return scm_cons(scm_cons(SCM_I_MAKINUM(_logical_),
PTR2NUM(gp_ci_h)),
scm_cons(PTR2NUM(gp_si),
scm_cons(SCM_I_MAKINUM(0), SCM_EOL)));
}
data = gp_ci[-1];
......@@ -353,7 +355,7 @@ static inline SCM gp_store_state()
}
return scm_cons(scm_cons(SCM_I_MAKINUM(_logical_),
PTR2NUM(gp_ci_h))
PTR2NUM(gp_ci_h)),
scm_cons(PTR2NUM(gp_si),
scm_cons(SCM_I_MAKINUM(gp_ci - gp_cstack)
......
......@@ -347,7 +347,7 @@ static inline SCM gp_set_ref(SCM *id, SCM ref, SCM s)
{
SCM val;
if(_logical_) return logical_add(GP_UNREF(id),v,s);
if(_logical_) return logical_add(GP_UNREF(id),ref,s);
gp_store_var_2(id,0);
gp_debug0("setref ...");
......@@ -364,7 +364,7 @@ static inline SCM gp_set_ref_bang(SCM *id, SCM ref, SCM s)
{
SCM val;
if(_logical_) return logical_add(GP_UNREF(id),v,s);
if(_logical_) return logical_add(GP_UNREF(id),ref,s);
gp_debug0("setref ...");
......@@ -565,8 +565,8 @@ static int gp_recurent(SCM *id1,SCM *id2, SCM s)
if(SCM_CONSP(GP_UNREF(id2)))
{
return
gp_recurent(id1,GP_GETREF(SCM_CAR(GP_UNREF(id2)))) ||
gp_recurent(id1,GP_GETREF(SCM_CDR(GP_UNREF(id2))));
gp_recurent(id1,GP_GETREF(SCM_CAR(GP_UNREF(id2))), s) ||
gp_recurent(id1,GP_GETREF(SCM_CDR(GP_UNREF(id2))), s);
}
return 0;
}
......@@ -605,8 +605,8 @@ SCM_DEFINE( smob2scm, "gp->scm", 1, 0, 0, (SCM scm, SCM s),
if(GP_CONS(id))
{
return scm_cons(smob2scm(SCM_PACK(GP_CAR(id))),
smob2scm(SCM_PACK(GP_CDR(id))));
return scm_cons(smob2scm(SCM_PACK(GP_CAR(id)), s),
smob2scm(SCM_PACK(GP_CDR(id)), s));
}
return smob2scm_gp(id, s);
}
......@@ -893,7 +893,7 @@ static SCM gp_unify(SCM *id1, SCM *id2, int raw, int gp_plus_unify, SCM s)
if(SCM_UNLIKELY(sp >= 18)) \
{ \
s = gp_unify(GP_CAR(id1), QCAR(id2) \
,raw, gp_plus_unify); \
,raw, gp_plus_unify, s); \
if(!s) return (SCM) 0; \
id1 = GP_CDR(id1); \
id2 = QCDR(id2); \
......@@ -1022,14 +1022,14 @@ SCM_DEFINE(gp_mkvar, "gp-var!", 0, 0, 0, (),
}
#undef FUNC_NAME
SCM_DEFINE(gp_varp,"gp-var?",1,0,0,(SCM x),
SCM_DEFINE(gp_varp,"gp-var?",1,0,0,(SCM x, SCM s),
"Test for an unbound variable.")
#define FUNC_NAME s_gp_varp
{
SCM *id;
if(GP(x))
{
id = gp_lookup(UN_GP(x));
id = gp_lookup(UN_GP(x), s);
return GP_UNBOUND(id) ? SCM_BOOL_T : SCM_BOOL_F;
}
return SCM_BOOL_F;
......@@ -1090,9 +1090,8 @@ static inline SCM ggp_set(SCM var, SCM val, SCM s)
{
return gp_set_val(id,val, s);
}
return SCM_BOOL_T;
}
scm_misc_error("gp-set!","wrong type of the variable to set",SCM_EOL)
scm_misc_error("gp-set!","wrong type of the variable to set",SCM_EOL);
return SCM_BOOL_F;
}
......@@ -1177,24 +1176,24 @@ SCM_DEFINE(gp_cons_bang, "gp-cons!", 3, 0, 0, (SCM car, SCM cdr, SCM s),
if(GP(car))
{
id = gp_lookup(GP_GETREF(car));
gp_set_ref(GP_CAR(cons),GP_UNREF(id));
id = gp_lookup(GP_GETREF(car), s);
gp_set_ref(GP_CAR(cons),GP_UNREF(id), s);
}
else
{
gp_debus0("atom car>\n");
gp_set_val(GP_CAR(cons),car);
gp_set_val(GP_CAR(cons),car, s);
}
if(GP(cdr))
{
id = gp_lookup(GP_GETREF(cdr));
gp_set_ref(GP_CDR(cons),GP_UNREF(id));
id = gp_lookup(GP_GETREF(cdr), s);
gp_set_ref(GP_CDR(cons),GP_UNREF(id), s);
}
else
{
gp_debus0("atom cdr>\n");
gp_set_val(GP_CDR(cons),cdr);
gp_set_val(GP_CDR(cons),cdr, s);
}
return GP_UNREF(cons);
......@@ -1315,7 +1314,7 @@ SCM_DEFINE(gp_m_unify, "gp-m-unify!", 3, 0, 0, (SCM x, SCM y, SCM s),
"checks for a prolog pair or scheme pair")
#define FUNC_NAME s_gp_m_unify
{
int ret;
SCM ret;
//Todo this is a ugly hack.
ret = gp_unify(GP_GETREF(x),GP_GETREF(y),1,0,s);
return ret ? ret : SCM_BOOL_F;
......@@ -1432,8 +1431,11 @@ SCM_DEFINE(gp_make_fluid, "gp-make-fluid", 0, 0, 0, (),
#define FUNC_NAME s_gp_make_fluid
{
SCM ret;
int old = _logical_;
_logical_ = 0;
SCM_NEWSMOB(ret,GP_MK_FRAME_UNBD(gp_type),(void *)0);
gp_set_unbound_bang(GP_GETREF(ret));
gp_set_unbound_bang(GP_GETREF(ret), SCM_BOOL_F);
_logical_ = old;
return ret;
}
#undef FUNC_NAME
......@@ -1443,15 +1445,18 @@ SCM_DEFINE(gp_fluid_set_bang, "gp-fluid-set!", 2, 0, 0, (SCM f, SCM v),
#define FUNC_NAME s_gp_fluid_set_bang
{
SCM *id;
int old = _logical_;
_logical_ = 0;
if(!GP(f))
scm_misc_error ("gp fluid error", "variable is not a fluid, ~a",
scm_list_1 (f));
id = gp_lookup(GP_GETREF(f));
id = gp_lookup(GP_GETREF(f),scm_cons(SCM_BOOL_F,SCM_EOL));
if(GP(v))
gp_set_ref_bang(id,v);
gp_set_ref_bang(id,v,SCM_EOL);
else
gp_set_val_bang(id,v);
gp_set_val_bang(id,v,SCM_EOL);
return SCM_UNSPECIFIED;
}
......@@ -1468,6 +1473,7 @@ SCM_DEFINE(gp_dynwind, "gp-dynwind", 2, 0, 0, (SCM in, SCM out),
}
#undef FUNC_NAME
/*
SCM_DEFINE(gp_copy,"gp-copy",1,0,0, (SCM x),
"make a fresh copy of a gp structure")
#define FUNC_NAME s_gp_copy
......@@ -1477,6 +1483,7 @@ SCM_DEFINE(gp_copy,"gp-copy",1,0,0, (SCM x),
return gp_gp_lookup(x);
}
#undef FUNC_NAME
*/
void gp_init()
{
......@@ -1524,11 +1531,11 @@ void gp_init()
swap_to_b();
x = GP_IT(gp_mk_var());
ggp_set(x,SCM_EOL);
ggp_set(x,SCM_EOL,SCM_EOL);
swap_to_a();
x = GP_IT(gp_mk_var());
ggp_set(x,SCM_EOL);
ggp_set(x,SCM_EOL,SCM_EOL);
}
......
......@@ -36,29 +36,28 @@ SCM_API SCM gp_swap_b();
SCM_API SCM gp_gp(SCM scm);
SCM_API SCM gp_varp(SCM x);
SCM_API SCM gp_atomicp(SCM x);
SCM_API SCM gp_varp(SCM x, SCM s);
SCM_API SCM gp_atomicp(SCM x, SCM s);
SCM_API SCM gp_consp(SCM x);
SCM_API SCM gp_set(SCM var, SCM val);
SCM_API SCM gp_ref_set(SCM var, SCM val);
SCM_API SCM gp_set(SCM var, SCM val, SCM s);
SCM_API SCM gp_ref_set(SCM var, SCM val, SCM s);
SCM_API SCM gp_clear();
SCM_API SCM gp_gp_newframe();
SCM_API SCM gp_gp_newframe(SCM s);
SCM_API SCM gp_mkvar();
SCM_API SCM smob2scm(SCM scm);
SCM_API SCM gp_gp_unify(SCM scm1, SCM scm2);
SCM_API SCM gp_gp_lookup(SCM scm);
SCM_API SCM smob2scm(SCM scm, SCM s);
SCM_API SCM gp_gp_unify(SCM scm1, SCM scm2, SCM s);
SCM_API SCM gp_gp_lookup(SCM scm, SCM s);
SCM_API SCM gp_var_number(SCM x);
SCM_API SCM gp_soft_init();
SCM_API SCM gp_cons_bang(SCM car, SCM cdr);
SCM_API SCM gp_pair_bang(SCM x);
SCM_API SCM gp_pair(SCM x);
SCM_API SCM gp_null(SCM x);
SCM_API SCM gp_null_bang(SCM x);
SCM_API SCM gp_gp_lookup(SCM x);
SCM_API SCM gp_m_unify(SCM x, SCM y);
SCM_API SCM gp_cons_bang(SCM car, SCM cdr, SCM s);
SCM_API SCM gp_pair_bang(SCM x, SCM s);
SCM_API SCM gp_pair(SCM x, SCM s);
SCM_API SCM gp_null(SCM x, SCM s);
SCM_API SCM gp_null_bang(SCM x, SCM s);
SCM_API SCM gp_m_unify(SCM x, SCM y, SCM s);
SCM_API SCM gp_gp_cdr(SCM x);
SCM_API SCM gp_car(SCM x);
......@@ -71,4 +70,7 @@ SCM_API SCM gp_fluid_set_bang(SCM f, SCM v);
SCM_API SCM gp_dynwind(SCM in, SCM out);
SCM_API SCM gp_copy(SCM x);
//SCM_API SCM gp_copy(SCM x);
SCM_API SCM gp_logical_incr();
SCM_API SCM gp_logical_decr();
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment