3 /// F# implementation of a `same-fringe' solver.
7 ///--------------------------------------------------------------------------
10 let curry f x y = f (x, y)
11 let uncurry f (x, y) = f x y
13 ///--------------------------------------------------------------------------
14 /// Iteration machinery.
16 // The type of an iterator. Unfortunately we need a layer of boxing to stop
17 // the compiler being unappy about infinite types. Silly compiler.
18 type 'a iterator = Iter of (unit -> ('a * 'a iterator) option)
20 // A handy way of getting to the actual iterator function.
21 let next (Iter itfn) = itfn ()
23 // Return an iterator for the items in the list XS.
24 let rec iterate_list xs =
25 let itfn = match xs with
26 | [] -> fun () -> None
27 | x::xs -> fun () -> Some (x, iterate_list xs)
30 // For each item X returned by the iterator, update the state A as F X A;
31 // return the final state.
32 let fold_iterator f a it =
33 let rec recur = function
35 | a, Some (x, it) -> recur (f x a, next it)
38 // Return a list containing the items returned by the iterator IT.
39 let list_iterator it = it |> fold_iterator (curry List.Cons) [] |> List.rev
41 // Asnwer whether two iterators report the same items.
42 let rec same_iterators_p ita itb =
44 | None -> Option.isNone(next itb)
47 | Some (b, itb) when a = b -> same_iterators_p ita itb
50 ///--------------------------------------------------------------------------
53 // A simple type for binary tree nodes.
56 | Node of 'a node * 'a * 'a node
58 // Parse a tree from a description in STRING. The syntax is:
60 // tree ::= empty | `(' tree char tree `)'
62 // disambiguated by deciding that `(' starts a tree wherever a tree is
63 // expected. Not ever-so pretty; parser combinator version left as an
65 let parse_tree string =
66 let n = String.length string
69 | i when i < n && string.[i] = '(' ->
70 let left, i = parse (i + 1)
71 if i >= n then failwith "no data"
73 let right, i = parse (i + 1)
74 if i >= n || string.[i] <> ')' then failwith "missing )"
75 Node (left, data, right), i + 1
78 if i < n then failwith "trailing junk"
81 // Return an iterator for the elements of T in order.
82 let iterate_fringe t =
87 itfn l <| fun () -> Some (ch, Iter <| fun () -> itfn r tail)
88 Iter <| fun () -> itfn t <| fun () -> None
90 ///--------------------------------------------------------------------------
93 let program_name = (System.Environment.GetCommandLineArgs ()).[0]
101 |> fold_iterator (fun ch _ -> stdout.Write(ch)) ()
105 (a |> parse_tree |> iterate_fringe)
106 (b |> parse_tree |> iterate_fringe)
107 then stdout.WriteLine("match")
108 else stdout.WriteLine("no match")
109 | _ -> failwith "bad args"
115 fprintf stderr "%s: %s\n" program_name exc.Message
118 ///----- That's all, folks --------------------------------------------------