Commit | Line | Data |
---|---|---|
2bd37ef1 MW |
1 | /// -*-f#-mode-*- |
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 -> | |
45 | match next itb with | |
46 | | None -> true | |
47 | | _ -> false | |
48 | | Some (a, ita) -> | |
49 | match next itb with | |
50 | | None -> false | |
51 | | Some (b, itb) -> | |
52 | if a = b then same_iterators_p ita itb | |
53 | else false | |
54 | ||
55 | ///-------------------------------------------------------------------------- | |
56 | /// Nodes and trees. | |
57 | ||
58 | // A simple type for binary tree nodes. | |
59 | type 'a node = | |
60 | | Leaf | |
61 | | Node of 'a node * 'a * 'a node | |
62 | ||
63 | // Parse a tree from a description in STRING. The syntax is: | |
64 | // | |
65 | // tree ::= empty | `(' tree char tree `)' | |
66 | // | |
67 | // disambiguated by deciding that `(' starts a tree wherever a tree is | |
68 | // expected. Not ever-so pretty; parser combinator version left as an | |
69 | // exercise. | |
70 | let parse_tree string = | |
71 | let n = String.length string | |
72 | let rec parse i = | |
73 | match i with | |
74 | | i when i < n && string.[i] = '(' -> | |
75 | let left, i = parse (i + 1) | |
76 | if i >= n then failwith "no data" | |
77 | let data = string.[i] | |
78 | let right, i = parse (i + 1) | |
79 | if i >= n || string.[i] <> ')' then failwith "missing )" | |
80 | Node (left, data, right), i + 1 | |
81 | | _ -> Leaf, i | |
82 | let tree, i = parse 0 | |
83 | if i < n then failwith "trailing junk" | |
84 | tree | |
85 | ||
86 | // Return an iterator for the elements of T in order. | |
87 | let iterate_fringe t = | |
88 | let rec itfn t tail = | |
89 | match t with | |
90 | | Leaf -> tail () | |
91 | | Node (l, ch, r) -> | |
92 | itfn l <| fun () -> Some (ch, Iter <| fun () -> itfn r tail) | |
93 | Iter <| fun () -> itfn t <| fun () -> None | |
94 | ||
95 | ///-------------------------------------------------------------------------- | |
96 | /// Main program. | |
97 | ||
98 | let program_name = (System.Environment.GetCommandLineArgs ()).[0] | |
99 | ||
100 | [<EntryPoint>] | |
101 | let main args = | |
102 | let run = function | |
103 | | [| a |] -> | |
104 | a |> parse_tree | |
105 | |> iterate_fringe | |
106 | |> fold_iterator (fun ch _ -> stdout.Write(ch)) () | |
107 | stdout.Write('\n') | |
108 | | [| a; b |] -> | |
109 | if same_iterators_p | |
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" | |
115 | try | |
116 | run args | |
117 | 0 | |
118 | with | |
119 | | exc -> | |
120 | fprintf stderr "%s: %s\n" program_name exc.Message | |
121 | 1 | |
122 | ||
123 | ///----- That's all, folks -------------------------------------------------- |