Commit Graph

64 Commits (master)

Author SHA1 Message Date
Jacques Garrigue 302d735ce8
Righteous ambivalence (#9767)
* Fix #9759: Typing without -principal is broken in 4.11 and trunk
* compile stdlib in -principal mode
* never modify generic part of ty_expected_explained
* use generic_instance where possible
* add comment for -no-principal in stdlib__oo.cmi
2020-07-29 09:10:17 +09:00
Pierre Roux 1e3cd41fe7 Add printf `%#F` to output floats in hexadecimal OCaml constants 2019-09-26 15:55:32 +02:00
Gabriel Scherer a9be9a4dba camlinternalFormat: fix the Formatting_gen case in fmt_of_string
Two bugs were present before the patch:

- Formatting_gen would always be printed as "@{",
  so for example "@[foo@]" would be reprinted as "@{foo@]"

- The Formatting_gen payload would be printed as a string literal,
  escaping '%', while it is a raw string representation of a format;
  so for example "@[<%d>" would be reprinted as "@[<%%d>"

  (This second bug was spotted by Florian Angeletti)
2019-06-06 12:50:22 +02:00
Gabriel Scherer bd6ef8413e Camlinternalformat: remove faulty check_open_box function
- Currently the check is a no-op, because the "emit a warning if the
  check fails" was never implemented. (It would actually require some
  work to pass a source location there to emit a warning, so it's not
  trivial.)

- The check is implemented by calling `open_box_of_string` and
  catching the `Failure _` exception if that function fails. This is
  just wrong: `Failure _` should be reserved to fatal program errors,
  and should not be caught for control-flow.

- The current implement is buggy (it fails all the time, but we don't
  notice because no warning is emitted):
  CamlinternalFormat.open_box_of_string expects a string of the form
  "v 3", but check_open_box would pass a string of the form "<v 3>"
  (or an empty string), which is the payload of the format value. So
  the check always fails.

- The idea of the check is wrong: "@[<x>foo@]" is an incorrect format
  string to pass to Format (the box indication does not make sense),
  but it is a perfectly fine format string to pass to Printf, where it
  just prints "@[<x>foo@]" on the output. So we cannot complain to the
  user at type-checking time, when we don't know how the format string
  will be used, whether the boxes will be interpreted as actual boxes
  or string literals.
2019-06-06 12:43:27 +02:00
Pierre Roux ed74b5b237 Enforce precision in printf %F 2019-03-09 12:03:43 +01:00
Fourchaux 1946594bd7 Fixing typos in various files (#2246)
Note: Typos found with https://github.com/codespell-project/codespell

Here is the (semi-manual) command used to get (and correct) the typos:

$ codespell -i 3 -w --skip=".png,.gif,./ocaml/boot,./ocaml/.git,./ocaml/manual/styles,./ocaml/manual/manual/htmlman" -L minimise,instal,contructor,"o'caml",cristal,pres,clos,cmo,uint,iff,te,objext,nto,nd,mut,upto,larg,exten,leage,mthod,delte,tim,atleast,langage,hten,iwth,mke,contant,succint,methids,eles,valu,clas,modul,que,classe,missings,froms,defaut,correspondance,differents,configury,reachs,cas,approche,normale,dur,millon,amin,oje,transfert
2019-02-13 14:04:56 +01:00
Daniel Bünzli a7afd89003 s/string_of_int/Int.to_string/g 2018-11-07 13:52:02 +01:00
Drup 82f5376044 Relax the type of make_iprintf and improve Format.ifprintf. 2018-08-02 23:17:47 +02:00
Drup 12238e40ae Remove the state argument in CamlinternalFormat.make_printf.
This state argument was passed around, but never used, except
by the continuation.
2018-08-02 23:09:20 +02:00
David Allsopp b5d1929e87 Whitespace and overlong line fixes. 2018-06-14 15:15:34 +01:00
ygrek 92748ee986 Printf: speedup %#d and allocate less 2018-05-28 17:52:33 -07:00
ygrek 97fca08b2d Printf: alternative int format %#d 1_234_567 2018-05-28 10:53:37 -07:00
Xavier Clerc 1f3f4a4100 Rename `make_string_padding` to `make_padding, as suggested. 2017-09-13 14:27:34 +01:00
Xavier Clerc 1b7abeddf1 Formats: use the optional width when formatting a boolean. 2017-09-01 13:22:00 +01:00
Alain Frisch 7eba1178ea Remove spurious semicolons after non-unit expressions (#1305) 2017-08-29 15:14:50 +01:00
Fourchaux 72cfdd56e9 Typos and basic grammar error fixing (#1280) 2017-08-10 11:59:23 +01:00
Sébastien Hinderer 50147913ac Call the '#' sign hash rather than sharp. 2016-05-09 16:34:40 +02:00
Damien Doligez 5401ce8473 Update headers for the new license.
Remains to be done: remove all headers in testsuite/tests.
2016-02-18 16:59:16 +01:00
Xavier Leroy 0c5e862a3e GPR#268: Hexadecimal notation for floating-point numbers
Merge of branch 'hex-float'.

- Add support in byterun/floats.c for conversions between floats and strings in hex notation. We cannot rely on the C standard library here because Microsoft consistently fails at supporting hex notation as standardized in C99. Instead, the conversions are implemented from scratch.
- Add support in the lexer so that hex float literals are recognized in OCaml sources.
- Add support in formats. The ISO C99 format letters for hex floats are %a and %A, but %a is already taken. I chose %h and %H, which are rejected today as bad formats (hence no backward incompatibility) and don't mean anything in C either (h is a modifier, not a format letter).
- Add support in printf. All the trimmings are there in the implementation of %h and %H, including sign modifier and fixed precision.
- Benoit Vaugon contributed support in scanf.

Resolved conflicts:
	boot/ocamlc
	boot/ocamldep
	boot/ocamllex
	parsing/lexer.mll
2015-11-19 10:37:20 +01:00
Gabriel Scherer b2e81d7800 Merge pull request #267 from yallop/faster-ifprintf
A more efficient implementation of ifprintf
2015-10-31 16:54:40 +01:00
alainfrisch a127e661b2 Code cleanup: replace let-binding of type unit with sequence. 2015-10-27 11:28:36 +01:00
Jeremy Yallop 1644284d0f Add make_iprintf (make_printf optimised for ifprintf) to CamlinternalFormat. 2015-10-27 00:02:45 +00:00
Damien Doligez b860d63145 whitespace cleanup, cut long lines, add some missing headers
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16415 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2015-09-11 11:58:31 +00:00
Xavier Leroy bb86f5b545 Preliminary support for hexadecimal notation for FP numbers.
- Primitives:
     caml_float_of_string  extended to recognize "0x" hexa notation
     caml_hexstring_of_float  new primitive
  We do not assume hex floats are supported by the C standard library.
  Instead, conversions hex string <-> float are implemented manually.
- Printf: hex FP output supported with formats %h / %H
- Scanf: remains to be updated (see TODO in stdlib/scanf.ml)


git-svn-id: http://caml.inria.fr/svn/ocaml/branches/hex-float@16257 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2015-07-26 09:29:33 +00:00
Gabriel Scherer 907305ce20 PR#6938: fix regression on "%047.27{l,L,n}{d,i,x,X,o,u}"
(Benoît Vaugon, report by Arduino Cascella)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16250 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2015-07-25 20:44:02 +00:00
Leo White 5c55e4cc08 Attach documentation comments to Parsetree
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16189 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2015-06-28 13:11:50 +00:00
Gabriel Scherer 30d6d06189 PR#6452 (part two): make custom_format string-only
(Jérémie Dimino, Benoît Vaugon)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16106 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2015-05-10 06:01:26 +00:00
Gabriel Scherer 3ad7f526a2 PR#6452, GPR#140: add internal support for custom printing formats
(Jérémie Dimino)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15884 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2015-03-08 09:36:10 +00:00
Damien Doligez 4b183eb686 PR#6727: Printf.sprintf "%F" misbehavior
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15746 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-12-24 19:58:14 +00:00
Damien Doligez 031cffd155 merge branch 4.02 from release 4.02.0 to release 4.02.1
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15558 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-10-15 13:34:58 +00:00
Alain Frisch bc3439603a #6577: fix performance of %C format.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15321 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-09-24 09:26:19 +00:00
Alain Frisch f8ca8db7bb #6577: fix performance of %S format.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15320 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-09-24 09:24:36 +00:00
Alain Frisch 45e9ebde3c #6577: fix performance of %L, %l, %n formats.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15319 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-09-24 09:20:05 +00:00
Damien Doligez a18bc7950b merge changes of version/4.02 from r15121 to r15155
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15168 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-08-29 17:14:00 +00:00
Damien Doligez cbfe627f92 merge changes from branch 4.02 from branching (rev 14852) to 4.02.0+rc1 (rev 15121)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15125 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-08-22 13:45:02 +00:00
Gabriel Scherer 49d3f7b9f8 PR#6418: support "@[<hov %d>" in the new format implementation (Benoît Vaugon)
The bootstrap procedure, as for commit trunk@14973 (see there for
detailed build instructions), requires to first commit a temporary
patch:

> diff -Naur old/typing/typecore.ml new/typing/typecore.ml
> --- old/typing/typecore.ml        2014-06-11 18:16:24.851647309 +0200
> +++ new/typing/typecore.ml        2014-06-11 18:15:50.075646418 +0200
> @@ -2758,16 +2758,9 @@
>        let mk_int n = mk_cst (Const_int n)
>        and mk_string str = mk_cst (Const_string (str, None))
>        and mk_char chr = mk_cst (Const_char chr) in
> -      let mk_block_type bty = match bty with
> -        | Pp_hbox   -> mk_constr "Pp_hbox"   []
> -        | Pp_vbox   -> mk_constr "Pp_vbox"   []
> -        | Pp_hvbox  -> mk_constr "Pp_hvbox"  []
> -        | Pp_hovbox -> mk_constr "Pp_hovbox" []
> -        | Pp_box    -> mk_constr "Pp_box"    []
> -        | Pp_fits   -> mk_constr "Pp_fits"   [] in
>        let rec mk_formatting_lit fmting = match fmting with
> -        | Open_box (org, bty, idt) ->
> -          mk_constr "Open_box" [ mk_string org; mk_block_type bty; mk_int idt ]
> +        | Open_box _ ->
> +          assert false
>          | Close_box ->
>            mk_constr "Close_box" []
>          | Close_tag ->
> @@ -2950,6 +2943,19 @@
>            mk_constr "Alpha" [ mk_fmt rest ]
>          | Theta rest ->
>            mk_constr "Theta" [ mk_fmt rest ]
> +        | Formatting_lit (Open_box (org, _bty, _idt), rest) ->
> +          mk_constr "Formatting_gen" [
> +            mk_constr "Open_box" [
> +              mk_constr "Format" [
> +                mk_constr "String_literal" [
> +                  mk_string "<>";
> +                  mk_constr "End_of_format" [];
> +                ];
> +                mk_string "@[<>";
> +              ]
> +            ];
> +            mk_fmt rest;
> +          ]
>          | Formatting_lit (fmting, rest) ->
>            mk_constr "Formatting_lit" [ mk_formatting_lit fmting; mk_fmt rest ]
>          | Formatting_gen (fmting, rest) ->

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14984 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-06-14 21:08:50 +00:00
Gabriel Scherer 7cb9d0d84e PR#6418: fix format regression on "@{<..%d..%s..>" (Benoît Vaugon)
To be able to compile this patch, you should temporarily apply the
following patch to bootstrap the format type change:

> diff -Naur old/typing/typecore.ml new/typing/typecore.ml
> --- old/typing/typecore.ml	2014-06-06 03:37:03.240926150 +0200
> +++ new/typing/typecore.ml	2014-06-06 03:37:24.696926699 +0200
> @@ -2956,7 +2956,7 @@
>          | Theta rest ->
>            mk_constr "Theta" [ mk_fmt rest ]
>          | Formatting (fmting, rest) ->
> -          mk_constr "Formatting" [ mk_formatting fmting; mk_fmt rest ]
> +          mk_constr "Formatting_lit" [ mk_formatting fmting; mk_fmt rest ]
>          | Reader rest ->
>            mk_constr "Reader" [ mk_fmt rest ]
>          | Scan_char_set (width_opt, char_set, rest) ->

Bootstrap process:

  make core
  apply the patch above
  make core
  make promote-cross
  make partialclean
  revert the patch above, apply the commit
  make partialclean
  make core
  make coreboot

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14973 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-06-09 13:53:47 +00:00
Gabriel Scherer d6bfdc7002 fix PR#6431 (patch by Benoît Vaugon)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14954 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-06-04 20:19:53 +00:00
Gabriel Scherer e0b000527b format+gadts: make format types "relational" to fix %(...%) typing
See the long comment in pervasives.ml for an explanation of the
change. The short summary is that we need to prove more elaborate
properties between the format types involved in the typing of %(...%),
and that proving things by writing GADT functions in OCaml reveals
that Coq's Ltac is a miracle of usability.

Proofs on OCaml GADTs are runtime functions that do have a runtime
semantics: it is legitimate to hope that those proof computations are
as simple as possible, but the current implementation was optimized
for feasability, not simplicity. François Bobot has some interesting
suggestions to simplify the reasoning part (with more equality
reasoning where I used transitivity and symmetry of the
relation profusely), which may make the code simpler in the future
(and possibly more efficient: the hope is that only %(...%) users will
pay a proof-related cost).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14897 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-21 13:23:13 +00:00
Gabriel Scherer 6d25df3c9b fix PR#6415: format had forgotten about 'b' boxes
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14874 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-15 07:37:15 +00:00
Gabriel Scherer a9aea4306c replay trunk@13911: better behavior of printf on nan/infinity floats
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14871 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-14 16:01:10 +00:00
Gabriel Scherer 3ffa399b37 Use a nominal datatype for CamlinternalFormat.format6
This should make the type-checking of formats simpler and more robust:
instead of trying to find a pair as previously, we can now use the
path of the format6 type directly.

A nice side-effect of the change is that the internal definition of
formats (as a pair) is not printed in error messages anymore.
Because format6 is in fact defined in the CamlinternalFormatBasics
submodule of Pervasives, and has an alias at the toplevel of
Pervasives, error messages still expand the definition:

> Error: This expression has type
>          ('a, 'b, 'c, 'd, 'd, 'a) format6 =
>            ('a, 'b, 'c, 'd, 'd, 'a) CamlinternalFormatBasics.format6
>        but an expression was expected of type ...

Passing the option `-short-paths` does avoid this expansion and
returns exactly the same error message as 4.01:

> Error: This expression has type ('a, 'b, 'c, 'd, 'd, 'a) format6
>        but an expression was expected of type ...

(To get this error message without -short-paths, one would need to
define format6 directly in Pervasives; but this type is mutually
recursive with several GADT types that we don't want to add in the
Pervasives namespace unqualified. This is why I'll keep the alias
for now.)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14868 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-14 15:07:13 +00:00
Gabriel Scherer eccf1e2975 formats: enable the legacy mode by default
Given that there still remains a small incompatibility (typing of
%(..%)), I decided to keep the legacy mode enabled for now. This means
that any failure related to format can be traced to this
incompatiblity (or unknown regressions), which will simplify the
monitoring and handling of changes considerably. As soon as the %(..%)
typing is generalized, we can turn the legacy mode off (or maybe
simply add warnings for ignored formats).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14841 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:35 +00:00
Gabriel Scherer f0e39fee7d For %{..%}, restore Pierre's semantics
(printf {%foo%} bar) will print the string representation of the
format type of both `foo` and `bar`, instead of printing `bar`
(for this purpose one can just use %s). `bar` content is ignored, but
the typer should check that its type is compatible with the one of
`foo`.

This semantics allows to use (printf %{..%}) for testing/debugging the
use of %(...%): put in the brackets what you believe to be the format
type you want to use, and as argument the format you wish to pass, and
you'll get type-checking confidence and the "canonical" representation
of the format string which you can use in the %(...%) -- note that
using the canonical format type is not mandatory.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14840 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:33 +00:00
Gabriel Scherer 8e52400ebe move code from pervasives.ml to camlinternalFormat.ml
This simplifies the charset-handling code, as camlinternalFormat is
allowed to depend on Bytes and String instead of re-importing the
needed primitives.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14837 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:27 +00:00
Gabriel Scherer f3a309d5ef simplification in bprint_char_set
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14836 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:25 +00:00
Gabriel Scherer 543e542a27 charset-parsing: require that '%' be written '%%' in charsets, as per the documentation
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14835 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:23 +00:00
Gabriel Scherer 2da1602532 printf behavior of %{..%}
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14833 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:19 +00:00
Gabriel Scherer 0a7224fd23 some characters were not allowed in charsets
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14831 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:15 +00:00
Gabriel Scherer 11fdab809d accept and ignore '+' and '-' before precision integers
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14830 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2014-05-12 15:38:14 +00:00