(* USAGE:

 * Pour afficher la traduction en ocaml: 
      camlp4o -impl anbn.parser 

 * Pour générer  la traduction dans un fichier .ml:
      camlp4o -impl anbn.parser -o anbn.ml

 * Pour interpréter le fichier ocaml généré: 
      ledit ocaml dynlink.cma camlp4o.cma 
      #use "anbn.ml";;
 *)
(* STREAM.is_empty does not exist. We define it to check if a stream is empty *)
let (is_empty : 't Stream.t -> bool) =
  fun stream -> (Stream.peek stream) = None
  
(* EXERCISE 
   ===============================================================
   Implement in ocaml the following grammar

     S -1-> ""
     S -2-> "a" . S . "b"

   The language generated by this grammar is { a^b^n | n in Nat } 

   This grammar is not ambigous since, given n in Nat,
   there is only one way to derive a^nb^n.
   =============================================================== *)
(* -1- A RECOGNIZER *)
let rec (anbn_recognizer : char Stream.t -> bool) =
  fun (__strm : _ Stream.t) ->
    match Stream.peek __strm with
    | Some 'a' ->
        (Stream.junk __strm;
         let bool =
           (try anbn_recognizer __strm
            with | Stream.Failure -> raise (Stream.Error ""))
         in
           (match Stream.peek __strm with
            | Some 'b' -> (Stream.junk __strm; bool)
            | _ -> raise (Stream.Error "")))
    | _ -> true
  
let (run : (char Stream.t -> bool) -> string -> bool) =
  fun parse word ->
    (print_string (String.concat "" [ "\n parser \""; word; "\" = \n" ]);
     let stream = Stream.of_string word in
     let r = parse stream
     and b = is_empty stream
     in (* the parser has red all the stream *) r && b)
  
(* TEST *)
let _ = run anbn_recognizer ""
  
let _ = run anbn_recognizer "ab"
  
let _ = run anbn_recognizer "aabb"
  
let _ = run anbn_recognizer "ba"
  
(* -2- A PARSER that counts the number of "a" in the word *)
let rec (anbn_parser_with_counter : char Stream.t -> int) =
  fun (__strm : _ Stream.t) ->
    match Stream.peek __strm with
    | Some 'a' ->
        (Stream.junk __strm;
         let n =
           (try anbn_parser_with_counter __strm
            with | Stream.Failure -> raise (Stream.Error ""))
         in
           (match Stream.peek __strm with
            | Some 'b' -> (Stream.junk __strm; n + 1)
            | _ -> raise (Stream.Error "")))
    | _ -> 0
  
let (run : (char Stream.t -> int) -> string -> (bool * int)) =
  fun parse word ->
    (print_string (String.concat "" [ "\n parser \""; word; "\" = \n" ]);
     let stream = Stream.of_string word in
     let r = parse stream and b = is_empty stream in (b, r))
  
(* TEST *)
let _ = run anbn_parser_with_counter ""
  
let _ = run anbn_parser_with_counter "ab"
  
let _ = run anbn_parser_with_counter "aabb"
  
let _ = run anbn_parser_with_counter "ba"
  
(* -3- A PARSER that builds the derivation tree of the word *)
type nonterminal = | S

type rule = int

type derivation_tree =
  | D of nonterminal * rule * derivation_tree list | L of char | Erreur

let rec
  (anbn_parser_with_derivation_tree : char Stream.t -> derivation_tree) 
  =
  fun (__strm : _ Stream.t) ->
    match Stream.peek __strm with
    | Some 'a' ->
        (Stream.junk __strm;
         let d =
           (try anbn_parser_with_derivation_tree __strm
            with | Stream.Failure -> raise (Stream.Error ""))
         in
           (match Stream.peek __strm with
            | Some 'b' -> (Stream.junk __strm; D (S, 1, [ L 'a'; d; L 'b' ]))
            | _ -> raise (Stream.Error "")))
    | _ -> D (S, 0, [])
  
let (run : (char Stream.t -> 'result) -> string -> (bool * 'result)) 
  =
  fun parse word ->
    (print_string (String.concat "" [ "\n parser \""; word; "\" = \n" ]);
     let stream = Stream.of_string word in
     let r = parse stream and b = is_empty stream in (b, r))
  
(* TEST *)
let _ = run anbn_parser_with_derivation_tree ""
  
let _ = run anbn_parser_with_derivation_tree "ab"
  
let _ = run anbn_parser_with_derivation_tree "aabb"
  
let _ = run anbn_parser_with_derivation_tree "ba"