1D 2-color cellular automata in F#

universe.fs

type cell = A | B

type 'cell U = U of 'cell LazyList * 'cell * LazyList<'cell>

module Universe = 
  open LazyList

  let U left focus right = U (left, focus, right)
  let initial () = U (repeat A) B (repeat A)
  let shiftRight = fun (U (left,focus,Cons(focus',right))) -> U (cons focus left) focus' right
  let shiftLeft  = fun (U (Cons(focus',left),focus,right)) -> U left focus' (cons focus right)
  let left  (U(l,_,_)) = l
  let focus (U(_,f,_)) = f
  let right (U(_,_,r)) = r
  let fmap f (U(left,focus,right)) = U (map f left) (f focus) (map f right)
  let invert = fmap (function A -> B | B -> A)
  let iterate f (a : 'a U) = unfold (fun a -> Some(a, f a)) a
  let cojoin (a : 'a U) = U (tail <| iterate shiftLeft a) a (tail <| iterate shiftRight a)
  let coreturn = focus

  let inline (=>>) f x = fmap f (cojoin x)

module Rules =
  open Universe
  open LazyList

  let u   = initial ()
  let cou = invert <| u

  let rule_gen_2c1d (n : byte) (U (left,focus,right)) =
    let x = 
      new System.Collections.BitArray([|n|])
      |> Seq.cast<bool>
      |> Seq.map (function true -> B | false -> A)
      |> Seq.toArray
    match head left, focus, head right with
    | B,B,B -> x.[7]
    | B,B,A -> x.[6]
    | B,A,B -> x.[5]
    | B,A,A -> x.[4]
    | A,B,B -> x.[3]
    | A,B,A -> x.[2]
    | A,A,B -> x.[1]
    | A,A,A -> x.[0]

module IO =
  open LazyList
  open Universe
  open Rules

  module Console =
    open System
    let write (s : string) = System.Console.Write s
    let newline () = System.Console.WriteLine("")
    let printc = function
      | A -> write " "
      | B -> write "█"

    let printu (U(l,f,r)) n =
      newline ()
      List.iter (printc) (List.rev (toList <| take n l))
      printc f
      iter (printc) (take n r)

    let drawu rule_f rule_n length height u =
      newline ()
      iter (flip printu ((length / 2) - 1)) <| (take height <| iterate ((=>>) <| rule_f rule_n) u)
      newline ()

    let multiverse_2c1d length height =
      let rec aux n =
        match n with
        | n when n < 255uy -> System.Console.WriteLine ();
                              System.Console.WriteLine ();
                              System.Console.WriteLine ("Rule: {0}", n)
                              drawu rule_gen_2c1d n length height u;
                              aux (n + 1uy)
        | _                -> System.Console.WriteLine ("Rule: {0}", n)
                              drawu rule_gen_2c1d n length height u;
                              ()
      aux 0uy