Commit | Line | Data |
---|---|---|
1a6b8421 | 1 | /// -*- mode: fsharp-mode; indent-tabs-mode: nil -*- |
2bd37ef1 MW |
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 | |
6bce693f | 44 | | None -> Option.isNone(next itb) |
2bd37ef1 MW |
45 | | Some (a, ita) -> |
46 | match next itb with | |
6bce693f MW |
47 | | Some (b, itb) when a = b -> same_iterators_p ita itb |
48 | | _ -> false | |
2bd37ef1 MW |
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 | |
226de6c6 | 117 | |
2bd37ef1 | 118 | ///----- That's all, folks -------------------------------------------------- |