(* 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) ^ (begin Stream.junk stream ; stream_to_string stream end)

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
	  begin
	    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)
	  end
;;


(* THE PARSER *)

let rec p_E = parser
  | [< t1 = p_P ; t2 = p_OpE >] -> E [t1;t2]
  | [< t1 = p_Z ; t2 = p_OpE >] -> E [t1;t2]

and p_P = parser
  | [< ''(' ; t = p_E ; '')' >] -> P t

and p_OpE = parser
  | [< t1 = p_Op ; t2 = p_E >] -> OpE [t1;t2]
  | [< >] -> OpE []

and p_Op = parser
  | [< ''+' >] -> L '+'
  | [< ''-' >] -> L '-'
  | [< ''*' >] -> L '*'

and p_Z = parser
  | [< ''-' ; t = p_N >] -> Z [L '-' ; t]
  | [< t = p_N >] -> Z [t]

and p_N = parser
  | [< c = p_C ; cs = p_Cs >] -> N (int_of_string (c ^ cs))

and p_C = parser
  | [< ''0' >] -> "0"
  | [< ''1' >] -> "1"
  | [< ''2' >] -> "2"
  | [< ''3' >] -> "3"
  | [< ''4' >] -> "4"
  | [< ''5' >] -> "5"
  | [< ''6' >] -> "6"
  | [< ''7' >] -> "7"
  | [< ''8' >] -> "8"
  | [< ''9' >] -> "9"

and p_Cs = parser
  | [< c = p_C ; cs = p_Cs >] -> c^cs
  | [< >] -> ""
;;


(* TEST *)

(* recognized *)

run p_E "1" ;;
run p_E "1+2" ;;
run p_E "1+-2" ;;
run p_E "1--2" ;;
run p_E "1*-2" ;;
run p_E "-1+-2" ;;
run p_E "1+(-2)" ;;
run p_E "(1+2)*(3+4)" ;;
run p_E "((1+2)*(3+4))" ;;
run p_E "1+2*3+4" ;;
run p_E "((((1))))-241";;

(* syntax error *)

run p_E "1+(2*)3+4" ;;
run p_E "()" ;;
run p_E "(1(2))" ;;
run p_E "(1+2" ;;
run p_E "1+2 abc" ;;