No subject

[Fergus Henderson]

Received: from styx.cs.kuleuven.ac.be (styx.cs.kuleuven.ac.be [134.58.40.3]) by mulga.cs.mu.OZ.AU with ESMTP
	id AAA22679 for <mercury-users at cs.mu.OZ.AU>; Sat, 10 Apr 1999 00:15:23 +1000 (EST)
Received: from cs.kuleuven.ac.be (henkv at druppel.cs.kuleuven.ac.be [134.58.45.74])
	by styx.cs.kuleuven.ac.be (8.9.1a/8.9.1) with ESMTP id QAA06753
	for <mercury-users at cs.mu.OZ.AU>; Fri, 9 Apr 1999 16:15:14 +0200 (MET DST)
Sender: Henk.Vandecasteele at cs.kuleuven.ac.be
Message-ID: <370E0B71.6BF5025E at cs.kuleuven.ac.be>
Date: Fri, 09 Apr 1999 16:15:13 +0200
From: Henk Vandecasteele <Henk.Vandecasteele at cs.kuleuven.ac.be>
X-Mailer: Mozilla 4.51 [en] (X11; I; Linux 2.2.5 i686)
X-Accept-Language: en
MIME-Version: 1.0
To: mercury-users at cs.mu.OZ.AU
Subject: How to define your own polymorfic type in Mercury
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Transfer-Encoding: 7bit
Status: RO
X-Status: A
Content-Length: 3377
Lines: 122

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;
}").