handled difference associativity for the same level of the extensible grammar

[helm.git] / helm / ocaml / cic_notation / test_parser.ml

diff --git a/helm/ocaml/cic_notation/test_parser.ml b/helm/ocaml/cic_notation/test_parser.ml
index 62b0ae32bd585ca0551ca1e3d4d851ddf85b05c5..960af9d5fddb846b1c17a36e0e3abbdd3b81888f 100644 (file)
--- a/helm/ocaml/cic_notation/test_parser.ml
+++ b/helm/ocaml/cic_notation/test_parser.ml
@@ -53,6 +53,13 @@ let errquit ignore_exn =
     exit 2
   end
 
+let pp_associativity = function
+  | Gramext.LeftA -> "left"
+  | Gramext.RightA -> "right"
+  | Gramext.NonA -> "non"
+
+let pp_precedence = string_of_int
+
 let process_stream ?(ignore_exn = false) istream =
   let char_count = ref 0 in
   let module P = CicNotationPt in
@@ -66,40 +73,32 @@ let process_stream ?(ignore_exn = false) istream =
           char_count := y + !char_count;
           match statement with
           | G.Executable (_, G.Macro (_, G.Check (_, t))) -> 
-              prerr_endline "====";
-              prerr_endline (CicNotationPp.pp_term t); flush stdout;
+              prerr_endline (sprintf "ast: %s" (CicNotationPp.pp_term t));
               let t' = CicNotationRew.pp_ast t in
-                prerr_endline (CicNotationPp.pp_term t'); flush stdout;
-                let tbl = Hashtbl.create 0 in
-                  dump_xml t' tbl "out.xml"
+              prerr_endline (sprintf "rendered ast: %s"
+                (CicNotationPp.pp_term t'));
+              let tbl = Hashtbl.create 0 in
+              dump_xml t' tbl "out.xml"
           | G.Executable (_, G.Command (_,
             G.Notation (_, l1, associativity, precedence, l2))) ->
-              prerr_endline "Extending parser ..."; flush stdout;
-              prerr_endline (CicNotationPp.pp_term l1) ;
-              prerr_endline (CicNotationPp.pp_term l2) ;
-              prerr_endline (sprintf "Found keywords: %s"
-                (String.concat " " (CicNotationUtil.keywords_of_term l1)));
-              let time1 = Unix.gettimeofday () in
-                ignore (CicNotationParser.extend l1 ?precedence ?associativity
-                   (fun env loc -> CicNotationFwd.instantiate_level2 env l2));
-                let time2 = Unix.gettimeofday () in
-                  prerr_endline "Extending pretty printer ..."; flush stdout;
-                  let time3 = Unix.gettimeofday () in
-                  ignore (CicNotationRew.add_pretty_printer
-                    ?precedence ?associativity l2 l1);
-                    let time4 = Unix.gettimeofday () in
-                      printf ("done (extending parser took %f, " ^^
-                        "extending pretty printer took %f)\n")
-                        (time2 -. time1) (time4 -. time3);
-                      flush stdout
+              prerr_endline "notation";
+              prerr_endline (sprintf "l1: %s" (CicNotationPp.pp_term l1));
+              prerr_endline (sprintf "l2: %s" (CicNotationPp.pp_term l2));
+              prerr_endline (sprintf "prec: %s" (pp_precedence precedence));
+              prerr_endline (sprintf "assoc: %s" (pp_associativity associativity));
+              let keywords = CicNotationUtil.keywords_of_term l1 in
+              if keywords <> [] then
+                prerr_endline (sprintf "keywords: %s"
+                  (String.concat " " keywords));
+              ignore (CicNotationParser.extend l1 ?precedence ?associativity
+                (fun env loc -> CicNotationFwd.instantiate_level2 env l2));
+              ignore (CicNotationRew.add_pretty_printer
+                ?precedence ?associativity l2 l1)
           | G.Executable (_, G.Command (_, G.Interpretation (_, id, l2, l3))) ->
-              prerr_endline "Adding interpretation ..."; flush stdout;
-              let time1 = Unix.gettimeofday () in
-                ignore (CicNotationRew.add_interpretation id l2 l3);
-                let time2 = Unix.gettimeofday () in
-                  printf "done (patterns compilation took %f seconds)\n"
-                    (time2 -. time1);
-                  flush stdout
+              prerr_endline "interpretation";
+              prerr_endline (sprintf "dsc: %s" id);
+              ignore (CicNotationRew.add_interpretation id l2 l3);
+              flush stdout
           | G.Executable (_, G.Command (_, G.Dump _)) ->
               CicNotationParser.print_l2_pattern (); print_newline ()
           | G.Executable (_, G.Command (_, G.Render (_, uri))) ->
@@ -113,25 +112,15 @@ let process_stream ?(ignore_exn = false) istream =
                   | Cic.AVariable (_, _, _, ty, _, _) -> ty
                   | _ -> assert false
               in
-              let time1 = Unix.gettimeofday () in
               let t, id_to_uri =
                 CicNotationRew.ast_of_acic id_to_sort annterm
               in
-              let time2 = Unix.gettimeofday () in
-                prerr_endline (sprintf "ast creation took %f seconds\n"
-                  (time2 -. time1));
-                prerr_endline "AST";
-                prerr_endline (CicNotationPp.pp_term t);
-                flush stdout;
-                let time3 = Unix.gettimeofday () in
-                let t' = CicNotationRew.pp_ast t in
-                let time4 = Unix.gettimeofday () in
-                  prerr_endline (sprintf "pretty printing took %f seconds\n"
-                    (time4 -. time3));
-                  prerr_endline (CicNotationPp.pp_term t');
-                  dump_xml t' id_to_uri "out.xml"
-          | _ ->
-              prerr_endline "Unsupported statement"
+              prerr_endline "AST";
+              prerr_endline (CicNotationPp.pp_term t);
+              let t' = CicNotationRew.pp_ast t in
+              prerr_endline (CicNotationPp.pp_term t');
+              dump_xml t' id_to_uri "out.xml"
+          | _ -> prerr_endline "Unsupported statement"
         with
         | End_of_file -> raise End_of_file
         | CicNotationParser.Parse_error (floc, msg) ->
@@ -157,9 +146,7 @@ let _ =
   let usage = "" in
   Arg.parse arg_spec (fun _ -> raise (Arg.Bad usage)) usage;
   print_endline "Loading builtin notation ...";
-  let ic = open_in (Helm_registry.get "notation.core_file") in
-  process_stream ~ignore_exn:true (Stream.of_channel ic);
-  close_in ic;
+  CicNotation.load_notation (Helm_registry.get "notation.core_file");
   print_endline "done.";
   flush stdout;
   process_stream ~ignore_exn:false (Stream.of_channel stdin)