[mercury-users] Self-referential data structures

[Henk Vandecasteele]

Warwick HARVEY wrote:
> 
> Hi all,
> 
> Has anybody out there played with stores (or anything else) to implement
> self-referential data structures?
Warwick,

I needed something like a store in the days the store didn't exist yet.
I needed also to have backtrackable destructive assignment in that
store.

I made (with help from Fergus) a mostly unique array with
the use of the ticket system designed for the connection with clp(r).

With this mostly_unique_array I also create self-referential
data-structures like a double-linked list(with constraints).

The first element in the array (with index 0) contains the 
next free element in the array.

This gives code like below. It's ugly because it's partly created 
automatically.

"Da" stands for destructive array.
"Fm", "FM" stands for Fucking Mercury when I have to introduce new
     variables where I don't like it.
"cle" stands for constraint_list_element


Henk

-------------------------------------------------------------------
/* some declarations below */

newConstraintList(Constraint, ConstraintList, Ref , Da0 , Da4):-
	(mostly_uniq_array__lookup(Da0, 0, Info1Da0),
	(Info1Da0 = i(FmRef  ) -> FmRef   = Ref  ;error("create mutable
error")),
	NewRef   is Ref   + 1,
	mostly_uniq_array__set(Da0, 0, i(NewRef  ), TempDa0),
	mostly_uniq_array__set(TempDa0, Ref  , cle(dummy, 0, 0), Da1)),
	(mostly_uniq_array__lookup(Da1, 0, Info1Da1),
	(Info1Da1 = i(FmLast ) -> FmLast  = Last ;error("create mutable
error")),
	NewLast  is Last  + 1,
	mostly_uniq_array__set(Da1, 0, i(NewLast ), TempDa1),
	mostly_uniq_array__set(TempDa1, Last , cle(dummy, 0, Ref), Da2)),
	(mostly_uniq_array__lookup(Da2, 0, Info1Da2),
	(Info1Da2 = i(FmConstraintList ) -> FmConstraintList  = ConstraintList
;error("create mutable error")),
	NewConstraintList  is ConstraintList  + 1,
	mostly_uniq_array__set(Da2, 0, i(NewConstraintList ), TempDa2),
	mostly_uniq_array__set(TempDa2, ConstraintList , cle(dummy, Ref, Last),
Da3)),
	mostly_uniq_array__set(Da3, Ref , cle(Constraint, Last,
ConstraintList), Da4).


addToConstraintList(List1, Constraint, List2, Ref , Da0 , Da3):-
	( List1 =  0 -> 
	  newConstraintList(Constraint, List2,Ref , Da0 , Da3);
	  List2 = List1,
	  mostly_uniq_array__lookup(Da0, List1 , Info1),
	  (Info1 = cle(_, _, FMLast) -> Last = FMLast; error("clhm10")),
	  mostly_uniq_array__lookup(Da0, Last , Info2),
	  (Info2 = cle(_, _, FMPrev) -> Prev = FMPrev; error("clhm11")),
	  mostly_uniq_array__lookup(Da0, Prev , Info3),
	  (Info3 = cle(FMC, _, FMPP) -> C = FMC, PP = FMPP; error("clhm12")),
	  (mostly_uniq_array__lookup(Da0, 0, Info1Da0),
	(Info1Da0 = i(FmRef ) -> FmRef  = Ref ;error("create mutable error")),
	NewRef  is Ref  + 1,
	mostly_uniq_array__set(Da0, 0, i(NewRef ), TempDa0),
	mostly_uniq_array__set(TempDa0, Ref , cle(Constraint, Last, Prev),
Da1)),
	  mostly_uniq_array__set(Da1, Prev , cle(C, Ref, PP), Da2),
	  mostly_uniq_array__set(Da2, Last , cle(dummy, 0, Ref), Da3)
	).


getConstraint(Ref,  Constraint, NewNr , Da0):-
	mostly_uniq_array__lookup(Da0, Ref , Info1),
	(Info1 = cle(_, MNr, _) -> Nr=MNr; error("hm7")),
	mostly_uniq_array__lookup(Da0, Nr , Info),
	(Info = cle(MC, MN, _) -> C=MC,N=MN; error("hm7")),
	(C = dummy ->  N > 0,
	   getConstraint(Nr, Constraint, NewNr , Da0);
           Constraint = C,
	   NewNr = Nr
	).    
		
deleteConstraint(Ref , Da0 , Da3):-
	mostly_uniq_array__lookup(Da0, Ref , Info1),
	(Info1 = cle(_, MN, MP) -> N=MN, P=MP; error("hm8")),
	mostly_uniq_array__lookup(Da0, P , Info2),
	(Info2 = cle(MC2, _, MPP) -> C2=MC2, PP=MPP; error("hm9")),
	mostly_uniq_array__lookup(Da0, N , Info3),
	(Info3 = cle(MC3, MNN, _) -> C3=MC3, NN=MNN; error("hm10")),
	mostly_uniq_array__set(Da0, P , cle(C2, N, PP), Da1),
	mostly_uniq_array__set(Da1, N , cle(C3,NN, P), Da2),
	mostly_uniq_array__set(Da2, Ref , cle(dummy, N, 0), Da3).

:- type global_data ---> i(int)
		;	r(range)
		;       novalue
		;	cle(internal_constraint, int, int) 
		; 	l(constraint_list) 
	        ;       il(list(int))
		;       expr(int, linear_term_list).


:- type constraint_list == int. 
:- type reference_bucket == int. 
:- type deletion_reference == int. 
:- type crossing_reference == int. 

:- pred newConstraintList(internal_constraint, constraint_list, 
     deletion_reference,
     mostly_uniq_array(global_data), mostly_uniq_array(global_data)).
:- mode newConstraintList(in, out, out, mostly_uniq_array_mdi,
mostly_uniq_array_muo) is det.

:- pred addToConstraintList(constraint_list, internal_constraint, 
                         constraint_list, deletion_reference,
                                          
mostly_uniq_array(global_data),
	                                   mostly_uniq_array(global_data)).
:- mode addToConstraintList(in, in, out, out, mostly_uniq_array_mdi, 
                                           mostly_uniq_array_muo) is
det.

:- pred getConstraint(crossing_reference, internal_constraint, 
     crossing_reference, 
     mostly_uniq_array(global_data)).
:- mode getConstraint(in, out, out, mostly_uniq_array_mui) is semidet.

:- pred deleteConstraint(deletion_reference,
                                          
mostly_uniq_array(global_data),
	                                   mostly_uniq_array(global_data)).
:- mode deleteConstraint(in, mostly_uniq_array_mdi,
mostly_uniq_array_muo) is det.