From 591ce4d341682304a6825f7e2b07291fdc683247 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Thu, 5 Sep 2019 17:49:35 +0100 Subject: [PATCH] Move jbuild support into a separate library (#2607) Signed-off-by: Jeremie Dimino --- CHANGES.md | 2 + bin/upgrade.ml | 4 +- src/dune/action_dune_lang.ml | 9 - src/dune/action_dune_lang.mli | 2 - src/dune/dune | 2 +- src/dune/dune_file.ml | 9 +- src/dune/dune_init.ml | 3 +- src/dune/dune_load.ml | 116 ++++------ src/dune/dune_load.mli | 1 - src/dune/dune_project.ml | 147 +++++-------- src/dune/dune_project.mli | 19 +- src/dune/file_tree.ml | 129 +++++------ src/dune/file_tree.mli | 22 +- src/dune/inline_tests.ml | 16 +- src/dune/ordered_set_lang.ml | 52 +---- src/dune/ordered_set_lang.mli | 2 - src/dune/predicate_lang.ml | 38 ++-- src/dune/preprocessing.ml | 12 +- src/dune/stanza.ml | 16 +- src/dune/stanza.mli | 11 - src/dune/string_with_vars.ml | 200 +----------------- src/dune/string_with_vars.mli | 13 +- src/dune/super_context.ml | 3 +- src/dune/upgrader.ml | 49 ++--- src/dune_lang/atom.ml | 45 +--- src/dune_lang/atom.mli | 4 +- src/dune_lang/dune | 2 +- src/dune_lang/dune_lang.ml | 5 +- src/dune_lang/dune_lang.mli | 8 +- src/dune_lang/dune_lexer.mli | 1 - src/dune_lang/file_syntax.ml | 20 -- src/dune_lang/file_syntax.mli | 13 -- src/dune_lang/jbuild_lexer.mli | 1 - src/dune_lang/lexer.ml | 11 - src/dune_lang/lexer.mli | 26 ++- src/dune_lang/{dune_lexer.mll => lexer.mll} | 63 +++++- src/dune_lang/lexer_shared.ml | 63 ------ src/dune_lang/lexer_shared.mli | 39 ---- src/dune_lang/template.ml | 2 +- src/jbuild_support/atom.ml | 32 +++ src/jbuild_support/atom.mli | 1 + src/jbuild_support/dune | 7 + src/jbuild_support/lexer.mli | 1 + .../lexer.mll} | 45 +++- src/jbuild_support/string_with_vars.ml | 172 +++++++++++++++ src/jbuild_support/string_with_vars.mli | 11 + .../test-cases/embed-jbuild/run.t | 24 +-- .../test-cases/syntax-versioning/run.t | 8 +- test/blackbox-tests/test-cases/upgrader/run.t | 16 +- test/expect-tests/dune_lang/dune | 1 + test/expect-tests/dune_lang/sexp_tests.ml | 19 +- test/unit-tests/dune | 2 +- test/unit-tests/sexp_tests.ml | 17 +- 53 files changed, 642 insertions(+), 894 deletions(-) delete mode 100644 src/dune_lang/dune_lexer.mli delete mode 100644 src/dune_lang/file_syntax.ml delete mode 100644 src/dune_lang/file_syntax.mli delete mode 100644 src/dune_lang/jbuild_lexer.mli delete mode 100644 src/dune_lang/lexer.ml rename src/dune_lang/{dune_lexer.mll => lexer.mll} (84%) delete mode 100644 src/dune_lang/lexer_shared.ml delete mode 100644 src/dune_lang/lexer_shared.mli create mode 100644 src/jbuild_support/atom.ml create mode 100644 src/jbuild_support/atom.mli create mode 100644 src/jbuild_support/dune create mode 100644 src/jbuild_support/lexer.mli rename src/{dune_lang/jbuild_lexer.mll => jbuild_support/lexer.mll} (80%) create mode 100644 src/jbuild_support/string_with_vars.ml create mode 100644 src/jbuild_support/string_with_vars.mli diff --git a/CHANGES.md b/CHANGES.md index 01db603e6cc..1f75c8a4c58 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -121,6 +121,8 @@ files. This is useful for installing only the binaries in a workspace for example. (#2609, fixes #2554, @rgrinberg) +- Drop support for `jbuild` and `jbuild-ignore` files (#2607, @diml) + 1.11.3 (23/08/2019) ------------------- diff --git a/bin/upgrade.ml b/bin/upgrade.ml index 45231e1d9c1..e792aabb253 100644 --- a/bin/upgrade.ml +++ b/bin/upgrade.ml @@ -18,8 +18,8 @@ let term = Common.set_common common ~targets:[]; Scheduler.go ~common (fun () -> Dune.Upgrader.upgrade - (Dune.File_tree.load Path.Source.root - ~warn_when_seeing_jbuild_file:false ~ancestor_vcs:None) + (Dune.File_tree.load Path.Source.root ~recognize_jbuilder_projects:true + ~ancestor_vcs:None) |> Fiber.return) let command = (term, info) diff --git a/src/dune/action_dune_lang.ml b/src/dune/action_dune_lang.ml index db1c11cd96d..f98e7691f02 100644 --- a/src/dune/action_dune_lang.ml +++ b/src/dune/action_dune_lang.ml @@ -29,15 +29,6 @@ include Action_ast.Make (String_with_vars) (String_with_vars) (Uast) module Mapper = Action_mapper.Make (Uast) (Uast) -let upgrade_to_dune = - let id ~dir:_ p = p in - let dir = String_with_vars.make_text Loc.none "" in - Mapper.map ~dir ~f_program:id ~f_path:id ~f_target:id - ~f_string:(fun ~dir:_ sw -> - String_with_vars.upgrade_to_dune sw ~allow_first_dep_var:false) - -let encode_and_upgrade a = encode (upgrade_to_dune a) - let remove_locs = let dir = String_with_vars.make_text Loc.none "" in let f_program ~dir:_ = String_with_vars.remove_locs in diff --git a/src/dune/action_dune_lang.mli b/src/dune/action_dune_lang.mli index 55430f1e22f..4ae005a57e1 100644 --- a/src/dune/action_dune_lang.mli +++ b/src/dune/action_dune_lang.mli @@ -11,8 +11,6 @@ include include Dune_lang.Conv with type t := t -val encode_and_upgrade : t Dune_lang.Encoder.t - include Action_intf.Helpers with type t := t diff --git a/src/dune/dune b/src/dune/dune index 7120f2ea1a4..900a62537a9 100644 --- a/src/dune/dune +++ b/src/dune/dune @@ -4,7 +4,7 @@ (name dune) (libraries unix stdune fiber incremental_cycles dag memo xdg dune_re threads.posix opam_file_format dune_lang dune_manager dune_memory - ocaml_config catapult) + ocaml_config catapult jbuild_support) (synopsis "Internal Dune library, do not use!") (preprocess future_syntax)) diff --git a/src/dune/dune_file.ml b/src/dune/dune_file.ml index 75c6b2dc064..a02b5059535 100644 --- a/src/dune/dune_file.ml +++ b/src/dune/dune_file.ml @@ -1347,7 +1347,6 @@ module Executables = struct ; project : Dune_project.t ; loc : Loc.t ; multi : bool - ; file_kind : Dune_lang.File_syntax.t } let names t = t.names @@ -1403,7 +1402,6 @@ module Executables = struct single_fields and+ loc = loc and+ dune_syntax = Syntax.get_exn Stanza.syntax - and+ file_kind = Stanza.file_kind () and+ package = field_o "package" (let+ loc = loc @@ -1456,13 +1454,12 @@ module Executables = struct Pkg.default_exn ~loc project (pluralize "executable" ~multi) } | Some (loc, _), None -> - User_warning.emit ~is_error:(file_kind = Dune) ~loc + User_error.raise ~loc [ Pp.textf "This field is useless without a (%s ...) field." (pluralize "public_name" ~multi) - ]; - None + ] in - { names; public; project; stanza; loc; multi; file_kind } + { names; public; project; stanza; loc; multi } let install_conf t ~ext = Option.map t.public ~f:(fun { package; public_names } -> diff --git a/src/dune/dune_init.ml b/src/dune/dune_init.ml index 9ebd24f136e..300a89f2d62 100644 --- a/src/dune/dune_init.ml +++ b/src/dune/dune_init.ml @@ -176,9 +176,10 @@ module Init_context = struct let project = match Dune_project.load ~dir:Path.Source.root ~files:String.Set.empty + ~infer_from_opam_files:true with | Some p -> p - | None -> Lazy.force Dune_project.anonymous + | None -> Dune_project.anonymous ~dir:Path.Source.root in let dir = match path with diff --git a/src/dune/dune_load.ml b/src/dune/dune_load.ml index 17d38a7355e..74a97636299 100644 --- a/src/dune/dune_load.ml +++ b/src/dune/dune_load.ml @@ -7,10 +7,9 @@ module Dune_file = struct { dir : Path.Source.t ; project : Dune_project.t ; stanzas : Stanzas.t - ; kind : Dune_lang.File_syntax.t } - let parse sexps ~dir ~file ~project ~kind = + let parse sexps ~dir ~file ~project = let stanzas = Stanzas.parse ~file project sexps in let stanzas = if !Clflags.ignore_promoted_rules then @@ -22,7 +21,7 @@ module Dune_file = struct else stanzas in - { dir; project; stanzas; kind } + { dir; project; stanzas } let rec fold_stanzas l ~init ~f = match l with @@ -40,7 +39,6 @@ module Dune_files = struct { dir : Path.Source.t ; file : Path.Source.t ; project : Dune_project.t - ; kind : Dune_lang.File_syntax.t } type one = @@ -54,56 +52,32 @@ module Dune_files = struct let ensure_parent_dir_exists path = Path.build path |> Path.parent |> Option.iter ~f:Path.mkdir_p - type requires = - | No_requires - | Unix - - let extract_requires path str ~kind = - let rec loop n lines acc = - match lines with - | [] -> acc - | line :: lines -> - let acc = - match Scanf.sscanf line "#require %S" (fun x -> x) with - | exception _ -> acc - | s -> ( - let loc : Loc.t = - let start : Lexing.position = - { pos_fname = Path.to_string path - ; pos_lnum = n - ; pos_cnum = 0 - ; pos_bol = 0 - } - in - { start; stop = { start with pos_cnum = String.length line } } + let check_no_requires path str = + List.iteri (String.split str ~on:'\n') ~f:(fun n line -> + match Scanf.sscanf line "#require %S" (fun x -> x) with + | exception _ -> () + | (_ : string) -> + let loc : Loc.t = + let start : Lexing.position = + { pos_fname = Path.to_string path + ; pos_lnum = n + ; pos_cnum = 0 + ; pos_bol = 0 + } in - ( match (kind : Dune_lang.File_syntax.t) with - | Jbuild -> () - | Dune -> - User_error.raise ~loc - [ Pp.text "#require is no longer supported in dune files." - ; Pp.text - "You can use the following function instead of \ - Unix.open_process_in:\n\n\ - \ (** Execute a command and read it's output *)\n\ - \ val run_and_read_lines : string -> string list" - ] ); - match String.split s ~on:',' with - | [] -> acc - | [ "unix" ] -> Unix - | _ -> - User_error.raise ~loc - [ Pp.text - "Using libraries other that \"unix\" is not supported." - ; Pp.text "See the manual for details." - ] ) - in - loop (n + 1) lines acc - in - loop 1 (String.split str ~on:'\n') No_requires + { start; stop = { start with pos_cnum = String.length line } } + in + User_error.raise ~loc + [ Pp.text "#require is no longer supported in dune files." + ; Pp.text + "You can use the following function instead of \ + Unix.open_process_in:\n\n\ + \ (** Execute a command and read it's output *)\n\ + \ val run_and_read_lines : string -> string list" + ]) let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper - ~target ~kind = + ~target = let plugin_contents = Io.read_file plugin in Io.with_file_out (Path.build wrapper) ~f:(fun oc -> let ocamlc_config = @@ -168,7 +142,7 @@ end context.name context.version_string ocamlc_config (Path.reach ~from:exec_dir (Path.build target)) (Path.to_string plugin) plugin_contents); - extract_requires plugin plugin_contents ~kind + check_no_requires plugin plugin_contents let eval dune_files ~(context : Context.t) = let open Fiber.O in @@ -177,7 +151,7 @@ end | Literal x -> Left x | Script x -> Right x) in - Fiber.parallel_map dynamic ~f:(fun { dir; file; project; kind } -> + Fiber.parallel_map dynamic ~f:(fun { dir; file; project } -> let generated_dune_file = Path.Build.append_source (Path.Build.relative generated_dune_files_dir context.name) @@ -187,27 +161,15 @@ end Path.Build.extend_basename generated_dune_file ~suffix:".ml" in ensure_parent_dir_exists generated_dune_file; - let requires = - create_plugin_wrapper context ~exec_dir:(Path.source dir) - ~plugin:(Path.source file) ~wrapper ~target:generated_dune_file - ~kind - in + create_plugin_wrapper context ~exec_dir:(Path.source dir) + ~plugin:(Path.source file) ~wrapper ~target:generated_dune_file; let context = Option.value context.for_host ~default:context in - let cmas = - match requires with - | No_requires -> [] - | Unix -> [ "unix.cma" ] - in let args = List.concat [ [ "-I"; "+compiler-libs" ] - ; cmas ; [ Path.to_absolute_filename (Path.build wrapper) ] ] in - (* CR-someday jdimino: if we want to allow plugins to use findlib: {[ - let args = match context.toplevel_path with | None -> args | Some - path -> "-I" :: Path.reach ~from:dir path :: args in ]} *) let* () = Process.run Strict ~dir:(Path.source dir) ~env:context.env context.ocaml args @@ -219,11 +181,8 @@ end ; Pp.textf "Did you forgot to call [Jbuild_plugin.V*.send]?" ]; Fiber.return - ( Dune_lang.Io.load - (Path.build generated_dune_file) - ~mode:Many - ~lexer:(Dune_lang.Lexer.of_syntax kind) - |> Dune_file.parse ~dir ~file ~project ~kind )) + ( Dune_lang.Io.load (Path.build generated_dune_file) ~mode:Many + |> Dune_file.parse ~dir ~file ~project )) >>| fun dynamic -> static @ dynamic end @@ -235,19 +194,20 @@ type conf = } let interpret ~dir ~project ~(dune_file : File_tree.Dune_file.t) = - match dune_file.contents with + match dune_file with | Plain p -> let dune_file = - Dune_files.Literal - (Dune_file.parse p.sexps ~dir ~file:p.path ~project - ~kind:dune_file.kind) + Dune_files.Literal (Dune_file.parse p.sexps ~dir ~file:p.path ~project) in p.sexps <- []; dune_file - | Ocaml_script file -> Script { dir; project; file; kind = dune_file.kind } + | Ocaml_script file -> Script { dir; project; file } let load ~ancestor_vcs () = - let ftree = File_tree.load Path.Source.root ~ancestor_vcs in + let ftree = + File_tree.load Path.Source.root ~ancestor_vcs + ~recognize_jbuilder_projects:false + in let projects = File_tree.fold ftree ~traverse:{ data_only = false; vendored = true; normal = true } ~init:[] diff --git a/src/dune/dune_load.mli b/src/dune/dune_load.mli index 6d27ff59112..6013ff73ab8 100644 --- a/src/dune/dune_load.mli +++ b/src/dune/dune_load.mli @@ -5,7 +5,6 @@ module Dune_file : sig { dir : Path.Source.t ; project : Dune_project.t ; stanzas : Dune_file.Stanzas.t - ; kind : Dune_lang.File_syntax.t } val fold_stanzas : diff --git a/src/dune/dune_project.ml b/src/dune/dune_project.ml index 997d56085c1..bac9e4f0476 100644 --- a/src/dune/dune_project.ml +++ b/src/dune/dune_project.ml @@ -31,8 +31,6 @@ module Name : sig val named : string -> t option - val anonymous_root : t - module Infix : Comparator.OPS with type t = t module Map : Map.S with type key = t @@ -578,51 +576,6 @@ let format_config t = let dune_lang = t.format_config in Format_config.of_config ~ext ~dune_lang -let anonymous = - lazy - (let lang = get_dune_lang () in - let name = Name.anonymous_root in - let project_file = - { Project_file.file = Path.Source.relative Path.Source.root filename - ; exists = false - ; project_name = name - } - in - let parsing_context, stanza_parser, extension_args = - interpret_lang_and_extensions ~lang ~explicit_extensions:[] - ~project_file - in - let implicit_transitive_deps = implicit_transitive_deps_default ~lang in - let wrapped_executables = wrapped_executables_default ~lang in - let explicit_js_mode = explicit_js_mode_default ~lang in - let root = Path.Source.root in - let file_key = File_key.make ~root ~name in - { name - ; packages = Package.Name.Map.empty - ; root - ; source = None - ; license = None - ; homepage = None - ; bug_reports = None - ; documentation = None - ; maintainers = [] - ; authors = [] - ; version = None - ; implicit_transitive_deps - ; wrapped_executables - ; stanza_parser - ; project_file - ; extension_args - ; parsing_context - ; dune_version = lang.version - ; allow_approx_merlin = true - ; generate_opam_files = false - ; file_key - ; dialects = Dialect.DB.builtin - ; explicit_js_mode - ; format_config = None - }) - let default_name ~dir ~packages = match Package.Name.Map.choose packages with | None -> Name.anonymous dir @@ -642,6 +595,51 @@ let default_name ~dir ~packages = User_error.raise ~loc:pkg.loc [ Pp.textf "%S is not a valid opam package name." name ] ) +let infer ~dir packages = + let lang = get_dune_lang () in + let name = default_name ~dir ~packages in + let project_file = + { Project_file.file = Path.Source.relative dir filename + ; exists = false + ; project_name = name + } + in + let parsing_context, stanza_parser, extension_args = + interpret_lang_and_extensions ~lang ~explicit_extensions:[] ~project_file + in + let implicit_transitive_deps = implicit_transitive_deps_default ~lang in + let wrapped_executables = wrapped_executables_default ~lang in + let explicit_js_mode = explicit_js_mode_default ~lang in + let root = dir in + let file_key = File_key.make ~root ~name in + { name + ; packages + ; root + ; source = None + ; license = None + ; homepage = None + ; bug_reports = None + ; documentation = None + ; maintainers = [] + ; authors = [] + ; version = None + ; implicit_transitive_deps + ; wrapped_executables + ; stanza_parser + ; project_file + ; extension_args + ; parsing_context + ; dune_version = lang.version + ; allow_approx_merlin = true + ; generate_opam_files = false + ; file_key + ; dialects = Dialect.DB.builtin + ; explicit_js_mode + ; format_config = None + } + +let anonymous ~dir = infer ~dir Package.Name.Map.empty + let parse ~dir ~lang ~opam_packages ~file = fields (let+ name = field_o "name" Name.decode @@ -820,51 +818,7 @@ let load_dune_project ~dir opam_packages = load (Path.source file) ~f:(fun lang -> parse ~dir ~lang ~opam_packages ~file) -let make_jbuilder_project ~dir opam_packages = - let lang = get_dune_lang () in - let packages = - Package.Name.Map.map opam_packages ~f:(fun (_loc, p) -> Lazy.force p) - in - let name = default_name ~dir ~packages in - let project_file = - { Project_file.file = Path.Source.relative dir filename - ; exists = false - ; project_name = name - } - in - let parsing_context, stanza_parser, extension_args = - interpret_lang_and_extensions ~lang ~explicit_extensions:[] ~project_file - in - let root = dir in - let file_key = File_key.make ~root ~name in - let dialects = Dialect.DB.builtin in - { name - ; root - ; file_key - ; version = None - ; source = None - ; license = None - ; homepage = None - ; bug_reports = None - ; documentation = None - ; maintainers = [] - ; authors = [] - ; packages - ; stanza_parser - ; project_file - ; extension_args - ; parsing_context - ; implicit_transitive_deps = true - ; dune_version = lang.version - ; allow_approx_merlin = true - ; generate_opam_files = false - ; wrapped_executables = false - ; dialects - ; explicit_js_mode = explicit_js_mode_default ~lang - ; format_config = None - } - -let load ~dir ~files = +let load ~dir ~files ~infer_from_opam_files = let opam_packages = String.Set.fold files ~init:[] ~f:(fun fn acc -> match Filename.split_extension fn with @@ -913,8 +867,13 @@ let load ~dir ~files = in if String.Set.mem files filename then Some (load_dune_project ~dir opam_packages) - else if not (Package.Name.Map.is_empty opam_packages) then - Some (make_jbuilder_project ~dir opam_packages) + else if + Path.Source.is_root dir + || (infer_from_opam_files && not (Package.Name.Map.is_empty opam_packages)) + then + Some + (infer ~dir + (Package.Name.Map.map opam_packages ~f:(fun (_loc, p) -> Lazy.force p))) else None diff --git a/src/dune/dune_project.mli b/src/dune/dune_project.mli index 68e2c818ad8..7c343c30e5c 100644 --- a/src/dune/dune_project.mli +++ b/src/dune/dune_project.mli @@ -148,16 +148,23 @@ module Extension : sig end (** Load a project description from the following directory. [files] is the set - of files in this directory. *) -val load : dir:Path.Source.t -> files:String.Set.t -> t option + of files in this directory. + + If [infer_from_opam_files] is true and the directory contains no + [dune-project] file but contains at least one [>package>.opam] files, then + a project description is inferred from the opam files. *) +val load : + dir:Path.Source.t + -> files:String.Set.t + -> infer_from_opam_files:bool + -> t option + +(** Create an anonymous project with no package rooted at the given directory *) +val anonymous : dir:Path.Source.t -> t (** "dune-project" *) val filename : string -(** Represent the scope at the root of the workspace when the root of the - workspace contains no [dune-project] or [.opam] files. *) -val anonymous : t Lazy.t - type created_or_already_exist = | Created | Already_exist diff --git a/src/dune/file_tree.ml b/src/dune/file_tree.ml index c9440165775..7d133c8668b 100644 --- a/src/dune/file_tree.ml +++ b/src/dune/file_tree.ml @@ -35,33 +35,21 @@ module Dune_file = struct } end - module Contents = struct - type t = - | Plain of Plain.t - | Ocaml_script of Path.Source.t - end - type t = - { contents : Contents.t - ; kind : Dune_lang.File_syntax.t - } + | Plain of Plain.t + | Ocaml_script of Path.Source.t - let path t = - match t.contents with + let path = function | Plain x -> x.path | Ocaml_script p -> p - let load file ~project ~kind = + let load file ~project = Io.with_lexbuf_from_file (Path.source file) ~f:(fun lb -> - let contents, sub_dirs = + let t, sub_dirs = if Dune_lexer.is_script lb then - (Contents.Ocaml_script file, Sub_dirs.default) + (Ocaml_script file, Sub_dirs.default) else - let sexps = - Dune_lang.Parser.parse lb - ~lexer:(Dune_lang.Lexer.of_syntax kind) - ~mode:Many - in + let sexps = Dune_lang.Parser.parse lb ~mode:Many in let decoder = Dune_project.set_parsing_context project Sub_dirs.decode in @@ -71,7 +59,7 @@ module Dune_file = struct in (Plain { path = file; sexps }, sub_dirs) in - ({ contents; kind }, sub_dirs)) + (t, sub_dirs)) end module Dir = struct @@ -205,22 +193,22 @@ let readdir path = } |> Result.ok -let load ?(warn_when_seeing_jbuild_file = true) path ~ancestor_vcs = +let load path ~ancestor_vcs ~recognize_jbuilder_projects = let open Result.O in let nb_path_visited = ref 0 in let rec walk path ~dirs_visited ~project:parent_project ~vcs - ~(dir_status : Sub_dirs.Status.t) : (_, _) Result.t = + ~(dir_status : Sub_dirs.Status.t) { dirs; files } = incr nb_path_visited; if !nb_path_visited mod 100 = 0 then Console.update_status_line (Pp.verbatim (Printf.sprintf "Scanned %i directories" !nb_path_visited)); - let+ { dirs; files } = readdir path in let project = if dir_status = Data_only then parent_project else Option.value - (Dune_project.load ~dir:path ~files) + (Dune_project.load ~dir:path ~files + ~infer_from_opam_files:recognize_jbuilder_projects) ~default:parent_project in let vcs = @@ -242,57 +230,33 @@ let load ?(warn_when_seeing_jbuild_file = true) path ~ancestor_vcs = (let dune_file, sub_dirs = if dir_status = Data_only then (None, Sub_dirs.default) - else - let dune_file, sub_dirs = - match - List.filter [ "dune"; "jbuild" ] ~f:(String.Set.mem files) - with - | [] -> (None, Sub_dirs.default) - | [ fn ] -> - let file = Path.Source.relative path fn in - let warn_about_jbuild = - warn_when_seeing_jbuild_file && dir_status <> Vendored - in - if fn = "dune" then - ignore - ( Dune_project.ensure_project_file_exists project - : Dune_project.created_or_already_exist ) - else if Dune_project.dune_version project >= (2, 0) then - User_warning.emit - ~loc:(Loc.in_file (Path.source file)) - [ Pp.text - "jbuild files are not allowed inside Dune 2.0 \ - projects, please convert this file to a dune file \ - instead." - ; Pp.text - "Note: You can use \"dune upgrade\" to convert your \ - project to dune." - ] - else if warn_about_jbuild then - User_warning.emit - ~loc:(Loc.in_file (Path.source file)) - [ Pp.text - "jbuild files are deprecated, please convert this \ - file to a dune file instead." - ; Pp.text - "Note: You can use \"dune upgrade\" to convert your \ - project to dune." - ]; - let dune_file, sub_dirs = - Dune_file.load file ~project - ~kind: - (Option.value_exn (Dune_lang.File_syntax.of_basename fn)) - in - (Some dune_file, sub_dirs) - | _ -> - User_error.raise - [ Pp.textf - "Directory %s has both a 'dune' and 'jbuild' file.\n\ - This is not allowed" - (Path.Source.to_string_maybe_quoted path) - ] - in - (dune_file, sub_dirs) + else ( + if + (not recognize_jbuilder_projects) + && String.Set.mem files "jbuild" + then + User_error.raise + ~loc: + (Loc.in_file + (Path.source (Path.Source.relative path "jbuild"))) + [ Pp.text + "jbuild files are no longer supported, please convert \ + this file to a dune file instead." + ; Pp.text + "Note: You can use \"dune upgrade\" to convert your \ + project to dune." + ]; + if not (String.Set.mem files "dune") then + (None, Sub_dirs.default) + else ( + ignore + ( Dune_project.ensure_project_file_exists project + : Dune_project.created_or_already_exist ); + let file = Path.Source.relative path "dune" in + let dune_file, sub_dirs = Dune_file.load file ~project in + (Some dune_file, sub_dirs) + ) + ) in let sub_dirs = Sub_dirs.eval sub_dirs ~dirs:(List.map ~f:(fun (a, _, _) -> a) dirs) @@ -332,7 +296,8 @@ let load ?(warn_when_seeing_jbuild_file = true) path ~ancestor_vcs = ] in match - walk path ~dirs_visited ~project ~dir_status ~vcs + let+ x = readdir path in + walk path ~dirs_visited ~project ~dir_status ~vcs x with | Ok dir -> String.Map.set acc fn dir | Error _ -> acc )) @@ -342,11 +307,17 @@ let load ?(warn_when_seeing_jbuild_file = true) path ~ancestor_vcs = Dir.create ~path ~contents ~status:dir_status ~project ~vcs in let walk = + let+ x = readdir path in + let project = + match + Dune_project.load ~dir:path ~files:x.files ~infer_from_opam_files:true + with + | None -> Dune_project.anonymous ~dir:path + | Some p -> p + in walk path ~dirs_visited:(File.Map.singleton (File.of_source_path path) path) - ~dir_status:Normal - ~project:(Lazy.force Dune_project.anonymous) - ~vcs:ancestor_vcs + ~dir_status:Normal ~project ~vcs:ancestor_vcs x in Console.clear_status_line (); match walk with diff --git a/src/dune/file_tree.mli b/src/dune/file_tree.mli index 553e7da9588..f2f94221681 100644 --- a/src/dune/file_tree.mli +++ b/src/dune/file_tree.mli @@ -14,16 +14,9 @@ module Dune_file : sig } end - module Contents : sig - type t = private - | Plain of Plain.t - | Ocaml_script of Path.Source.t - end - type t = private - { contents : Contents.t - ; kind : Dune_lang.File_syntax.t - } + | Plain of Plain.t + | Ocaml_script of Path.Source.t val path : t -> Path.Source.t end @@ -43,8 +36,8 @@ module Dir : sig val sub_dir_names : t -> String.Set.t - (** Whether this directory is ignored by an [ignored_subdirs] stanza or - [jbuild-ignore] file in one of its ancestor directories. *) + (** Whether this directory is ignored by an [ignored_subdirs] stanza in one + of its ancestor directories. *) val ignored : t -> bool (** Whether this directory is vendored or sits within a vendored directory *) @@ -65,14 +58,13 @@ module Dir : sig end (** A [t] value represent a view of the source tree. It is lazily constructed - by scanning the file system and interpreting a few stanzas in [dune] files - as well as [jbuild-ignore] files for backward compatibility. *) + by scanning the file system and interpreting a few stanzas in [dune] files. *) type t val load : - ?warn_when_seeing_jbuild_file:bool - -> Path.Source.t + Path.Source.t -> ancestor_vcs:Vcs.t option + -> recognize_jbuilder_projects:bool -> t (** Passing [~traverse_data_only_dirs:true] to this functions causes the whole diff --git a/src/dune/inline_tests.ml b/src/dune/inline_tests.ml index c69e450f258..38c1e3bf42f 100644 --- a/src/dune/inline_tests.ml +++ b/src/dune/inline_tests.ml @@ -16,7 +16,6 @@ module Backend = struct ; flags : Ordered_set_lang.Unexpanded.t ; generate_runner : (Loc.t * Action_unexpanded.t) option ; extends : (Loc.t * Lib_name.t) list - ; file_kind : Stanza.File_kind.t } type Sub_system_info.t += T of t @@ -44,14 +43,8 @@ module Backend = struct field_o "generate_runner" (located Action_dune_lang.decode) and+ extends = field "extends" (repeat (located Lib_name.decode)) ~default:[] - and+ file_kind = Stanza.file_kind () in - { loc - ; runner_libraries - ; flags - ; generate_runner - ; extends - ; file_kind - }) + in + { loc; runner_libraries; flags; generate_runner; extends }) end type t = @@ -101,9 +94,8 @@ module Backend = struct ( (1, 0) , record_fields @@ [ field_l "runner_libraries" lib (Result.ok_exn t.runner_libraries) - ; field_i "flags" Ordered_set_lang.Unexpanded.encode_and_upgrade - t.info.flags - ; field_o "generate_runner" Action_dune_lang.encode_and_upgrade + ; field_i "flags" Ordered_set_lang.Unexpanded.encode t.info.flags + ; field_o "generate_runner" Action_dune_lang.encode (Option.map t.info.generate_runner ~f:snd) ; field_l "extends" f (Result.ok_exn t.extends) ] ) diff --git a/src/dune/ordered_set_lang.ml b/src/dune/ordered_set_lang.ml index daa33eac56b..0afcf529514 100644 --- a/src/dune/ordered_set_lang.ml +++ b/src/dune/ordered_set_lang.ml @@ -38,7 +38,7 @@ module Parse = struct let generic ~inc ~elt = let open Dune_lang.Decoder in - let rec one (kind : Dune_lang.File_syntax.t) = + let rec one () = peek_exn >>= function | Atom (loc, A "\\") -> User_error.raise ~loc [ Pp.text "unexpected \\" ] @@ -58,31 +58,28 @@ module Parse = struct User_error.raise ~loc [ Pp.textf "undefined symbol %s" s ] | _ -> elt ) | List (_, Atom (loc, A s) :: _) -> ( - match (s, kind) with - | ":include", _ -> inc - | s, Dune when s <> "" && s.[0] <> '-' && s.[0] <> ':' -> + match s with + | ":include" -> inc + | s when s <> "" && s.[0] <> '-' && s.[0] <> ':' -> User_error.raise ~loc [ Pp.text "This atom must be quoted because it is the first element of \ a list and doesn't start with - or:" ] - | _ -> enter (many [] kind) ) - | List _ -> enter (many [] kind) - and many acc kind = + | _ -> enter (many []) ) + | List _ -> enter (many []) + and many acc = peek >>= function | None -> return (Union (List.rev acc)) | Some (Atom (_, A "\\")) -> - let+ to_remove = junk >>> many [] kind in + let+ to_remove = junk >>> many [] in Diff (Union (List.rev acc), to_remove) | Some _ -> - let* x = one kind in - many (x :: acc) kind + let* x = one () in + many (x :: acc) in - let* kind = Stanza.file_kind () in - match kind with - | Dune -> many [] kind - | Jbuild -> one kind + many [] let with_include ~elt = generic ~elt @@ -210,13 +207,6 @@ let eval_loc t ~parse ~eq ~standard = let standard = { ast = Ast.Standard; loc = None; context = Univ_map.empty } -let dune_kind t = - match Univ_map.find t.context (Syntax.key Stanza.syntax) with - | Some (0, _) -> Dune_lang.File_syntax.Jbuild - | None - |Some (_, _) -> - Dune - let field ?check name = let decode = match check with @@ -240,18 +230,6 @@ module Unexpanded = struct in { ast; loc = Some loc; context } - let map t ~f : t = - let rec map_ast : ast -> ast = - let open Ast in - function - | Element sw -> Element (f sw) - | Include sw -> Include (f sw) - | Union xs -> Union (List.map ~f:map_ast xs) - | Diff (x, y) -> Diff (map_ast x, map_ast y) - | Standard as t -> t - in - { t with ast = map_ast t.ast } - let encode t = let open Ast in let rec loop = function @@ -271,14 +249,6 @@ module Unexpanded = struct | Diff (a, b) -> [ loop a; Dune_lang.unsafe_atom_of_string "\\"; loop b ] | ast -> [ loop ast ] - let upgrade_to_dune t = - match dune_kind t with - | Dune -> t - | Jbuild -> - map t ~f:(String_with_vars.upgrade_to_dune ~allow_first_dep_var:false) - - let encode_and_upgrade t = encode (upgrade_to_dune t) - let standard = standard let of_strings ~pos l = diff --git a/src/dune/ordered_set_lang.mli b/src/dune/ordered_set_lang.mli index a65fcb6115c..a5f4aaaf6ff 100644 --- a/src/dune/ordered_set_lang.mli +++ b/src/dune/ordered_set_lang.mli @@ -75,8 +75,6 @@ module Unexpanded : sig val encode : t -> Dune_lang.t list - val encode_and_upgrade : t -> Dune_lang.t list - val standard : t val of_strings : pos:string * int * int * int -> string list -> t diff --git a/src/dune/predicate_lang.ml b/src/dune/predicate_lang.ml index 8ab1387d154..3d9bdb42668 100644 --- a/src/dune/predicate_lang.ml +++ b/src/dune/predicate_lang.ml @@ -28,7 +28,7 @@ module Ast = struct let+ e = elt in Element e in - let rec one (kind : Dune_lang.File_syntax.t) = + let rec one () = peek_exn >>= function | Atom (loc, A "\\") -> User_error.raise ~loc [ Pp.text "unexpected \\" ] @@ -46,40 +46,40 @@ module Ast = struct User_error.raise ~loc [ Pp.textf "undefined symbol %s" s ] | _ -> elt ) | List (_, Atom (loc, A s) :: _) -> ( - match (s, kind) with - | ":include", _ -> + match s with + | ":include" -> User_error.raise ~loc [ Pp.text ":include isn't supported in the predicate language" ] - | ("or" | "and" | "not"), _ -> bool_ops kind - | s, Dune when s <> "" && s.[0] <> '-' && s.[0] <> ':' -> + | "or" + |"and" + |"not" -> + bool_ops () + | s when s <> "" && s.[0] <> '-' && s.[0] <> ':' -> User_error.raise ~loc [ Pp.text "This atom must be quoted because it is the first element of \ a list and doesn't start with - or:" ] - | _ -> enter (many union [] kind) ) - | List _ -> enter (many union [] kind) - and bool_ops kind = + | _ -> enter (many union []) ) + | List _ -> enter (many union []) + and bool_ops () = sum - [ ("or", many union [] kind) - ; ("and", many inter [] kind) - ; ("not", many not_union [] kind) + [ ("or", many union []) + ; ("and", many inter []) + ; ("not", many not_union []) ] - and many k acc kind = + and many k acc = peek >>= function | None -> return (k (List.rev acc)) | Some (Atom (_, A "\\")) -> - junk >>> many union [] kind + junk >>> many union [] >>| fun to_remove -> diff (k (List.rev acc)) to_remove | Some _ -> - let* x = one kind in - many k (x :: acc) kind + let* x = one () in + many k (x :: acc) in - let* kind = Stanza.file_kind () in - match kind with - | Dune -> many union [] kind - | Jbuild -> one kind + many union [] let rec to_dyn f = let open Dyn.Encoder in diff --git a/src/dune/preprocessing.ml b/src/dune/preprocessing.ml index 963d13246f5..46af9110f4b 100644 --- a/src/dune/preprocessing.ml +++ b/src/dune/preprocessing.ml @@ -128,7 +128,6 @@ module Driver = struct ; lint_flags : Ordered_set_lang.Unexpanded.t ; main : string ; replaces : (Loc.t * Lib_name.t) list - ; file_kind : Stanza.File_kind.t } type Sub_system_info.t += T of t @@ -155,8 +154,8 @@ module Driver = struct and+ main = field "main" string and+ replaces = field "replaces" (repeat (located Lib_name.decode)) ~default:[] - and+ file_kind = Stanza.file_kind () in - { loc; flags; as_ppx_flags; lint_flags; main; replaces; file_kind }) + in + { loc; flags; as_ppx_flags; lint_flags; main; replaces }) end (* The [lib] field is lazy so that we don't need to fill it for hardcoded @@ -206,10 +205,9 @@ module Driver = struct let f x = Lib_name.encode (Lib.name (Lazy.force x.lib)) in ( (1, 0) , record_fields - @@ [ field_i "flags" Ordered_set_lang.Unexpanded.encode_and_upgrade - t.info.flags - ; field_i "lint_flags" - Ordered_set_lang.Unexpanded.encode_and_upgrade t.info.lint_flags + @@ [ field_i "flags" Ordered_set_lang.Unexpanded.encode t.info.flags + ; field_i "lint_flags" Ordered_set_lang.Unexpanded.encode + t.info.lint_flags ; field "main" string t.info.main ; field_l "replaces" f (Result.ok_exn t.replaces) ] ) diff --git a/src/dune/stanza.ml b/src/dune/stanza.ml index 0c11683ef2b..0b1efc23aee 100644 --- a/src/dune/stanza.ml +++ b/src/dune/stanza.ml @@ -10,18 +10,4 @@ let latest_version = (2, 0) let syntax = Syntax.create ~name:"dune" ~desc:"the dune language" - [ (0, 0) (* Jbuild syntax *); (1, 12); latest_version ] - -module File_kind = struct - type t = Dune_lang.File_syntax.t = - | Jbuild - | Dune - - let of_syntax = function - | 0, _ -> Jbuild - | _, _ -> Dune -end - -let file_kind () = - let open Dune_lang.Decoder in - Syntax.get_exn syntax >>| File_kind.of_syntax + [ (1, 12); latest_version ] diff --git a/src/dune/stanza.mli b/src/dune/stanza.mli index ccaac52bab2..17e305126a2 100644 --- a/src/dune/stanza.mli +++ b/src/dune/stanza.mli @@ -17,14 +17,3 @@ end (** Syntax identifier for the Dune language. [(0, X)] correspond to the Jbuild language while versions from [(1, 0)] correspond to the Dune one. *) val syntax : Syntax.t - -module File_kind : sig - type t = Dune_lang.File_syntax.t = - | Jbuild - | Dune - - val of_syntax : Syntax.Version.t -> t -end - -(** Whether we are parsing a [jbuild] or [dune] file. *) -val file_kind : unit -> (File_kind.t, _) Dune_lang.Decoder.parser diff --git a/src/dune/string_with_vars.ml b/src/dune/string_with_vars.ml index c5d6f53fffd..56890920d8a 100644 --- a/src/dune/string_with_vars.ml +++ b/src/dune/string_with_vars.ml @@ -14,97 +14,17 @@ let compare_no_loc t1 t2 = let make_syntax = (1, 0) -let make ?(quoted = false) loc part = - { template = { parts = [ part ]; quoted; loc } - ; syntax_version = make_syntax - } +let make template = { template; syntax_version = make_syntax } -let make_text ?quoted loc s = make ?quoted loc (Text s) +let make_text ?(quoted = false) loc s = + make { parts = [ Text s ]; quoted; loc } -let make_var ?quoted loc ?payload name = +let make_var ?(quoted = false) loc ?payload name = let var = { loc; name; payload; syntax = Percent } in - make ?quoted loc (Var var) + make { parts = [ Var var ]; quoted; loc } let literal ~quoted ~loc s = { parts = [ Text s ]; quoted; loc } -(* This module implements the "old" template parsing that is only used in - jbuild files *) -module Jbuild : sig - val parse : string -> loc:Loc.t -> quoted:bool -> Dune_lang.Template.t -end = struct - type var_syntax = - | Parens - | Braces - - module Token = struct - type t = - | String of string - | Open of var_syntax - | Close of var_syntax - - let tokenise s = - let len = String.length s in - let sub i j = String.sub s ~pos:i ~len:(j - i) in - let cons_str i j acc = - if i = j then - acc - else - String (sub i j) :: acc - in - let rec loop i j = - if j = len then - cons_str i j [] - else - match s.[j] with - | '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1)) - | ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1)) - | '$' when j + 1 < len -> ( - match s.[j + 1] with - | '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2)) - | '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2)) - | _ -> loop i (j + 1) ) - | _ -> loop i (j + 1) - in - loop 0 0 - - let to_string = function - | String s -> s - | Open Braces -> "${" - | Open Parens -> "$(" - | Close Braces -> "}" - | Close Parens -> ")" - end - - (* Remark: Consecutive [Text] items are concatenated. *) - let rec of_tokens : Loc.t -> Token.t list -> part list = - fun loc -> function - | [] -> [] - | Open a :: String s :: Close b :: rest when a = b -> - let name, payload = - match String.lsplit2 s ~on:':' with - | None -> (s, None) - | Some (n, p) -> (n, Some p) - in - Var - { loc - ; name - ; payload - ; syntax = - ( match a with - | Parens -> Dollar_paren - | Braces -> Dollar_brace ) - } - :: of_tokens loc rest - | token :: rest -> ( - let s = Token.to_string token in - match of_tokens loc rest with - | Text s' :: l -> Text (s ^ s') :: l - | l -> Text s :: l ) - - let parse s ~loc ~quoted = - { parts = of_tokens loc (Token.tokenise s); loc; quoted } -end - let decode = let open Dune_lang.Decoder in let template_parser = @@ -123,10 +43,6 @@ let loc t = t.template.loc let syntax_version t = t.syntax_version -let virt ?(quoted = false) pos s = - let template = Jbuild.parse ~quoted ~loc:(Loc.of_pos pos) s in - { template; syntax_version = make_syntax } - let virt_var ?(quoted = false) pos s = assert ( String.for_all s ~f:(function @@ -400,112 +316,6 @@ let to_dyn t = Dune_lang.to_dyn (encode t) let remove_locs t = { t with template = Dune_lang.Template.remove_locs t.template } -module Upgrade_var = struct - type info = - | Keep - | Deleted of string - | Renamed_to of string - - let map = - let macros = - [ ("exe", Keep) - ; ("bin", Keep) - ; ("lib", Keep) - ; ("libexec", Keep) - ; ("lib-available", Keep) - ; ("version", Keep) - ; ("read", Keep) - ; ("read-lines", Keep) - ; ("read-strings", Keep) - ; ("path", Renamed_to "dep") - ; ("findlib", Renamed_to "lib") - ; ("path-no-dep", Deleted "") - ; ("ocaml-config", Keep) - ] - in - let static_vars = - [ ( "<" - , Deleted - "Use a named dependency instead:\n\n\ - \ (deps (:x ) ...)\n\ - \ ... %{x} ..." ) - ; ("@", Renamed_to "targets") - ; ("^", Renamed_to "deps") - ; ("SCOPE_ROOT", Renamed_to "project_root") - ] - in - let lowercased = - [ ("cpp", Keep) - ; ("pa_cpp", Keep) - ; ("cc", Keep) - ; ("cxx", Keep) - ; ("ocaml", Keep) - ; ("ocamlc", Keep) - ; ("ocamlopt", Keep) - ; ("arch_sixtyfour", Keep) - ; ("make", Keep) - ] - in - let uppercased = - List.map lowercased ~f:(fun (k, _) -> (String.uppercase k, Renamed_to k)) - in - let other = - [ ("-verbose", Keep) - ; ("ocaml_bin", Keep) - ; ("ocaml_version", Keep) - ; ("ocaml_where", Keep) - ; ("null", Keep) - ; ("ext_obj", Keep) - ; ("ext_asm", Keep) - ; ("ext_lib", Keep) - ; ("ext_dll", Keep) - ; ("ext_exe", Keep) - ; ("profile", Keep) - ; ("workspace_root", Keep) - ; ("context_name", Keep) - ; ("ROOT", Renamed_to "workspace_root") - ; ("corrected-suffix", Keep) - ; ("library-name", Keep) - ; ("impl-files", Keep) - ; ("intf-files", Keep) - ] - in - String.Map.of_list_exn - (List.concat [ macros; static_vars; lowercased; uppercased; other ]) -end - -let upgrade_to_dune t ~allow_first_dep_var = - if t.syntax_version >= make_syntax then - t - else - let map_var (v : Var.t) = - match String.Map.find Upgrade_var.map v.name with - | None -> None - | Some info -> ( - match info with - | Deleted repl -> - if v.name = "<" && allow_first_dep_var then - Some v.name - else - User_error.raise ~loc:v.loc - [ Pp.textf "%s is not supported in dune files.%s" - (Var.describe v) repl - ] - | Keep -> Some v.name - | Renamed_to new_name -> Some new_name ) - in - let map_part = function - | Text _ as part -> part - | Var v -> ( - match map_var v with - | None -> Text (string_of_var v) - | Some name -> Var { v with name; syntax = Percent } ) - in - { syntax_version = make_syntax - ; template = - { t.template with parts = List.map t.template.parts ~f:map_part } - } - module Partial = struct include Private.Partial diff --git a/src/dune/string_with_vars.mli b/src/dune/string_with_vars.mli index ee3c6d3dedf..df30fdee8e3 100644 --- a/src/dune/string_with_vars.mli +++ b/src/dune/string_with_vars.mli @@ -21,11 +21,7 @@ val to_dyn : t Dyn.Encoder.t include Dune_lang.Conv with type t := t (** [t] generated by the OCaml code. The first argument should be [__POS__]. - The second is either a string to parse, a variable name or plain text. - [quoted] says whether the string is quoted ([false] by default). Those - functions expect jbuild syntax. *) -val virt : ?quoted:bool -> string * int * int * int -> string -> t - + [quoted] says whether the string is quoted ([false] by default). *) val virt_var : ?quoted:bool -> string * int * int * int -> string -> t val virt_text : string * int * int * int -> string -> t @@ -34,6 +30,8 @@ val make_var : ?quoted:bool -> Loc.t -> ?payload:string -> string -> t val make_text : ?quoted:bool -> Loc.t -> string -> t +val make : Dune_lang.Template.t -> t + val is_var : t -> name:string -> bool val has_vars : t -> bool @@ -118,8 +116,3 @@ val partial_expand : -> 'a Partial.t val remove_locs : t -> t - -(** Upgrade the following string with variables coming from a jbuild file to - one suitable for a dune file. Fail if the [<] variable is found and - [allow_first_dep_var] is [true]. *) -val upgrade_to_dune : t -> allow_first_dep_var:bool -> t diff --git a/src/dune/super_context.ml b/src/dune/super_context.ml index 2d4006e7fba..4074507f835 100644 --- a/src/dune/super_context.ml +++ b/src/dune/super_context.ml @@ -426,8 +426,7 @@ let create ~(context : Context.t) ?host ~projects ~file_tree ~packages ~stanzas libs external_variants in let stanzas = - List.map stanzas - ~f:(fun { Dune_load.Dune_file.dir; project; stanzas; kind = _ } -> + List.map stanzas ~f:(fun { Dune_load.Dune_file.dir; project; stanzas } -> let ctx_dir = Path.Build.append_source context.build_dir dir in let dune_version = Dune_project.dune_version project in { Dir_with_dune.src_dir = dir diff --git a/src/dune/upgrader.ml b/src/dune/upgrader.ml index 1c7fd11134d..f73c4a67517 100644 --- a/src/dune/upgrader.ml +++ b/src/dune/upgrader.ml @@ -11,7 +11,7 @@ let scan_included_files path = let csts = Dune_lang.parse_cst_string s ~fname:(Path.Source.to_string path) - ~lexer:Dune_lang.Lexer.jbuild_token + ~lexer:Jbuild_support.Lexer.token |> List.map ~f:(Dune_lang.Cst.fetch_legacy_comments ~file_contents:s) in let comments = Dune_lang.Cst.extract_comments csts in @@ -98,22 +98,20 @@ let upgrade_stanza stanza = | x -> x) } in - let upgrade_string sexp = - let loc = Dune_lang.Ast.loc sexp in - Dune_lang.Decoder.parse String_with_vars.decode - (Univ_map.singleton (Syntax.key Stanza.syntax) (0, 0)) - sexp - |> String_with_vars.upgrade_to_dune ~allow_first_dep_var:true - |> String_with_vars.encode |> Dune_lang.add_loc ~loc + let upgrade_string s ~loc ~quoted = + Jbuild_support.String_with_vars.upgrade_to_dune s ~loc ~quoted + ~allow_first_dep_var:true + |> String_with_vars.make |> String_with_vars.encode + |> Dune_lang.add_loc ~loc in let rec upgrade = function - | Atom (loc, A s) as x -> ( + | Atom (loc, A s) -> ( match s with | "files_recursively_in" -> Atom (loc, Dune_lang.Atom.of_string "source_tree") - | _ -> upgrade_string x ) + | _ -> upgrade_string s ~loc ~quoted:false ) | Template _ as x -> x - | Quoted_string _ as x -> upgrade_string x + | Quoted_string (loc, s) -> upgrade_string s ~loc ~quoted:true | List (loc, l) -> let l = match l with @@ -362,21 +360,20 @@ let upgrade_dir todo dir = let fn = Package.opam_file pkg in if Path.exists (Path.source fn) then upgrade_opam_file todo fn) ); - Option.iter (File_tree.Dir.dune_file dir) ~f:(fun dune_file -> - match (dune_file.kind, dune_file.contents) with - | Dune, _ -> () - | Jbuild, Ocaml_script fn -> - User_warning.emit - ~loc:(Loc.in_file (Path.source fn)) - [ Pp.text - "Cannot upgrade this jbuild file as it is using the OCaml syntax." - ; Pp.text "You need to upgrade it manually." - ] - | Jbuild, Plain { path; sexps = _ } -> - let files = scan_included_files path in - Path.Source.Map.iteri files ~f:(fun fn (sexps, comments) -> - upgrade_file todo fn sexps comments - ~look_for_jbuild_ignore:(Path.Source.equal fn path))) + if String.Set.mem (File_tree.Dir.files dir) "jbuild" then + let fn = Path.Source.relative (File_tree.Dir.path dir) "jbuild" in + if Io.with_lexbuf_from_file (Path.source fn) ~f:Dune_lexer.is_script then + User_warning.emit + ~loc:(Loc.in_file (Path.source fn)) + [ Pp.text + "Cannot upgrade this jbuild file as it is using the OCaml syntax." + ; Pp.text "You need to upgrade it manually." + ] + else + let files = scan_included_files fn in + Path.Source.Map.iteri files ~f:(fun fn' (sexps, comments) -> + upgrade_file todo fn' sexps comments + ~look_for_jbuild_ignore:(Path.Source.equal fn fn')) let upgrade ft = Dune_project.default_dune_language_version := (1, 0); diff --git a/src/dune_lang/atom.ml b/src/dune_lang/atom.ml index fc86f8b9877..314be979641 100644 --- a/src/dune_lang/atom.ml +++ b/src/dune_lang/atom.ml @@ -8,7 +8,7 @@ let to_dyn (A s) = let equal (A a) (A b) = String.equal a b -let is_valid_dune = +let is_valid = let rec loop s i len = i = len || @@ -41,51 +41,16 @@ let is_valid_dune = let len = String.length s in len > 0 && loop s 0 len -let is_valid_jbuild str = - let len = String.length str in - len > 0 - && - let rec loop ix = - match str.[ix] with - | '"' - |'(' - |')' - |';' -> - true - | '|' -> - ix > 0 - && - let next = ix - 1 in - str.[next] = '#' || loop next - | '#' -> - ix > 0 - && - let next = ix - 1 in - str.[next] = '|' || loop next - | ' ' - |'\t' - |'\n' - |'\012' - |'\r' -> - true - | _ -> ix > 0 && loop (ix - 1) - in - not (loop (len - 1)) - let of_string s = A s let to_string (A s) = s -let is_valid (A t) = function - | File_syntax.Jbuild -> is_valid_jbuild t - | Dune -> is_valid_dune t - -let print (A atom as t) = - if is_valid t Dune then - atom +let print (A s) = + if is_valid s then + s else Code_error.raise "atom cannot be printed in dune syntax" - [ ("atom", String atom) ] + [ ("atom", String s) ] let of_int i = of_string (string_of_int i) diff --git a/src/dune_lang/atom.mli b/src/dune_lang/atom.mli index 7fda81e66b6..770d0712fc1 100644 --- a/src/dune_lang/atom.mli +++ b/src/dune_lang/atom.mli @@ -4,9 +4,7 @@ type t = private A of string [@@unboxed] val equal : t -> t -> bool -val is_valid_dune : string -> bool - -val is_valid : t -> File_syntax.t -> bool +val is_valid : string -> bool val of_string : string -> t diff --git a/src/dune_lang/dune b/src/dune_lang/dune index 74a46eb08d5..01cd610f8cf 100644 --- a/src/dune_lang/dune +++ b/src/dune_lang/dune @@ -5,4 +5,4 @@ (public_name dune._dune_lang) (preprocess future_syntax)) -(ocamllex dune_lexer jbuild_lexer) +(ocamllex lexer) diff --git a/src/dune_lang/dune_lang.ml b/src/dune_lang/dune_lang.ml index 8d629cabd3a..df55405ac4f 100644 --- a/src/dune_lang/dune_lang.ml +++ b/src/dune_lang/dune_lang.ml @@ -1,7 +1,6 @@ open! Stdune module Atom = Atom module Template = Template -module File_syntax = File_syntax type t = | Atom of Atom.t @@ -10,7 +9,7 @@ type t = | Template of Template.t let atom_or_quoted_string s = - if Atom.is_valid_dune s then + if Atom.is_valid s then Atom (Atom.of_string s) else Quoted_string s @@ -166,7 +165,7 @@ let rec add_loc t ~loc : Ast.t = | Template t -> Template { t with loc } module Cst = struct - module Comment = Lexer_shared.Token.Comment + module Comment = Lexer.Token.Comment type t = | Atom of Loc.t * Atom.t diff --git a/src/dune_lang/dune_lang.mli b/src/dune_lang/dune_lang.mli index b893841676c..1716e5c4cda 100644 --- a/src/dune_lang/dune_lang.mli +++ b/src/dune_lang/dune_lang.mli @@ -3,12 +3,10 @@ This library is internal to dune and guarantees no API stability.*) open! Stdune -module File_syntax = File_syntax - module Atom : sig type t = private A of string [@@unboxed] - val is_valid : t -> File_syntax.t -> bool + val is_valid : string -> bool val equal : t -> t -> bool @@ -180,10 +178,6 @@ module Lexer : sig type t = with_comments:bool -> Lexing.lexbuf -> Token.t val token : t - - val jbuild_token : t - - val of_syntax : File_syntax.t -> t end module Parser : sig diff --git a/src/dune_lang/dune_lexer.mli b/src/dune_lang/dune_lexer.mli deleted file mode 100644 index 5d1e70f7e0e..00000000000 --- a/src/dune_lang/dune_lexer.mli +++ /dev/null @@ -1 +0,0 @@ -val token : Lexer_shared.t diff --git a/src/dune_lang/file_syntax.ml b/src/dune_lang/file_syntax.ml deleted file mode 100644 index 342f7ce45b0..00000000000 --- a/src/dune_lang/file_syntax.ml +++ /dev/null @@ -1,20 +0,0 @@ -open Stdune - -type t = - | Jbuild - | Dune - -let equal = ( = ) - -let hash = Hashtbl.hash - -let of_basename = function - | "jbuild" -> Some Jbuild - | "dune" -> Some Dune - | _ -> None - -let to_dyn = - let open Dyn.Encoder in - function - | Jbuild -> constr "Jbuild" [] - | Dune -> constr "Dune" [] diff --git a/src/dune_lang/file_syntax.mli b/src/dune_lang/file_syntax.mli deleted file mode 100644 index 1e6386592d1..00000000000 --- a/src/dune_lang/file_syntax.mli +++ /dev/null @@ -1,13 +0,0 @@ -open Stdune - -type t = - | Jbuild - | Dune - -val equal : t -> t -> bool - -val hash : t -> int - -val of_basename : string -> t option - -val to_dyn : t -> Dyn.t diff --git a/src/dune_lang/jbuild_lexer.mli b/src/dune_lang/jbuild_lexer.mli deleted file mode 100644 index 5d1e70f7e0e..00000000000 --- a/src/dune_lang/jbuild_lexer.mli +++ /dev/null @@ -1 +0,0 @@ -val token : Lexer_shared.t diff --git a/src/dune_lang/lexer.ml b/src/dune_lang/lexer.ml deleted file mode 100644 index 0815a334f4f..00000000000 --- a/src/dune_lang/lexer.ml +++ /dev/null @@ -1,11 +0,0 @@ -module Token = Lexer_shared.Token - -type t = Lexer_shared.t - -let token = Dune_lexer.token - -let jbuild_token = Jbuild_lexer.token - -let of_syntax = function - | File_syntax.Dune -> token - | Jbuild -> jbuild_token diff --git a/src/dune_lang/lexer.mli b/src/dune_lang/lexer.mli index 07bdaf1547a..f7c55371ac2 100644 --- a/src/dune_lang/lexer.mli +++ b/src/dune_lang/lexer.mli @@ -1,9 +1,25 @@ -module Token = Lexer_shared.Token +open Stdune -type t = with_comments:bool -> Lexing.lexbuf -> Token.t +module Token : sig + module Comment : sig + type t = + | Lines of string list + | Legacy -val token : t + val to_dyn : t -> Dyn.t + end -val jbuild_token : t + type t = + | Atom of Atom.t + | Quoted_string of string + | Lparen + | Rparen + | Sexp_comment + | Eof + | Template of Template.t + | Comment of Comment.t +end -val of_syntax : File_syntax.t -> t +type t = with_comments:bool -> Lexing.lexbuf -> Token.t + +val token : t diff --git a/src/dune_lang/dune_lexer.mll b/src/dune_lang/lexer.mll similarity index 84% rename from src/dune_lang/dune_lexer.mll rename to src/dune_lang/lexer.mll index 19aa81b1862..0757c3b420b 100644 --- a/src/dune_lang/dune_lexer.mll +++ b/src/dune_lang/lexer.mll @@ -1,6 +1,67 @@ { open! Stdune -open Lexer_shared + +open Stdune + +module Token = struct + module Comment = struct + type t = + | Lines of string list + | Legacy + + let to_dyn = + let open Dyn.Encoder in + function + | Legacy -> constr "Legacy" [] + | Lines l -> constr "Lines" [ list string l ] + end + + type t = + | Atom of Atom.t + | Quoted_string of string + | Lparen + | Rparen + | Sexp_comment + | Eof + | Template of Template.t + | Comment of Comment.t +end + +type t = with_comments:bool -> Lexing.lexbuf -> Token.t + +let error ?(delta = 0) lexbuf message = + let start = Lexing.lexeme_start_p lexbuf in + let loc : Loc.t = + { start = { start with pos_cnum = start.pos_cnum + delta } + ; stop = Lexing.lexeme_end_p lexbuf + } + in + User_error.raise ~loc [ Pp.text message ] + +let invalid_dune_or_jbuild lexbuf = + let start = Lexing.lexeme_start_p lexbuf in + let fname = Filename.basename start.pos_fname in + error lexbuf (sprintf "Invalid %s file" fname) + +type escape_sequence = + | Newline + | Other + +let eval_decimal_char c = Char.code c - Char.code '0' + +let eval_decimal_escape c1 c2 c3 = + (eval_decimal_char c1 * 100) + + (eval_decimal_char c2 * 10) + + eval_decimal_char c3 + +let eval_hex_char c = + match c with + | '0' .. '9' -> Char.code c - Char.code '0' + | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10 + | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10 + | _ -> -1 + +let eval_hex_escape c1 c2 = (eval_hex_char c1 * 16) + eval_hex_char c2 type block_string_line_kind = | With_escape_sequences diff --git a/src/dune_lang/lexer_shared.ml b/src/dune_lang/lexer_shared.ml deleted file mode 100644 index aeb60c2912f..00000000000 --- a/src/dune_lang/lexer_shared.ml +++ /dev/null @@ -1,63 +0,0 @@ -open Stdune - -module Token = struct - module Comment = struct - type t = - | Lines of string list - | Legacy - - let to_dyn = - let open Dyn.Encoder in - function - | Legacy -> constr "Legacy" [] - | Lines l -> constr "Lines" [ list string l ] - end - - type t = - | Atom of Atom.t - | Quoted_string of string - | Lparen - | Rparen - | Sexp_comment - | Eof - | Template of Template.t - | Comment of Comment.t -end - -type t = with_comments:bool -> Lexing.lexbuf -> Token.t - -let error ?(delta = 0) lexbuf message = - let start = Lexing.lexeme_start_p lexbuf in - let loc : Loc.t = - { start = { start with pos_cnum = start.pos_cnum + delta } - ; stop = Lexing.lexeme_end_p lexbuf - } - in - User_error.raise ~loc [ Pp.text message ] - -let invalid_dune_or_jbuild lexbuf = - let start = Lexing.lexeme_start_p lexbuf in - let fname = Filename.basename start.pos_fname in - error lexbuf (sprintf "Invalid %s file" fname) - -let escaped_buf = Buffer.create 256 - -type escape_sequence = - | Newline - | Other - -let eval_decimal_char c = Char.code c - Char.code '0' - -let eval_decimal_escape c1 c2 c3 = - (eval_decimal_char c1 * 100) - + (eval_decimal_char c2 * 10) - + eval_decimal_char c3 - -let eval_hex_char c = - match c with - | '0' .. '9' -> Char.code c - Char.code '0' - | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10 - | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10 - | _ -> -1 - -let eval_hex_escape c1 c2 = (eval_hex_char c1 * 16) + eval_hex_char c2 diff --git a/src/dune_lang/lexer_shared.mli b/src/dune_lang/lexer_shared.mli deleted file mode 100644 index 049df3d72a4..00000000000 --- a/src/dune_lang/lexer_shared.mli +++ /dev/null @@ -1,39 +0,0 @@ -open Stdune - -module Token : sig - module Comment : sig - type t = - | Lines of string list - | Legacy - - val to_dyn : t -> Dyn.t - end - - type t = - | Atom of Atom.t - | Quoted_string of string - | Lparen - | Rparen - | Sexp_comment - | Eof - | Template of Template.t - | Comment of Comment.t -end - -type t = with_comments:bool -> Lexing.lexbuf -> Token.t - -val error : ?delta:int -> Lexing.lexbuf -> string -> 'a - -val invalid_dune_or_jbuild : Lexing.lexbuf -> 'a - -val escaped_buf : Buffer.t - -type escape_sequence = - | Newline - | Other - -val eval_decimal_char : char -> int - -val eval_decimal_escape : char -> char -> char -> int - -val eval_hex_escape : char -> char -> int diff --git a/src/dune_lang/template.ml b/src/dune_lang/template.ml index b318a8c8bb8..7cf0c419a01 100644 --- a/src/dune_lang/template.ml +++ b/src/dune_lang/template.ml @@ -49,7 +49,7 @@ end = struct Buffer.add_string buf after let check_valid_unquoted s ~loc = - if not (Atom.is_valid (Atom.of_string s) Dune) then + if not (Atom.is_valid s) then Code_error.raise ~loc "Invalid text in unquoted template" [ ("s", String s) ] diff --git a/src/jbuild_support/atom.ml b/src/jbuild_support/atom.ml new file mode 100644 index 00000000000..c33232d00ac --- /dev/null +++ b/src/jbuild_support/atom.ml @@ -0,0 +1,32 @@ +open Stdune + +let is_valid str = + let len = String.length str in + len > 0 + && + let rec loop ix = + match str.[ix] with + | '"' + |'(' + |')' + |';' -> + true + | '|' -> + ix > 0 + && + let next = ix - 1 in + str.[next] = '#' || loop next + | '#' -> + ix > 0 + && + let next = ix - 1 in + str.[next] = '|' || loop next + | ' ' + |'\t' + |'\n' + |'\012' + |'\r' -> + true + | _ -> ix > 0 && loop (ix - 1) + in + not (loop (len - 1)) diff --git a/src/jbuild_support/atom.mli b/src/jbuild_support/atom.mli new file mode 100644 index 00000000000..213168f1ad4 --- /dev/null +++ b/src/jbuild_support/atom.mli @@ -0,0 +1 @@ +val is_valid : string -> bool diff --git a/src/jbuild_support/dune b/src/jbuild_support/dune new file mode 100644 index 00000000000..9ebfef4ec86 --- /dev/null +++ b/src/jbuild_support/dune @@ -0,0 +1,7 @@ +(library + (name jbuild_support) + (libraries stdune dune_lang) + (synopsis "Internal Dune library, do not use!") + (preprocess future_syntax)) + +(ocamllex lexer) diff --git a/src/jbuild_support/lexer.mli b/src/jbuild_support/lexer.mli new file mode 100644 index 00000000000..e396cc7e010 --- /dev/null +++ b/src/jbuild_support/lexer.mli @@ -0,0 +1 @@ +val token : Dune_lang.Lexer.t diff --git a/src/dune_lang/jbuild_lexer.mll b/src/jbuild_support/lexer.mll similarity index 80% rename from src/dune_lang/jbuild_lexer.mll rename to src/jbuild_support/lexer.mll index 3b74db152c9..55d9f95bcb0 100644 --- a/src/dune_lang/jbuild_lexer.mll +++ b/src/jbuild_support/lexer.mll @@ -1,5 +1,42 @@ { - open Lexer_shared +open Stdune +open Dune_lang + +let error ?(delta = 0) lexbuf message = + let start = Lexing.lexeme_start_p lexbuf in + let loc : Loc.t = + { start = { start with pos_cnum = start.pos_cnum + delta } + ; stop = Lexing.lexeme_end_p lexbuf + } + in + User_error.raise ~loc [ Pp.text message ] + +let invalid_dune_or_jbuild lexbuf = + let start = Lexing.lexeme_start_p lexbuf in + let fname = Filename.basename start.pos_fname in + error lexbuf (sprintf "Invalid %s file" fname) + +let escaped_buf = Buffer.create 256 + +type escape_sequence = + | Newline + | Other + +let eval_decimal_char c = Char.code c - Char.code '0' + +let eval_decimal_escape c1 c2 c3 = + (eval_decimal_char c1 * 100) + + (eval_decimal_char c2 * 10) + + eval_decimal_char c3 + +let eval_hex_char c = + match c with + | '0' .. '9' -> Char.code c - Char.code '0' + | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10 + | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10 + | _ -> -1 + +let eval_hex_escape c1 c2 = (eval_hex_char c1 * 16) + eval_hex_char c2 (* The difference between the old and new syntax is that the old syntax allows backslash following by any characters other than 'n', @@ -34,7 +71,7 @@ rule token with_comments = parse token with_comments lexbuf } | '(' - { Token.Lparen } + { Lexer.Token.Lparen } | ')' { Rparen } | '"' @@ -64,7 +101,7 @@ and comment_trail acc = parse | newline blank* ';' (comment_body as s) { comment_trail (s :: acc) lexbuf } | "" - { Token.Comment (Lines (List.rev acc)) } + { Lexer.Token.Comment (Lines (List.rev acc)) } and atom acc start = parse | '#'+ '|' @@ -81,7 +118,7 @@ and atom acc start = parse | "" { if acc = "" then invalid_dune_or_jbuild lexbuf; lexbuf.lex_start_p <- start; - Token.Atom (Atom.of_string acc) + Lexer.Token.Atom (Atom.of_string acc) } and quoted_string mode = parse diff --git a/src/jbuild_support/string_with_vars.ml b/src/jbuild_support/string_with_vars.ml new file mode 100644 index 00000000000..4027fcd2893 --- /dev/null +++ b/src/jbuild_support/string_with_vars.ml @@ -0,0 +1,172 @@ +open Stdune + +type var_syntax = + | Parens + | Braces + +module Token = struct + type t = + | String of string + | Open of var_syntax + | Close of var_syntax + + let tokenise s = + let len = String.length s in + let sub i j = String.sub s ~pos:i ~len:(j - i) in + let cons_str i j acc = + if i = j then + acc + else + String (sub i j) :: acc + in + let rec loop i j = + if j = len then + cons_str i j [] + else + match s.[j] with + | '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1)) + | ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1)) + | '$' when j + 1 < len -> ( + match s.[j + 1] with + | '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2)) + | '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2)) + | _ -> loop i (j + 1) ) + | _ -> loop i (j + 1) + in + loop 0 0 + + let to_string = function + | String s -> s + | Open Braces -> "${" + | Open Parens -> "$(" + | Close Braces -> "}" + | Close Parens -> ")" +end + +(* Remark: Consecutive [Text] items are concatenated. *) +let rec of_tokens : Loc.t -> Token.t list -> Dune_lang.Template.part list = + fun loc -> function + | [] -> [] + | Open a :: String s :: Close b :: rest when a = b -> + let name, payload = + match String.lsplit2 s ~on:':' with + | None -> (s, None) + | Some (n, p) -> (n, Some p) + in + Var + { loc + ; name + ; payload + ; syntax = + ( match a with + | Parens -> Dollar_paren + | Braces -> Dollar_brace ) + } + :: of_tokens loc rest + | token :: rest -> ( + let s = Token.to_string token in + match of_tokens loc rest with + | Text s' :: l -> Text (s ^ s') :: l + | l -> Text s :: l ) + +let parse ~loc s = of_tokens loc (Token.tokenise s) + +module Upgrade_var = struct + type info = + | Keep + | Deleted of string + | Renamed_to of string + + let map = + let macros = + [ ("exe", Keep) + ; ("bin", Keep) + ; ("lib", Keep) + ; ("libexec", Keep) + ; ("lib-available", Keep) + ; ("version", Keep) + ; ("read", Keep) + ; ("read-lines", Keep) + ; ("read-strings", Keep) + ; ("path", Renamed_to "dep") + ; ("findlib", Renamed_to "lib") + ; ("path-no-dep", Deleted "") + ; ("ocaml-config", Keep) + ] + in + let static_vars = + [ ( "<" + , Deleted + "Use a named dependency instead:\n\n\ + \ (deps (:x ) ...)\n\ + \ ... %{x} ..." ) + ; ("@", Renamed_to "targets") + ; ("^", Renamed_to "deps") + ; ("SCOPE_ROOT", Renamed_to "project_root") + ] + in + let lowercased = + [ ("cpp", Keep) + ; ("pa_cpp", Keep) + ; ("cc", Keep) + ; ("cxx", Keep) + ; ("ocaml", Keep) + ; ("ocamlc", Keep) + ; ("ocamlopt", Keep) + ; ("arch_sixtyfour", Keep) + ; ("make", Keep) + ] + in + let uppercased = + List.map lowercased ~f:(fun (k, _) -> (String.uppercase k, Renamed_to k)) + in + let other = + [ ("-verbose", Keep) + ; ("ocaml_bin", Keep) + ; ("ocaml_version", Keep) + ; ("ocaml_where", Keep) + ; ("null", Keep) + ; ("ext_obj", Keep) + ; ("ext_asm", Keep) + ; ("ext_lib", Keep) + ; ("ext_dll", Keep) + ; ("ext_exe", Keep) + ; ("profile", Keep) + ; ("workspace_root", Keep) + ; ("context_name", Keep) + ; ("ROOT", Renamed_to "workspace_root") + ; ("corrected-suffix", Keep) + ; ("library-name", Keep) + ; ("impl-files", Keep) + ; ("intf-files", Keep) + ] + in + String.Map.of_list_exn + (List.concat [ macros; static_vars; lowercased; uppercased; other ]) +end + +let upgrade_to_dune s ~loc ~quoted ~allow_first_dep_var = + let open Dune_lang.Template in + let map_var v = + match String.Map.find Upgrade_var.map v.name with + | None -> None + | Some info -> ( + match info with + | Deleted repl -> + if v.name = "<" && allow_first_dep_var then + Some v.name + else + User_error.raise ~loc:v.loc + [ Pp.textf "this form is not allowed in dune files.%s" repl ] + | Keep -> Some v.name + | Renamed_to new_name -> Some new_name ) + in + let map_part = function + | Text _ as part -> part + | Var v -> ( + match map_var v with + | None -> Text (string_of_var v) + | Some name -> Var { v with name; syntax = Percent } ) + in + let parts = List.map (parse ~loc s) ~f:map_part in + { Dune_lang.Template.quoted; parts; loc } diff --git a/src/jbuild_support/string_with_vars.mli b/src/jbuild_support/string_with_vars.mli new file mode 100644 index 00000000000..53a25a7f57f --- /dev/null +++ b/src/jbuild_support/string_with_vars.mli @@ -0,0 +1,11 @@ +open Stdune + +(** Upgrade string with variables coming from a jbuild file to one suitable for + a dune file. Fail if the [<] variable is found and [allow_first_dep_var] is + [true]. *) +val upgrade_to_dune : + string + -> loc:Loc.t + -> quoted:bool + -> allow_first_dep_var:bool + -> Dune_lang.Template.t diff --git a/test/blackbox-tests/test-cases/embed-jbuild/run.t b/test/blackbox-tests/test-cases/embed-jbuild/run.t index e9c98e4cc0e..ad7623196fa 100644 --- a/test/blackbox-tests/test-cases/embed-jbuild/run.t +++ b/test/blackbox-tests/test-cases/embed-jbuild/run.t @@ -7,35 +7,23 @@ Now lets try with a jbuild project in the subdirectory: $ cd a-jbuild-proj && dune build version.ml --root=. File "jbuild", line 1, characters 0-0: - Warning: jbuild files are not allowed inside Dune 2.0 projects, please - convert this file to a dune file instead. + Error: jbuild files are no longer supported, please convert this file to a + dune file instead. Note: You can use "dune upgrade" to convert your project to dune. - File "jbuild", line 1, characters 0-18: - 1 | (jbuild_version 1) - ^^^^^^^^^^^^^^^^^^ - Error: 'jbuild_version' was deleted in version 1.0 of the dune language [1] Now lets try it from the current directory: $ dune build a-dune-proj/version.ml --root=. File "a-jbuild-proj/jbuild", line 1, characters 0-0: - Warning: jbuild files are not allowed inside Dune 2.0 projects, please - convert this file to a dune file instead. + Error: jbuild files are no longer supported, please convert this file to a + dune file instead. Note: You can use "dune upgrade" to convert your project to dune. - File "a-jbuild-proj/jbuild", line 1, characters 0-18: - 1 | (jbuild_version 1) - ^^^^^^^^^^^^^^^^^^ - Error: 'jbuild_version' was deleted in version 1.0 of the dune language [1] $ dune build a-jbuild-proj/version.ml --root=. File "a-jbuild-proj/jbuild", line 1, characters 0-0: - Warning: jbuild files are not allowed inside Dune 2.0 projects, please - convert this file to a dune file instead. + Error: jbuild files are no longer supported, please convert this file to a + dune file instead. Note: You can use "dune upgrade" to convert your project to dune. - File "a-jbuild-proj/jbuild", line 1, characters 0-18: - 1 | (jbuild_version 1) - ^^^^^^^^^^^^^^^^^^ - Error: 'jbuild_version' was deleted in version 1.0 of the dune language [1] diff --git a/test/blackbox-tests/test-cases/syntax-versioning/run.t b/test/blackbox-tests/test-cases/syntax-versioning/run.t index 4ce214785e0..9c3deabd4d3 100644 --- a/test/blackbox-tests/test-cases/syntax-versioning/run.t +++ b/test/blackbox-tests/test-cases/syntax-versioning/run.t @@ -12,13 +12,9 @@ $ echo '(jbuild_version 1)' > jbuild $ dune build File "jbuild", line 1, characters 0-0: - Warning: jbuild files are deprecated, please convert this file to a dune file - instead. + Error: jbuild files are no longer supported, please convert this file to a + dune file instead. Note: You can use "dune upgrade" to convert your project to dune. - File "jbuild", line 1, characters 0-18: - 1 | (jbuild_version 1) - ^^^^^^^^^^^^^^^^^^ - Error: 'jbuild_version' was deleted in version 1.0 of the dune language [1] $ rm -f jbuild diff --git a/test/blackbox-tests/test-cases/upgrader/run.t b/test/blackbox-tests/test-cases/upgrader/run.t index d8e91e9c301..d5b69bace67 100644 --- a/test/blackbox-tests/test-cases/upgrader/run.t +++ b/test/blackbox-tests/test-cases/upgrader/run.t @@ -2,10 +2,6 @@ Info: Creating file dune-project with this contents: | (lang dune 1.0) | (name foo) - File "jbuild", line 1, characters 0-0: - Warning: jbuild files are not allowed inside Dune 2.0 projects, please - convert this file to a dune file instead. - Note: You can use "dune upgrade" to convert your project to dune. Upgrading foo.opam... Upgrading jbuild.inc to dune.inc... Upgrading jbuild to dune... @@ -16,13 +12,16 @@ ; (rule - (deps x y z) ; abc + (deps + (:< x) + y + z) ; abc (targets z) ; def (action (with-stdout-to z - (run echo ${<}))) + (run echo %{<}))) (mode fallback)) ; other @@ -38,10 +37,11 @@ $ cat dune.inc (rule - (deps a) + (deps + (:< a)) (targets b) (action - (copy ${<} ${@}))) + (copy %{<} %{targets}))) $ cat foo.opam build: [ diff --git a/test/expect-tests/dune_lang/dune b/test/expect-tests/dune_lang/dune index 6c67f0990d0..f8e210bb294 100644 --- a/test/expect-tests/dune_lang/dune +++ b/test/expect-tests/dune_lang/dune @@ -5,6 +5,7 @@ dune_tests_common stdune dune_lang + jbuild_support ;; This is because of the (implicit_transitive_deps false) ;; in dune-project ppx_expect.config diff --git a/test/expect-tests/dune_lang/sexp_tests.ml b/test/expect-tests/dune_lang/sexp_tests.ml index 6e9f4e23c20..5fcd40c8d9f 100644 --- a/test/expect-tests/dune_lang/sexp_tests.ml +++ b/test/expect-tests/dune_lang/sexp_tests.ml @@ -81,7 +81,7 @@ let parse s = | User_error.E msg -> Error (string_of_user_error msg) | e -> Error (Printexc.to_string e) in - let jbuild = f ~lexer:Dune_lang.Lexer.jbuild_token in + let jbuild = f ~lexer:Jbuild_support.Lexer.token in let dune = f ~lexer:Dune_lang.Lexer.token in let res = if jbuild <> dune then @@ -268,13 +268,20 @@ let l x = Dune_lang.List x let var ?(syntax = Dune_lang.Template.Percent) ?payload name = { Dune_lang.Template.loc; name; payload; syntax } -type sexp = S of Dune_lang.File_syntax.t * Dune_lang.t +type syntax = + | Dune + | Jbuild + +type sexp = S of syntax * Dune_lang.t let dyn_of_sexp (S (syntax, dlang)) = let open Dyn.Encoder in constr "S" - [ Dyn.Encoder.pair Dune_lang.File_syntax.to_dyn Dune_lang.to_dyn - (syntax, dlang) + [ Dyn.Encoder.pair + (function + | Dune -> Variant ("Dune", []) + | Jbuild -> Variant ("Jbuild", [])) + Dune_lang.to_dyn (syntax, dlang) ] let print_sexp ppf (S (_, sexp)) = Dune_lang.Deprecated.pp ppf sexp @@ -303,7 +310,7 @@ let test syntax sexp = Dune_lang.parse_string s ~mode:Single ~fname:"" ~lexer: ( match syntax with - | Jbuild -> Dune_lang.Lexer.jbuild_token + | Jbuild -> Jbuild_support.Lexer.token | Dune -> Dune_lang.Lexer.token ) with | sexp' -> @@ -410,7 +417,7 @@ comment|# |} let%expect_test _ = - Dune_lang.Parser.parse_cst ~lexer:Dune_lang.Lexer.jbuild_token + Dune_lang.Parser.parse_cst ~lexer:Jbuild_support.Lexer.token (Lexing.from_string jbuild_file) |> List.map ~f:(Dune_lang.Cst.fetch_legacy_comments ~file_contents:jbuild_file) diff --git a/test/unit-tests/dune b/test/unit-tests/dune index 16b0820685e..f290f6df9c8 100644 --- a/test/unit-tests/dune +++ b/test/unit-tests/dune @@ -1,7 +1,7 @@ (executable (name sexp_tests) (modules sexp_tests) - (libraries stdune dune_lang)) + (libraries stdune dune_lang jbuild_support)) (alias (name runtest) diff --git a/test/unit-tests/sexp_tests.ml b/test/unit-tests/sexp_tests.ml index 5983c854f37..e112a637159 100644 --- a/test/unit-tests/sexp_tests.ml +++ b/test/unit-tests/sexp_tests.ml @@ -5,18 +5,19 @@ let () = Printexc.record_backtrace true (* Test that all strings of length <= 3 such that [Dune_lang.Atom.is_valid s] are recignized as atoms by the parser *) -let string_of_syntax (x : Dune_lang.File_syntax.t) = - match x with +type syntax = + | Dune + | Jbuild + +let string_of_syntax = function | Dune -> "dune" | Jbuild -> "jbuild" let () = - [ ( Dune_lang.File_syntax.Dune - , Dune_lang.Lexer.token - , fun s -> Dune_lang.Atom.is_valid s Dune ) + [ (Dune, Dune_lang.Lexer.token, fun s -> Dune_lang.Atom.is_valid s) ; ( Jbuild - , Dune_lang.Lexer.jbuild_token - , fun s -> Dune_lang.Atom.is_valid s Jbuild ) + , Jbuild_support.Lexer.token + , fun s -> Jbuild_support.Atom.is_valid s ) ] |> List.iter ~f:(fun (syntax, lexer, validator) -> for len = 0 to 3 do @@ -39,7 +40,7 @@ let () = | Atom _ -> true | _ -> false in - let valid_dune_atom = validator (Dune_lang.Atom.of_string s) in + let valid_dune_atom = validator s in if valid_dune_atom <> parser_recognizes_as_atom then ( Printf.eprintf "Dune_lang.Atom.is_valid error:\n\