/// -*- mode: fsharp-mode; indent-tabs-mode: nil -*-
///
/// F# implementation of a `same-fringe' solver.

module Fringe

///--------------------------------------------------------------------------
/// Utilities.

let curry f x y = f (x, y)
let uncurry f (x, y) = f x y

///--------------------------------------------------------------------------
/// Iteration machinery.

// The type of an iterator.  Unfortunately we need a layer of boxing to stop
// the compiler being unappy about infinite types.  Silly compiler.
type 'a iterator = Iter of (unit -> ('a * 'a iterator) option)

// A handy way of getting to the actual iterator function.
let next (Iter itfn) = itfn ()

// Return an iterator for the items in the list XS.
let rec iterate_list xs =
  let itfn = match xs with
               | [] -> fun () -> None
               | x::xs -> fun () -> Some (x, iterate_list xs)
  Iter itfn

// For each item X returned by the iterator, update the state A as F X A;
// return the final state.
let fold_iterator f a it =
  let rec recur = function
    | a, None -> a
    | a, Some (x, it) -> recur (f x a, next it)
  recur (a, next it)

// Return a list containing the items returned by the iterator IT.
let list_iterator it = it |> fold_iterator (curry List.Cons) [] |> List.rev

// Asnwer whether two iterators report the same items.
let rec same_iterators_p ita itb =
  match next ita with
    | None -> Option.isNone(next itb)
    | Some (a, ita) ->
      match next itb with
        | Some (b, itb) when a = b -> same_iterators_p ita itb
        | _ -> false

///--------------------------------------------------------------------------
/// Nodes and trees.

// A simple type for binary tree nodes.
type 'a node =
  | Leaf
  | Node of 'a node * 'a * 'a node

// Parse a tree from a description in STRING.  The syntax is:
//
//      tree ::= empty | `(' tree char tree `)'
//
// disambiguated by deciding that `(' starts a tree wherever a tree is
// expected.  Not ever-so pretty; parser combinator version left as an
// exercise.
let parse_tree string =
  let n = String.length string
  let rec parse i =
    match i with
      | i when i < n && string.[i] = '(' ->
        let left, i = parse (i + 1)
        if i >= n then failwith "no data"
        let data = string.[i]
        let right, i = parse (i + 1)
        if i >= n || string.[i] <> ')' then failwith "missing )"
        Node (left, data, right), i + 1
      | _ -> Leaf, i
  let tree, i = parse 0
  if i < n then failwith "trailing junk"
  tree

// Return an iterator for the elements of T in order.
let iterate_fringe t =
  let rec itfn t tail =
    match t with
      | Leaf -> tail ()
      | Node (l, ch, r) ->
        itfn l <| fun () -> Some (ch, Iter <| fun () -> itfn r tail)
  Iter <| fun () -> itfn t <| fun () -> None

///--------------------------------------------------------------------------
/// Main program.

let program_name = (System.Environment.GetCommandLineArgs ()).[0]

[<EntryPoint>]
let main args =
  let run = function
    | [| a |] ->
      a |> parse_tree
        |> iterate_fringe
        |> fold_iterator (fun ch _ -> stdout.Write(ch)) ()
      stdout.Write('\n')
    | [| a; b |] ->
      if same_iterators_p
           (a |> parse_tree |> iterate_fringe)
           (b |> parse_tree |> iterate_fringe)
      then stdout.WriteLine("match")
      else stdout.WriteLine("no match")
    | _ -> failwith "bad args"
  try
    run args
    0
  with
    | exc ->
      fprintf stderr "%s: %s\n" program_name exc.Message
      1

///----- That's all, folks --------------------------------------------------