(*
 * This file implements operations on Determistic Finite Automata (DFAs).
 *
 * ----------------------------------------------------------------
 *
 * @begin[license]
 * Copyright (C) 2002 Jason Hickey, Caltech
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * Author: Jason Hickey
 * @email{jyh@cs.caltech.edu}
 * @end[license]
 *)
open Printf

(*
 * We'll use a small alphabet for this lab.
 *)
type abc_symbol = A | B | C

(*
 * A DFA is a 5-tuple:
 *    state : the type of states.  The type should have a finite
 *       number of elements.
 *    symbol : the type of symbols.
 *    delta : the transition function.
 *    start : the start state
 *    is_final : a final state predicate.  This differs from the
 *       textbook account, which defines a set of final states.
 *       It is more convenient to use a final state predicate.
 *)
module type DFASig =
sig
   (* A finite set of states *)
   type state

   (*
    * The type of symbols in the input alphabet.
    * For this lab, we'll consistently use abc_symbol.
    *)
   type symbol = abc_symbol

   (* The transition function *)
   val delta : state -> symbol -> state

   (* Initial and final states *)
   val start : state
   val is_final : state -> bool
end

(*
 * This is an example of a DFA that accepts
 * the language ((ab)*c)*
 *)
module Example1 : DFASig =
struct
   (*
    * The states of the machine.
    *
    * Start: the start state
    * Abort: the string is not in the language
    * StateA: we just saw an A
    *)
   type state =
      Start
    | Abort
    | StateA

   (*
    * Use the simple alphabet.
    *)
   type symbol = abc_symbol

   (*
    * The transition function is defined as a table.
    *)
   let delta q c =
      match q, c with
         Start,  A -> StateA
       | Start,  B -> Abort
       | Start,  C -> Start
       | StateA, A -> Abort
       | StateA, B -> Start
       | StateA, C -> Abort
       | Abort,  _ -> Abort

   (*
    * The initial state is the Start state.
    *)
   let start = Start

   (*
    * The Start state is the only final state.
    *)
   let is_final q =
      q = Start
end

(*
 * TODO: define a machine that accepts the language
 * (epsilon + abc + aabb*cc* )
 *)
module Example2 : DFASig =
struct
   (*
    * TODO: define the states of the machine.
    *)
   type state =
      Start
    | Abort
    | StateA
    | StateB1
    | StateC1
    | StateA2
    | StateB2
    | StateC2

   (*
    * Use the simple alphabet.
    *)
   type symbol = abc_symbol

   (*
    * TODO: define a transition function.
    *)
   let delta q c =
      match q, c with
         (* First symbol must be an "a" *)
         Start,   A -> StateA
       | Start,   B
       | Start,   C -> Abort

         (* Once we have seen the initial "a", the next symbol determines which path *)
       | StateA,  A -> StateA2
       | StateA,  B -> StateB1
       | StateA,  C -> Abort

         (* Currently matching "abc" *)
       | StateB1, A
       | StateB1, B -> Abort
       | StateB1, C -> StateC1
       | StateC1, _ -> Abort

         (* Currently matching "aabb*cc*" *)
       | StateA2, A -> Abort
       | StateA2, B -> StateB2
       | StateA2, C -> Abort
       | StateB2, A -> Abort
       | StateB2, B -> StateB2
       | StateB2, C -> StateC2
       | StateC2, A
       | StateC2, B -> Abort
       | StateC2, C -> StateC2

         (* Once aborting, always abort *)
       | Abort,   _ -> Abort

   (*
    * The initial state is the Start state.
    *)
   let start = Start

   (*
    * TODO: define the set of final states.
    *)
   let is_final = function
      Start
    | StateC1
    | StateC2 ->
         true
    | _ ->
         false
end

(*
 * Given a DFA, define the machine that accepts
 * the complement language.
 *)
module Complement (DFA : DFASig) : DFASig =
struct
    (*
     * The machine is almost entirely the same.
     * The only modification is to invert the set of final states.
     *)
    type state = DFA.state
    type symbol = DFA.symbol

    let delta = DFA.delta
    let start = DFA.start

    let is_final q =
       not (DFA.is_final q)
end

(*
 * Given two DFAs, construct the intersection DFA.
 * The new machine is build as a product of the two argument
 * machines.  See the lecture notes for Oct 3 for the construction.
 *)
module Intersection (DFA1 : DFASig) (DFA2 : DFASig) : DFASig =
struct
    (*
     * The new set of states is the product of the old states.
     *)
    type state = DFA1.state * DFA2.state

    (*
     * All the alphabets are the same.
     *)
    type symbol = abc_symbol

    (*
     * The transition function is the product on the pair.
     *)
    let delta (q1, q2) c =
       (DFA1.delta q1 c, DFA2.delta q2 c)

    (*
     * The initial state is the initial state for both machines.
     *)
    let start = (DFA1.start, DFA2.start)

    (*
     * A state is final if it is final for both machines.
     *)
    let is_final (q1, q2) =
       DFA1.is_final q1 && DFA2.is_final q2
end

(*
 * Given two DFAs, construct the union DFA.
 * For this part, use DeMorgan's Law
 * (A union B) = not (A intersection B).
 *)
module Union (DFA1 : DFASig) (DFA2 : DFASig) : DFASig =
   Complement (Intersection (Complement (DFA1)) (Complement (DFA2)))

(************************************************************************
 * Test programs.
 *
 * For the lab, you don't need to know the test program.
 * In fact, it would not normally be included in this file,
 * but we wanted to make compiling easier by putting everything
 * in one file.
 *
 * First, we define the delta-hat function, to test if a string
 * is in the language.  We then define a test function that takes
 * a command-line argument and determines what languages the
 * argument string belongs to.
 *)

(*
 * The delta-hat function is the transitive closure of the delta
 * function.
 *)
module type RunSig =
sig
   val run : string -> bool
end

module Run (DFA : DFASig) : RunSig =
struct
   (*
    * Convert the string to a list of abc_symbols.
    * Raises Invalid_argument if the string contains
    * any characters that are not 'a', 'b', or 'c'.
    *)
   let abc_of_string s =
      let len = String.length s in
      let rec collect i =
         if i = len then
            []
         else
            let c =
               match s.[i] with
                  'A' | 'a' -> A
                | 'B' | 'b' -> B
                | 'C' | 'c' -> C
                | _ ->
                     raise (Invalid_argument ("Illegal character: " ^ Char.escaped s.[i]))
            in
               c :: collect (i + 1)
      in
         collect 0

   (*
    * Test whether the string is in the language
    * defined by the DFA.  First, convert it to symbols,
    * then run the automaton, and check the final state.
    *)
   let run s =
      let l = abc_of_string s in
      let q = List.fold_left DFA.delta DFA.start l in
         DFA.is_final q
end

(*
 * These are the machines we want to test.
 *)
module Machine1 = Run (Example1)
module Machine2 = Run (Complement (Example1))
module Machine3 = Run (Example2)
module Machine4 = Run (Complement (Example2))
module Machine5 = Run (Intersection (Example1) (Example2))
module Machine6 = Run (Union (Example1) (Example2))

(*
 * Get the argument string from the command line.
 *)
let arg_string =
   let argv = Sys.argv in
   let len = Array.length argv in
      if len <> 2 then
         begin
            eprintf "Usage: %s <string>\n" argv.(0);
            exit 1
         end;
      argv.(1)

(*
 * Simulate each machine.
 *)
let main () =
   eprintf "Argument string:\t\t\"%s\"\n"          (String.escaped arg_string);
   eprintf "((ab)*c)*:\t\t\t%b\n"                  (Machine1.run arg_string);
   eprintf "not ((ab)*c)*):\t\t\t%b\n"             (Machine2.run arg_string);
   eprintf "(epsilon + abc + aabb*cc*):\t%b\n"     (Machine3.run arg_string);
   eprintf "not (epsilon + abc + aabb*cc*):\t%b\n" (Machine4.run arg_string);
   eprintf "intersection:\t\t\t%b\n"               (Machine5.run arg_string);
   eprintf "union:\t\t\t\t%b\n"                    (Machine6.run arg_string);
   flush stderr

let _ =
   Printexc.catch main ()

(*!
 * @docoff
 *
 * -*-
 * Local Variables:
 * Caml-master: "compile"
 * End:
 * -*-
 *)