[m-dev.] Polymorphic insts problem

[Ralph Becket]

Attached are two modules, globalvar.m and test_globalvar.m.  When I try
compiling test_globalvar.m I get the following error:

test_globalvar.m:041: In clause for `g = out((test_globalvar.ch))':
test_globalvar.m:041:   mode error: argument 1 had the wrong instantiatedness.
test_globalvar.m:041:   Final instantiatedness of `G' was `bound((test_globalvar.z))',
test_globalvar.m:041:   expected final instantiatedness was `bound(s((test_globalvar.ch)) ; z)'.
For more information, try recompiling with `-E'.

Now, the final inst for G is certainly a subinst of the expected final
inst.  David, does this look like a simple bug to fix?  I'd start
looking myself, but I thought I'd ask you first as I'm trying to get
some benchmarks implemented for a paper.

Ta,
-- Ralph
-------------- next part --------------
%-----------------------------------------------------------------------------%
% globalvar.m
% Ralph Becket <rafe at cs.mu.oz.au>
% Fri Jan 21 15:01:39 EST 2005
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%
% Trailed global variables.  NOTE: code using this module must be compiled
% in a trailing grade.
%
% To set-up a global variable g of type t, do the following:
%
%
% :- func g = globalvar(t).
% :- pragma memo(g/0).
% :- pragma promise_pure(g/0).
%
% g = G :-
%   impure G = globalvar.new(<<initial value of g>>).
%
%
% Then, use `globalvar.get(g, X)' to read g and `globalvar.set(g, X)'
% to update g.
%
%-----------------------------------------------------------------------------%

:- module globalvar.

:- interface.



:- type globalvar(T).



:- impure   func new(T::in(I)) = (globalvar(T)::out(I)) is det.
:- impure   pred set(globalvar(T)::in(I), T::in(I)) is det.
:- semipure pred get(globalvar(T)::in(I), T::out(I)) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.



:- pragma foreign_type("C", globalvar(T), "MR_Word *").



:- pragma foreign_proc("C", new(X::in(I)) = (G::out(I)),
    [will_not_call_mercury], "

    G = MR_NEW(MR_Word);
    *G = X;

").



:- pragma foreign_proc("C", set(G::in(I), X::in(I)),
    [will_not_call_mercury], "

    MR_trail_current_value(G);
    *G = X;

").



:- pragma foreign_proc("C", get(G::in(I), X::out(I)),
    [will_not_call_mercury, promise_semipure], "

    X = *G;

").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-------------- next part --------------
%-----------------------------------------------------------------------------%
% test_globalvar.m
% Ralph Becket <rafe at cs.mu.oz.au>
% Fri Jan 21 15:14:09 EST 2005
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%
%-----------------------------------------------------------------------------%

:- module test_globalvar.

:- interface.

:- import_module io.



:- impure pred main(io :: di, io :: uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module globalvar.
:- import_module int.
:- import_module list.
:- import_module string.



:- type ch ---> z ; s(ch).
:- inst ch ---> z ; s(ch).



:- func g = (globalvar(ch)::out(ch)) is det.
:- pragma memo(g/0).
:- pragma promise_pure(g/0).

g = G :-
    impure G = globalvar.new(z).



:- impure pred inc_g is det.

inc_g :-
    semipure globalvar.get(g, X),
    impure   globalvar.set(g, s(X)).

%-----------------------------------------------------------------------------%

main(!IO) :-
    semipure globalvar.get(g, A),
    impure   inc_g,
    semipure globalvar.get(g, B),
    impure   inc_g,
    semipure globalvar.get(g, C),
    io.print(A, !IO), io.nl(!IO),
    io.print(B, !IO), io.nl(!IO),
    io.print(C, !IO), io.nl(!IO).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%