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 =
52 if a = b then same_iterators_p ita itb
55 ///--------------------------------------------------------------------------
58 // A simple type for binary tree nodes.
61 | Node of 'a node * 'a * 'a node
63 // Parse a tree from a description in STRING. The syntax is:
65 // tree ::= empty | `(' tree char tree `)'
67 // disambiguated by deciding that `(' starts a tree wherever a tree is
68 // expected. Not ever-so pretty; parser combinator version left as an
70 let parse_tree string =
71 let n = String.length string
74 | i when i < n && string.[i] = '(' ->
75 let left, i = parse (i + 1)
76 if i >= n then failwith "no data"
78 let right, i = parse (i + 1)
79 if i >= n || string.[i] <> ')' then failwith "missing )"
80 Node (left, data, right), i + 1
83 if i < n then failwith "trailing junk"
86 // Return an iterator for the elements of T in order.
87 let iterate_fringe t =
92 itfn l <| fun () -> Some (ch, Iter <| fun () -> itfn r tail)
93 Iter <| fun () -> itfn t <| fun () -> None
95 ///--------------------------------------------------------------------------
98 let program_name = (System.Environment.GetCommandLineArgs ()).[0]
106 |> fold_iterator (fun ch _ -> stdout.Write(ch)) ()
110 (a |> parse_tree |> iterate_fringe)
111 (b |> parse_tree |> iterate_fringe)
112 then stdout.WriteLine("match")
113 else stdout.WriteLine("no match")
114 | _ -> failwith "bad args"
120 fprintf stderr "%s: %s\n" program_name exc.Message
123 ///----- That's all, folks --------------------------------------------------