chiark - git - mdw - fringe/blob - f#-fringe.fs

   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 --------------------------------------------------