Implementation of infinite sequence

datatype 'a seq = Nil
                 | Cons of 'a * (unit -> 'a seq) ;


exception Empty ;

fun hd (Cons (x,xf)) = x 
   | hd Nil          =  raise Empty;

fun tl (Cons(x,xf)) = xf()
     |  tl Nil      =  raise Empty ;


fun cons(x,xq) = Cons(x, fn() => xq) ;

fun from k = Cons(k, fn() =>from(k+1)) ;


exception Subscripts ;

fun take (xq, 0 )  =  [] 
  | take (Nil,n)   = raise Subscript
  | take (Cons(x,xf),n)  = x::take(xf(), n-1) ;

exception Null ;
fun Nth (Nil, _ ) = raise Null
   | Nth ( Cons(x,xf), 1) = x
   | Nth ( Cons(x,xf),n) = Nth(xf(),n-1) ;


fun interleave (Nil, yq) = yq
   |  interleave ( Cons(x,xf), yq ) =
        Cons(x, fn() =>  interleave (yq, xf())) ;

fun map f Nil = Nil 
  |  map f (Cons(x,xf)) = Cons(f  x , fn() => map f (xf())) ;

fun filter pred Nil          =     Nil
  | filter pred (Cons(x,xf)) =
           if  pred x then Cons(x, fn() => filter pred (xf()))
           else filter pred (xf()) ;


fun iterates f x  = Cons(x,  fn() => iterates f ( f x)) ;




fun toList Nil = []   (* represent the inf seq as a list *)
  | toList (Cons(x,xf)) = x :: toList (xf());

fun fromList L = List.foldr cons Nil L ; (* construct sequence from given list L *)

Compiler.Control.Print.printLength := 1000 ;

Applications :

• Fibonacci sequence

  
  fun fibo(a,b) = Cons(a, fn () => fibo(b,a+b)) ; (* define the fibonacci sequence with inital values a and b *)
  
  val fib = fibo(1,1) ;
  
  take(fib , 35) ; (* generate the first 35 fibonacci numbers *)
  Nth(fib, 35)  ;  (* get the 35th fibonacci number *)
  
  

• generate a sequences with a_n = n! (n factorial)

  
  fun fact(a,b) =  Cons(a, fn()=>fact(a*b,b+1)) ;
  
  val fac = fact(1,1) ;
  
  take(fac,10) ;
  
  

• prime numbers

  fun sift p =  filter (fn  n => n mod p <> 0 ) ;
  
  fun sieve (Cons(p, nf)) = Cons(p, fn() => sieve (sift p (nf()))) ;
  
  val primes = sieve( from 2) ;
  
  take( primes, 25) ;
  
  
  N-Queen problem 
  
  fun secl x f y = f(x,y) ;
  
  fun secr f y  x = f(x,y) ;
  
  val halve  = (secr op/ 2.0) ;
  
  val recip = (secl  1.0 op/) ;
  
  val knightify = (secl "Sir " op^) ;
  
  fun upto(m,n) = if m > n then []
                  else m::upto(m+1,n) ;
  
  infix mem ;
  
  fun x mem [] = false
    |  x mem (y::ys) = (x = y) orelse  ( x mem ys) ;
  
  
  fun safeQueen oldqs newq = 
      let fun nodiag ( i , [] )  =  true
            | nodiag (i, q::qs) =
                Int.abs(newq-q) <> i andalso nodiag(i+1,qs) 
      in  not (newq mem oldqs) andalso nodiag (1, oldqs) end;
  
  
  fun isFull n qs = ( length qs = n ) ;
  
  fun  nextQueen n  qs =
       List.map (secr op:: qs) (List.filter (safeQueen qs) ( upto(1,n))) ;
  
  (* depth first search *)
  
  fun depthFirst     next x = 
       let fun dfs [] = Nil
           | dfs (y::ys) = Cons(y, fn() => dfs ( next  y @ ys))
       in dfs [x] end;
  
  (* breadth first search *)
  
  fun breadthFirst next x =
      let fun bfs [] = Nil
          |  bfs (y::ys) = Cons( y, fn() => bfs(ys @ next y ) )
      in bfs[x] end ;
  
  
  fun depthQueen n = filter( isFull n) (depthFirst (nextQueen n ) []);