How to define your own polymorfic type in Mercury

[Henk Vandecasteele]

Dear mercury-users(@cs.mu.OZ.AU?)

I have the following interface of a mutable object:

:- module mutable.

:- interface.

:- type mutable(T). /* a polymorfic mutable object */

:- pred mutable__init(mutable(T), T).
:- mode mutable__init(out, in) is det.
     /* create a new mutable object with the initial contents */

:- pred mutable__overwrite(mutable(T), T).
:- mode mutable__overwrite(in, in) is det.
     /* Overwrite the current contents of the mutable object with 
        a new data. When the system backtracks over  this operation
        the old data willl be restored  */

:- pred mutable__get(mutable(T), T).
:- mode mutable__get(in, out) is det.
    /* Get the current contents of the mutable object */


I had an implementation which is based on the array-module in 
the library. I do not understand half wat happened in there,
I suppose this is not the way to do it. I added the code in the end 
of the mail. It worked up to version 0.8, but it fails
with "rotd-1999-04-04". Of course I could again see what happened 
with array.m (of course I already did) and mimic it again.
But is there I better documented way? I searched without luck.

Henk


:- implementation.


:- pragma(c_code, "

Define_extern_entry(mercury____Unify___mutable__mutable_1_0);
Define_extern_entry(mercury____Index___mutable__mutable_1_0);
Define_extern_entry(mercury____Compare___mutable__mutable_1_0);

#ifdef  USE_TYPE_LAYOUT

static const struct
mercury_data_mutable__base_type_layout_mutable_1_struct {
        TYPE_LAYOUT_FIELDS
} mercury_data_mutable__base_type_layout_mutable_1 = {
        make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
                mkbody(TYPELAYOUT_ARRAY_VALUE))
};

static const struct
mercury_data_mutable__base_type_functors_mutable_1_struct {
        Integer f1;
} mercury_data_mutable__base_type_functors_mutable_1 = {
        MR_TYPEFUNCTORS_SPECIAL
};

#endif

Declare_entry(mercury__mutable__mutable_equal_2_0);
Declare_entry(mercury__mutable__mutable_compare_3_0);

BEGIN_MODULE(mutable_module)
        init_entry(mercury____Unify___mutable__mutable_1_0);
        init_entry(mercury____Index___mutable__mutable_1_0);
        init_entry(mercury____Compare___mutable__mutable_1_0);
BEGIN_CODE

Define_entry(mercury____Unify___mutable__mutable_1_0);
	fatal_error(""cannot unify dada""); 

Define_entry(mercury____Index___mutable__mutable_1_0);
        index_output = -1;
        proceed();

Define_entry(mercury____Compare___mutable__mutable_1_0);
	fatal_error(""cannot compare dada""); 

END_MODULE

/* Ensure that the initialization code for the above module gets run. */
/*
INIT sys_init_mutable_module
*/
void sys_init_mutable_module(void); /* suppress gcc -Wmissing-decl
warning */
void sys_init_mutable_module(void) {
        extern ModuleFunc mutable_module;
        mutable_module();
}

").


:- pragma(c_code, mutable__init(Mutable::out, Value::in),
will_not_call_mercury, "{
	 Word *mutable;
	 mutable = make(Word);
	 (*mutable)  = Value;
	 Mutable = (Word) mutable;
}").

:- pragma(c_code, mutable__overwrite(Mutable::in, Value::in),
will_not_call_mercury, "{
	 Word *mutable;
         mutable = (Word *) Mutable;
	 MR_trail_current_value(mutable);
	 (*mutable) = Value;
}").
	
:- pragma(c_code, mutable__get(Mutable::in, Value::out),
will_not_call_mercury, "{
	 Word *mutable;
	 mutable = (Word *) Mutable;
	 Value = *mutable;
}").