(* USAGE:

 * Pour afficher la traduction en ocaml: 
      camlp4o -impl <file>.parser 

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

 * Pour interpréter le fichier ocaml généré: 
      ledit ocaml dynlink.cma camlp4o.cma 
      #use "<file>.ml";;
 *)
(* Grammar of expressions with parenthesis

   E -> P OpE
   E -> Z OpE
   P -> '(' E ')'
   OpE -> "" | Op E 
   Op -> '+' | '-' | '*' 
   Z -> '-' N | N
   N -> C Cs
   Cs -> C Cs | ""
   C -> '0' | ... | '9'
*)
type derivation_tree =
  | E of derivation_tree list
  | P of derivation_tree
  | OpE of derivation_tree list
  | Z of derivation_tree list
  | N of int
  | L of char
  | Impossible

(* USEFUL FUNCTIONS FOR RUNNING A PARSER WITH PARSING ERROR MESSAGE *)
type 'result of_parsing =
  | Recognized of 'result | Syntax_Error of 'result * string

let rec (stream_to_string : char Stream.t -> string) =
  fun stream ->
    match Stream.peek stream with
    | None -> ""
    | Some c ->
        (String.make 1 c) ^ (Stream.junk stream; stream_to_string stream)
  
let (stream_is_empty : 't Stream.t -> bool) =
  fun stream -> (Stream.peek stream) = None
  
let (run : (char Stream.t -> 'resultat) -> string -> 'resultat of_parsing) 
  =
  fun parse word ->
    let stream = Stream.of_string word in
    let ast = try parse stream with | Stream.Error _ -> Impossible in
    let recognized = (stream_is_empty stream) && (ast <> Impossible)
    in
      (print_string
         (String.concat ""
            [ "parser \""; word; "\" = ";
              if recognized then "ok" else "syntax error"; "\n" ]);
       if recognized
       then Recognized ast
       else Syntax_Error (ast, stream_to_string stream))
  
(* THE PARSER *)
let rec p_E (__strm : _ Stream.t) =
  match try Some (p_P __strm) with | Stream.Failure -> None with
  | Some t1 ->
      let t2 =
        (try p_OpE __strm with | Stream.Failure -> raise (Stream.Error ""))
      in E [ t1; t2 ]
  | _ ->
      let t1 = p_Z __strm in
      let t2 =
        (try p_OpE __strm with | Stream.Failure -> raise (Stream.Error ""))
      in E [ t1; t2 ]
and p_P (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some '(' ->
      (Stream.junk __strm;
       let t =
         (try p_E __strm with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ')' -> (Stream.junk __strm; P t)
          | _ -> raise (Stream.Error "")))
  | _ -> raise Stream.Failure
and p_OpE (__strm : _ Stream.t) =
  match try Some (p_Op __strm) with | Stream.Failure -> None with
  | Some t1 ->
      let t2 =
        (try p_E __strm with | Stream.Failure -> raise (Stream.Error ""))
      in OpE [ t1; t2 ]
  | _ -> OpE []
and p_Op (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some '+' -> (Stream.junk __strm; L '+')
  | Some '-' -> (Stream.junk __strm; L '-')
  | Some '*' -> (Stream.junk __strm; L '*')
  | _ -> raise Stream.Failure
and p_Z (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some '-' ->
      (Stream.junk __strm;
       let t =
         (try p_N __strm with | Stream.Failure -> raise (Stream.Error ""))
       in Z [ L '-'; t ])
  | _ -> let t = p_N __strm in Z [ t ]
and p_N (__strm : _ Stream.t) =
  let c = p_C __strm in
  let cs = try p_Cs __strm with | Stream.Failure -> raise (Stream.Error "")
  in N (int_of_string (c ^ cs))
and p_C (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some '0' -> (Stream.junk __strm; "0")
  | Some '1' -> (Stream.junk __strm; "1")
  | Some '2' -> (Stream.junk __strm; "2")
  | Some '3' -> (Stream.junk __strm; "3")
  | Some '4' -> (Stream.junk __strm; "4")
  | Some '5' -> (Stream.junk __strm; "5")
  | Some '6' -> (Stream.junk __strm; "6")
  | Some '7' -> (Stream.junk __strm; "7")
  | Some '8' -> (Stream.junk __strm; "8")
  | Some '9' -> (Stream.junk __strm; "9")
  | _ -> raise Stream.Failure
and p_Cs (__strm : _ Stream.t) =
  match try Some (p_C __strm) with | Stream.Failure -> None with
  | Some c ->
      let cs =
        (try p_Cs __strm with | Stream.Failure -> raise (Stream.Error ""))
      in c ^ cs
  | _ -> ""
  
(* TEST *)
(* recognized *)
let _ = run p_E "1"
  
let _ = run p_E "1+2"
  
let _ = run p_E "1+-2"
  
let _ = run p_E "1--2"
  
let _ = run p_E "1*-2"
  
let _ = run p_E "-1+-2"
  
let _ = run p_E "1+(-2)"
  
let _ = run p_E "(1+2)*(3+4)"
  
let _ = run p_E "((1+2)*(3+4))"
  
let _ = run p_E "1+2*3+4"
  
let _ = run p_E "((((1))))-241"
  
(* syntax error *)
let _ = run p_E "1+(2*)3+4"
  
let _ = run p_E "()"
  
let _ = run p_E "(1(2))"
  
let _ = run p_E "(1+2"
  
let _ = run p_E "1+2 abc"