Skip to content

Commit

Permalink
Merge branch 'master' into master
Browse files Browse the repository at this point in the history
  • Loading branch information
costcould authored Oct 13, 2024
2 parents c107b12 + 6455bb6 commit b385975
Show file tree
Hide file tree
Showing 78 changed files with 13,315 additions and 11,665 deletions.
27 changes: 27 additions & 0 deletions .ocamlformat
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
break-infix = fit-or-vertical
break-infix-before-func = false
break-fun-decl = fit-or-vertical
break-separators = before
break-sequences = true
cases-exp-indent = 2
dock-collection-brackets = false
field-space = loose
if-then-else = keyword-first
indicate-multiline-delimiters = no
infix-precedence = parens
leading-nested-match-parens = true
let-and = sparse
let-module = sparse
ocp-indent-compat = true
parens-tuple = multi-line-only
parse-docstrings = true
sequence-blank-line = preserve-one
sequence-style = terminator
single-case = sparse
space-around-arrays= true
space-around-lists= true
space-around-records= true
space-around-variants= true
type-decl = sparse
wrap-comments = true
wrap-fun-args = false
6 changes: 6 additions & 0 deletions .ocamlformat-ignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
src/vendored-omp/**
src/reason-parser/vendor/**
test/**.cppo.ml
src/**.cppo.ml
src/**.cppo.mli
rtop/**.cppo.ml
12 changes: 12 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,18 @@
[#2780](https://github.com/reasonml/reason/pull/2780))
- Improve printing of arrows with labelled arguments (@anmonteiro,
[#2778](https://github.com/reasonml/reason/pull/2778))
- Parse and print extensions in `open%foo` expressions and structure items
(@anmonteiro, [#2784](https://github.com/reasonml/reason/pull/2784))
- Add support for module type substitutions
(@anmonteiro, [#2785](https://github.com/reasonml/reason/pull/2785))
- Support `type%foo` extension sugar syntax (@anmonteiro,
[#2790](https://github.com/reasonml/reason/pull/2790))
- Support quoted extensions (@anmonteiro,
[#2794](https://github.com/reasonml/reason/pull/2794))
- Parse universal type variables in signature items (@anmonteiro,
[#2797](https://github.com/reasonml/reason/pull/2797))
- Fix formatting of callbacks with sequence expressions (@anmonteiro,
[#2799](https://github.com/reasonml/reason/pull/2799))

## 3.12.0

Expand Down
4 changes: 2 additions & 2 deletions nix/shell.nix
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@

mkShell {
inputsFrom = [ reason ];
nativeBuildInputs = with ocamlPackages; [ utop merlin odoc ocamlformat ];
buildInputs =
with ocamlPackages; [ utop merlin odoc ]
++ (if release-mode then [ cacert curl dune-release git ] else [ ]);
with ocamlPackages; (if release-mode then [ cacert curl dune-release git ] else [ ]);
}
38 changes: 24 additions & 14 deletions rtop/reason_toploop.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -5,27 +5,37 @@
* LICENSE file in the root directory of this source tree.
*)

(* this file's triggered by utop/rtop *)
let main () =
if List.exists ((=) "camlp4o") !Topfind.predicates ||
List.exists ((=) "camlp4r") !Topfind.predicates then
print_endline "Reason is incompatible with camlp4!"
else begin
Toploop.parse_toplevel_phrase := Reason_util.correctly_catch_parse_errors
(fun x ->
let r = Reason_toolchain.To_current.copy_toplevel_phrase
(Reason_toolchain.RE.toplevel_phrase x)
in
let default_parse_toplevel_phrase = !Toploop.parse_toplevel_phrase
let reason_parse_toplevel_phrase =
Reason_util.correctly_catch_parse_errors
(fun x ->
let r =
Reason_toolchain.To_current.copy_toplevel_phrase
(Reason_toolchain.RE.toplevel_phrase x)
in
#if OCAML_VERSION >= (5,2,0)
(* NOTE(anmonteiro): after https://github.com/ocaml/ocaml/pull/12029, we get a
(* NOTE(anmonteiro): after https://github.com/ocaml/ocaml/pull/12029, we get a
Fatal error: exception Invalid_argument("index out of bounds")
Raised by primitive operation at Toploop.ends_with_lf in file "toplevel/toploop.ml"
Setting `lex_eof_reached` seems to avoid whatever check upstream is doing. *)
x.lex_eof_reached <- true;
x.lex_eof_reached <- true;
#endif
r);
r)


(* this file's triggered by utop/rtop *)
let main () =
if List.exists ((=) "camlp4o") !Topfind.predicates ||
List.exists ((=) "camlp4r") !Topfind.predicates then
print_endline "Reason is incompatible with camlp4!"
else begin
Toploop.parse_toplevel_phrase := (fun t ->
if !Reason_utop.current_top = UTop then
default_parse_toplevel_phrase t
else
reason_parse_toplevel_phrase t);
Toploop.parse_use_file := Reason_util.correctly_catch_parse_errors
(fun x -> List.map Reason_toolchain.To_current.copy_toplevel_phrase
(Reason_toolchain.RE.use_file x));
Expand Down
25 changes: 11 additions & 14 deletions rtop/reason_util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -17,25 +17,22 @@ let extract_exn src name =
try
ignore (!Toploop.parse_toplevel_phrase (Lexing.from_string src));
assert false
with exn ->
with
| exn ->
assert (Printexc.exn_slot_name exn = name);
exn

let exn_Lexer_Error = extract_exn "\128" "Lexer.Error"
let exn_Syntaxerr_Error = extract_exn "fun" "Syntaxerr.Error"

let correctly_catch_parse_errors fn lexbuf =
(*let kind = if !Toploop.input_name = "//toplevel//" then `Toplevel else `Batch in*)
(*let kind = if !Toploop.input_name = "//toplevel//" then `Toplevel else
`Batch in*)
fn lexbuf
(*with exn when kind = `Toplevel ->
(* In expunged toplevel, we have a split-brain situation where toplevel
and m17n have different internal IDs for the "same" exceptions.
Fixup. *)
raise
(match exn with
(* FIXME... Maybe? *)
(*| Reason_lexer.Error _ -> transmogrify_exn exn exn_Lexer_Error*)
| Syntaxerr.Error _ -> transmogrify_exn exn exn_Syntaxerr_Error
| Reason_syntax_util.Error (loc, _) -> transmogrify_exn (Syntaxerr.Error(Syntaxerr.Other loc)) exn_Syntaxerr_Error
| _ -> exn)
*)
(*with exn when kind = `Toplevel -> (* In expunged toplevel, we have a
split-brain situation where toplevel and m17n have different internal IDs for
the "same" exceptions. Fixup. *) raise (match exn with (* FIXME... Maybe? *)
(*| Reason_lexer.Error _ -> transmogrify_exn exn exn_Lexer_Error*) |
Syntaxerr.Error _ -> transmogrify_exn exn exn_Syntaxerr_Error |
Reason_syntax_util.Error (loc, _) -> transmogrify_exn
(Syntaxerr.Error(Syntaxerr.Other loc)) exn_Syntaxerr_Error | _ -> exn) *)
96 changes: 55 additions & 41 deletions rtop/reason_utop.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,4 @@
(**
* Some of this was coppied from @whitequark's m17n project.
*)
(** * Some of this was coppied from \@whitequark's m17n project. *)
(*
* Portions Copyright (c) 2015-present, Facebook, Inc.
*
Expand All @@ -17,40 +15,48 @@ module ToploopBackup = struct
let print_out_sig_item = !Toploop.print_out_sig_item
let print_out_signature = !Toploop.print_out_signature
let print_out_phrase = !Toploop.print_out_phrase
let[@ocaml.warning "-3"] current_show = Hashtbl.find Toploop.directive_table "show"

let[@ocaml.warning "-3"] current_show =
Hashtbl.find Toploop.directive_table "show"
end

let rec lident_operator_map mapper li =
let open Longident in
match li with
| Lident s -> Lident (mapper s)
| Ldot (x, s) -> Ldot (x, mapper s)
| Lapply (x, y) -> Lapply (lident_operator_map mapper x, lident_operator_map mapper y)
| Lapply (x, y) ->
Lapply (lident_operator_map mapper x, lident_operator_map mapper y)

type top_kind =
| RTop
| UTop

type top_kind = RTop | UTop
let current_top = ref RTop

let init_reason () =
if List.exists ((=) "camlp4o") !Topfind.predicates ||
List.exists ((=) "camlp4r") !Topfind.predicates then
print_endline "Reason is incompatible with camlp4!"
else begin
if List.exists (( = ) "camlp4o") !Topfind.predicates
|| List.exists (( = ) "camlp4r") !Topfind.predicates
then print_endline "Reason is incompatible with camlp4!"
else
let use_file x =
List.map Reason_toolchain.To_current.copy_toplevel_phrase
List.map
Reason_toolchain.To_current.copy_toplevel_phrase
(Reason_toolchain.RE.use_file x)
in
current_top := RTop;
UTop.set_phrase_terminator ";";
UTop.prompt := fst (React.S.create LTerm_text.
(eval [B_fg (LTerm_style.green); S "Reason # "]));
UTop.parse_toplevel_phrase := UTop.parse_default (
Reason_util.correctly_catch_parse_errors
(fun x -> Reason_toolchain.To_current.copy_toplevel_phrase
(Reason_toolchain.RE.toplevel_phrase x))
);
UTop.parse_use_file := UTop.parse_default (
Reason_util.correctly_catch_parse_errors use_file
);
UTop.prompt :=
fst
(React.S.create
LTerm_text.(eval [ B_fg LTerm_style.green; S "Reason # " ]));
UTop.parse_toplevel_phrase :=
UTop.parse_default
(Reason_util.correctly_catch_parse_errors (fun x ->
Reason_toolchain.To_current.copy_toplevel_phrase
(Reason_toolchain.RE.toplevel_phrase x)));
UTop.parse_use_file :=
UTop.parse_default (Reason_util.correctly_catch_parse_errors use_file);
UTop.history_file_name :=
Some (Filename.concat LTerm_resources.home ".rtop-history");

Expand All @@ -59,10 +65,8 @@ let init_reason () =
(* Printing in Reason syntax *)
let open Reason_toolchain.From_current in
let wrap f g fmt x = g fmt (f x) in
Toploop.print_out_value :=
wrap copy_out_value Reason_oprint.print_out_value;
Toploop.print_out_type :=
wrap copy_out_type Reason_oprint.print_out_type;
Toploop.print_out_value := wrap copy_out_value Reason_oprint.print_out_value;
Toploop.print_out_type := wrap copy_out_type Reason_oprint.print_out_type;
Toploop.print_out_class_type :=
wrap copy_out_class_type Reason_oprint.print_out_class_type;
Toploop.print_out_module_type :=
Expand All @@ -75,25 +79,32 @@ let init_reason () =
wrap (List.map copy_out_sig_item) Reason_oprint.print_out_signature;
Toploop.print_out_phrase :=
wrap copy_out_phrase Reason_oprint.print_out_phrase;
let current_show_fn = match ToploopBackup.current_show with
| Toploop.Directive_ident fn -> fn
| _ -> assert false
let current_show_fn =
match ToploopBackup.current_show with
| Toploop.Directive_ident fn -> fn
| _ -> assert false
in
Hashtbl.replace (Toploop.directive_table [@ocaml.warning "-3"]) "show"
(Toploop.Directive_ident (fun li ->
let li' = lident_operator_map Reason_syntax_util.reason_to_ml_swap li in
current_show_fn li'));
end
Hashtbl.replace
(Toploop.directive_table [@ocaml.warning "-3"])
"show"
(Toploop.Directive_ident
(fun li ->
let li' =
lident_operator_map Reason_syntax_util.reason_to_ml_swap li
in
current_show_fn li'))

let init_ocaml () =
current_top := UTop;
UTop.set_phrase_terminator ";;";
UTop.prompt := fst (React.S.create LTerm_text.
(eval[B_fg (LTerm_style.green); S "OCaml # "]));
UTop.prompt :=
fst
(React.S.create
LTerm_text.(eval [ B_fg LTerm_style.green; S "OCaml # " ]));
UTop.parse_toplevel_phrase := UTop.parse_toplevel_phrase_default;
UTop.parse_use_file := UTop.parse_use_file_default;
UTop.history_file_name :=
Some (Filename.concat LTerm_resources.home ".utop-history");
Some (Filename.concat LTerm_resources.home ".utop-history");

Toploop.print_out_value := ToploopBackup.print_out_value;
Toploop.print_out_type := ToploopBackup.print_out_type;
Expand All @@ -103,14 +114,17 @@ let init_ocaml () =
Toploop.print_out_sig_item := ToploopBackup.print_out_sig_item;
Toploop.print_out_signature := ToploopBackup.print_out_signature;
Toploop.print_out_phrase := ToploopBackup.print_out_phrase;
Hashtbl.replace (Toploop.directive_table [@ocaml.warning "-3"]) "show" ToploopBackup.current_show
Hashtbl.replace
(Toploop.directive_table [@ocaml.warning "-3"])
"show"
ToploopBackup.current_show

let toggle_syntax () =
match !current_top with
| RTop -> init_ocaml ()
| UTop -> init_reason ()
match !current_top with RTop -> init_ocaml () | UTop -> init_reason ()

let _ =
Hashtbl.add (Toploop.directive_table [@ocaml.warning "-3"]) "toggle_syntax"
Hashtbl.add
(Toploop.directive_table [@ocaml.warning "-3"])
"toggle_syntax"
(Toploop.Directive_none toggle_syntax);
init_reason ()
39 changes: 19 additions & 20 deletions rtop/rtop.ml
Original file line number Diff line number Diff line change
@@ -1,25 +1,24 @@
let () = UTop.require ["reason.ocaml-migrate-parsetree"; "menhirLib";]
let () = UTop.require [ "reason.ocaml-migrate-parsetree"; "menhirLib" ]

let () = try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") with | Not_found -> ();;

let () = UTop.require ["reason.easy_format"; "reason";]
let () =
try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") with
| Not_found -> ()

let () = UTop.require [ "reason.easy_format"; "reason" ]
let () = Reason_toploop.main ()

let () = Reason_utop.init_reason ()

let () = print_string
"
___ _______ ________ _ __
/ _ \\/ __/ _ | / __/ __ \\/ |/ /
/ , _/ _// __ |_\\ \\/ /_/ / /
/_/|_/___/_/ |_/___/\\____/_/|_/
Execute statements/let bindings. Hit <enter> after the semicolon. Ctrl-d to quit.
> let myVar = \"Hello Reason!\";
> let myList: list(string) = [\"first\", \"second\"];
> #use \"./src/myFile.re\"; /* loads the file into here */
"

let () = UTop_main.main ()
let () =
print_string
"\n\
\ ___ _______ ________ _ __\n\
\ / _ \\/ __/ _ | / __/ __ \\/ |/ /\n\
\ / , _/ _// __ |_\\ \\/ /_/ / /\n\
\ /_/|_/___/_/ |_/___/\\____/_/|_/\n\n\
\ Execute statements/let bindings. Hit <enter> after the semicolon. \
Ctrl-d to quit.\n\n\
\ > let myVar = \"Hello Reason!\";\n\
\ > let myList: list(string) = [\"first\", \"second\"];\n\
\ > #use \"./src/myFile.re\"; /* loads the file into here */\n"

let () = UTop_main.main ()
Loading

0 comments on commit b385975

Please sign in to comment.