Support for toplevel primitives with multiple arguments.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14616 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -50,6 +50,9 @@ Compilers:
 - PR#6345: Better compilation of optional arguments with default values
 - PR#6260: Unnecessary boxing in let (patch by vbrankov)
 
+Toplevel interactive system:
+- Support for directive with multiple arguments
+
 Runtime system:
 - Fixed a major performance problem on large heaps (~1GB) by making heap
   increments proportional to heap size

parsing/parser.mly

@@ -1938,14 +1938,18 @@ class_longident:
 /* Toplevel directives */
 
 toplevel_directive:
-    SHARP ident                 { Ptop_dir($2, Pdir_none) }
-  | SHARP ident STRING          { Ptop_dir($2, Pdir_string (fst $3)) }
-  | SHARP ident INT             { Ptop_dir($2, Pdir_int $3) }
-  | SHARP ident val_longident   { Ptop_dir($2, Pdir_ident $3) }
-  | SHARP ident FALSE           { Ptop_dir($2, Pdir_bool false) }
-  | SHARP ident TRUE            { Ptop_dir($2, Pdir_bool true) }
+    SHARP ident toplevel_directive_args    { Ptop_dir($2, $3) }
+;
+toplevel_directive_arg:
+  | STRING          { Pdir_string (fst $1) }
+  | INT             { Pdir_int $1 }
+  | val_longident   { Pdir_ident $1 }
+  | FALSE           { Pdir_bool false }
+  | TRUE            { Pdir_bool true }
+toplevel_directive_args:
+  | /*empty*/ { [] }
+  | toplevel_directive_arg toplevel_directive_args { $1 :: $2 }
 ;
-
 /* Miscellaneous */
 
 name_tag:

parsing/parsetree.mli

@@ -759,11 +759,10 @@ and module_binding =
 
 type toplevel_phrase =
   | Ptop_def of structure
-  | Ptop_dir of string * directive_argument
+  | Ptop_dir of string * directive_argument list
      (* #use, #load ... *)
 
 and directive_argument =
-  | Pdir_none
   | Pdir_string of string
   | Pdir_int of int
   | Pdir_ident of Longident.t

parsing/pprintast.ml

@@ -1223,7 +1223,6 @@ class printer  ()= object(self:'self)
 
   method directive_argument f x =
     (match x with
-    | Pdir_none -> ()
     | Pdir_string (s) -> pp f "@ %S" s
     | Pdir_int (i) -> pp f "@ %d" i
     | Pdir_ident (li) -> pp f "@ %a" self#longident li
@@ -1236,7 +1235,8 @@ class printer  ()= object(self:'self)
         self#list self#structure_item f s ;
         pp_close_box f ();
     | Ptop_dir (s, da) ->
-        pp f "@[<hov2>#%s@ %a@]" s self#directive_argument da
+        pp f "@[<hov2>#%s@ %a@]" s
+          (self#list ~sep:" " self#directive_argument) da
 end;;
 
 
@@ -1250,7 +1250,8 @@ let toplevel_phrase f x =
    (* pp_print_list structure_item f s ; *)
    (* pp_close_box f (); *)
   | Ptop_dir (s, da) ->
-   pp f "@[<hov2>#%s@ %a@]" s default#directive_argument da
+   pp f "@[<hov2>#%s@ %a@]" s
+     (default#list ~sep:" " default#directive_argument) da
    (* pp f "@[<hov2>#%s@ %a@]" s directive_argument da *)
 
 let expression f x =

parsing/printast.ml

@@ -838,11 +838,10 @@ let rec toplevel_phrase i ppf x =
       structure (i+1) ppf s;
   | Ptop_dir (s, da) ->
       line i ppf "Ptop_dir \"%s\"\n" s;
-      directive_argument i ppf da;
+      list i directive_argument ppf da;
 
 and directive_argument i ppf x =
   match x with
-  | Pdir_none -> line i ppf "Pdir_none\n"
   | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s;
   | Pdir_int (i) -> line i ppf "Pdir_int %d\n" i;
   | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li;

toplevel/toploop.ml

@@ -28,6 +28,7 @@ type directive_fun =
    | Directive_int of (int -> unit)
    | Directive_ident of (Longident.t -> unit)
    | Directive_bool of (bool -> unit)
+   | Directive_generic of (Parsetree.directive_argument list -> unit)
 
 (* The table of toplevel value bindings and its accessors *)
 
@@ -282,11 +283,12 @@ let execute_phrase print_outcome ppf phr =
   | Ptop_dir(dir_name, dir_arg) ->
       try
         match (Hashtbl.find directive_table dir_name, dir_arg) with
-        | (Directive_none f, Pdir_none) -> f (); true
-        | (Directive_string f, Pdir_string s) -> f s; true
-        | (Directive_int f, Pdir_int n) -> f n; true
-        | (Directive_ident f, Pdir_ident lid) -> f lid; true
-        | (Directive_bool f, Pdir_bool b) -> f b; true
+        | (Directive_none f, []) -> f (); true
+        | (Directive_string f, [Pdir_string s]) -> f s; true
+        | (Directive_int f, [Pdir_int n]) -> f n; true
+        | (Directive_ident f, [Pdir_ident lid]) -> f lid; true
+        | (Directive_bool f, [Pdir_bool b]) -> f b; true
+        | (Directive_generic f, l) -> f l; true
         | (_, _) ->
             fprintf ppf "Wrong type of argument for directive `%s'.@." dir_name;
             false

toplevel/toploop.mli

@@ -39,6 +39,7 @@ type directive_fun =
    | Directive_int of (int -> unit)
    | Directive_ident of (Longident.t -> unit)
    | Directive_bool of (bool -> unit)
+   | Directive_generic of (Parsetree.directive_argument list -> unit)
 
 val directive_table : (string, directive_fun) Hashtbl.t
         (* Table of known directives, with their execution function *)