(*********************************************************
 | ML definitions.  A flat version (without structures)  |
 | of the contents of                                    |
 |    Chrisprelude, Charpics, Life                       |
 | For use with ML implementations without modules       |
 |                                                       |
 | Chris Reade   19th October 1993                       |
 *********************************************************)

(*********** FUNCTIONS FROM Chrisprelude **********************************)

exception ex_error of string;
fun error s = (output(std_out,"ERROR REPORT:\n"^s^"\n"); raise ex_error s);

fun equal a b = a=b;

fun I x = x;
fun K x y = x;
fun C f x y = f y x;
fun W f x = f x x;
fun Y f = let fun fixf x = f (fixf) x in fixf end;
fun curry f a b = f(a,b);
fun uncurry f (a,b) = f a b;
fun pair a b = (a,b);
fun fst(x,y) = x;
fun snd(x,y) = y;
fun couple f g x = (f x,g x);
fun repeat f = let fun rptf n x = if n=0 then x else rptf (n-1) (f x);
                   fun check n = if n<0 then error "repeat <0" else n
               in rptf o check end;

fun plus (a:int) b = a+b;
fun times (a:int) b = a*b;
fun less (a:int) b = b<a;
fun lesseq (a:int) b = b<=a;
fun greater (a:int) b = b>a;
fun greatereq (a:int) b = b>=a;
fun max (a:int) b = if a<b then b else a;
fun min (a:int) b = if a<b then a else b;

fun non p = not o p;
fun ou p q x = p x orelse q x;
fun et p q x = p x andalso q x;

fun assoc pairlist default arg
             = let fun search []         = default arg 
                   |   search ((a,b)::x) = if arg = a then b else search x
               in search pairlist end;
fun fold f = let fun foldf a []     = a 
                 |   foldf a (b::x) = foldf (f a b) x 
             in foldf end;
val accumulate = fold;
fun foldright f a x = accumulate (C f) a (rev x);
fun zip f = let fun zf (a::x) (b::y) = f a b :: zf x y 
                |   zf [] []  = []
                |   zf _  _   = error "zip with different lengthed lists"
            in zf end;
fun splice f = let fun sf (a::x) (b::y) = f a b :: sf x y 
                   |   sf x [] = x 
                   |   sf [] x = x
               in sf end;
fun filter p = let fun consifp x a = if p a then a::x else x
               in rev o accumulate consifp [] end;
fun exists p = let fun existsp [] = false 
                   |   existsp (a::x) = if p a then true
                                               else existsp x
               in existsp end;
val forall =  non o exists o non;
fun member x a = exists (equal a) x ;
fun contains x y = forall (member y) x;
fun null [] = true
|   null _  = false;
fun hd(a::x) = a 
|   hd []    = error "hd of [] is undefined" 
and tl(a::x) = x 
|   tl []    = error "tl of [] is undefined";
fun cons a x = a::x;
fun append x y = x @ y;

   infix 5 upto ;
fun n upto m = if n>m then [] else n::(n+1 upto m);
val revonto = accumulate (C cons);
val reverse = revonto [];
fun link llist = rev (accumulate revonto [] llist) ;
fun linkwith (front,sep,back) l
               = let fun f []  = [back] 
                     |   f [a] = [a,back] 
                     |   f (a::x) = a::sep::f x
                 in link (front::f l)  end;
val pairlists = zip pair;
fun copy n x = repeat (cons x) n [];
val sumlist = accumulate plus 0;
val mullist = accumulate times 1;

fun maxlist (a::x) = accumulate max a x 
|   maxlist []     = error "maxlist of [] is undefined";
fun maxposlist x   = accumulate max 0 x;
fun transpose [] = [] 
|   transpose x  = if exists null x 
                   then [] 
                   else (map hd x):: transpose (map tl x);
val length = let fun count n a = n+1
             in accumulate count 0 end;
val drop = repeat tl;
fun split n = if n<0 
              then error "negative subscript error(split failed)"
              else let fun shunt 0 x1 x2      = (rev x1,x2)
                       |   shunt n x1 (a::x2) = shunt (n-1) (a::x1) x2
                       |   shunt _  _  _      = error "list subscript error(split failed)"
              in shunt n [] end;
fun front n x = fst(split n x);
fun back n x = drop (length x - n) x;
fun select n = hd o (drop (n-1));
fun sublist n m x =  front m (drop (n-1) x);

fun concat s1 s2 = s1 ^ s2;
fun show x = output(std_out,x);
fun stringwith (front,sep,back) sl 
               = let fun f []  = [back] 
                     |   f [a] = [a,back] 
                     |   f (a::x) = a::sep::f x
                 in implode (front::f sl)  end;
fun spaces n = implode (copy n " ");
fun newlines n = implode (copy n "\n");
local
  fun cofdig n = chr (n+48);
  fun stringofnat n = if n<10 then cofdig n
                              else stringofnat (n div 10) ^ cofdig (n mod 10)
in
  fun stringofint n = if n<0 then "~" ^ stringofnat(~n)
                            else stringofnat n
end;
fun sless (s:string) s' = s' < s;
fun slesseq (s:string) s' = s' <= s;

(******** BRIEF DESCRIPTION OF CHRISPRELUDE FUNCTIONS ABOVE ***********

The functions described here are (mostly) of general use in
constructing further functions.
Some are more specialised and are included to illustrate
ways in which functions can be defined and used in ML.
(One or two higher order functions may look obscure because of
the amount of parameterisation, but they are flexible and can
be easily specialised once understood.)
Each function is given with its type, a brief description and
its actual definition.

error : string -> 'a
When error is applied to any string, the result is undefined
(the result type is arbitrary since there is no result).
The purpose of error is to  cause the program to abort with the
error message supplied as its argument when such an application
is evaluated in some larger expression.
(See the definitions of hd and tl for examples of its use.)
Evaluation abortion is achieved using ML's exception mechanism,
but exceptions are not defined or raised anywhere else in these
definitions other than through applications of 'error'.
(ex_error is the name of the (only) exception raised).

Boolean Related Functions *********************
ou : ('a -> bool) -> ('a -> bool) -> 'a -> bool
combines predicates using 'or' so that
ou p q a = p a orelse q a

et : ('a -> bool) -> ('a -> bool) -> 'a -> bool
combines predicates using 'and' so that
et p q a = p a andalso q a

non : ('a -> bool) -> 'a -> bool
negates a predicate so that
non p a = not(p a)

List Operations *******************************
exists : ('a -> bool) -> 'a list -> bool   
exists p x is true if x contains an item satisfying
predicate p and isfalse otherwise.

maxlist : int list -> int   
maxlist x produces the maximum integer in list x (x non-empty)
and raises ex_undefined if x is empty.

zip : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list   
zip extends two place functions to act on lists in a
zip-fastener fashion.
e.g. zip f [a1,a2,...,an] [b1,b2,...,bn] = [f a1 b1, f a2 b2,..., f an bn] 
zip raises ex_undefined if the list lengths are not the same.

accumulate : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a   
accumulate is a synonym for fold.

foldright : ('a -> 'b -> 'b) -> 'b -> 'a list -> 'b  
foldright is similar to accumulate/fold but associating the
argument-function applications to the right instead of the left.
E.g. foldright f a [a1,a2,a3,...,an] = f a1 (f a2 (f a3 (...(f an a)...)))
It is defined in terms of accumulate in order to benefit from
tail recursion optimisation.

cons : 'a -> 'a list -> 'a list   
cons is a curried version of the list constructor.

maxposlist : int list -> int   
maxposlist x is equivalent to maxlist(0::x) and produces 0 if
x is empty or if x contains only negative integers.

member : ''a list -> ''a -> bool   
a test for membership of a list. member [2,4,7,9] 7 = true

assoc : (''a -> 'c) -> ((''a * 'c) list) -> ''a -> 'c
This complex looking function essentially builds a function
from a list of pairs (representing a mapping).
It takes an additional parameter, 
namely: a default function to be used if no match is found.
E.g. fun example = assoc I [(2,4),(3,9)]
Then example 2 = 4, example 3 = 9 and example x = x for any
other int x.

append : 'a list -> 'a list -> 'a list   
append is a curried form for the infix operator @

null : 'a list -> bool   
The predicate null asks if a list is empty

hd : 'a list -> 'a   
The selector hd and tl returns the first item
when applied to a non empty list. 
It raises ex_undefined if applied to the empty list.

revonto : 'a list -> 'a list -> 'a list   
revonto x y is the list produced by reversing list y onto the
front of x. e.g. revonto x [a1,a2,...,an] = [an,...a2,a1] @ x

linkwith : 'a list * 'a list * 'a list -> 'a list list -> 'a list
linkwith (front,sep,back) l  links together a list of lists l  
into a single list seperating each list with the list sep and
surrounding the result by  the lists front and back.
e.g. linkwith (front,sep,back) [a1,a2,a3,...an]
      = front @ a1 @ sep @ a2 @ sep @ a3 @ sep ... @ an @ back

copy : int -> 'a -> 'a list   
copy n x produces a list n copies of x (n>=0) and raises abort if n<0.

splice : ('a -> 'a -> 'a) -> 'a list -> 'a list -> 'a list   
splice extends two place functions to act on lists in the same
way as zip. The difference is that splice appends the remainder
of the longer list if given lists of different lengths and it
has a more restrictive type.
e.g. splice f [a1,a2,...,an] [b1,b2,...,bm] 
      = [f a1 b1, f a2 b2, ... , f an bn] @ [bn',...,bm] 
      when n <= m (n'=n+1) and similarly. 
      = [f a1 b1, f a2 b2, ... , f am bm] @ [am',...,an] 
      when m <= n (m'=m+1). 

forall : ('a -> bool) -> 'a list -> bool   
forall p x is true if every item in x satisfies p and is
false otherwise.

sumlist : int list -> int   
sumlist x produces the sum of the integers in list x.

mullist : int list -> int
mullist x produces the product of the integers in list x.

length : 'a list -> int   
length x returns the length of list x.

drop : int -> 'a list -> 'a list
drop n x is the remainder of list x after dropping the
first n items.
It raises ex_undefined when n<0 and when n>length x.

filter : ('a -> bool) -> 'a list -> 'a list   
filter p x returns the sublist of those items in list x which
satisfy the predicate p (in the same order as they appear in x).
back : int -> 'a list -> 'a list
back n x is the last n items of list x.
It raises ex_undefined when n<0 and when n>length x

upto : int * int -> int list   
upto is an infix operator. "n upto m" produces the ascending
list of integers between and including n and m (n<=m)
and is [] if n>m. e.g. 3 upto 7 = [3,4,5,6,7]
YOU MAY NEED to reaffirm 'infix upto;'
before using it this way.

front : int -> 'a list -> 'a list
front n x is the first n items of x.
It raises ex_undefined when n<0 and when n>length x.

select : int -> 'a list -> 'a   
select n x returns the nth item in list x
(starting at 1 for the head).
It raises ex_undefined when n is too large and when n<1.

pairlists : 'a list -> 'b list -> ('a * 'b) list   
pairlists forms a list of pairs by combining two lists
componentwise e.g.
pairlists [a1,a2, ..., an] [b1,b2,...,bn] = [(a1,b1),(a2,b2),...,(an,bn)]
pairlists raises ex_undefined if the list lengths are not the same.

split : int -> 'a list -> ('a list * 'a list)
split n x returns a pair of lists consisting of the front n
items of x and the rest of x, respectively. 
It raises ex_undefined when n<0 and when n>length x.

sublist : int -> int -> 'a list -> 'a list
sublist n m x is the list of m items starting with and
following on from the nth item of x.
It raises ex_undefined when n<1 and when m<0 and when n+m-1>length x.

transpose : 'a list list -> 'a list list   
transpose takes a list of lists thought of as rows of a matrix and   
produces the list of lists representing columns.
Any rows longer than the shortest row will be clipped.   

tl : 'a list -> 'a list
The selector hd and tl returns the list without the first item
when applied to a non empty list. 
It raises ex_undefined if applied to the empty list.

fold : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a   
fold combines items in a list with a two place function and a
default value to reduce the list.
e.g. fold f a [a1,a2,a3,...,an] = f (f...(f (f a a1) a2) a3) ...an

reverse : 'a list -> 'a list   
reverse just reverses a list and is equivalent to predefined rev.

link : 'a list list -> 'a list   
link llist  links together llist (a list of lists) into a single list    
e.g. link [a1,a2,a3,...an] = a1 @ a2 @ a3 @ ... @ an

contains : ''a list -> ''a list -> bool   
contains is a list version of set containment.
Testing whether list y contains all the items in x is written:
      contains x y
NOTE THE ORDER OF ARGUMENTS (contains x) is a predicate on lists such as y
contains [2,4,7,9] [3,7,9,5,4,2] = true


Some Combinators ********************************
uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c   
If f is a function expecting two successive arguments, then
(uncurry f) is a similar function applicable to argument pairs.

I : 'a -> 'a
I is the identity function

couple : ('a -> 'b) -> ('a -> 'c) -> 'a -> 'b * 'c
couple is used to apply two functions to the same argument
to return a pair of results.
Thus couple f g a = (f a, g a).

K : 'a -> 'b -> 'a   
K forms constant functions, so that K x returns x when applied
to anything

curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c   
If f is a function expecting an argument pair, then (curry f)
is a similar function expecting the arguments one at a time

snd : 'a * 'b -> 'b
snd returns the second item from a pair

W = fn : ('a -> 'a -> 'b) -> 'a -> 'b
W duplicates an argument for a curried function (W f a =  f a a)
Y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b   
Y is the fixed point combinator. If F is an operation on functions 
returning a function of the same type, then Y F is the (least) 
fixed point of F satisfying F(Y F) = (Y F).

repeat : ('a -> 'a) -> int -> 'a -> 'a   
repeat f n x is equivalent to n applications of f to x, i.e.
f (f (f...(f x)..)).
However, if n<0 then repeat f n x raises ex_undefined.

C : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c   
C swaps the arguments for a curried function so (C f) x y = f y x.

pair : 'a -> 'b -> 'a * 'b   
pair is a curried function constructing pairs.

fst : 'a * 'b -> 'a
fst returns the first item from a pair

Operations on Strings *************************
slesseq : string -> string -> bool
curried <= for strings where slesseq s1 s2 = s2<=s1
NOTE argument order.

sless : string -> string -> bool
curried < for strings where sless s1 s2 = s2<s1
NOTE argument order.

stringofint : int -> string
converts any integer to its decimal representation as a string

stringwith : string * string * string -> string list -> string
stringwith is a string version of linkwith.
E.g. stringwith (front,sep,back) [s1,s2,s3,...,sn]
      = front ^ s1 ^ sep ^ s2 ^ sep ^ ... ^ sn ^ back

spaces : int -> string
spaces n is a string of n space chars (n>=0) and raises
ex_undefined if n<=0.

newlines : int -> string
newlines n is a string of n newline chars (n>=0) raises
ex_undefined if n<=0.

show : string -> unit   
show prints a string at the terminal as a side effect.
For functional programming, it should only be used at top level
for  displaying strings in their crude form
(with control characters interpreted) or for defining other,
similarly restricted, display functions.

concat : string -> string -> string   
concat is a curried version of the string concatenator ^

Integer Arithmetic
greatereq : int -> int -> bool   
greatereq is a curried version of < for integers
BUT NOTE THE ORDER OF ARGUMENTS
(greatereq a) is a predicate which when applied to b returns true if b>=a.

min : int -> int -> int   
min a b returns the smaller of integers a and b

greater : int -> int -> bool   
greater is a curried version of > for integers
BUT NOTE THE ORDER OF ARGUMENTS
(greater a) is a predicate which when applied to b returns true if b>a.

max : int -> int -> int   
max a b returns the larger of integers a and b

lesseq : int -> int -> bool   
lesseq is a curried version of <= for integers
BUT NOTE THE ORDER OF ARGUMENTS
(lesseq a) is a predicate which when applied to b returns true if b<=a.

times : int -> int -> int   
times is a curried version of * for integers

less : int -> int -> bool   
less is a curried version of < for integers
BUT NOTE THE ORDER OF ARGUMENTS
(less a) is a predicate which when applied to b returns true if b<a.

plus : int -> int -> int   
plus is a curried version of + for integers



******** FUNCTIONS FROM Charpics and ABSTRACT TYPE PICTURE *****************)


abstype picture = Pic of int * int * string list
with
     fun mkpic linelist 
               = let val d = length linelist;
                     val shape = map size linelist;
                     val w = maxposlist shape;
                     fun addspaces line = let val a = size line in
                                           if a<w then line^spaces(w-a) 
                                                  else line
                                          end;
                     val checkedlines = map addspaces linelist
                 in Pic(d,w,checkedlines) end;

     fun depth (Pic(d,_,_)) = d;
     fun width (Pic(_,w,_)) = w;
     fun linesof (Pic(_,_,sl)) = sl;
     val nullpic = Pic(0,0,[]);
     fun padside n (pic as Pic(d,w,sl))
          = if n <= w then pic
                      else Pic(d,n,map (fn s=>s^spaces(n-w)) sl);
     fun padbottom n (pic as Pic(d,w,sl))
          = if n <= d then pic
                      else Pic(n,w,sl @ copy (n-d) (spaces w));
    fun rowwith fsb piclist 
          = let val d' = maxposlist(map depth piclist);
                val blocks = map (linesof o padbottom d') piclist;
                fun mkline n = stringwith fsb (map (select n) blocks);
                val sl' = map mkline (1 upto d');
                val w' = if null sl' then 0 else size(hd sl')
            in Pic(d',w',sl') end;

    val row = rowwith ("","","");

    fun colwith (f,s,b) piclist
          = let val w' = maxposlist(map width piclist);
                val flines = map (implode o (copy w')) (explode f);
                val slines = map (implode o (copy w')) (explode s);
                val blines = map (implode o (copy w')) (explode b);
                val sl' = linkwith(flines,slines,blines)
                                  (map (linesof o padside w') piclist);
                val d' = length sl'
             in Pic(d',w',sl') end;

    val column = colwith ("","","");

    fun indent n (pic as Pic(d,w,sl))
               = if n<1 then pic
                        else Pic(d,w+n,map (concat(spaces n)) sl);

    fun lower n (pic as Pic(d,w,sl))
               = if n<1 then pic
                        else Pic(d+n,w,copy n (spaces w) @ sl);

   fun table [] = nullpic |
       table piclistlist 
                = let fun mkrect piclistlist  (* makes sure each list has same length *)
                  = let val sizerows = map length piclistlist;
                        val maxrow = maxposlist sizerows;
                        fun addnulls len piclist
                            = if len<maxrow 
                              then piclist @ (copy (maxrow-len) nullpic)
                              else piclist
                    in zip addnulls sizerows piclistlist end;
               val newpics = mkrect piclistlist;
               val picwidths = map(map width) newpics
               val colwidths = map maxposlist (transpose picwidths);
               val picrowlists = map (zip padside colwidths) newpics;
               val tablerows = map (rowwith ("|","|","|")) picrowlists;
               fun dashes n = implode (copy n "-");
               val sep = stringwith ("+","+","+") (map dashes colwidths);
               val sl' = linkwith ([sep],[sep],[sep]) (map linesof tablerows);
               val d' = length sl';
               val w' = size(hd sl')
           in Pic(d',w',sl') end;

    fun frame picture = table [[picture]];
           
    fun header s pic = colwith ("","~","") [mkpic[s],pic];

    fun showpic picture
            = (show(stringwith ("","\n","\n") (linesof picture));picture);

    fun paste n m pic1 pic2   (* n,m may be negative, pic2 goes over *)
                              (* pic1 at n rows down and m chars in  *)
            = if n<0 then paste 0 m (lower (~n) pic1) pic2 else
              if m<0 then paste n 0 (indent(~m) pic1) pic2 else
              let val pic1' = padbottom (n+depth pic2) (padside (m+width pic2) pic1);
                  fun spliceat n f x y = if   n<1 
                                         then splice f x y
                                         else hd x::spliceat (n-1) f (tl x) y;
                  fun overlay a b = b;
                  fun stringop line line' = implode(spliceat m overlay 
                                                             (explode line)
                                                             (explode line'));
                  val sl' = spliceat n stringop (linesof pic1') (linesof pic2);
                  val w' = if null sl' then 0 else size(hd sl');
                  val d' = length sl'
              in Pic(d',w',sl') end;

   fun cutfrom pic n m a b  (* n,m,a,b may be negative, a picture of size a deep and b wide *)
                            (* is cut from pic starting at n rows down and m chars in       *)
            = if n<0 then cutfrom (lower (~n) pic) 0 m a b else
              if m<0 then cutfrom (indent(~m) pic) n 0 a b else
              if a<0 then cutfrom pic (n+a) m (~a) b       else
              if b<0 then cutfrom pic n (m+b) a (~b)       else
              let val pic' = padbottom (n+a) (padside (m+b) pic);
                  fun edit str = implode(sublist (m+1) b (explode str));
                  val newsl = map edit (sublist (n+1) a (linesof pic'))
              in Pic(a,b,newsl) end

end (* of abstract type picture *);

(************* COMMENTS ON CHARPIC FUNCTIONS *****************************

The following are available for constructing character pictures
 
abstype picture

** BASIC OPERATIONS ****************

 mkpic       : (string list) -> picture
             This can be used to form very simple atomic pictures.
             The argument should be a list of the picture lines.
 showpic     : picture -> picture
             This can be used to look at a picture. (It is actually
             the identity operation with a side effect printing the
             picture. Consequently it should only be used at the top level.
 depth       : picture -> int
             Returns the number of lines
 width       : picture -> int
             Returns the length of the longest line
 linesof     : picture -> (string list)
             Returns the lines themselves (used in defining some other ops.)
 nullpic     : picture
             An empty picture. (Equivalent to mkpic[]).

** MAIN PICTURE OPERATIONS *******

 frame       : picture -> picture
             This outlines a picture using "+---+" and "|"
 table       : ((picture list) list) -> picture
             This forms a table when supplied with a list of the rows of the
             table. Each row should be a list of pictures.
 paste       : int -> (int -> (picture -> (picture -> picture)))
             paste n m p1 p2 places p2 ontop of p1 at the point after
             n characters down and m characters along. It is robust in that
             it works for negative n and m and when p1 is too small.
 cutfrom     : picture -> (int -> (int -> (int -> (int -> picture))))
             cutfrom p n m d w produces a picture of depth d and width w
             cut from p starting at the point after n characters down and
             m characters along. (None of the integers are required to be 
             positive.

** SOME OTHER PICTURE OPERATIONS *******

 row         : (picture list) -> picture
             This forms a picture by lining up a list of pictures as a row
 column      : (picture list) -> picture
             This forms a picture by lining up a list of pictures as a column
 rowwith     : (string * string * string) -> ((picture list) -> picture)
             Similar to row, but a triple of strings must be supplied
             to be duplicated on the left, between pictures and on the
             right respectively.
 colwith     : (string * string * string) -> ((picture list) -> picture)
             Similar to column, but a triple of strings must be supplied
             (characters) to be duplicated along the top, between pictures
             and along the bottom, respectively.
 indent      : int -> (picture -> picture)
             indent n p adds spaces to the left of p
 lower       : int -> (picture -> picture)
             lower n p adds spaces at the top of p
 padside     : int -> (picture -> picture)
             padside n p forms a picture of AT LEAST width n using
             spaces to pad when necessary.
 padbottom   : int -> (picture -> picture)
             padbottom n p forms a picture of AT LEAST depth n using
             spaces to pad when necessary.
 header    : string -> (picture -> picture)
             The string is supplied as a heading to be placed above the picture.

***********************************************************************)

(***** FUNCTIONS FROM LIFE Including type generation ******************
 * type generation
 * val mkgen         : (int * int) list -> generation
 * val alive         : generation -> (int * int) list
 * val mk_nextgen_fn : ((int * int) -> (int * int) list) -> (generation -> generation)
 *------------------------------------------------------------------------------------
 * generation is an abstract type with operations mkgen and alive and mk_nextgen_fn.
 * mkgen produces a generation from an arbitrary list of coordinates (integer pairs)
 *   for live squares.
 * alive produces the list of coordinates of live squares of a generation
 *   in lexical order (with no repetitions).
 * mk_nextgen_fn can be used to produce a nextgeneration function of type
 *   generation -> generation. It should be supplied with an argument function
 * which calculates the neighbours of a coordinate. For example, if you first define
 *                            neighbours:(int*int)->(int*int)list 
 * Then you can define        val nextgen = mk_nextgen_fn (neighbours)
 * This allows you to experiment with different neighbour functions (usually 8 neigh-
 * bours possibly modified with wraparound or cutoff at some upper and lower limits).
 ************************************************************************************)

local (*********************** AUXILIARY DEFINITIONS *****************************)
    fun lexordset [] = []
      | lexordset (a::x) = lexordset(filter (lexless a) x) @ [a] @
                           lexordset(filter (lexgreater a) x)
    and lexless (a1:int,b1:int) (a2,b2) = a2<a1 orelse (a2=a1 andalso b2<b1)
    and lexgreater pr1 pr2 = lexless pr2 pr1;
    fun collect f list 
            = let fun accumf sofar [] = sofar
                    | accumf sofar (a::x) = accumf (revonto sofar (f a)) x
              in accumf [] list end;
    fun occurs3 x   (* finds coords which occur exactly 3 times in coordlist x *)
        = let fun f xover x3 x2 x1 [] = diff x3 xover
                | f xover x3 x2 x1 (a::x)
                   = if member xover a then f xover x3 x2 x1 x else
                     if member x3 a then f (a::xover) x3 x2 x1 x else
                     if member x2 a then f xover (a::x3) x2 x1 x else
                     if member x1 a then f xover x3 (a::x2) x1 x else
                                         f xover x3 x2 (a::x1) x
              and diff x y = filter (not o member y) x
          in f [] [] [] [] x end
in (*********************** MAIN DEFINITIONS FOLLOW *******************************)

abstype generation = GEN of (int*int)list
   with
     fun alive (GEN livecoords) = livecoords
     and mkgen coordlist = GEN(lexordset coordlist)
     and mk_nextgen_fn neighbours gen
          = let val living = alive gen
                val isalive = member living
                val liveneighbours = length o filter isalive o neighbours
                fun twoorthree n = n=2 orelse n=3
                val survivors = filter (twoorthree o liveneighbours) living
                val newnbrlist = collect (filter (not o isalive) o neighbours) living
                val newborn = occurs3 newnbrlist
            in mkgen(survivors @ newborn) end
   end
end (* of local *);