Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add an 'exec' label to execute include OCaml blocks #450

Draft
wants to merge 1 commit into
base: main
Choose a base branch
from
Draft

Add an 'exec' label to execute include OCaml blocks #450

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
90 changes: 69 additions & 21 deletions lib/block.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,16 @@ let locate_errors ~loc r =
(fun l -> List.map (fun (`Msg m) -> `Msg (locate_error_msg ~loc m)) l)
r

module OCaml_kind = struct
type t = Impl | Intf

let infer_from_file file =
match Filename.(remove_extension (basename file), extension file) with
| _, (".ml" | ".mlt" | ".eliom") -> Some Impl
| _, (".mli" | ".eliomi") -> Some Intf
| _ -> None
end

module Header = struct
type t = Shell of [ `Sh | `Bash ] | OCaml | Other of string

Expand Down Expand Up @@ -85,7 +95,14 @@ type ocaml_value = {
}

type toplevel_value = { env : Ocaml_env.t; non_det : Label.non_det option }
type include_ocaml_file = { part_included : string option }

type include_ocaml_file = {
part_included : string option;
ocaml_value : ocaml_value option;
kind : OCaml_kind.t;
exec : bool;
}

type include_other_file = { header : Header.t option }

type include_file_kind =
Expand Down Expand Up @@ -118,6 +135,12 @@ type t = {
value : value;
}

let get_ocaml_value t =
match t.value with
| OCaml ocaml_value -> Some ocaml_value
| Include { file_kind = Fk_ocaml { ocaml_value; _ }; _ } -> ocaml_value
| _ -> None

let dump_section = Fmt.(Dump.pair int string)

let header t =
Expand Down Expand Up @@ -190,24 +213,22 @@ let pp_error ?syntax ?delim ppf outputs =
outputs err_delim
| _ -> ()

let has_output t =
match t.value with
| OCaml { errors = []; _ } -> false
| OCaml { errors = _; _ } -> true
let has_errors t =
match get_ocaml_value t with
| Some { errors = _ :: _; _ } -> true
| _ -> false

let pp_value ?syntax ppf t =
let delim = t.delim in
match t.value with
| OCaml { errors = []; _ } -> ()
| OCaml { errors; _ } ->
match get_ocaml_value t with
| Some { errors; _ } ->
let errors = error_padding errors in
pp_error ?syntax ?delim ppf errors
| _ -> ()

let pp_footer ?syntax ppf t =
let delim =
if has_output t then (
if has_errors t then (
pp_value ?syntax ppf t;
None)
else t.delim
Expand Down Expand Up @@ -288,6 +309,13 @@ let non_det t =
| Include _ | Raw _ -> None

let skip t = t.skip

let exec t =
match t.value with
| Include { file_kind = Fk_ocaml { exec; _ }; _ } -> exec
| Include _ | Raw _ -> false
| _ -> true

let set_variables t = t.set_variables
let unset_variables t = t.unset_variables
let value t = t.value
Expand Down Expand Up @@ -349,6 +377,7 @@ type block_config = {
env : string option;
dir : string option;
skip : bool;
exec : bool;
version : (Label.Relation.t * Ocaml_version.t) option;
os_type : (Label.Relation.t * string) option;
set_variables : (string * string) list;
Expand All @@ -369,6 +398,7 @@ let get_block_config l =
env = get_label (function Env x -> Some x | _ -> None) l;
dir = get_label (function Dir x -> Some x | _ -> None) l;
skip = List.exists (function Label.Skip -> true | _ -> false) l;
exec = List.exists (function Label.Exec -> true | _ -> false) l;
version = get_label (function Version (x, y) -> Some (x, y) | _ -> None) l;
os_type = get_label (function Os_type (x, y) -> Some (x, y) | _ -> None) l;
set_variables =
Expand All @@ -378,13 +408,16 @@ let get_block_config l =
file_inc = get_label (function File x -> Some x | _ -> None) l;
}

let mk_ocaml_value env non_det errors header =
{ env = Ocaml_env.mk env; non_det; errors; header }

let mk_ocaml ~loc ~config ~header ~contents ~errors =
let kind = "OCaml" in
match config with
| { file_inc = None; part = None; env; non_det; _ } -> (
(* TODO: why does this call guess_ocaml_kind when infer_block already did? *)
match guess_ocaml_kind contents with
| `Code -> Ok (OCaml { env = Ocaml_env.mk env; non_det; errors; header })
| `Code -> Ok (OCaml (mk_ocaml_value env non_det errors header))
| `Toplevel ->
loc_error ~loc "toplevel syntax is not allowed in OCaml blocks.")
| { file_inc = Some _; _ } -> label_not_allowed ~loc ~label:"file" ~kind
Expand Down Expand Up @@ -422,23 +455,38 @@ let mk_toplevel ~loc ~config ~contents ~errors =
let mk_include ~loc ~config ~header ~errors =
let kind = "include" in
match config with
| { file_inc = Some file_included; part; non_det = None; env = None; _ } -> (
let* () = check_no_errors ~loc errors in
match header with
| Some Header.OCaml ->
let file_kind = Fk_ocaml { part_included = part } in
| { file_inc = Some file_included; part; non_det; env; exec; _ } -> (
let kind =
match header with
| Some Header.OCaml -> `OCaml
| None -> (
match OCaml_kind.infer_from_file file_included with
| Some _ -> `OCaml
| None -> `Other)
| _ -> `Other
in
match kind with
| `OCaml ->
let kind =
Util.Option.value ~default:OCaml_kind.Impl
(OCaml_kind.infer_from_file file_included)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nitpick: Ocaml_kind.infer_from_file is called twice in a few lines... Maybe store the result in the `OCaml polymorphic variant?

(This would also remove the call to Option.value)

in
let part_included = part in
let ocaml_value =
match kind with
| Impl -> Some (mk_ocaml_value env non_det errors header)
| Intf -> None
in
let file_kind = Fk_ocaml { part_included; ocaml_value; kind; exec } in
Ok (Include { file_included; file_kind })
| _ -> (
| `Other -> (
match part with
| None ->
let file_kind = Fk_other { header } in
Ok (Include { file_included; file_kind })
| Some _ ->
label_not_allowed ~loc ~label:"part" ~kind:"non-OCaml include"))
| { file_inc = None; _ } -> label_required ~loc ~label:"file" ~kind
| { non_det = Some _; _ } ->
label_not_allowed ~loc ~label:"non-deterministic" ~kind
| { env = Some _; _ } -> label_not_allowed ~loc ~label:"env" ~kind

let infer_block ~loc ~config ~header ~contents ~errors =
match config with
Expand Down Expand Up @@ -523,12 +571,12 @@ let from_raw raw =
~delim:None

let is_active ?section:s t =
let active =
let active_section =
match s with
| Some p -> (
match t.section with
| Some s -> Re.execp (Re.Perl.compile_pat p) (snd s)
| None -> Re.execp (Re.Perl.compile_pat p) "")
| None -> true
in
active && t.version_enabled && t.os_type_enabled && not t.skip
active_section && t.version_enabled && t.os_type_enabled && not t.skip
10 changes: 10 additions & 0 deletions lib/block.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,10 @@

(** Code blocks headers. *)

module OCaml_kind : sig
type t = Impl | Intf
end

module Header : sig
type t = Shell of [ `Sh | `Bash ] | OCaml | Other of string

Expand Down Expand Up @@ -47,6 +51,9 @@ type include_ocaml_file = {
part_included : string option;
(** [part_included] is the part of the file to synchronize with.
If lines is not specified synchronize the whole file. *)
ocaml_value : ocaml_value option;
kind : OCaml_kind.t;
exec : bool;
}

type include_other_file = { header : Header.t option }
Expand Down Expand Up @@ -168,6 +175,9 @@ val unset_variables : t -> string list
val skip : t -> bool
(** [skip t] is true iff [skip] is in the labels of [t]. *)

val exec : t -> bool
(** [exec t] is true iff [exec] is in the labels of [t]. *)

val value : t -> value
(** [value t] is [t]'s value. *)

Expand Down
15 changes: 8 additions & 7 deletions lib/dep.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,14 +16,15 @@

type t = File of string | Dir of string

let of_block block =
let of_block b =
let open Block in
match (directory block, file block, skip block) with
| Some d, Some f, false -> Some (File (Filename.concat d f))
| Some d, None, false -> Some (Dir d)
| None, Some f, false -> Some (File f)
| None, None, false -> None
| _, _, true -> None
let block b = (not (skip b)) || exec b in
match (directory b, file b, block b) with
| Some d, Some f, true -> Some (File (Filename.concat d f))
| Some d, None, true -> Some (Dir d)
| None, Some f, true -> Some (File f)
| None, None, true -> None
| _, _, false -> None

let of_lines =
let open Document in
Expand Down
3 changes: 3 additions & 0 deletions lib/label.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,7 @@ type t =
| Part of string
| Env of string
| Skip
| Exec
| Non_det of non_det option
| Version of Relation.t * Ocaml_version.t
| Os_type of Relation.t * string
Expand All @@ -111,6 +112,7 @@ let pp ppf = function
| Part p -> Fmt.pf ppf "part=%s" p
| Env e -> Fmt.pf ppf "env=%s" e
| Skip -> Fmt.string ppf "skip"
| Exec -> Fmt.string ppf "exec"
| Non_det None -> Fmt.string ppf "non-deterministic"
| Non_det (Some Nd_output) -> Fmt.string ppf "non-deterministic=output"
| Non_det (Some Nd_command) -> Fmt.string ppf "non-deterministic=command"
Expand Down Expand Up @@ -159,6 +161,7 @@ let requires_eq_value ~label ~value f =
let interpret label value =
match label with
| "skip" -> doesnt_accept_value ~label ~value Skip
| "exec" -> doesnt_accept_value ~label ~value Exec
| "ocaml" -> doesnt_accept_value ~label ~value (Block_kind OCaml)
| "cram" -> doesnt_accept_value ~label ~value (Block_kind Cram)
| "toplevel" -> doesnt_accept_value ~label ~value (Block_kind Toplevel)
Expand Down
1 change: 1 addition & 0 deletions lib/label.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ type t =
| Part of string
| Env of string
| Skip
| Exec (** Only for include blocks. *)
| Non_det of non_det option
| Version of Relation.t * Ocaml_version.t
| Os_type of Relation.t * string
Expand Down
Loading
Loading