[r2003-11-20 11:41:50 by szach] added support and help for #print_{schema,type}

Original author: szach
Date: 2003-11-20 11:41:50+00:00

driver/cduce.ml

@@ -68,6 +68,8 @@ let dump_env ppf =
   Format.fprintf ppf "Namespace prefixes:@\n%a" Typer.dump_ns !typing_env;
   Format.fprintf ppf "Namespace prefixes used for pretty-printing:@.%t"
     Ns.InternalPrinter.dump;
+  Format.fprintf ppf "Schemas: %s@."
+    (String.concat " " (Typer.get_schema_names ()));
   Format.fprintf ppf "Values:@.";
   Typer.iter_values !typing_env
     (fun x t -> dump_value ppf x t (get_global_value x))
@@ -75,12 +77,14 @@ let dump_env ppf =
 let directive_help ppf =
   Format.fprintf ppf
 "Toplevel directives:
-  #quit;;               quit the interpreter
-  #env;;                dump current environment
-  #reinit_ns;;          reinitialize namespace processing
-  #help;;               shows this help message
-  #dump_value <expr>;;  dump an XML-ish representation of the resulting
-                        value of a given expression
+  #quit;;                 quit the interpreter
+  #env;;                  dump current environment
+  #reinit_ns;;            reinitialize namespace processing
+  #help;;                 shows this help message
+  #dump_value <expr>;;    dump an XML-ish representation of the resulting
+                          value of a given expression
+  #print_schema <name>;;
+  #print_type <name>;;
 "
 
 let rec print_exn ppf = function
@@ -272,6 +276,7 @@ let rec collect_types ppf accu = function
         Typer.enter_types (Typer.type_defs !typing_env accu) !typing_env;
       rest
 
+let flush_stdout () = Format.fprintf Format.std_formatter "@."
 
 let rec phrases ppf phs = match phs with
   | { descr = Ast.FunDecl _ } :: _ -> 
@@ -287,7 +292,6 @@ let rec phrases ppf phs = match phs with
   | { descr = Ast.Using (x,cu) } :: rest ->
       Librarian.import cu;
       Librarian.run Value.nil cu;
-
       typing_env := Typer.enter_cu x cu !typing_env;
       phrases ppf rest
   | { descr = Ast.EvalStatement e } :: rest ->
@@ -305,6 +309,18 @@ let rec phrases ppf phs = match phs with
   | { descr = Ast.Directive `Env } :: rest ->
       dump_env ppf;
       phrases ppf rest
+  | { descr = Ast.Directive (`Print_schema schema) } :: rest ->
+      Schema_common.print_schema ppf (Typer.get_schema schema);
+      flush_stdout ();
+      phrases ppf rest
+  | { descr = Ast.Directive (`Print_type name) } :: rest ->
+      Typer.dump_type Format.std_formatter !typing_env name;
+      flush_stdout ();
+      phrases ppf rest
+  | { descr = Ast.Directive (`Print_schema_type schema_ref) } :: rest ->
+      Typer.dump_schema_type Format.std_formatter schema_ref;
+      flush_stdout ();
+      phrases ppf rest
   | { descr = Ast.Directive `Reinit_ns } :: rest ->
       Typer.set_ns_table_for_printer !typing_env;
       phrases ppf rest