Permalink
Browse files

Support for toplevel primitives with multiple arguments.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14616 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent 8106136 commit 26a8bc20a79d7b817444b51c81bf6653ecb57651 @alainfrisch alainfrisch committed Apr 16, 2014
Showing with 28 additions and 19 deletions.
  1. +3 −0 Changes
  2. +11 −7 parsing/parser.mly
  3. +1 −2 parsing/parsetree.mli
  4. +4 −3 parsing/pprintast.ml
  5. +1 −2 parsing/printast.ml
  6. +7 −5 toplevel/toploop.ml
  7. +1 −0 toplevel/toploop.mli
View
@@ -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
View
@@ -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:
View
@@ -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
View
@@ -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 =
View
@@ -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;
View
@@ -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
View
@@ -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 *)

0 comments on commit 26a8bc2

Please sign in to comment.