[m-dev.] Resources example

[Ralph Becket]

Julien Fischer, Friday, 22 April 2005:
> 
> For the benefit of those of us who haven't seen it, could someone
> please post the original partial order solver code.

Ask and ye shall receive...


% A partial order vertex type supporting unification and ordering
% constraints.  Written to conserve space on the page.

:- module po_solver.

:- interface.

:- solver type po_vertex.
:- pred init(po_vertex::oa) is det.
:- pred eq(po_vertex::ia, po_vertex::ia) is semidet.
:- pred (po_vertex::ia) =< (po_vertex::ia) is semidet.
:- pred (po_vertex::ia)  < (po_vertex::ia) is semidet.



:- implementation.

:- import_module counter, eqvclass, list, ref, set.

:- solver type po_vertex where  representation  is vertex,
                                initialisation  is init,
                                equality        is eq.

:- type cstore     --->  cs(counter, set(constraint)).
:- type constraint --->  lt(vertex, vertex) ; le(vertex, vertex).
:- type vertex     ==    int.
:- type path_kind  --->  nonstrict ; strict.

:- func global_cstore = ref(cstore).
:- pragma memo(global_cstore/0).
global_cstore = CStore :-
    promise_pure ( impure CStore = ref.new(cs(counter.init(0), set.init)) ).

init(A) :-
    promise_pure (
        semipure CStore = ref.get(global_cstore),
        CStore = cs(Ctr0, Constraints),

        counter.allocate(X, Ctr0, Ctr),

        impure   ref.set(global_cstore, cs(Ctr, Constraints)),
        impure   A = 'representation to any po_vertex/0'(X)
    ).

eq(A, B) :-
    promise_pure (
        impure   X = 'representation of any po_vertex/0'(A),
        impure   Y = 'representation of any po_vertex/0'(B),
        semipure CStore = ref.get(global_cstore),
        CStore = cs(Ctr, Constraints0),

        ( if   path(X, Y, Constraints0, [], nonstrict)
          then path(Y, X, Constraints0, [], nonstrict),
               Constraints = Constraints0
          else not path(X, Y, Constraints0, [], strict),
               Constraints = Constraints0 `insert` le(Y, X) `insert` le(X, Y)
        ),

        impure   ref.set(global_cstore, cs(Ctr, Constraints))
    ).

A =< B :-
    promise_pure (
        impure   X = 'representation of any po_vertex/0'(A),
        impure   Y = 'representation of any po_vertex/0'(B),
        semipure CStore = ref.get(global_cstore),
        CStore = cs(Ctr, Constraints0),

        ( if   path(X, Y, Constraints0, [], _)
          then Constraints = Constraints0
          else not path(Y, X, Constraints0, [], strict),
               Constraints = Constraints0 `insert` le(X, Y)
        ),

        impure   ref.set(global_cstore, cs(Ctr, Constraints))
    ).

A < B :-
    promise_pure (
        impure   X = 'representation of any po_vertex/0'(A),
        impure   Y = 'representation of any po_vertex/0'(B),
        semipure CStore = ref.get(global_cstore),
        CStore = cs(Ctr, Constraints0),

        ( if   path(X, Y, Constraints0, [], strict)
          then Constraints = Constraints0
          else not path(Y, X, Constraints0, [], _),
               Constraints = Constraints0 `delete` le(X, Y) `insert` lt(X, Y)
        ),

        impure   ref.set(global_cstore, cs(Ctr, Constraints))
    ).

:- pred path(vertex::in, vertex::in, set(constraint)::in, list(vertex)::in,
	path_kind::out) is semidet.

path(X, X, _Constraints, _Path, nonstrict).

path(X, Y,  Constraints,  Path, strict) :-
    member(lt(X, Z), Constraints),
    path(Z, Y, Constraints, [X | Path], _).

path(X, Y,  Constraints,  Path, PathKind) :-
    member(le(X, Z), Constraints),
    not member(Z, Path),
    path(Z, Y, Constraints, [X | Path], PathKind).

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------