-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

(--DOC
  Lists are sequences based on a linked-list representation. General
  lists support `first' (a.k.a. `car', `head') and `rest'
  (a.k.a. `cdr', `tail') operations, plus all the standard sequence
  operations, like `length', `is_empty', `do', `pick_any', `includes',
  `find', `copy', `reverse_do', `flatten', `||', etc.
--)

abstract object list[T] isa sequence[T];
extend type list[`T] subtypes list[`S >= T];

signature first(list[`T]):T;
signature rest(list[`T]):list[T];
method collection_name(@:list[`T]):string { "list" }

predicate empty_list[T] isa list[T], empty_collection[T];
predicate non_empty_list[T] isa list[T], non_empty_collection[T];

implementation first(@:empty_list[`T]):none {
    error("accessing first element of empty list") }
implementation rest(@:empty_list[`T]):none {
    error("accessing rest of empty list") }


(--DOC
  Simple lists are mutable Lisp-style singly-linked lists with two
  representations, `nil' and `cons'.  Method `cons' creates a new
  cons cell; object `nil[T]' can be used directly.
  Simple lists are mutable, in the sense that
  `set_first' and `set_rest' operations are defined (they produce
  run-time errors when invoked on nil).  However, simple lists
  are not `extensible_sequences' because they do not support `add' in
  place. Instead, `cons' (a.k.a. `add_functional') adds to the front of a
  simple list, returning a new list.
--)

abstract object simple_list[T] isa list[T],
                                   functionally_extensible_collection[T];
-- also supports mutating first and rest fields; refine type of rest field
var field signature first(simple_list[`T]):T;
var field signature rest(simple_list[`T]):simple_list[T];
signature copy(simple_list[`T]):simple_list[T];

method add_functional(l@:simple_list[`T], x:T):simple_list[T] { cons(x, l) }

-- cons * cons version overrides below
method do(c1@:simple_list[`T1], c2@:simple_list[`T2],
	       c:&(T1, T2):void):void {}
method do(c1@:simple_list[`T1], c2@:simple_list[`T2],
		 c3@:simple_list[`T3], c:&(T1, T2, T3):void):void {}

concrete representation nil[T] isa simple_list[T];
method first(@:nil[`T]):none {
    error("accessing first element of empty list") }
method rest(@:nil[`T]):none {
    error("accessing rest of empty list") }
method length(@:nil[`T]):int { 0 }
method is_empty(@:nil[`T]):bool { true }
method do(@:nil[`T], :&(T):void):void {}
method reverse_do(@:nil[`T], :&(T):void):void {}
method copy(n@:nil[`T]):simple_list[T] { n }

method set_first(@:nil[`T], :T):none {
    error("accessing first element of empty list") }
method set_rest(@:nil[`T], :simple_list[T]):none {
    error("accessing rest of empty list") }

template representation cons[T] isa simple_list[T];
var field first(@:cons[`T]):T;
var field rest(@:cons[`T]):simple_list[T] := nil[T];
method length(c@:cons[`T]):int { 1 + c.rest.length }
method is_empty(@:cons[`T]):bool { false }
method do(c@:cons[`T], closure:&(T):void):void {
    eval(closure, c.first);
    do(c.rest, closure);
}
method reverse_do(c@:cons[`T], closure:&(T):void):void {
    reverse_do(c.rest, closure);
    eval(closure, c.first);
}
method do(c1@:cons[`T1], c2@:cons[`T2],
	       c:&(T1,T2):void):void {
    eval(c, c1.first, c2.first);
    do(c1.rest, c2.rest, c);
}
method do(c1@:cons[`T1], c2@:cons[`T2], c3@:cons[`T3],
		 c:&(T1,T2,T3):void):void {
    eval(c, c1.first, c2.first, c3.first);
    do(c1.rest, c2.rest, c3.rest, c);
}
method copy(c@:cons[`T]):simple_list[T] { cons(c.first, c.rest.copy) }

method cons(hd:T, tl@:simple_list[`T]):cons[T] {
    concrete object isa cons[T] { first := hd, rest := tl } }


(--DOC
  To correct this problem, the `m_list' type defines a full-fledged
  mutable, extensible list data structure, implemented as a wrapper
  around a simple list. `m_list' inherits `add' and `remove' from
  `extensible_collection'.  For historical reasons, `add' is defined
  to `add' to the front of the list. `m_list' also inherits
  `{add,remove}_{first,last}' from `extensible_sequence'.
  (This data structure definition doesn't follow the usual pattern:
  add adds to the front of the collection, not to the end; there is no
  i_list data type defined and the m_list data type is concrete rather
  than abstract.) In the future, it would be really nice to define a
  view of doubly-linked lists that treats them as a sequence of link
  nodes. Then lots of list splicing operations could be supported that
  aren't really supported through the existing generic m_list
  interface. E.g. removing an element from a list during an iteration
  through it requires two traversals if written in terms of the m_list
  interface. Doubly-linked and circular lists might also be useful
  data structures.
--)

-- Mutable lists (with in-place mutation).
-- Stacks and queues are a subclass.
-- Have pointer to front & back to support efficient adds/removes, but
-- list is only singly linked.  Thus, removing the last element of the list
-- is still an O(n) operation.  Adding first/last and removing first are O(1).

template object m_list[T] isa list[T], extensible_sequence[T];
  private var field front(@:m_list[`T]):simple_list[T] := nil[T];
  private var field back(@:m_list[`T]):simple_list[T] := nil[T];
  private var field length(@:m_list[`T]):int := 0;

extend m_list[`T <= comparable[T]] isa removable_collection[T];

method reverse_do(l@:m_list[`T], c:&(T):void):void {
    -- this is pretty expensive; since its recursive and all
    reverse_do(l.front, c); }

method do(l@:m_list[`T], c:&(T):void):void (** inline **) {
    -- implement tail-recursive traversal of a simple list
    -- as an in-line while loop
    let var cell:simple_list[T] := l.front;
    while({ cell !== nil[T] }, {
	eval(c, cell.first);
	cell := cell.rest;
    });
}
method do(l1@:m_list[`T1], l2@:m_list[`T2],
	       c:&(T1,T2):void):void (** inline **) {
    -- implement tail-recursive parallel traversal of two simple lists
    -- as an in-line while loop
    let var cell1:simple_list[T1] := l1.front;
    let var cell2:simple_list[T2] := l2.front;
    while({ cell1 !== nil[T1] & { cell2 !== nil[T2] }}, {
	eval(c, cell1.first, cell2.first);
	cell1 := cell1.rest;
	cell2 := cell2.rest;
    });
}
method do(l1@:m_list[`T1], l2@:m_list[`T2], l3@:m_list[`T3],
		 c:&(T1,T2,T3):void):void {
    -- implement tail-recursive parallel traversal of three simple lists
    -- as an in-line while loop
    let var cell1:simple_list[T1] := l1.front;
    let var cell2:simple_list[T2] := l2.front;
    let var cell3:simple_list[T3] := l3.front;
    while({ cell1 !== nil[T1] & { cell2 !== nil[T2] & { cell3 !== nil[T3] }}},{
	eval(c, cell1.first, cell2.first, cell3.first);
	cell1 := cell1.rest;
	cell2 := cell2.rest;
	cell3 := cell3.rest;
    });
}

method first(l@:m_list[`T]):T { l.front.first }
method second(l@:m_list[`T]):T { l.front.rest.first }
method rest(l@:m_list[`T]):m_list[T] {
    let r:m_list[T] := new_m_list[T]();
    if(l.length > 1, {
	r.front := l.front.rest;
	r.back := l.back;
	r.length := l.length.pred;
    });
    r }


method add(l@:m_list[`T], x:T):void {
    l.add_first(x);
}
method add_first(l@:m_list[`T], x:T):void {
    let new:simple_list[T] := cons(x, l.front);
    if(l.is_empty, {
	l.back := new;
    });
    l.front := new;
    l.length := l.length.succ;
}
method add_last(l@:m_list[`T], x:T):void {
    if(l.is_empty, {
	add(l, x);
    }, {
	let new:simple_list[T] := cons(x, nil[T]);
	l.back.rest := new;
	l.back := new;
	l.length := l.length.succ;
    });
}

method remove(l@:m_list[`T <= comparable[T]], x:T, if_absent:&():void):void {
    l.remove_and_return_one(&(c:T){ c = x }, { eval(if_absent); ^ });
    void }

-- this rather wierd function is exactly what we need to implement efficient
-- removes for data structures which are built on top of m_list's without
-- epxosing details of the m_list implementation to the clients.
-- It removes the first element which makes test evaluate to true and then
-- returns the data element to the client.
method remove_and_return_one(l@:m_list[`T], test:&(T):bool,
			     if_absent:&():`Else):T|Else {
    if(l.non_empty, {
	if(eval(test, l.front.first), {
	    -- removing the first element of the list, need to fix front ptr
	    let x:T := l.front.first;
	    l.front := l.front.rest;
	    l.length := l.length.pred;
	    if(l.is_empty, {
		l.back := nil[T];
	    });
	    ^ x
	});
	-- at this point, list is non empty, and will not remove first elem
	let var prev:simple_list[T] := l.front;
	let var cur:simple_list[T] := prev.rest;
	while({ cur !== nil[T] }, {
	    if(eval(test, cur.first), {
		let x:T := cur.first;
		prev.rest := cur.rest;
		if(cur.rest == nil[T], {
		    -- was last element, need to fix back ptr
		    l.back := prev;
		});
		l.length := l.length.pred;
		^ x
	    });
	    prev := cur;
	    cur := cur.rest;
	});
    });
    eval(if_absent);
}

method remove_if(l@:m_list[`T], test:&(T):bool):int {
    -- keep removing the first element of the list until either it
    -- fails the test or there are no elements remaining
    let var init_len:int := l.length;
    while({ l.front !== nil[T] & { eval(test, l.front.first) } }, {
	l.front := l.front.rest;
	l.length := l.length.pred;
    });

    -- at this point, we know that the first element of the list will
    -- not be removed (if it exists at all)
    if(l.non_empty, {
	-- current first element will not be removed, thus we know that the
	-- list will be non-empty after we are done.
	let var prev:simple_list[T] := l.front;
	let var cur:simple_list[T] := prev.rest;
	while({ cur !== nil[T] }, {
	    if(eval(test, cur.first), {
		-- cur.first contains an element that should be removed
		prev.rest := cur.rest;
		if(cur.rest == nil[T], {
		    -- was last element, need to fix back ptr
		    l.back := prev;
		});
		l.length := l.length.pred;
		cur := cur.rest;
	    }, {
		prev := cur;
		cur := cur.rest;
	    });
	});
    }, {
	-- list was empty, need to blitz back ptr
	l.back := nil[T];
    });
    init_len - l.length;
}

method remove_first(l@:m_list[`T], if_empty:&():`S):T|S (** inline **) {
    if(l.is_empty, {
	eval(if_empty)
    }, {
	let x:T := l.front.first;
	l.front := l.front.rest;
	l.length := l.length.pred;
	if(l.is_empty, {
	    -- removed the only element in the list, fix back ptr
	    l.back := nil[T];
	});
	x
    }) }

method remove_last(l@:m_list[`T], if_empty:&():`S):T|S {
    if(l.is_empty, {
	eval(if_empty)
    }, {
	if(l.front.rest == nil[T], {
	    let x:T := l.front.first;
	    l.front := nil[T];
	    l.back := nil[T];
	    l.length := 0;
	    x
	}, {
	    -- boy, it is a pain to remove the last element
	    -- in a singly-linked list
	    let var prev:simple_list[T] := l.front;
	    let var cur:simple_list[T] := l.front.rest;
	    while({ cur.rest !== nil[T] }, {
		prev := cur;
		cur := cur.rest;
	    });
	    let x:T := cur.first;
	    prev.rest := nil[T];
	    l.back := prev;
	    l.length := l.length.pred;
	    x
	})
    }) }

method splice_onto_end(l1@:m_list[`T], l2:m_list[T]):m_list[T] {
    if(l1.is_empty, { ^ l2 });
    if(l2.is_empty, { ^ l1 });
    l1.back.rest := l2.front;
    l1.back := l2.back;
    l1.length := l1.length + l2.length;
    l1 }

method remove_all(l@:m_list[`T]):void {
    l.front := nil[T];
    l.back := nil[T];
    l.length := 0;
}

method new_m_list[T]():m_list[T] { concrete object isa m_list[T] }

method copy_empty(l@:m_list[`T]):m_list[T] { new_m_list[T]() }

method copy(l@m_list[`T]:`L <= m_list[`T]):LC 
				where signature copy_empty(L):`LC {
    let new := l.copy_empty;
    if(l.is_empty, { ^ new });
    new.front := cons(l.front.first, nil[T]);
    let var prev:simple_list[T] := new.front;
    let var old_ptr:simple_list[T] := l.front;
    while({ old_ptr := old_ptr.rest; old_ptr !== nil[T] }, {
	let temp:simple_list[T] := cons(old_ptr.first, nil[T]);
	prev.rest := temp;
	prev := temp;
    });
    new.back := prev;
    new.length := l.length;
    new }

(--
   An old predicate object-based version of lists.
   Too slow now for actual use, also a little out of date.

template object m_list[T] isa list[T], extensible_sequence[T];
extend m_list[`T <= comparable[T]] isa removable_collection[T];

private var field elems(@:m_list[`T]):simple_list[T] := nil[T];

predicate empty_m_list[T] isa m_list[T], empty_list[T];
predicate non_empty_m_list[T] isa m_list[T], non_empty_list[T];
predicate singleton_m_list[T] isa m_list[T], singleton_collection[T];
predicate multiple_m_list[T] isa m_list[T], multiple_collection[T];

-- simple forwarders
method length(l@:m_list[`T]):int { l.elems.length }
method is_empty(l@:m_list[`T]):bool { l.elems.is_empty }
method do(l@:m_list[`T], c:&(T):void):void { do(l.elems, c); }
method reverse_do(l@:m_list[`T], c:&(T):void):void { reverse_do(l.elems, c); }
method do(l1@:m_list[`T1], l2@:m_list[`T2],
	       c:&(T1,T2):void):void {
    do(l1.elems, l2.elems, c);
}
method do(l1@:m_list[`T1], l2@:m_list[`T2],
		 l3@:m_list[`T3], c:&(T1,T2,T3):void):void {
    do(l1.elems, l2.elems, l3.elems, c);
}
method first(l@:m_list[`T]):T { l.elems.first }
method set_first(l@:m_list[`T], x:T):void { l.elems.first := x; }
method rest(l@:m_list[`T]):m_list[T] {
    let r:m_list[T] := new_m_list[T]();
    r.elems := l.elems.rest;
    r }
method set_rest(l@:m_list[`T], x:m_list[T]):void {
    l.elems.rest := x.elems; }

method add(l@:m_list[`T], x:T):void {
    l.add_first(x);
}
method add_first(l@:m_list[`T], x:T):void {
    l.elems := cons(x, l.elems);
}
method add_last(l@:empty_m_list[`T], x:T):void { add(l, x); }
method add_last(l@:non_empty_m_list[`T], x:T):void {
    let var c1:simple_list[T] := l.elems;
    let var c2:simple_list[T] := c1.rest;
    while({ non_empty(c2) }, { c1 := c2; c2 := c2.rest; });
    c1.rest := cons(x, c1.rest);
}

method remove(l@:non_empty_m_list[`T <= comparable[T]], x:T,
	      if_absent:&():void):void {
    if(l.elems.first = x, { l.elems := l.elems.rest; ^ });
    let var c1:simple_list[T] := l.elems;
    let var c2:simple_list[T] := c1.rest;
    while({ non_empty(c2) }, {
	if(c2.first = x, { c1.rest := c2.rest; ^ });
	c1 := c2; c2 := c2.rest; });
    eval(if_absent);
}

method remove_if(l@:m_list[`T], test:&(T):bool):int {
    let var count:int := 0;
    let var prev:simple_list[T] := nil[T];
    let var next:simple_list[T] := l.elems;
    while({ next.non_empty }, {
	if(eval(test, next.first), {
	    next := next.rest;
	    if(prev.is_empty, {
		l.elems := next;
	    }, {
		prev.rest := next;
	    });
	    count := count + 1;
	}, {
	    prev := next;
	    next := next.rest;
	});
    });
    count
}

method remove_first(l@:non_empty_m_list[`T], if_empty:&():`S):T|S {
    let x:T := l.elems.first;
    l.elems := l.elems.rest;
    x }
method remove_last(l@:singleton_m_list[`T], if_empty:&():`S):T|S {
    remove_first(l, if_empty) }
method remove_last(l@:multiple_m_list[`T], if_empty:&():`S):T|S {
    let var c1:simple_list[T] := l.elems;
    let var c2:simple_list[T] := c1.rest;
    let var c3:simple_list[T] := nil[T];
    while({ c3 := c2.rest; non_empty(c3) }, { c1 := c2; c2 := c3; });
    let x:T := c2.first;
    c1.rest := c3;
    x }
method remove_all(l@:m_list[`T]):void {
    l.elems := nil[T];
}

method new_m_list[T]():m_list[T] { concrete object isa m_list[T] }

method copy(l@:m_list[`T]):m_list[T] {
    concrete object isa m_list[T] { elems := l.elems.copy } }

--)