| 1 | /// -*- mode: fsharp-mode; indent-tabs-mode: nil -*- |
| 2 | /// |
| 3 | /// F# implementation of a `same-fringe' solver. |
| 4 | |
| 5 | module Fringe |
| 6 | |
| 7 | ///-------------------------------------------------------------------------- |
| 8 | /// Utilities. |
| 9 | |
| 10 | let curry f x y = f (x, y) |
| 11 | let uncurry f (x, y) = f x y |
| 12 | |
| 13 | ///-------------------------------------------------------------------------- |
| 14 | /// Iteration machinery. |
| 15 | |
| 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) |
| 19 | |
| 20 | // A handy way of getting to the actual iterator function. |
| 21 | let next (Iter itfn) = itfn () |
| 22 | |
| 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) |
| 28 | Iter itfn |
| 29 | |
| 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 |
| 34 | | a, None -> a |
| 35 | | a, Some (x, it) -> recur (f x a, next it) |
| 36 | recur (a, next it) |
| 37 | |
| 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 |
| 40 | |
| 41 | // Asnwer whether two iterators report the same items. |
| 42 | let rec same_iterators_p ita itb = |
| 43 | match next ita with |
| 44 | | None -> Option.isNone(next itb) |
| 45 | | Some (a, ita) -> |
| 46 | match next itb with |
| 47 | | Some (b, itb) when a = b -> same_iterators_p ita itb |
| 48 | | _ -> false |
| 49 | |
| 50 | ///-------------------------------------------------------------------------- |
| 51 | /// Nodes and trees. |
| 52 | |
| 53 | // A simple type for binary tree nodes. |
| 54 | type 'a node = |
| 55 | | Leaf |
| 56 | | Node of 'a node * 'a * 'a node |
| 57 | |
| 58 | // Parse a tree from a description in STRING. The syntax is: |
| 59 | // |
| 60 | // tree ::= empty | `(' tree char tree `)' |
| 61 | // |
| 62 | // disambiguated by deciding that `(' starts a tree wherever a tree is |
| 63 | // expected. Not ever-so pretty; parser combinator version left as an |
| 64 | // exercise. |
| 65 | let parse_tree string = |
| 66 | let n = String.length string |
| 67 | let rec parse i = |
| 68 | match i with |
| 69 | | i when i < n && string.[i] = '(' -> |
| 70 | let left, i = parse (i + 1) |
| 71 | if i >= n then failwith "no data" |
| 72 | let data = string.[i] |
| 73 | let right, i = parse (i + 1) |
| 74 | if i >= n || string.[i] <> ')' then failwith "missing )" |
| 75 | Node (left, data, right), i + 1 |
| 76 | | _ -> Leaf, i |
| 77 | let tree, i = parse 0 |
| 78 | if i < n then failwith "trailing junk" |
| 79 | tree |
| 80 | |
| 81 | // Return an iterator for the elements of T in order. |
| 82 | let iterate_fringe t = |
| 83 | let rec itfn t tail = |
| 84 | match t with |
| 85 | | Leaf -> tail () |
| 86 | | Node (l, ch, r) -> |
| 87 | itfn l <| fun () -> Some (ch, Iter <| fun () -> itfn r tail) |
| 88 | Iter <| fun () -> itfn t <| fun () -> None |
| 89 | |
| 90 | ///-------------------------------------------------------------------------- |
| 91 | /// Main program. |
| 92 | |
| 93 | let program_name = (System.Environment.GetCommandLineArgs ()).[0] |
| 94 | |
| 95 | [<EntryPoint>] |
| 96 | let main args = |
| 97 | let run = function |
| 98 | | [| a |] -> |
| 99 | a |> parse_tree |
| 100 | |> iterate_fringe |
| 101 | |> fold_iterator (fun ch _ -> stdout.Write(ch)) () |
| 102 | stdout.Write('\n') |
| 103 | | [| a; b |] -> |
| 104 | if same_iterators_p |
| 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" |
| 110 | try |
| 111 | run args |
| 112 | 0 |
| 113 | with |
| 114 | | exc -> |
| 115 | fprintf stderr "%s: %s\n" program_name exc.Message |
| 116 | 1 |
| 117 | |
| 118 | ///----- That's all, folks -------------------------------------------------- |