Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'trunk' of github.com:ocaml/ocaml into trunk

master
Jacques Garrigue 2016-05-11 08:39:19 +09:00
parent 5331b57010 4a2107be8d
commit fc4ddcb599
39 changed files with 144 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Changes
View File

@ -30,6 +30,9 @@ OCaml 4.04.0:
- MPR#7248: have ocamldep interpret -open arguments in left-to-right order
(Gabriel Scherer, report by Anton Bachin)
- Add the -no-version option to the toplevel
(Sébastien Hinderer)
### Standard library:
- GPR#427: Obj.is_block is now an inlined OCaml function instead of a

6
config/Makefile-templ
View File

@ -33,9 +33,9 @@ MANEXT=1
### Do #! scripts work on your system?
### Beware: on some systems (e.g. SunOS 4), this will work only if
### the string "#!$(BINDIR)/ocamlrun" is less than 32 characters long.
### In doubt, set SHARPBANGSCRIPTS to false.
SHARPBANGSCRIPTS=true
#SHARPBANGSCRIPTS=false
### In doubt, set HASHBANGSCRIPTS to false.
HASHBANGSCRIPTS=true
#HASHBANGSCRIPTS=false
########## Configuration for the bytecode compiler

2
config/Makefile.mingw
View File

@ -61,7 +61,7 @@ EXT_OBJ=.$(O)
EXT_LIB=.$(A)
EXT_ASM=.$(S)
MANEXT=1
SHARPBANGSCRIPTS=false
HASHBANGSCRIPTS=false
PTHREAD_LINK=
X11_INCLUDES=
X11_LINK=

2
config/Makefile.mingw64
View File

@ -61,7 +61,7 @@ EXT_OBJ=.$(O)
EXT_LIB=.$(A)
EXT_ASM=.$(S)
MANEXT=1
SHARPBANGSCRIPTS=false
HASHBANGSCRIPTS=false
PTHREAD_LINK=
X11_INCLUDES=
X11_LINK=

2
config/Makefile.msvc
View File

@ -56,7 +56,7 @@ EXT_OBJ=.$(O)
EXT_LIB=.$(A)
EXT_ASM=.$(S)
MANEXT=1
SHARPBANGSCRIPTS=false
HASHBANGSCRIPTS=false
PTHREAD_LINK=
X11_INCLUDES=
X11_LINK=

2
config/Makefile.msvc64
View File

@ -56,7 +56,7 @@ EXT_OBJ=.$(O)
EXT_LIB=.$(A)
EXT_ASM=.$(S)
MANEXT=1
SHARPBANGSCRIPTS=false
HASHBANGSCRIPTS=false
PTHREAD_LINK=
X11_INCLUDES=
X11_LINK=

0
config/auto-aux/sharpbang → config/auto-aux/hashbang
View File

0
config/auto-aux/sharpbang2 → config/auto-aux/hashbang2
View File

12
configure vendored
View File

@ -985,27 +985,27 @@ echo "#define OCAML_STDLIB_DIR \"$libdir\"" >> s.h
# Do #! scripts work?
if (SHELL=/bin/sh; export SHELL; (./sharpbang || ./sharpbang2) >/dev/null); then
if (SHELL=/bin/sh; export SHELL; (./hashbang || ./hashbang2) >/dev/null); then
inf "#! appears to work in shell scripts."
case "$target" in
*-*-sunos*|*-*-unicos*)
wrn "We won't use it, though, because under SunOS and Unicos it breaks " \
"on pathnames longer than 30 characters"
echo "SHARPBANGSCRIPTS=false" >> Makefile;;
echo "HASHBANGSCRIPTS=false" >> Makefile;;
*-*-cygwin*)
wrn "We won't use it, though, because of conflicts with .exe extension " \
"under Cygwin"
echo "SHARPBANGSCRIPTS=false" >> Makefile;;
echo "HASHBANGSCRIPTS=false" >> Makefile;;
*-*-mingw*)
inf "We won't use it, though, because it's on the target platform " \
"it would be used and windows doesn't support it."
echo "SHARPBANGSCRIPTS=false" >> Makefile;;
echo "HASHBANGSCRIPTS=false" >> Makefile;;
*)
echo "SHARPBANGSCRIPTS=true" >> Makefile;;
echo "HASHBANGSCRIPTS=true" >> Makefile;;
esac
else
inf "No support for #! in shell scripts"
echo "SHARPBANGSCRIPTS=false" >> Makefile
echo "HASHBANGSCRIPTS=false" >> Makefile
fi
# Use 64-bit file offset if possible

2
debugger/lexer.mll
View File

@ -78,7 +78,7 @@ and lexeme = (* Read a lexeme *)
| "."
{ DOT }
| "#"
{ SHARP }
{ HASH }
| "@"
{ AT }
| "$"

4
debugger/parser.mly
View File

@ -31,7 +31,7 @@ open Parser_aux
%token STAR /* * */
%token MINUS /* - */
%token DOT /* . */
%token SHARP /* # */
%token HASH /* # */
%token AT /* @ */
%token DOLLAR /* $ */
%token BANG /* ! */
@ -238,7 +238,7 @@ break_argument_eol :
| integer_eol { BA_pc $1 }
| expression end_of_line { BA_function $1 }
| AT opt_longident INTEGER opt_integer_eol { BA_pos1 ($2, (to_int $3), $4)}
| AT opt_longident SHARP integer_eol { BA_pos2 ($2, $4) }
| AT opt_longident HASH integer_eol { BA_pos2 ($2, $4) }
;
/* Arguments for list */

7
driver/main_args.ml
View File

@ -501,6 +501,10 @@ let mk__version f =
"--version", Arg.Unit f, " Print version and exit"
;;
let mk_no_version f =
"-no-version", Arg.Unit f, " Do not print version at startup"
;;
let mk_vmthread f =
"-vmthread", Arg.Unit f,
" Generate code that supports the threads library with VM-level\n\
@ -789,6 +793,7 @@ module type Toplevel_options = sig
include Common_options
val _init : string -> unit
val _noinit : unit -> unit
val _no_version : unit -> unit
val _noprompt : unit -> unit
val _nopromptcont : unit -> unit
val _stdin : unit -> unit
@ -1030,6 +1035,7 @@ struct
mk_unsafe_string F._unsafe_string;
mk_version F._version;
mk__version F._version;
mk_no_version F._no_version;
mk_vnum F._vnum;
mk_w F._w;
mk_warn_error F._warn_error;
@ -1228,6 +1234,7 @@ module Make_opttop_options (F : Opttop_options) = struct
mk_unsafe_string F._unsafe_string;
mk_version F._version;
mk__version F._version;
mk_no_version F._no_version;
mk_vnum F._vnum;
mk_w F._w;
mk_warn_error F._warn_error;

1
driver/main_args.mli
View File

@ -104,6 +104,7 @@ module type Toplevel_options = sig
include Common_options
val _init : string -> unit
val _noinit : unit -> unit
val _no_version : unit -> unit
val _noprompt : unit -> unit
val _nopromptcont : unit -> unit
val _stdin : unit -> unit

26
experimental/garrigue/show_types.diff
View File

@ -57,19 +57,19 @@ Index: parsing/parser.mly
/* Toplevel directives */
toplevel_directive:
- SHARP ident { Ptop_dir($2, Pdir_none) }
- | SHARP ident STRING { Ptop_dir($2, Pdir_string $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 { Ptop_dir($2, Pdir_none) }
+ | SHARP ident STRING { Ptop_dir($2, Pdir_string $3) }
+ | SHARP ident INT { Ptop_dir($2, Pdir_int $3) }
+ | SHARP ident val_longident { Ptop_dir($2, Pdir_ident (mkrhs $3 3)) }
+ | SHARP ident ident_kind any_longident { Ptop_dir($2, Pdir_show ($3, mkrhs $4 4)) }
+ | SHARP ident FALSE { Ptop_dir($2, Pdir_bool false) }
+ | SHARP ident TRUE { Ptop_dir($2, Pdir_bool true) }
- HASH ident { Ptop_dir($2, Pdir_none) }
- | HASH ident STRING { Ptop_dir($2, Pdir_string $3) }
- | HASH ident INT { Ptop_dir($2, Pdir_int $3) }
- | HASH ident val_longident { Ptop_dir($2, Pdir_ident $3) }
- | HASH ident FALSE { Ptop_dir($2, Pdir_bool false) }
- | HASH ident TRUE { Ptop_dir($2, Pdir_bool true) }
+ HASH ident { Ptop_dir($2, Pdir_none) }
+ | HASH ident STRING { Ptop_dir($2, Pdir_string $3) }
+ | HASH ident INT { Ptop_dir($2, Pdir_int $3) }
+ | HASH ident val_longident { Ptop_dir($2, Pdir_ident (mkrhs $3 3)) }
+ | HASH ident ident_kind any_longident { Ptop_dir($2, Pdir_show ($3, mkrhs $4 4)) }
+ | HASH ident FALSE { Ptop_dir($2, Pdir_bool false) }
+ | HASH ident TRUE { Ptop_dir($2, Pdir_bool true) }
;
/* Miscellaneous */

2
lex/lexer.mll
View File

@ -188,7 +188,7 @@ rule main = parse
| ')' { Trparen }
| '^' { Tcaret }
| '-' { Tdash }
| '#' { Tsharp }
| '#' { Thash }
| eof { Tend }
| _
{ raise_lexical_error lexbuf

6
lex/parser.mly
View File

@ -53,13 +53,13 @@ let as_cset = function
%token <Syntax.location> Taction
%token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof
Tlbracket Trbracket Trefill
%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Tsharp
%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Thash
%right Tas
%left Tor
%nonassoc CONCAT
%nonassoc Tmaybe Tstar Tplus
%left Tsharp
%left Thash
%nonassoc Tident Tchar Tstring Tunderscore Teof Tlbracket Tlparen
%start lexer_definition
@ -145,7 +145,7 @@ regexp:
{ Alternative(Epsilon, $1) }
| regexp Tplus
{ Sequence(Repetition (remove_as $1), $1) }
| regexp Tsharp regexp
| regexp Thash regexp
{
let s1 = as_cset $1
and s2 = as_cset $3 in

5
man/ocaml.m
View File

@ -38,7 +38,7 @@ that permits interactive use of the OCaml system through a
read-eval-print loop. In this mode, the system repeatedly reads OCaml
phrases from the input, then typechecks, compiles and evaluates
them, then prints the inferred type and result value, if any. The
system prints a # (sharp) prompt before reading each phrase.
system prints a # (hash) prompt before reading each phrase.
A toplevel phrase can span several lines. It is terminated by ;; (a
double-semicolon). The syntax of toplevel phrases is as follows.
@ -206,6 +206,9 @@ Print version string and exit.
.B \-vnum
Print short version number and exit.
.TP
.B \-no\-version
Do not print the version banner at startup.
.TP
.BI \-w \ warning\-list
Enable or disable warnings according to the argument
.IR warning-list .

3
manual/manual/cmds/top.etex
View File

@ -246,6 +246,9 @@ Print version string and exit.
\item["-vnum"]
Print short version number and exit.
\item["-no-version"]
Do not print the version banner at startup.
\item["-w" \var{warning-list}]
Enable or disable warnings according to the argument \var{warning-list}.
See section~\ref{s:comp-options} for the syntax of the argument.

2
ocamldoc/ocamldoc.hva
View File

@ -20,7 +20,7 @@
\newcommand\textbar{|}
\newcommand\textbackslash{\begin{rawhtml}\\end{rawhtml}}
\newcommand\textasciicircum{\^{}}
\newcommand\sharp{#}
\newcommand\hash{#}
\let\ocamldocvspace\vspace
\newenvironment{ocamldocindent}{\list{}{}\item\relax}{\endlist}

2
parsing/lexer.mli
View File

@ -17,7 +17,7 @@
val init : unit -> unit
val token: Lexing.lexbuf -> Parser.token
val skip_sharp_bang: Lexing.lexbuf -> unit
val skip_hash_bang: Lexing.lexbuf -> unit
type error =
| Illegal_character of char

6
parsing/lexer.mll
View File

@ -428,7 +428,7 @@ rule token = parse
{ update_loc lexbuf name (int_of_string num) true 0;
token lexbuf
}
| "#" { SHARP }
| "#" { HASH }
| "&" { AMPERSAND }
| "&&" { AMPERAMPER }
| "`" { BACKQUOTE }
@ -492,7 +492,7 @@ rule token = parse
| ['*' '/' '%'] symbolchar *
{ INFIXOP3(Lexing.lexeme lexbuf) }
| '#' (symbolchar | '#') +
{ SHARPOP(Lexing.lexeme lexbuf) }
{ HASHOP(Lexing.lexeme lexbuf) }
| eof { EOF }
| _
{ raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0),
@ -652,7 +652,7 @@ and quoted_string delim = parse
{ store_string_char(Lexing.lexeme_char lexbuf 0);
quoted_string delim lexbuf }
and skip_sharp_bang = parse
and skip_hash_bang = parse
| "#!" [^ '\n']* '\n' [^ '\n']* "\n!#\n"
{ update_loc lexbuf None 3 false 0 }
| "#!" [^ '\n']* '\n'

58
parsing/parser.mly
View File

@ -561,8 +561,8 @@ let package_type_of_module_type pmty =
%token RPAREN
%token SEMI
%token SEMISEMI
%token SHARP
%token <string> SHARPOP
%token HASH
%token <string> HASHOP
%token SIG
%token STAR
%token <string * string option> STRING
@ -639,9 +639,9 @@ The precedences must be listed from low to high.
%nonassoc prec_unary_minus prec_unary_plus /* unary - */
%nonassoc prec_constant_constructor /* cf. simple_expr (C versus C x) */
%nonassoc prec_constr_appl /* above AS BAR COLONCOLON COMMA */
%nonassoc below_SHARP
%nonassoc SHARP /* simple_expr/toplevel_directive */
%left SHARPOP
%nonassoc below_HASH
%nonassoc HASH /* simple_expr/toplevel_directive */
%left HASHOP
%nonassoc below_DOT
%nonassoc DOT
/* Finally, the first tokens of simple_expr are above everything else. */
@ -1350,7 +1350,7 @@ let_pattern:
{ mkpat(Ppat_constraint($1, $3)) }
;
expr:
simple_expr %prec below_SHARP
simple_expr %prec below_HASH
{ $1 }
| simple_expr simple_labeled_expr_list
{ mkexp(Pexp_apply($1, List.rev $2)) }
@ -1384,9 +1384,9 @@ expr:
{ syntax_error() }
| expr_comma_list %prec below_COMMA
{ mkexp(Pexp_tuple(List.rev $1)) }
| constr_longident simple_expr %prec below_SHARP
| constr_longident simple_expr %prec below_HASH
{ mkexp(Pexp_construct(mkrhs $1 1, Some $2)) }
| name_tag simple_expr %prec below_SHARP
| name_tag simple_expr %prec below_HASH
{ mkexp(Pexp_variant($1, Some $2)) }
| IF ext_attributes seq_expr THEN expr ELSE expr
{ mkexp_attrs(Pexp_ifthenelse($3, $5, Some $7)) $2 }
@ -1457,9 +1457,9 @@ expr:
{ bigarray_set $1 $4 $7 }
| label LESSMINUS expr
{ mkexp(Pexp_setinstvar(mkrhs $1 1, $3)) }
| ASSERT ext_attributes simple_expr %prec below_SHARP
| ASSERT ext_attributes simple_expr %prec below_HASH
{ mkexp_attrs (Pexp_assert $3) $2 }
| LAZY ext_attributes simple_expr %prec below_SHARP
| LAZY ext_attributes simple_expr %prec below_HASH
{ mkexp_attrs (Pexp_lazy $3) $2 }
| OBJECT ext_attributes class_structure END
{ mkexp_attrs (Pexp_object $3) $2 }
@ -1567,9 +1567,9 @@ simple_expr:
{ mkexp(Pexp_open(Fresh, mkrhs $1 1, mkexp (Pexp_override [])))}
| mod_longident DOT LBRACELESS field_expr_list error
{ unclosed "{<" 3 ">}" 5 }
| simple_expr SHARP label
| simple_expr HASH label
{ mkexp(Pexp_send($1, $3)) }
| simple_expr SHARPOP simple_expr
| simple_expr HASHOP simple_expr
{ mkinfix $1 $2 $3 }
| LPAREN MODULE ext_attributes module_expr RPAREN
{ mkexp_attrs (Pexp_pack $4) $3 }
@ -1597,19 +1597,19 @@ simple_labeled_expr_list:
{ $2 :: $1 }
;
labeled_simple_expr:
simple_expr %prec below_SHARP
simple_expr %prec below_HASH
{ (Nolabel, $1) }
| label_expr
{ $1 }
;
label_expr:
LABEL simple_expr %prec below_SHARP
LABEL simple_expr %prec below_HASH
{ (Labelled $1, $2) }
| TILDE label_ident
{ (Labelled (fst $2), snd $2) }
| QUESTION label_ident
{ (Optional (fst $2), snd $2) }
| OPTLABEL simple_expr %prec below_SHARP
| OPTLABEL simple_expr %prec below_HASH
{ (Optional $1, $2) }
;
label_ident:
@ -1810,7 +1810,7 @@ simple_pattern_not_ident:
{ mkpat(Ppat_construct(mkrhs $1 1, None)) }
| name_tag
{ mkpat(Ppat_variant($1, None)) }
| SHARP type_longident
| HASH type_longident
{ mkpat(Ppat_type (mkrhs $2 2)) }
| simple_delimited_pattern
{ $1 }
@ -2240,9 +2240,9 @@ core_type2:
;
simple_core_type:
simple_core_type2 %prec below_SHARP
simple_core_type2 %prec below_HASH
{ $1 }
| LPAREN core_type_comma_list RPAREN %prec below_SHARP
| LPAREN core_type_comma_list RPAREN %prec below_HASH
{ match $2 with [sty] -> sty | _ -> raise Parse_error }
;
@ -2261,11 +2261,11 @@ simple_core_type2:
{ let (f, c) = $2 in mktyp(Ptyp_object (f, c)) }
| LESS GREATER
{ mktyp(Ptyp_object ([], Closed)) }
| SHARP class_longident
| HASH class_longident
{ mktyp(Ptyp_class(mkrhs $2 2, [])) }
| simple_core_type2 SHARP class_longident
| simple_core_type2 HASH class_longident
{ mktyp(Ptyp_class(mkrhs $3 3, [$1])) }
| LPAREN core_type_comma_list RPAREN SHARP class_longident
| LPAREN core_type_comma_list RPAREN HASH class_longident
{ mktyp(Ptyp_class(mkrhs $5 5, List.rev $2)) }
| LBRACKET tag_field RBRACKET
{ mktyp(Ptyp_variant([$2], Closed, None)) }
@ -2393,7 +2393,7 @@ operator:
| INFIXOP2 { $1 }
| INFIXOP3 { $1 }
| INFIXOP4 { $1 }
| SHARPOP { $1 }
| HASHOP { $1 }
| BANG { "!" }
| PLUS { "+" }
| PLUSDOT { "+." }
@ -2465,14 +2465,14 @@ 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 { let (n, m) = $3 in
HASH ident { Ptop_dir($2, Pdir_none) }
| HASH ident STRING { Ptop_dir($2, Pdir_string (fst $3)) }
| HASH ident INT { let (n, m) = $3 in
Ptop_dir($2, Pdir_int (n ,m)) }
| SHARP ident val_longident { Ptop_dir($2, Pdir_ident $3) }
| SHARP ident mod_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) }
| HASH ident val_longident { Ptop_dir($2, Pdir_ident $3) }
| HASH ident mod_longident { Ptop_dir($2, Pdir_ident $3) }
| HASH ident FALSE { Ptop_dir($2, Pdir_bool false) }
| HASH ident TRUE { Ptop_dir($2, Pdir_bool true) }
;
/* Miscellaneous */

2
stdlib/Makefile
View File

@ -52,7 +52,7 @@ camlheader target_camlheader camlheader_ur \
camlheaderd target_camlheaderd \
camlheaderi target_camlheaderi: \
header.c ../config/Makefile
if $(SHARPBANGSCRIPTS); then \
if $(HASHBANGSCRIPTS); then \
for suff in '' d i; do \
echo '#!$(BINDIR)/ocamlrun'$$suff > camlheader$$suff && \
echo '#!$(TARGET_BINDIR)/ocamlrun'$$suff >target_camlheader$$suff; \

64
stdlib/camlinternalFormat.ml
View File

@ -2012,7 +2012,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
(* - zero: is the '0' flag defined in the current micro-format. *)
(* - minus: is the '-' flag defined in the current micro-format. *)
(* - plus: is the '+' flag defined in the current micro-format. *)
(* - sharp: is the '#' flag defined in the current micro-format. *)
(* - hash: is the '#' flag defined in the current micro-format. *)
(* - space: is the ' ' flag defined in the current micro-format. *)
(* - ign: is the '_' flag defined in the current micro-format. *)
(* - pad: padding of the current micro-format. *)
@ -2105,7 +2105,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
fun pct_ind str_ind end_ind ign ->
let zero = ref false and minus = ref false
and plus = ref false and space = ref false
and sharp = ref false in
and hash = ref false in
let set_flag str_ind flag =
(* in legacy mode, duplicate flags are accepted *)
if !flag && not legacy_behavior then
@ -2120,11 +2120,11 @@ let fmt_ebb_of_string ?legacy_behavior str =
| '0' -> set_flag str_ind zero; read_flags (str_ind + 1)
| '-' -> set_flag str_ind minus; read_flags (str_ind + 1)
| '+' -> set_flag str_ind plus; read_flags (str_ind + 1)
| '#' -> set_flag str_ind sharp; read_flags (str_ind + 1)
| '#' -> set_flag str_ind hash; read_flags (str_ind + 1)
| ' ' -> set_flag str_ind space; read_flags (str_ind + 1)
| _ ->
parse_padding pct_ind str_ind end_ind
!zero !minus !plus !sharp !space ign
!zero !minus !plus !hash !space ign
end
in
read_flags str_ind
@ -2133,7 +2133,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
and parse_padding : type e f .
int -> int -> int -> bool -> bool -> bool -> bool -> bool -> bool ->
(_, _, e, f) fmt_ebb =
fun pct_ind str_ind end_ind zero minus plus sharp space ign ->
fun pct_ind str_ind end_ind zero minus plus hash space ign ->
if str_ind = end_ind then unexpected_end_of_format end_ind;
let padty = match zero, minus with
| false, false -> Right
@ -2145,26 +2145,26 @@ let fmt_ebb_of_string ?legacy_behavior str =
match str.[str_ind] with
| '0' .. '9' ->
let new_ind, width = parse_positive str_ind end_ind 0 in
parse_after_padding pct_ind new_ind end_ind minus plus sharp space ign
parse_after_padding pct_ind new_ind end_ind minus plus hash space ign
(Lit_padding (padty, width))
| '*' ->
parse_after_padding pct_ind (str_ind + 1) end_ind minus plus sharp space
parse_after_padding pct_ind (str_ind + 1) end_ind minus plus hash space
ign (Arg_padding padty)
| _ ->
begin match padty with
| Left ->
if not legacy_behavior then
invalid_format_without (str_ind - 1) '-' "padding";
parse_after_padding pct_ind str_ind end_ind minus plus sharp space ign
parse_after_padding pct_ind str_ind end_ind minus plus hash space ign
No_padding
| Zeros ->
(* a '0' padding indication not followed by anything should
be interpreted as a Right padding of width 0. This is used
by scanning conversions %0s and %0c *)
parse_after_padding pct_ind str_ind end_ind minus plus sharp space ign
parse_after_padding pct_ind str_ind end_ind minus plus hash space ign
(Lit_padding (Right, 0))
| Right ->
parse_after_padding pct_ind str_ind end_ind minus plus sharp space ign
parse_after_padding pct_ind str_ind end_ind minus plus hash space ign
No_padding
end
@ -2172,25 +2172,25 @@ let fmt_ebb_of_string ?legacy_behavior str =
and parse_after_padding : type x e f .
int -> int -> int -> bool -> bool -> bool -> bool -> bool ->
(x, _) padding -> (_, _, e, f) fmt_ebb =
fun pct_ind str_ind end_ind minus plus sharp space ign pad ->
fun pct_ind str_ind end_ind minus plus hash space ign pad ->
if str_ind = end_ind then unexpected_end_of_format end_ind;
match str.[str_ind] with
| '.' ->
parse_precision pct_ind (str_ind + 1) end_ind minus plus sharp space ign
parse_precision pct_ind (str_ind + 1) end_ind minus plus hash space ign
pad
| symb ->
parse_conversion pct_ind (str_ind + 1) end_ind plus sharp space ign pad
parse_conversion pct_ind (str_ind + 1) end_ind plus hash space ign pad
No_precision pad symb
(* Read the digital or '*' precision. *)
and parse_precision : type x e f .
int -> int -> int -> bool -> bool -> bool -> bool -> bool ->
(x, _) padding -> (_, _, e, f) fmt_ebb =
fun pct_ind str_ind end_ind minus plus sharp space ign pad ->
fun pct_ind str_ind end_ind minus plus hash space ign pad ->
if str_ind = end_ind then unexpected_end_of_format end_ind;
let parse_literal minus str_ind =
let new_ind, prec = parse_positive str_ind end_ind 0 in
parse_after_precision pct_ind new_ind end_ind minus plus sharp space ign
parse_after_precision pct_ind new_ind end_ind minus plus hash space ign
pad (Lit_precision prec) in
match str.[str_ind] with
| '0' .. '9' -> parse_literal minus str_ind
@ -2205,14 +2205,14 @@ let fmt_ebb_of_string ?legacy_behavior str =
still blatantly wrong, as 123_456 or 0xFF are rejected. *)
parse_literal (minus || symb = '-') (str_ind + 1)
| '*' ->
parse_after_precision pct_ind (str_ind + 1) end_ind minus plus sharp space
parse_after_precision pct_ind (str_ind + 1) end_ind minus plus hash space
ign pad Arg_precision
| _ ->
if legacy_behavior then
(* note that legacy implementation did not ignore '.' without
a number (as it does for padding indications), but
interprets it as '.0' *)
parse_after_precision pct_ind str_ind end_ind minus plus sharp space ign
parse_after_precision pct_ind str_ind end_ind minus plus hash space ign
pad (Lit_precision 0)
else
invalid_format_without (str_ind - 1) '.' "precision"
@ -2221,10 +2221,10 @@ let fmt_ebb_of_string ?legacy_behavior str =
and parse_after_precision : type x y z t e f .
int -> int -> int -> bool -> bool -> bool -> bool -> bool ->
(x, y) padding -> (z, t) precision -> (_, _, e, f) fmt_ebb =
fun pct_ind str_ind end_ind minus plus sharp space ign pad prec ->
fun pct_ind str_ind end_ind minus plus hash space ign pad prec ->
if str_ind = end_ind then unexpected_end_of_format end_ind;
let parse_conv (type u) (type v) (padprec : (u, v) padding) =
parse_conversion pct_ind (str_ind + 1) end_ind plus sharp space ign pad
parse_conversion pct_ind (str_ind + 1) end_ind plus hash space ign pad
prec padprec str.[str_ind] in
(* in legacy mode, some formats (%s and %S) accept a weird mix of
padding and precision, which is merged as a single padding
@ -2247,15 +2247,15 @@ let fmt_ebb_of_string ?legacy_behavior str =
and parse_conversion : type x y z t u v e f .
int -> int -> int -> bool -> bool -> bool -> bool -> (x, y) padding ->
(z, t) precision -> (u, v) padding -> char -> (_, _, e, f) fmt_ebb =
fun pct_ind str_ind end_ind plus sharp space ign pad prec padprec symb ->
fun pct_ind str_ind end_ind plus hash space ign pad prec padprec symb ->
(* Flags used to check option usages/compatibilities. *)
let plus_used = ref false and sharp_used = ref false
let plus_used = ref false and hash_used = ref false
and space_used = ref false and ign_used = ref false
and pad_used = ref false and prec_used = ref false in
(* Access to options, update flags. *)
let get_plus () = plus_used := true; plus
and get_sharp () = sharp_used := true; sharp
and get_hash () = hash_used := true; hash
and get_space () = space_used := true; space
and get_ign () = ign_used := true; ign
and get_pad () = pad_used := true; pad
@ -2374,7 +2374,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
make_padding_fmt_ebb pad fmt_rest in
Fmt_EBB (Caml_string (pad', fmt_rest'))
| 'd' | 'i' | 'x' | 'X' | 'o' | 'u' ->
let iconv = compute_int_conv pct_ind str_ind (get_plus ()) (get_sharp ())
let iconv = compute_int_conv pct_ind str_ind (get_plus ()) (get_hash ())
(get_space ()) symb in
let Fmt_EBB fmt_rest = parse str_ind end_ind in
if get_ign () then
@ -2402,7 +2402,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
Fmt_EBB (Scan_get_counter (counter, fmt_rest))
| 'l' ->
let iconv =
compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_sharp ())
compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_hash ())
(get_space ()) str.[str_ind] in
let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
if get_ign () then
@ -2415,7 +2415,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
| 'n' ->
let iconv =
compute_int_conv pct_ind (str_ind + 1) (get_plus ())
(get_sharp ()) (get_space ()) str.[str_ind] in
(get_hash ()) (get_space ()) str.[str_ind] in
let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
if get_ign () then
let ignored = Ignored_nativeint (iconv, get_pad_opt '_') in
@ -2426,7 +2426,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
Fmt_EBB (Nativeint (iconv, pad', prec', fmt_rest'))
| 'L' ->
let iconv =
compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_sharp ())
compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_hash ())
(get_space ()) str.[str_ind] in
let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
if get_ign () then
@ -2512,7 +2512,7 @@ let fmt_ebb_of_string ?legacy_behavior str =
if not legacy_behavior then begin
if not !plus_used && plus then
incompatible_flag pct_ind str_ind symb "'+'";
if not !sharp_used && sharp then
if not !hash_used && hash then
incompatible_flag pct_ind str_ind symb "'#'";
if not !space_used && space then
incompatible_flag pct_ind str_ind symb "' '";
@ -2858,8 +2858,8 @@ let fmt_ebb_of_string ?legacy_behavior str =
| 'L' -> Token_counter | _ -> assert false
(* Convert (plus, symb) to its associated int_conv. *)
and compute_int_conv pct_ind str_ind plus sharp space symb =
match plus, sharp, space, symb with
and compute_int_conv pct_ind str_ind plus hash space symb =
match plus, hash, space, symb with
| false, false, false, 'd' -> Int_d | false, false, false, 'i' -> Int_i
| false, false, true, 'd' -> Int_sd | false, false, true, 'i' -> Int_si
| true, false, false, 'd' -> Int_pd | true, false, false, 'i' -> Int_pi
@ -2878,15 +2878,15 @@ let fmt_ebb_of_string ?legacy_behavior str =
| true, _, true, _ ->
if legacy_behavior then
(* plus and space: legacy implementation prefers plus *)
compute_int_conv pct_ind str_ind plus sharp false symb
compute_int_conv pct_ind str_ind plus hash false symb
else incompatible_flag pct_ind str_ind ' ' "'+'"
| false, _, true, _ ->
if legacy_behavior then (* ignore *)
compute_int_conv pct_ind str_ind plus sharp false symb
compute_int_conv pct_ind str_ind plus hash false symb
else incompatible_flag pct_ind str_ind symb "' '"
| true, _, false, _ ->
if legacy_behavior then (* ignore *)
compute_int_conv pct_ind str_ind false sharp space symb
compute_int_conv pct_ind str_ind false hash space symb
else incompatible_flag pct_ind str_ind symb "'+'"
| false, _, false, _ -> assert false

0
stdlib/sharpbang → stdlib/hashbang
View File

4
tools/lexer299.mll
View File

@ -58,6 +58,7 @@ type token =
| GREATER
| GREATERRBRACE
| GREATERRBRACKET
| HASH
| IF
| IN
| INCLUDE
@ -104,7 +105,6 @@ type token =
| RPAREN
| SEMI
| SEMISEMI
| SHARP
| SIG
| STAR
| STRING of (string)
@ -345,7 +345,7 @@ rule token = parse
| "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n")
(* # linenum ... *)
{ token lexbuf }
| "#" { SHARP }
| "#" { HASH }
| "&" { AMPERSAND }
| "&&" { AMPERAMPER }
| "`" { BACKQUOTE }

4
tools/lexer301.mll
View File

@ -57,6 +57,7 @@ type token =
| GREATER
| GREATERRBRACE
| GREATERRBRACKET
| HASH
| IF
| IN
| INCLUDE
@ -106,7 +107,6 @@ type token =
| RPAREN
| SEMI
| SEMISEMI
| SHARP
| SIG
| STAR
| STRING of (string)
@ -346,7 +346,7 @@ rule token = parse
| "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n")
(* # linenum ... *)
{ token lexbuf }
| "#" { SHARP }
| "#" { HASH }
| "&" { AMPERSAND }
| "&&" { AMPERAMPER }
| "`" { BACKQUOTE }

5
toplevel/opttoploop.ml
View File

@ -424,7 +424,7 @@ let use_file ppf wrap_mod name =
let lb = Lexing.from_channel ic in
Location.init lb filename;
(* Skip initial #! line if any *)
Lexer.skip_sharp_bang lb;
Lexer.skip_hash_bang lb;
let success =
protect_refs [ R (Location.input_name, filename) ] (fun () ->
try
@ -536,7 +536,8 @@ exception PPerror
let loop ppf =
Location.formatter_for_warnings := ppf;
fprintf ppf " OCaml version %s - native toplevel@.@." Config.version;
if not !Clflags.noversion then
fprintf ppf " OCaml version %s - native toplevel@.@." Config.version;
initialize_toplevel_env ();
let lb = Lexing.from_function refill_lexbuf in
Location.init lb "//toplevel//";

1
toplevel/opttopmain.ml
View File

@ -170,6 +170,7 @@ module Options = Main_args.Make_opttop_options (struct
let _unsafe = set fast
let _version () = print_version ()
let _vnum () = print_version_num ()
let _no_version = set noversion
let _w s = Warnings.parse_options false s
let _warn_error s = Warnings.parse_options true s
let _warn_help = Warnings.help_warnings

5
toplevel/toploop.ml
View File

@ -385,7 +385,7 @@ let use_file ppf wrap_mod name =
Warnings.reset_fatal ();
Location.init lb filename;
(* Skip initial #! line if any *)
Lexer.skip_sharp_bang lb;
Lexer.skip_hash_bang lb;
let success =
protect_refs [ R (Location.input_name, filename) ] (fun () ->
try
@ -507,7 +507,8 @@ exception PPerror
let loop ppf =
Location.formatter_for_warnings := ppf;
fprintf ppf " OCaml version %s@.@." Config.version;
if not !Clflags.noversion then
fprintf ppf " OCaml version %s@.@." Config.version;
begin
try initialize_toplevel_env ()
with Env.Error _ | Typetexp.Error _ as exn ->

1
toplevel/topmain.ml
View File

@ -97,6 +97,7 @@ module Options = Main_args.Make_bytetop_options (struct
let _unsafe_string = set unsafe_string
let _version () = print_version ()
let _vnum () = print_version_num ()
let _no_version = set noversion
let _w s = Warnings.parse_options false s
let _warn_error s = Warnings.parse_options true s
let _warn_help = Warnings.help_warnings

11
typing/ctype.ml
View File

@ -3647,16 +3647,17 @@ let rec filter_visited = function
let memq_warn t visited =
if List.memq t visited then (warn := true; true) else false
let rec lid_of_path ?(sharp="") = function
let rec lid_of_path ?(hash="") = function
Path.Pident id ->
Longident.Lident (sharp ^ Ident.name id)
Longident.Lident (hash ^ Ident.name id)
| Path.Pdot (p1, s, _) ->
Longident.Ldot (lid_of_path p1, sharp ^ s)
Longident.Ldot (lid_of_path p1, hash ^ s)
| Path.Papply (p1, p2) ->
Longident.Lapply (lid_of_path ~sharp p1, lid_of_path p2)
Longident.Lapply (lid_of_path ~hash p1, lid_of_path p2)
let find_cltype_for_path env p =
let _path, cl_abbr = Env.lookup_type (lid_of_path ~sharp:"#" p) env in
let _path, cl_abbr = Env.lookup_type (lid_of_path ~hash:"#" p) env in
match cl_abbr.type_manifest with
Some ty ->
begin match (repr ty).desc with

2
typing/ctype.mli
View File

@ -81,7 +81,7 @@ val set_object_name:
val remove_object_name: type_expr -> unit
val hide_private_methods: type_expr -> unit
val find_cltype_for_path: Env.t -> Path.t -> type_declaration * type_expr
val lid_of_path: ?sharp:string -> Path.t -> Longident.t
val lid_of_path: ?hash:string -> Path.t -> Longident.t
val sort_row_fields: (label * row_field) list -> (label * row_field) list
val merge_row_fields:

2
typing/typeclass.ml
View File

@ -1532,7 +1532,7 @@ let final_decl env define_class
ci_id_class = id;
ci_id_class_type = ty_id;
ci_id_object = obj_id;
ci_id_typesharp = cl_id;
ci_id_typehash = cl_id;
ci_expr = expr;
ci_decl = clty;
ci_type_decl = cltydef;

4
typing/typedecl.ml
View File

@ -881,7 +881,7 @@ let compute_variance_decl env check decl (required, _ as rloc) =
(mn @ List.map (fun {Types.ld_mutable; ld_type} ->
(ld_mutable = Mutable, ld_type)) ftl)
let is_sharp id =
let is_hash id =
let s = Ident.name id in
String.length s > 0 && s.[0] = '#'
@ -941,7 +941,7 @@ let rec compute_properties_fixpoint env decls required variances immediacies =
else ())
new_decls;
List.iter2
(fun (id, decl) req -> if not (is_sharp id) then
(fun (id, decl) req -> if not (is_hash id) then
ignore (compute_variance_decl new_env true decl req))
new_decls required;
new_decls, new_env

2
typing/typedtree.ml
View File

@ -507,7 +507,7 @@ and 'a class_infos =
ci_id_class: Ident.t;
ci_id_class_type: Ident.t;
ci_id_object: Ident.t;
ci_id_typesharp: Ident.t;
ci_id_typehash: Ident.t;
ci_expr: 'a;
ci_decl: Types.class_declaration;
ci_type_decl: Types.class_type_declaration;

2
typing/typedtree.mli
View File

@ -615,7 +615,7 @@ and 'a class_infos =
ci_id_class: Ident.t;
ci_id_class_type : Ident.t;
ci_id_object : Ident.t;
ci_id_typesharp : Ident.t;
ci_id_typehash : Ident.t;
ci_expr: 'a;
ci_decl: Types.class_declaration;
ci_type_decl : Types.class_type_declaration;

1
utils/clflags.ml
View File

@ -67,6 +67,7 @@ and use_threads = ref false (* -thread *)
and use_vmthreads = ref false (* -vmthread *)
and noassert = ref false (* -noassert *)
and verbose = ref false (* -verbose *)
and noversion = ref false (* -no-version *)
and noprompt = ref false (* -noprompt *)
and nopromptcont = ref false (* -nopromptcont *)
and init_file = ref (None : string option) (* -init *)

1
utils/clflags.mli
View File

@ -97,6 +97,7 @@ val noprompt : bool ref
val nopromptcont : bool ref
val init_file : string option ref
val noinit : bool ref
val noversion : bool ref
val use_prims : string ref
val use_runtime : string ref
val principal : bool ref