From 6bcc7a46caad1ce695f9141a099d3ae1758ae6b0 Mon Sep 17 00:00:00 2001 From: Nicolas Jeannerod Date: Sun, 17 Sep 2023 16:39:27 +0000 Subject: [PATCH] Bump topiary to follow latest version (#52) --- flake.lock | 274 +++++++++++++++++- flake.nix | 11 +- src/AST.ml | 18 +- src/AST.mli | 95 +++--- src/CST_to_AST.ml | 513 ++++++++++++++++++--------------- src/equality/located.ml | 2 - src/equality/nonLocated.ml | 1 - src/location.ml | 7 +- src/morsmall.ml | 6 +- src/printer/debug.ml | 6 +- src/printer/debugNonLocated.ml | 3 +- src/printer/json.ml | 2 - src/printer/jsonNonLocated.ml | 1 - src/printer/safe.ml | 386 ++++++++++++++++--------- src/utilities/testParser.ml | 92 +++--- src/utilities/testParser.mli | 10 +- tests/golden/golden.ml | 49 ++-- tests/qcheck/generator.ml | 282 ++++++++++-------- tests/qcheck/qcheck.ml | 115 +++++--- 19 files changed, 1171 insertions(+), 702 deletions(-) diff --git a/flake.lock b/flake.lock index 9d5f71c..cc89613 100644 --- a/flake.lock +++ b/flake.lock @@ -1,5 +1,45 @@ { "nodes": { + "advisory-db": { + "flake": false, + "locked": { + "lastModified": 1688825073, + "narHash": "sha256-fK2huTDGHJc/oZjZWhMZMAt1nQSuuY6p41Y2pudtJdM=", + "owner": "rustsec", + "repo": "advisory-db", + "rev": "5ceeefcbbabf4b510ef8ede121d6dc57d1a1f7f8", + "type": "github" + }, + "original": { + "owner": "rustsec", + "repo": "advisory-db", + "type": "github" + } + }, + "crane": { + "inputs": { + "flake-compat": "flake-compat_4", + "flake-utils": "flake-utils_4", + "nixpkgs": [ + "topiary", + "nixpkgs" + ], + "rust-overlay": "rust-overlay" + }, + "locked": { + "lastModified": 1688772518, + "narHash": "sha256-ol7gZxwvgLnxNSZwFTDJJ49xVY5teaSvF7lzlo3YQfM=", + "owner": "ipetkov", + "repo": "crane", + "rev": "8b08e96c9af8c6e3a2b69af5a7fa168750fcf88e", + "type": "github" + }, + "original": { + "owner": "ipetkov", + "repo": "crane", + "type": "github" + } + }, "flake-compat": { "flake": false, "locked": { @@ -48,6 +88,22 @@ "type": "github" } }, + "flake-compat_4": { + "flake": false, + "locked": { + "lastModified": 1673956053, + "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, "flake-parts": { "inputs": { "nixpkgs-lib": "nixpkgs-lib" @@ -132,6 +188,60 @@ "type": "github" } }, + "flake-utils_4": { + "inputs": { + "systems": "systems_2" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_5": { + "inputs": { + "systems": "systems_3" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_6": { + "inputs": { + "systems": "systems_4" + }, + "locked": { + "lastModified": 1681202837, + "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "cfacdce06f30d2b68473a46042957675eebb3401", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, "gitignore": { "inputs": { "nixpkgs": [ @@ -214,6 +324,21 @@ "type": "github" } }, + "nix-filter": { + "locked": { + "lastModified": 1687178632, + "narHash": "sha256-HS7YR5erss0JCaUijPeyg2XrisEb959FIct3n2TMGbE=", + "owner": "numtide", + "repo": "nix-filter", + "rev": "d90c75e8319d0dd9be67d933d8eb9d0894ec9174", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "nix-filter", + "type": "github" + } + }, "nixpkgs": { "locked": { "lastModified": 1686501370, @@ -298,6 +423,38 @@ "type": "github" } }, + "nixpkgs_2": { + "locked": { + "lastModified": 1688981480, + "narHash": "sha256-AYgIAotBA5C+55PjXKck8cpDgWYrUYsTMpMxH1bZ7/M=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "b9ebd80c7dbcdec2240c5baae334365eaf3d7230", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1681358109, + "narHash": "sha256-eKyxW4OohHQx9Urxi7TQlFBTDWII+F+x2hklDOQPB50=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "96ba1c52e54e74c3197f4d43026b3f3d92e83ff9", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, "opam-nix": { "inputs": { "flake-compat": "flake-compat_2", @@ -432,7 +589,54 @@ "morbig": "morbig", "nixpkgs": "nixpkgs", "opam-nix": "opam-nix", - "pre-commit-hooks": "pre-commit-hooks_2" + "pre-commit-hooks": "pre-commit-hooks_2", + "topiary": "topiary" + } + }, + "rust-overlay": { + "inputs": { + "flake-utils": [ + "topiary", + "crane", + "flake-utils" + ], + "nixpkgs": [ + "topiary", + "crane", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1688351637, + "narHash": "sha256-CLTufJ29VxNOIZ8UTg0lepsn3X03AmopmaLTTeHDCL4=", + "owner": "oxalica", + "repo": "rust-overlay", + "rev": "f9b92316727af9e6c7fee4a761242f7f46880329", + "type": "github" + }, + "original": { + "owner": "oxalica", + "repo": "rust-overlay", + "type": "github" + } + }, + "rust-overlay_2": { + "inputs": { + "flake-utils": "flake-utils_6", + "nixpkgs": "nixpkgs_3" + }, + "locked": { + "lastModified": 1689042658, + "narHash": "sha256-p7cQAFNt5kX19sZvK74CmY0nTrtujpZg6sZUiV1ntAk=", + "owner": "oxalica", + "repo": "rust-overlay", + "rev": "d7181bb2237035df17cab9295c95f987f5c527e6", + "type": "github" + }, + "original": { + "owner": "oxalica", + "repo": "rust-overlay", + "type": "github" } }, "systems": { @@ -449,6 +653,74 @@ "repo": "default", "type": "github" } + }, + "systems_2": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, + "systems_3": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, + "systems_4": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, + "topiary": { + "inputs": { + "advisory-db": "advisory-db", + "crane": "crane", + "flake-utils": "flake-utils_5", + "nix-filter": "nix-filter", + "nixpkgs": "nixpkgs_2", + "rust-overlay": "rust-overlay_2" + }, + "locked": { + "lastModified": 1694704701, + "narHash": "sha256-DcmrQ8IuvUBDCBKKSt13k8rU8DJZWFC8MvxWB7dwiQM=", + "owner": "tweag", + "repo": "topiary", + "rev": "7e6cb4f8b505eacee57aaf3c1ab0f3cf539da159", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "topiary", + "type": "github" + } } }, "root": "root", diff --git a/flake.nix b/flake.nix index 61707bb..03e52b3 100644 --- a/flake.nix +++ b/flake.nix @@ -15,6 +15,8 @@ pre-commit-hooks.inputs.nixpkgs.follows = "nixpkgs"; flake-parts.url = "github:hercules-ci/flake-parts"; + + topiary.url = "github:tweag/topiary"; }; outputs = inputs@{ flake-parts, ... }: @@ -28,13 +30,14 @@ inputs.pre-commit-hooks.flakeModule ]; - perSystem = { self', pkgs, config, ... }: { + perSystem = { self', inputs', pkgs, config, ... }: { formatter = pkgs.nixfmt; packages.default = self'.packages.with-nixpkgs; devShells.default = pkgs.mkShell { - buildInputs = (with pkgs; [ headache topiary ]) + buildInputs = + (with pkgs; [ headache inputs'.topiary.packages.default ]) ++ (with pkgs.ocamlPackages; [ ocaml-lsp ocp-indent ]); inputsFrom = [ self'.packages.default ]; shellHook = config.pre-commit.installationScript; @@ -47,7 +50,9 @@ dune-opam-sync.enable = true; opam-lint.enable = true; checkmake.enable = true; - topiary.enable = true; + topiary-latest = inputs'.topiary.lib.pre-commit-hook // { + types = [ "ocaml" ]; + }; }; }; diff --git a/src/AST.ml b/src/AST.ml index 8411013..d65b8af 100644 --- a/src/AST.ml +++ b/src/AST.ml @@ -92,13 +92,13 @@ and case_item = pattern' * command' option and case_item' = case_item located and kind = - | Output (* > *) + | Output (* > *) | OutputDuplicate (* >& *) - | OutputAppend (* >> *) - | OutputClobber (* >| *) - | Input (* < *) - | InputDuplicate (* <& *) - | InputOutput (* <> *) + | OutputAppend (* >> *) + | OutputClobber (* >| *) + | Input (* < *) + | InputDuplicate (* <& *) + | InputOutput (* <> *) (* Smart constructors *) @@ -124,7 +124,7 @@ let wUnquoted str = let wSingleQuoted str = WSingleQuoted str -let wVariable ?(attribute=noAttribute) name = +let wVariable ?(attribute = noAttribute) name = WVariable (name, attribute) let wSubshell program = @@ -167,7 +167,7 @@ let program commands = commands (** {3 Commands} *) -let simple ?(assignments=[]) words = +let simple ?(assignments = []) words = if assignments = [] && words = [] then failwith "simple: assignments and words cannot both be empty"; Simple (assignments, words) @@ -189,7 +189,7 @@ let function_ name body = Function (name, body) let redirection ?around descr kind target = Redirection (around, descr, kind, target) -let hereDocument ?around ?(delimiter=[wUnquoted "EOF"]) descr content = +let hereDocument ?around ?(delimiter = [wUnquoted "EOF"]) descr content = List.iter ( function diff --git a/src/AST.mli b/src/AST.mli index 7de259d..29e1b9f 100644 --- a/src/AST.mli +++ b/src/AST.mli @@ -34,7 +34,8 @@ type name = string (** The type {!word} is a description of words in Shell. {e See POSIX, 2 Shell & Utilities, 2.3 Token Recognition} *) -and attribute = private +and attribute = + private | NoAttribute | ParameterLength | UseDefaultValues of word * bool @@ -46,7 +47,8 @@ and attribute = private | RemoveSmallestPrefixPattern of word | RemoveLargestPrefixPattern of word -and word_component = private +and word_component = + private | WTildePrefix of string | WUnquoted of string | WSingleQuoted of string @@ -193,33 +195,33 @@ and descr = int and program = command' list and command = private - (* Simple Commands *) - | Simple of assignment' list * word' list - - (* Lists *) - | Async of command' - | Seq of command' * command' - | And of command' * command' - | Or of command' * command' - - (* Pipelines *) - | Not of command' - | Pipe of command' * command' - - (* Compound Command's *) - | Subshell of command' - | For of name * word' list option * command' - | Case of word' * case_item' list - | If of command' * command' * command' option - | While of command' * command' - | Until of command' * command' - - (* Function Definition Command' *) - | Function of name * command' - - (* Redirection *) - | Redirection of command' option * descr * kind * word' - | HereDocument of command' option * descr * word * word' +(* Simple Commands *) +| Simple of assignment' list * word' list + +(* Lists *) +| Async of command' +| Seq of command' * command' +| And of command' * command' +| Or of command' * command' + +(* Pipelines *) +| Not of command' +| Pipe of command' * command' + +(* Compound Command's *) +| Subshell of command' +| For of name * word' list option * command' +| Case of word' * case_item' list +| If of command' * command' * command' option +| While of command' * command' +| Until of command' * command' + +(* Function Definition Command' *) +| Function of name * command' + +(* Redirection *) +| Redirection of command' option * descr * kind * word' +| HereDocument of command' option * descr * word * word' and command' = command located @@ -227,14 +229,15 @@ and case_item = pattern' * command' option and case_item' = case_item located -and kind = private - | Output (* > *) +and kind = + private + | Output (* > *) | OutputDuplicate (* >& *) - | OutputAppend (* >> *) - | OutputClobber (* >| *) - | Input (* < *) - | InputDuplicate (* <& *) - | InputOutput (* <> *) + | OutputAppend (* >> *) + | OutputClobber (* >| *) + | Input (* < *) + | InputDuplicate (* <& *) + | InputOutput (* <> *) (** {2 Smart Constructors} *) @@ -242,10 +245,10 @@ and kind = private val noAttribute : attribute val parameterLength : attribute -val useDefaultValues : also_for_null:bool -> word -> attribute -val assignDefaultValues : also_for_null:bool -> word -> attribute -val indicateErrorifNullorUnset : also_for_null:bool -> word -> attribute -val useAlternativeValue : also_for_null:bool -> word -> attribute +val useDefaultValues : also_for_null: bool -> word -> attribute +val assignDefaultValues : also_for_null: bool -> word -> attribute +val indicateErrorifNullorUnset : also_for_null: bool -> word -> attribute +val useAlternativeValue : also_for_null: bool -> word -> attribute val removeSmallestSuffixPattern : word -> attribute val removeLargestSuffixPattern : word -> attribute val removeSmallestPrefixPattern : word -> attribute @@ -254,7 +257,7 @@ val removeLargestPrefixPattern : word -> attribute val wTildePrefix : string -> word_component val wUnquoted : string -> word_component val wSingleQuoted : string -> word_component -val wVariable : ?attribute:attribute -> name -> word_component +val wVariable : ?attribute: attribute -> name -> word_component val wSubshell : program -> word_component val wGlobAll : word_component val wGlobAny : word_component @@ -265,7 +268,7 @@ val word : word_component list -> word (** {3 Commands} *) -val simple : ?assignments:assignment' list -> word' list -> command +val simple : ?assignments: assignment' list -> word' list -> command val async : command' -> command val seq : command' -> command' -> command val and_ : command' -> command' -> command @@ -273,18 +276,18 @@ val or_ : command' -> command' -> command val not_ : command' -> command val pipe : command' -> command' -> command val subshell : command' -> command -val for_ : name -> ?words:word' list -> command' -> command +val for_ : name -> ?words: word' list -> command' -> command val case : word' -> case_item' list -> command -val if_ : then_:command' -> ?else_:command' -> command' -> command +val if_ : then_: command' -> ?else_: command' -> command' -> command val while_ : command' -> command' -> command val until : command' -> command' -> command val function_ : name -> command' -> command -val redirection : ?around:command' -> descr -> kind -> word' -> command +val redirection : ?around: command' -> descr -> kind -> word' -> command (** [hereDocument c d w] creates a here-document redirection around [c], about descriptor [d] and containing the word [w]. The last newline must not be included. *) -val hereDocument : ?around:command' -> ?delimiter:word -> descr -> word' -> command +val hereDocument : ?around: command' -> ?delimiter: word -> descr -> word' -> command (** {3 Others} *) diff --git a/src/CST_to_AST.ml b/src/CST_to_AST.ml index 77a8aae..fa5d29f 100644 --- a/src/CST_to_AST.ml +++ b/src/CST_to_AST.ml @@ -23,25 +23,24 @@ open Morbig.CST (* Helpers about locations. *) -let convert_location : 'a 'b. ('a -> 'b) -> 'a located -> 'b Location.located = - fun f loc -> { value = f loc.value ; position = loc.position } +let convert_location : 'a 'b. ('a -> 'b) -> 'a located -> 'b Location.located = fun f loc -> + { value = f loc.value; position = loc.position } -let convert_location_2 : 'a 'b 'c. ('a -> 'b -> 'c) -> 'a located -> 'b -> 'c Location.located = - fun f loc x -> - { value = f loc.value x ; position = loc.position } +let convert_location_2 : 'a 'b 'c. ('a -> 'b -> 'c) -> 'a located -> 'b -> 'c Location.located = fun f loc x -> + { value = f loc.value x; position = loc.position } -let erase_location : 'a 'b. ('a -> 'b) -> 'a located -> 'b = - fun f x -> f x.value +let erase_location : 'a 'b. ('a -> 'b) -> 'a located -> 'b = fun f x -> + f x.value let rec list_bd = function | [] -> failwith "list_bd" | [_] -> [] - | h::t -> h :: list_bd t + | h :: t -> h :: list_bd t let rec list_ft_opt = function | [] -> None | [x] -> Some x - | _::t -> list_ft_opt t + | _ :: t -> list_ft_opt t let assert_remove_last_newline_from_word word = (* NOTE: Necessary for as long as Morbig will generate newlines at the end of @@ -61,9 +60,9 @@ let assert_remove_last_newline_from_word word = let rec program__to__program = function | Program_LineBreak_CompleteCommands_LineBreak (_, complete_commands', _) -> - complete_commands'__to__command'_list complete_commands' + complete_commands'__to__command'_list complete_commands' | Program_LineBreak _ -> - [] + [] and program'__to__program (program' : program') : AST.program = erase_location program__to__program program' @@ -72,10 +71,10 @@ and program'__to__program (program' : program') : AST.program = and complete_commands__to__command_list = function | CompleteCommands_CompleteCommands_NewlineList_CompleteCommand (complete_commands', _, complete_command') -> - (complete_commands'__to__command'_list complete_commands') - @ [complete_command'__to__command' complete_command'] + (complete_commands'__to__command'_list complete_commands') @ + [complete_command'__to__command' complete_command'] | CompleteCommands_CompleteCommand complete_command' -> - [complete_command'__to__command' complete_command'] + [complete_command'__to__command' complete_command'] and complete_commands'__to__command'_list (complete_commands' : complete_commands') : AST.command' list = erase_location complete_commands__to__command_list complete_commands' @@ -84,10 +83,10 @@ and complete_commands'__to__command'_list (complete_commands' : complete_command and complete_command__to__command = function | CompleteCommand_CList_SeparatorOp (clist', sepop') -> - clist'__to__command' clist' - |> separator_op'__to__command sepop' + clist'__to__command' clist' + |> separator_op'__to__command sepop' | CompleteCommand_CList clist' -> - clist'__to__command clist' + clist'__to__command clist' and complete_command'__to__command' (complete_command' : complete_command') : AST.command' = convert_location complete_command__to__command complete_command' @@ -96,12 +95,14 @@ and complete_command'__to__command' (complete_command' : complete_command') : AS and clist__to__command : clist -> AST.command = function | CList_CList_SeparatorOp_AndOr (clist', sep_op', and_or') -> - AST.seq - (clist'__to__command' clist' - |> separator_op'__to__command' sep_op') - (and_or'__to__command' and_or') + AST.seq + ( + clist'__to__command' clist' + |> separator_op'__to__command' sep_op' + ) + (and_or'__to__command' and_or') | CList_AndOr and_or' -> - and_or'__to__command and_or' + and_or'__to__command and_or' and clist'__to__command (clist' : clist') : AST.command = erase_location clist__to__command clist' @@ -113,15 +114,15 @@ and clist'__to__command' (clist' : clist') : AST.command' = and and_or__to__command : and_or -> AST.command = function | AndOr_Pipeline pipeline' -> - pipeline'__to__command pipeline' + pipeline'__to__command pipeline' | AndOr_AndOr_AndIf_LineBreak_Pipeline (and_or', _, pipeline') -> - AST.and_ - (and_or'__to__command' and_or') - (pipeline'__to__command' pipeline') + AST.and_ + (and_or'__to__command' and_or') + (pipeline'__to__command' pipeline') | AndOr_AndOr_OrIf_LineBreak_Pipeline (and_or', _, pipeline') -> - AST.or_ - (and_or'__to__command' and_or') - (pipeline'__to__command' pipeline') + AST.or_ + (and_or'__to__command' and_or') + (pipeline'__to__command' pipeline') and and_or'__to__command (and_or' : and_or') : AST.command = erase_location and_or__to__command and_or' @@ -133,9 +134,9 @@ and and_or'__to__command' (and_or' : and_or') : AST.command' = and pipeline__to__command : pipeline -> AST.command = function | Pipeline_PipeSequence pipe_sequence' -> - pipe_sequence'__to__command pipe_sequence' + pipe_sequence'__to__command pipe_sequence' | Pipeline_Bang_PipeSequence pipe_sequence' -> - AST.not_ (pipe_sequence'__to__command' pipe_sequence') + AST.not_ (pipe_sequence'__to__command' pipe_sequence') and pipeline'__to__command (pipeline' : pipeline') : AST.command = erase_location pipeline__to__command pipeline' @@ -147,11 +148,11 @@ and pipeline'__to__command' (pipeline' : pipeline') : AST.command' = and pipe_sequence__to__command : pipe_sequence -> AST.command = function | PipeSequence_Command command' -> - command'__to__command command' + command'__to__command command' | PipeSequence_PipeSequence_Pipe_LineBreak_Command (pipe_sequence', _, command') -> - AST.pipe - (pipe_sequence'__to__command' pipe_sequence') - (command'__to__command' command') + AST.pipe + (pipe_sequence'__to__command' pipe_sequence') + (command'__to__command' command') and pipe_sequence'__to__command (pipe_sequence') : AST.command = erase_location pipe_sequence__to__command pipe_sequence' @@ -163,14 +164,14 @@ and pipe_sequence'__to__command' (pipe_sequence') : AST.command' = and command__to__command : command -> AST.command = function | Command_SimpleCommand simple_command' -> - simple_command'__to__command simple_command' + simple_command'__to__command simple_command' | Command_CompoundCommand compound_command' -> - compound_command'__to__command compound_command' + compound_command'__to__command compound_command' | Command_CompoundCommand_RedirectList (compound_command', redirect_list') -> - compound_command'__to__command' compound_command' - |> redirect_list'__to__command redirect_list' + compound_command'__to__command' compound_command' + |> redirect_list'__to__command redirect_list' | Command_FunctionDefinition function_definition' -> - function_definition'__to__command function_definition' + function_definition'__to__command function_definition' and command'__to__command (command' : command') : AST.command = erase_location command__to__command command' @@ -182,19 +183,19 @@ and command'__to__command' (command' : command') : AST.command' = and compound_command__to__command : compound_command -> AST.command = function | CompoundCommand_BraceGroup brace_group' -> - brace_group'__to__command brace_group' + brace_group'__to__command brace_group' | CompoundCommand_Subshell subshell' -> - subshell'__to__command subshell' + subshell'__to__command subshell' | CompoundCommand_ForClause for_clause' -> - for_clause'__to__command for_clause' + for_clause'__to__command for_clause' | CompoundCommand_CaseClause case_clause' -> - case_clause'__to__command case_clause' + case_clause'__to__command case_clause' | CompoundCommand_IfClause if_clause' -> - if_clause'__to__command if_clause' + if_clause'__to__command if_clause' | CompoundCommand_WhileClause while_clause' -> - while_clause'__to__command while_clause' + while_clause'__to__command while_clause' | CompoundCommand_UntilClause until_clause' -> - until_clause'__to__command until_clause' + until_clause'__to__command until_clause' and compound_command'__to__command (compound_command' : compound_command') : AST.command = erase_location compound_command__to__command compound_command' @@ -204,9 +205,9 @@ and compound_command'__to__command' (compound_command' : compound_command') : AS (* CST.subshell -> AST.command *) -and subshell__to__command : subshell -> AST.command = function +and subshell__to__command : subshell -> AST.command = function | Subshell_Lparen_CompoundList_Rparen compound_list' -> - AST.subshell (compound_list'__to__command' compound_list') + AST.subshell (compound_list'__to__command' compound_list') and subshell'__to__command (subshell' : subshell') : AST.command = erase_location subshell__to__command subshell' @@ -215,10 +216,10 @@ and subshell'__to__command (subshell' : subshell') : AST.command = and compound_list__to__command : compound_list -> AST.command = function | CompoundList_LineBreak_Term (_, term') -> - term'__to__command term' + term'__to__command term' | CompoundList_LineBreak_Term_Separator (_, term', sep') -> - term'__to__command' term' - |> separator'__to__command sep' + term'__to__command' term' + |> separator'__to__command sep' and compound_list'__to__command (compound_list' : compound_list') : AST.command = erase_location compound_list__to__command compound_list' @@ -230,12 +231,14 @@ and compound_list'__to__command' (compound_list' : compound_list') : AST.command and term__to__command : term -> AST.command = function | Term_Term_Separator_AndOr (term', sep', and_or') -> - AST.seq - (term'__to__command' term' - |> separator'__to__command' sep') - (and_or'__to__command' and_or') + AST.seq + ( + term'__to__command' term' + |> separator'__to__command' sep' + ) + (and_or'__to__command' and_or') | Term_AndOr and_or' -> - and_or'__to__command and_or' + and_or'__to__command and_or' and term'__to__command (term' : term') : AST.command = erase_location term__to__command term' @@ -254,12 +257,12 @@ and for_clause__to__command : for_clause -> AST.command = function | ForClause_For_Name_LineBreak_In_SequentialSep_DoGroup (name', _, _, do_group') -> AST.for_ (name'__to__name name') - ~words:[] + ~words: [] (do_group'__to__command' do_group') | ForClause_For_Name_LineBreak_In_WordList_SequentialSep_DoGroup (name', _, wordlist', _, do_group') -> AST.for_ (name'__to__name name') - ~words:(wordlist'__to__word'_list wordlist') + ~words: (wordlist'__to__word'_list wordlist') (do_group'__to__command' do_group') and for_clause'__to__command (for_clause' : for_clause') : AST.command = @@ -269,10 +272,10 @@ and for_clause'__to__command (for_clause' : for_clause') : AST.command = and wordlist__to__word'_list : wordlist -> AST.word' list = function | WordList_WordList_Word (wordlist', word') -> - (wordlist'__to__word'_list wordlist') - @ [word'__to__word' word'] + (wordlist'__to__word'_list wordlist') @ + [word'__to__word' word'] | WordList_Word word' -> - [word'__to__word' word'] + [word'__to__word' word'] and wordlist'__to__word'_list (wordlist' : wordlist') : AST.word' list = erase_location wordlist__to__word'_list wordlist' @@ -281,41 +284,43 @@ and wordlist'__to__word'_list (wordlist' : wordlist') : AST.word' list = and case_clause__to__command : case_clause -> AST.command = function | CaseClause_Case_Word_LineBreak_In_LineBreak_CaseList_Esac (word', _, _, case_list') -> - AST.case - (word'__to__word' word') - (case_list'__to__case_item'_list case_list') + AST.case + (word'__to__word' word') + (case_list'__to__case_item'_list case_list') | CaseClause_Case_Word_LineBreak_In_LineBreak_CaseListNS_Esac (word', _, _, case_list_ns') -> - AST.case - (word'__to__word' word' ) - (case_list_ns'__to__case_item'_list case_list_ns') + AST.case + (word'__to__word' word') + (case_list_ns'__to__case_item'_list case_list_ns') | CaseClause_Case_Word_LineBreak_In_LineBreak_Esac (word', _, _) -> - AST.case - (word'__to__word' word') - [] + AST.case + (word'__to__word' word') + [] and case_clause'__to__command (case_clause' : case_clause') : AST.command = erase_location case_clause__to__command case_clause' (* CST.case_list_ns -> AST.case list *) -and case_list_ns__to__case_item'_list : case_list_ns -> AST.case_item' list = function (*FIXME*) +and case_list_ns__to__case_item'_list : case_list_ns -> AST.case_item' list = function + (*FIXME*) | CaseListNS_CaseList_CaseItemNS (case_list', case_item_ns') -> - (case_list'__to__case_item'_list case_list') - @ [case_item_ns'__to__case_item' case_item_ns'] + (case_list'__to__case_item'_list case_list') @ + [case_item_ns'__to__case_item' case_item_ns'] | CaseListNS_CaseItemNS case_item_ns' -> - [case_item_ns'__to__case_item' case_item_ns'] + [case_item_ns'__to__case_item' case_item_ns'] and case_list_ns'__to__case_item'_list (case_list_ns' : case_list_ns') : AST.case_item' list = erase_location case_list_ns__to__case_item'_list case_list_ns' (* CST.case_list -> AST.case list *) -and case_list__to__case_item'_list : case_list -> AST.case_item' list = function (*FIXME*) +and case_list__to__case_item'_list : case_list -> AST.case_item' list = function + (*FIXME*) | CaseList_CaseList_CaseItem (case_list', case_item') -> - (case_list'__to__case_item'_list case_list') - @ [case_item'__to__case_item' case_item'] + (case_list'__to__case_item'_list case_list') @ + [case_item'__to__case_item' case_item'] | CaseList_CaseItem case_item' -> - [case_item'__to__case_item' case_item'] + [case_item'__to__case_item' case_item'] and case_list'__to__case_item'_list (case_list' : case_list') : AST.case_item' list = erase_location case_list__to__case_item'_list case_list' @@ -325,10 +330,10 @@ and case_list'__to__case_item'_list (case_list' : case_list') : AST.case_item' l and case_item_ns__to__case_item : case_item_ns -> AST.case_item = function | CaseItemNS_Pattern_Rparen_LineBreak (pattern', _) | CaseItemNS_Lparen_Pattern_Rparen_LineBreak (pattern', _) -> - (pattern'__to__pattern' pattern', None) + (pattern'__to__pattern' pattern', None) | CaseItemNS_Pattern_Rparen_CompoundList (pattern', compound_list') | CaseItemNS_Lparen_Pattern_Rparen_CompoundList (pattern', compound_list') -> - (pattern'__to__pattern' pattern', Some (compound_list'__to__command' compound_list')) + (pattern'__to__pattern' pattern', Some (compound_list'__to__command' compound_list')) and case_item_ns'__to__case_item' (case_item_ns' : case_item_ns') : AST.case_item' = convert_location case_item_ns__to__case_item case_item_ns' @@ -338,10 +343,10 @@ and case_item_ns'__to__case_item' (case_item_ns' : case_item_ns') : AST.case_ite and case_item__to__case_item : case_item -> AST.case_item = function | CaseItem_Pattern_Rparen_LineBreak_Dsemi_LineBreak (pattern', _, _) | CaseItem_Lparen_Pattern_Rparen_LineBreak_Dsemi_LineBreak (pattern', _, _) -> - (pattern'__to__pattern' pattern', None) + (pattern'__to__pattern' pattern', None) | CaseItem_Pattern_Rparen_CompoundList_Dsemi_LineBreak (pattern', compound_list', _) | CaseItem_Lparen_Pattern_Rparen_CompoundList_Dsemi_LineBreak (pattern', compound_list', _) -> - (pattern'__to__pattern' pattern', Some (compound_list'__to__command' compound_list')) + (pattern'__to__pattern' pattern', Some (compound_list'__to__command' compound_list')) and case_item'__to__case_item' (case_item' : case_item') : AST.case_item' = convert_location case_item__to__case_item case_item' @@ -350,10 +355,10 @@ and case_item'__to__case_item' (case_item' : case_item') : AST.case_item' = and pattern__to__pattern : pattern -> AST.pattern = function | Pattern_Word word' -> - [word'__to__word word'] + [word'__to__word word'] | Pattern_Pattern_Pipe_Word (pattern', word') -> - (pattern'__to__pattern pattern') - @ [word'__to__word word'] + (pattern'__to__pattern pattern') @ + [word'__to__word word'] and pattern'__to__pattern (pattern' : pattern') : AST.pattern = erase_location pattern__to__pattern pattern' @@ -367,12 +372,12 @@ and if_clause__to__command : if_clause -> AST.command = function | IfClause_If_CompoundList_Then_CompoundList_ElsePart_Fi (compound_list', compound_list2', else_part') -> AST.if_ (compound_list'__to__command' compound_list') - ~then_:(compound_list'__to__command' compound_list2') - ~else_:(else_part'__to__command' else_part') + ~then_: (compound_list'__to__command' compound_list2') + ~else_: (else_part'__to__command' else_part') | IfClause_If_CompoundList_Then_CompoundList_Fi (compound_list', compound_list2') -> AST.if_ (compound_list'__to__command' compound_list') - ~then_:(compound_list'__to__command' compound_list2') + ~then_: (compound_list'__to__command' compound_list2') and if_clause'__to__command (if_clause' : if_clause') : AST.command = erase_location if_clause__to__command if_clause' @@ -383,14 +388,14 @@ and else_part__to__command : else_part -> AST.command = function | ElsePart_Elif_CompoundList_Then_CompoundList (compound_list', compound_list2') -> AST.if_ (compound_list'__to__command' compound_list') - ~then_:(compound_list'__to__command' compound_list2') + ~then_: (compound_list'__to__command' compound_list2') | ElsePart_Elif_CompoundList_Then_CompoundList_ElsePart (compound_list', compound_list2', else_part') -> AST.if_ (compound_list'__to__command' compound_list') - ~then_:(compound_list'__to__command' compound_list2' ) - ~else_:(else_part'__to__command' else_part') + ~then_: (compound_list'__to__command' compound_list2') + ~else_: (else_part'__to__command' else_part') | ElsePart_Else_CompoundList compound_list' -> - compound_list'__to__command compound_list' + compound_list'__to__command compound_list' and else_part'__to__command' (else_part' : else_part') : AST.command' = convert_location else_part__to__command else_part' @@ -421,9 +426,9 @@ and until_clause'__to__command (until_clause' : until_clause') : AST.command = and function_definition__to__command : function_definition -> AST.command = function | FunctionDefinition_Fname_Lparen_Rparen_LineBreak_FunctionBody (fname', _, function_body') -> - AST.function_ - (fname'__to__name fname') - (function_body'__to__command' function_body') + AST.function_ + (fname'__to__name fname') + (function_body'__to__command' function_body') and function_definition'__to__command (function_definition' : function_definition') : AST.command = erase_location function_definition__to__command function_definition' @@ -432,10 +437,10 @@ and function_definition'__to__command (function_definition' : function_definitio and function_body__to__command : function_body -> AST.command = function | FunctionBody_CompoundCommand compound_command' -> - compound_command'__to__command compound_command' + compound_command'__to__command compound_command' | FunctionBody_CompoundCommand_RedirectList (compound_command', redirect_list') -> - compound_command'__to__command' compound_command' - |> redirect_list'__to__command redirect_list' + compound_command'__to__command' compound_command' + |> redirect_list'__to__command redirect_list' and function_body'__to__command' (function_body' : function_body') : AST.command' = convert_location function_body__to__command function_body' @@ -452,7 +457,7 @@ and fname'__to__name (fname' : fname') : AST.name = and brace_group__to__command : brace_group -> AST.command = function | BraceGroup_LBrace_CompoundList_RBrace compound_list' -> - compound_list'__to__command compound_list' + compound_list'__to__command compound_list' and brace_group'__to__command (brace_group' : brace_group') : AST.command = erase_location brace_group__to__command brace_group' @@ -461,7 +466,7 @@ and brace_group'__to__command (brace_group' : brace_group') : AST.command = and do_group__to__command : do_group -> AST.command = function | DoGroup_Do_CompoundList_Done compound_list' -> - compound_list'__to__command compound_list' + compound_list'__to__command compound_list' and do_group'__to__command' (do_group' : do_group') : AST.command' = convert_location do_group__to__command do_group' @@ -469,61 +474,69 @@ and do_group'__to__command' (do_group' : do_group') : AST.command' = (* CST.simple_command -> AST.command *) and simple_command'__to__command (simple_command' : simple_command') : AST.command = - let ( assignment'_list , word'_list , io_redirect'_list ) = + let (assignment'_list, word'_list, io_redirect'_list) = match simple_command'.value with | SimpleCommand_CmdPrefix_CmdWord_CmdSuffix (cmd_prefix', cmd_word', cmd_suffix') -> - (* Since we are sorting right-to-left, we need to sort the - suffix before the prefix. *) - let ( word'_list , io_redirect'_list ) = sort__cmd_suffix' [] [] cmd_suffix' in - let ( assignment_word'_list , io_redirect'_list ) = sort__cmd_prefix' [] io_redirect'_list cmd_prefix' in - ( - List.map assignment_word'__to__assignment' assignment_word'_list , - cmd_word'__to__word' cmd_word' :: List.map word'__to__word' word'_list , - io_redirect'_list - ) - + (* Since we are sorting right-to-left, we need to sort the + suffix before the prefix. *) + let (word'_list, io_redirect'_list) = sort__cmd_suffix' [] [] cmd_suffix' in + let (assignment_word'_list, io_redirect'_list) = sort__cmd_prefix' [] io_redirect'_list cmd_prefix' in + ( + List.map assignment_word'__to__assignment' assignment_word'_list, + cmd_word'__to__word' cmd_word' :: List.map word'__to__word' word'_list, + io_redirect'_list + ) | SimpleCommand_CmdPrefix_CmdWord (cmd_prefix', cmd_word') -> - let ( assignment_word'_list , io_redirect'_list ) = sort__cmd_prefix' [] [] cmd_prefix' in - ( - List.map assignment_word'__to__assignment' assignment_word'_list , - cmd_word'__to__word' cmd_word' :: [] , - io_redirect'_list - ) - + let (assignment_word'_list, io_redirect'_list) = sort__cmd_prefix' [] [] cmd_prefix' in + ( + List.map assignment_word'__to__assignment' assignment_word'_list, + cmd_word'__to__word' cmd_word' :: [], + io_redirect'_list + ) | SimpleCommand_CmdPrefix cmd_prefix' -> - let ( assignment_word'_list , io_redirect'_list ) = sort__cmd_prefix' [] [] cmd_prefix' in - ( List.map assignment_word'__to__assignment' assignment_word'_list , - [] , - io_redirect'_list ) - + let (assignment_word'_list, io_redirect'_list) = sort__cmd_prefix' [] [] cmd_prefix' in + ( + List.map assignment_word'__to__assignment' assignment_word'_list, + [], + io_redirect'_list + ) | SimpleCommand_CmdName_CmdSuffix (cmd_name', cmd_suffix') -> - let ( word'_list , io_redirect'_list ) = sort__cmd_suffix' [] [] cmd_suffix' in - ( [] , - cmd_name'__to__word' cmd_name' :: List.map word'__to__word' word'_list , - io_redirect'_list ) - + let (word'_list, io_redirect'_list) = sort__cmd_suffix' [] [] cmd_suffix' in + ( + [], + cmd_name'__to__word' cmd_name' :: List.map word'__to__word' word'_list, + io_redirect'_list + ) | SimpleCommand_CmdName cmd_name' -> - ( [] , - cmd_name'__to__word' cmd_name' :: [] , - [] ) + ( + [], + cmd_name'__to__word' cmd_name' :: [], + [] + ) in (* Because of the semantics of redirections, we need to handle that redirection list from right to left. *) List.fold_right ( fun io_redirect' command -> - Some - (io_redirect'__to__command - io_redirect' - (Option.map - (fun value -> { value; position = simple_command'.position }) - command)) + Some + ( + io_redirect'__to__command + io_redirect' + ( + Option.map + (fun value -> { value; position = simple_command'.position }) + command + ) + ) ) io_redirect'_list - (if assignment'_list = [] && word'_list = [] then - None - else - Some (AST.simple ~assignments:assignment'_list (word'_list))) + ( + if assignment'_list = [] && word'_list = [] then + None + else + Some (AST.simple ~assignments: assignment'_list (word'_list)) + ) |> Option.get (* Should always succeed because there cannot be no assignments, words and redirections at the same point. *) @@ -535,30 +548,38 @@ and simple_command'__to__command (simple_command' : simple_command') : AST.comma since we are converting right-to-left lists to left-to-right lists, we do not need a List.rev. *) -and sort__cmd_prefix (assignment_word'_acc : assignment_word' list) (io_redirect'_acc : io_redirect' list) (*FIXME: check order*) - : cmd_prefix -> assignment_word' list * io_redirect' list = function +and sort__cmd_prefix + (assignment_word'_acc : assignment_word' list) + (io_redirect'_acc : io_redirect' list) (*FIXME: check order*) + : cmd_prefix -> assignment_word' list * io_redirect' list + = function | CmdPrefix_IoRedirect io_redirect' -> - ( assignment_word'_acc , - io_redirect' :: io_redirect'_acc ) - + ( + assignment_word'_acc, + io_redirect' :: io_redirect'_acc + ) | CmdPrefix_CmdPrefix_IoRedirect (cmd_prefix', io_redirect') -> - sort__cmd_prefix' - assignment_word'_acc - (io_redirect' :: io_redirect'_acc) - cmd_prefix' - + sort__cmd_prefix' + assignment_word'_acc + (io_redirect' :: io_redirect'_acc) + cmd_prefix' | CmdPrefix_AssignmentWord assignment_word' -> - ( assignment_word' :: assignment_word'_acc , - io_redirect'_acc ) - + ( + assignment_word' :: assignment_word'_acc, + io_redirect'_acc + ) | CmdPrefix_CmdPrefix_AssignmentWord (cmd_prefix', assignment_word') -> - sort__cmd_prefix' - (assignment_word' :: assignment_word'_acc) - io_redirect'_acc - cmd_prefix' - -and sort__cmd_prefix' (assignment_word'_acc : assignment_word' list) (io_redirect'_acc : io_redirect' list) - (cmd_prefix' : cmd_prefix') : assignment_word' list * io_redirect' list = + sort__cmd_prefix' + (assignment_word' :: assignment_word'_acc) + io_redirect'_acc + cmd_prefix' + +and sort__cmd_prefix' + (assignment_word'_acc : assignment_word' list) + (io_redirect'_acc : io_redirect' list) + (cmd_prefix' : cmd_prefix') + : assignment_word' list * io_redirect' list + = sort__cmd_prefix assignment_word'_acc io_redirect'_acc cmd_prefix'.value (* CST.cmd_suffix -> CST.word' list * CST.io_redirect' list @@ -569,37 +590,45 @@ and sort__cmd_prefix' (assignment_word'_acc : assignment_word' list) (io_redirec converting right-to-left lists to left-to-right lists, we do not need a List.rev. *) -and sort__cmd_suffix (word'_acc : word' list) (io_redirect'_acc : io_redirect' list) - : cmd_suffix -> word' list * io_redirect' list = function +and sort__cmd_suffix + (word'_acc : word' list) + (io_redirect'_acc : io_redirect' list) + : cmd_suffix -> word' list * io_redirect' list + = function | CmdSuffix_IoRedirect io_redirect' -> - ( word'_acc , - io_redirect' :: io_redirect'_acc ) - + ( + word'_acc, + io_redirect' :: io_redirect'_acc + ) | CmdSuffix_CmdSuffix_IoRedirect (cmd_suffix', io_redirect') -> - sort__cmd_suffix' - word'_acc - (io_redirect' :: io_redirect'_acc) - cmd_suffix' - + sort__cmd_suffix' + word'_acc + (io_redirect' :: io_redirect'_acc) + cmd_suffix' | CmdSuffix_Word word' -> - ( word' :: word'_acc , - io_redirect'_acc ) - + ( + word' :: word'_acc, + io_redirect'_acc + ) | CmdSuffix_CmdSuffix_Word (cmd_suffix', word') -> - sort__cmd_suffix' - (word' :: word'_acc) - io_redirect'_acc - cmd_suffix' - -and sort__cmd_suffix' (word'_acc : word' list) (io_redirect'_acc : io_redirect' list) - (cmd_suffix' : cmd_suffix') : word' list * io_redirect' list = + sort__cmd_suffix' + (word' :: word'_acc) + io_redirect'_acc + cmd_suffix' + +and sort__cmd_suffix' + (word'_acc : word' list) + (io_redirect'_acc : io_redirect' list) + (cmd_suffix' : cmd_suffix') + : word' list * io_redirect' list + = sort__cmd_suffix word'_acc io_redirect'_acc cmd_suffix'.value (* CST.cmd_name -> AST.word *) and cmd_name__to__word : cmd_name -> AST.word = function | CmdName_Word word' -> - word'__to__word word' + word'__to__word word' and cmd_name'__to__word' (cmd_name' : cmd_name') : AST.word' = convert_location cmd_name__to__word cmd_name' @@ -608,7 +637,7 @@ and cmd_name'__to__word' (cmd_name' : cmd_name') : AST.word' = and cmd_word__to__word : cmd_word -> AST.word = function | CmdWord_Word word' -> - word'__to__word word' + word'__to__word word' and cmd_word'__to__word' (cmd_word' : cmd_word') : AST.word' = convert_location cmd_word__to__word cmd_word' @@ -618,14 +647,14 @@ and cmd_word'__to__word' (cmd_word' : cmd_word') : AST.word' = and redirect_list__to__command redirect_list (command' : AST.command') : AST.command = match redirect_list with | RedirectList_IoRedirect io_redirect' -> - command' - |> Option.some - |> io_redirect'__to__command io_redirect' + command' + |> Option.some + |> io_redirect'__to__command io_redirect' | RedirectList_RedirectList_IoRedirect (redirect_list', io_redirect') -> - command' - |> Option.some - |> io_redirect'__to__command' io_redirect' - |> redirect_list'__to__command redirect_list' (*FIXME: check order of the redirections*) + command' + |> Option.some + |> io_redirect'__to__command' io_redirect' + |> redirect_list'__to__command redirect_list' (*FIXME: check order of the redirections*) and redirect_list'__to__command (redirect_list' : redirect_list') (command' : AST.command') : AST.command = erase_location redirect_list__to__command redirect_list' command' @@ -635,35 +664,35 @@ and redirect_list'__to__command (redirect_list' : redirect_list') (command' : AS and io_redirect__to__command (io_redirect : io_redirect) (command'_option : AST.command' option) : AST.command = match io_redirect with | IoRedirect_IoFile io_file' -> - let kind, word' = io_file'__to__kind_word' io_file' in - AST.redirection - ?around:command'_option - (ASTUtils.default_redirection_descriptor kind) - kind - word' + let kind, word' = io_file'__to__kind_word' io_file' in + AST.redirection + ?around: command'_option + (ASTUtils.default_redirection_descriptor kind) + kind + word' | IoRedirect_IoNumber_IoFile (io_number, io_file') -> - let kind, word' = io_file'__to__kind_word' io_file' in - AST.redirection - ?around:command'_option - (io_number__to__int io_number) - kind - word' + let kind, word' = io_file'__to__kind_word' io_file' in + AST.redirection + ?around: command'_option + (io_number__to__int io_number) + kind + word' | IoRedirect_IoHere io_here' -> - let _strip, delimiter, word' = io_here'__to__strip_delim_word' io_here' in - (* FIXME: strip that word if needed *) - AST.hereDocument - ?around:command'_option - ~delimiter - 0 - (Location.map_located assert_remove_last_newline_from_word word') + let _strip, delimiter, word' = io_here'__to__strip_delim_word' io_here' in + (* FIXME: strip that word if needed *) + AST.hereDocument + ?around: command'_option + ~delimiter + 0 + (Location.map_located assert_remove_last_newline_from_word word') | IoRedirect_IoNumber_IoHere (io_number, io_here') -> - let _strip, delimiter, word' = io_here'__to__strip_delim_word' io_here' in - (* FIXME: strip that word if needed *) - AST.hereDocument - ?around:command'_option - ~delimiter - (io_number__to__int io_number) - (Location.map_located assert_remove_last_newline_from_word word') + let _strip, delimiter, word' = io_here'__to__strip_delim_word' io_here' in + (* FIXME: strip that word if needed *) + AST.hereDocument + ?around: command'_option + ~delimiter + (io_number__to__int io_number) + (Location.map_located assert_remove_last_newline_from_word word') and io_redirect'__to__command (io_redirect' : io_redirect') (command'_option : AST.command' option) : AST.command = erase_location io_redirect__to__command io_redirect' command'_option @@ -684,7 +713,7 @@ and io_file__to__kind_word' io_file = | IoFile_LessGreat_FileName filename' -> AST.inputOutput, filename' | IoFile_Clobber_FileName filename' -> AST.outputClobber, filename' in - ( kind , filename'__to__word' filename' ) + (kind, filename'__to__word' filename') and io_file'__to__kind_word' (io_file' : io_file') : AST.kind * AST.word' = erase_location io_file__to__kind_word' io_file' @@ -693,7 +722,7 @@ and io_file'__to__kind_word' (io_file' : io_file') : AST.kind * AST.word' = and filename__to__word' : filename -> AST.word' = function | Filename_Word word' -> - word'__to__word' word' + word'__to__word' word' and filename'__to__word' (filename' : filename') : AST.word' = erase_location filename__to__word' filename' @@ -702,16 +731,16 @@ and filename'__to__word' (filename' : filename') : AST.word' = and io_here__to__strip_delim_word' : io_here -> bool * AST.word * AST.word' = function | IoHere_DLess_HereEnd (here_end', word'_ref) -> - (false, here_end'__to__word here_end', word'__to__word' !word'_ref) + (false, here_end'__to__word here_end', word'__to__word' !word'_ref) | IoHere_DLessDash_HereEnd (here_end', word'_ref) -> - (true, here_end'__to__word here_end', word'__to__word' !word'_ref) + (true, here_end'__to__word here_end', word'__to__word' !word'_ref) and io_here'__to__strip_delim_word' (io_here' : io_here') : bool * AST.word * AST.word' = erase_location io_here__to__strip_delim_word' io_here' (* CST.here_end -> AST.word *) -and here_end__to__word (HereEnd_Word word' : here_end) : AST.word = +and here_end__to__word (HereEnd_Word word': here_end) : AST.word = (word'__to__word word') and here_end'__to__word (here_end' : here_end') : AST.word = @@ -737,9 +766,9 @@ and separator_op'__to__command' (sep_op' : separator_op') (command' : AST.comman and separator__to__command (sep : separator) (command' : AST.command') : AST.command = match sep with | Separator_SeparatorOp_LineBreak (sep_op', _) -> - separator_op'__to__command sep_op' command' + separator_op'__to__command sep_op' command' | Separator_NewLineList _ -> - command'.value + command'.value and separator'__to__command (sep' : separator') (command' : AST.command') : AST.command = erase_location separator__to__command sep' command' @@ -758,7 +787,7 @@ and sequential_sep__to__command _ (command : AST.command) : AST.command = and word__to__word : word -> AST.word = function | Word (_, word_cst) -> - word_cst__to__word word_cst + word_cst__to__word word_cst and word'__to__word (word' : word') : AST.word = erase_location word__to__word word' @@ -791,8 +820,8 @@ and word_component__to__word = function | WordLiteral literal -> [AST.wUnquoted literal] | WordAssignmentWord (Name name, Word (_, word_cst)) -> - [AST.wUnquoted name; AST.wUnquoted "="] - @ word_cst__to__word word_cst + [AST.wUnquoted name; AST.wUnquoted "="] @ + word_cst__to__word word_cst | WordSingleQuoted (Word (_, [WordLiteral literal])) -> [AST.wSingleQuoted literal] | WordSingleQuoted (Word (_, [])) -> @@ -804,7 +833,7 @@ and word_component__to__word = function | WordDoubleQuoted word -> [AST.wDoubleQuoted (word_double_quoted__to__word word)] | WordVariable (VariableAtom (name, variable_attribute)) -> - [AST.wVariable name ~attribute:(variable_attribute__to__attribute variable_attribute)] + [AST.wVariable name ~attribute: (variable_attribute__to__attribute variable_attribute)] | WordGlobAll -> [AST.wGlobAll] | WordGlobAny -> @@ -820,14 +849,16 @@ and word_component_double_quoted__to__word = function | WordSubshell (_, program') -> [AST.wSubshell (program'__to__program program')] | WordAssignmentWord (Name name, Word (_, word_cst)) -> - [AST.wUnquoted name; AST.wUnquoted "="] - @ word_cst_double_quoted__to__word word_cst + [AST.wUnquoted name; AST.wUnquoted "="] @ + word_cst_double_quoted__to__word word_cst | WordVariable (VariableAtom (name, variable_attribute)) -> - [AST.wVariable name ~attribute:(variable_attribute__to__attribute variable_attribute)] + [AST.wVariable name ~attribute: (variable_attribute__to__attribute variable_attribute)] | WordReBracketExpression _bracket_expression -> assert false (* FIXME: [AST.WBracketExpression] *) - | WordDoubleQuoted _ | WordSingleQuoted _ - | WordGlobAll | WordGlobAny -> + | WordDoubleQuoted _ + | WordSingleQuoted _ + | WordGlobAll + | WordGlobAny -> assert false and variable_attribute__to__attribute = function @@ -836,13 +867,13 @@ and variable_attribute__to__attribute = function | ParameterLength -> AST.parameterLength | UseDefaultValues (p, word) -> - AST.useDefaultValues ~also_for_null:(p.[0] = ':') (word__to__word word) + AST.useDefaultValues ~also_for_null: (p.[0] = ':') (word__to__word word) | AssignDefaultValues (p, word) -> - AST.assignDefaultValues ~also_for_null:(p.[0] = ':') (word__to__word word) + AST.assignDefaultValues ~also_for_null: (p.[0] = ':') (word__to__word word) | IndicateErrorifNullorUnset (p, word) -> - AST.indicateErrorifNullorUnset ~also_for_null:(p.[0] = ':') (word__to__word word) + AST.indicateErrorifNullorUnset ~also_for_null: (p.[0] = ':') (word__to__word word) | UseAlternativeValue (p, word) -> - AST.useAlternativeValue ~also_for_null:(p.[0] = ':') (word__to__word word) + AST.useAlternativeValue ~also_for_null: (p.[0] = ':') (word__to__word word) | RemoveSmallestSuffixPattern word -> AST.removeSmallestSuffixPattern (word__to__word word) | RemoveLargestSuffixPattern word -> @@ -863,13 +894,15 @@ and name'__to__name (name' : name') : AST.name = (* CST.assignment_word -> AST.assignment *) and assignment_word__to__assignment ((name, word) : assignment_word) : AST.assignment = - (name__to__name name, - word__to__word word) + ( + name__to__name name, + word__to__word word + ) and assignment_word'__to__assignment' (assignment_word' : assignment_word') : AST.assignment' = convert_location assignment_word__to__assignment assignment_word' (* CST.io_number -> AST.descr *) -and io_number__to__int = function +and io_number__to__int = function | IONumber io_number -> int_of_string io_number diff --git a/src/equality/located.ml b/src/equality/located.ml index 1e3d09b..e7acb30 100644 --- a/src/equality/located.ml +++ b/src/equality/located.ml @@ -22,7 +22,6 @@ type lexing_position = [%import: Location.lexing_position] and position = [%import: Location.position] and 'a located = [%import: 'a Location.located] - [@@deriving eq] type name = [%import: AST.name] @@ -42,5 +41,4 @@ and pattern' = [%import: AST.pattern'] and assignment' = [%import: AST.assignment'] and command' = [%import: AST.command'] and case_item' = [%import: AST.case_item'] - [@@deriving eq] diff --git a/src/equality/nonLocated.ml b/src/equality/nonLocated.ml index 804662f..b060040 100644 --- a/src/equality/nonLocated.ml +++ b/src/equality/nonLocated.ml @@ -42,5 +42,4 @@ and pattern' = [%import: AST.pattern'] and assignment' = [%import: AST.assignment'] and command' = [%import: AST.command'] and case_item' = [%import: AST.case_item'] - [@@deriving eq] diff --git a/src/location.ml b/src/location.ml index 4e202db..93d86b0 100644 --- a/src/location.ml +++ b/src/location.ml @@ -23,12 +23,11 @@ type lexing_position = [%import: Morbig.CST.lexing_position] and position = [%import: Morbig.CST.position] and 'a located = [%import: 'a Morbig.CST.located] -let locate ?(position=Morbig.CSTHelpers.dummy_position) value = +let locate ?(position = Morbig.CSTHelpers.dummy_position) value = { value; position } -let copy_location : 'a 'b. 'a located -> 'b -> 'b located = - fun located value -> - { value ; position = located.position } +let copy_location : 'a 'b. 'a located -> 'b -> 'b located = fun located value -> + { value; position = located.position } let on_located f v = f v.value diff --git a/src/morsmall.ml b/src/morsmall.ml index dfeb74b..0b6463c 100644 --- a/src/morsmall.ml +++ b/src/morsmall.ml @@ -32,9 +32,9 @@ let parse_file filename = try Morbig.parse_file filename with - | Errors.DuringParsing position - | Errors.DuringLexing (position, _) -> - raise (SyntaxError position) + | Errors.DuringParsing position + | Errors.DuringLexing (position, _) -> + raise (SyntaxError position) ) |> from_CST diff --git a/src/printer/debug.ml b/src/printer/debug.ml index 37c12e6..78788cc 100644 --- a/src/printer/debug.ml +++ b/src/printer/debug.ml @@ -22,8 +22,7 @@ type lexing_position = [%import: Location.lexing_position] and position = [%import: Location.position] and 'a located = [%import: 'a Location.located] - -[@@deriving show {with_path = false}] +[@@deriving show { with_path = false }] type name = [%import: AST.name] and attribute = [%import: AST.attribute] @@ -42,5 +41,4 @@ and pattern' = [%import: AST.pattern'] and assignment' = [%import: AST.assignment'] and command' = [%import: AST.command'] and case_item' = [%import: AST.case_item'] - -[@@deriving show {with_path = false}] +[@@deriving show { with_path = false }] diff --git a/src/printer/debugNonLocated.ml b/src/printer/debugNonLocated.ml index 665a4ee..7d9403f 100644 --- a/src/printer/debugNonLocated.ml +++ b/src/printer/debugNonLocated.ml @@ -42,5 +42,4 @@ and pattern' = [%import: AST.pattern'] and assignment' = [%import: AST.assignment'] and command' = [%import: AST.command'] and case_item' = [%import: AST.case_item'] - -[@@deriving show {with_path = false}] +[@@deriving show { with_path = false }] diff --git a/src/printer/json.ml b/src/printer/json.ml index ba8267b..4602dd6 100644 --- a/src/printer/json.ml +++ b/src/printer/json.ml @@ -22,7 +22,6 @@ type lexing_position = [%import: Location.lexing_position] and position = [%import: Location.position] and 'a located = [%import: 'a Location.located] - [@@deriving to_yojson] type name = [%import: AST.name] @@ -42,7 +41,6 @@ and pattern' = [%import: AST.pattern'] and assignment' = [%import: AST.assignment'] and command' = [%import: AST.command'] and case_item' = [%import: AST.case_item'] - [@@deriving to_yojson] let pp_program fmt program = diff --git a/src/printer/jsonNonLocated.ml b/src/printer/jsonNonLocated.ml index b9a105a..b9bbfdc 100644 --- a/src/printer/jsonNonLocated.ml +++ b/src/printer/jsonNonLocated.ml @@ -42,7 +42,6 @@ and pattern' = [%import: AST.pattern'] and assignment' = [%import: AST.assignment'] and command' = [%import: AST.command'] and case_item' = [%import: AST.case_item'] - [@@deriving to_yojson] let pp_program fmt program = diff --git a/src/printer/safe.ml b/src/printer/safe.ml index 6fa011f..b128c31 100644 --- a/src/printer/safe.ml +++ b/src/printer/safe.ml @@ -59,11 +59,11 @@ let expand_here_document_delimiter_literal ~double_quoted s = s; Buffer.contents buf -let rec expand_here_document_delimiter ?(double_quoted=false) = function +let rec expand_here_document_delimiter ?(double_quoted = false) = function | [] -> "" | WUnquoted lit :: rest -> expand_here_document_delimiter_literal ~double_quoted lit ^ expand_here_document_delimiter ~double_quoted rest | WSingleQuoted lit :: rest -> expand_here_document_delimiter_literal ~double_quoted lit ^ expand_here_document_delimiter ~double_quoted rest - | WDoubleQuoted word :: rest -> expand_here_document_delimiter ~double_quoted:true word ^ expand_here_document_delimiter ~double_quoted rest + | WDoubleQuoted word :: rest -> expand_here_document_delimiter ~double_quoted: true word ^ expand_here_document_delimiter ~double_quoted rest | _ -> assert false (* AST.name *) @@ -73,23 +73,24 @@ let rec pp_name ppf = (* AST.word_component *) -and pp_word_component ppf = function (*FIXME*) +and pp_word_component ppf = function + (*FIXME*) | WUnquoted literal -> - fpf ppf "%s" literal + fpf ppf "%s" literal | WSingleQuoted literal -> - fpf ppf "'%s'" literal + fpf ppf "'%s'" literal | WTildePrefix tilde_prefix -> fpf ppf "~%s" tilde_prefix | WDoubleQuoted word -> fpf ppf "\"%a\"" pp_word word | WSubshell command_list -> - fpf ppf "$(%a)" pp_command'_list command_list + fpf ppf "$(%a)" pp_command'_list command_list | WGlobAll -> - fpf ppf "*" + fpf ppf "*" | WGlobAny -> - fpf ppf "?" + fpf ppf "?" | WBracketExpression -> - assert false + assert false | WVariable (variable, NoAttribute) -> fpf ppf "${%s}" variable | WVariable (variable, ParameterLength) -> @@ -124,31 +125,43 @@ and pp_word' ppf word' = and pp_words ppf = function | [] -> () | [word] -> - pp_word ppf word + pp_word ppf word | word :: words -> - fpf ppf "%a %a" - pp_word word - pp_words words + fpf + ppf + "%a %a" + pp_word + word + pp_words + words and pp_words' ppf = function | [] -> () | [word'] -> - pp_word' ppf word' + pp_word' ppf word' | word' :: words' -> - fpf ppf "%a %a" - pp_word' word' - pp_words' words' + fpf + ppf + "%a %a" + pp_word' + word' + pp_words' + words' (* AST.pattern *) and pp_pattern ppf = function | [] -> () | [word] -> - pp_word ppf word + pp_word ppf word | word :: pattern -> - fpf ppf "%a|%a" - pp_word word - pp_pattern pattern + fpf + ppf + "%a|%a" + pp_word + word + pp_pattern + pattern and pp_pattern' ppf pattern' = Location.on_located (pp_pattern ppf) pattern' @@ -156,9 +169,13 @@ and pp_pattern' ppf pattern' = (* AST.assignement *) and pp_assignment ppf (variable, word) = - fpf ppf "%a=%a" - pp_name variable - pp_word word + fpf + ppf + "%a=%a" + pp_name + variable + pp_word + word and pp_assignment' ppf assignment' = Location.on_located (pp_assignment ppf) assignment' @@ -166,38 +183,58 @@ and pp_assignment' ppf assignment' = and pp_assignments ppf = function | [] -> () | [assignment] -> - pp_assignment ppf assignment + pp_assignment ppf assignment | assignment :: assignments -> - fpf ppf "%a %a" - pp_assignment assignment - pp_assignments assignments + fpf + ppf + "%a %a" + pp_assignment + assignment + pp_assignments + assignments and pp_assignments' ppf = function | [] -> () | [assignment'] -> - pp_assignment' ppf assignment' + pp_assignment' ppf assignment' | assignment' :: assignments' -> - fpf ppf "%a %a" - pp_assignment' assignment' - pp_assignments' assignments' + fpf + ppf + "%a %a" + pp_assignment' + assignment' + pp_assignments' + assignments' and pp_redirection_kind ppf k = - fpf ppf "%s" - (match k with - | Input -> "<" | InputDuplicate -> "<&" - | Output -> ">" | OutputDuplicate -> ">&" | OutputAppend -> ">>" - | InputOutput -> "<>" | OutputClobber -> ">|") + fpf + ppf + "%s" + ( + match k with + | Input -> "<" + | InputDuplicate -> "<&" + | Output -> ">" + | OutputDuplicate -> ">&" + | OutputAppend -> ">>" + | InputOutput -> "<>" + | OutputClobber -> ">|" + ) (* AST.program *) and pp_program ppf = function | [] -> () | [command'] -> - pp_command' ppf command' + pp_command' ppf command' | command' :: program -> - fpf ppf "%a@\n%a" - pp_command' command' - pp_program program + fpf + ppf + "%a@\n%a" + pp_command' + command' + pp_program + program (* AST.command *) @@ -205,123 +242,180 @@ and pp_command ppf (command : command) = fpf ppf "{ "; ( match command with - | Async command -> - pp_command' ppf command - + pp_command' ppf command | Seq (command1, command2) -> - fpf ppf "%a;%a" - pp_command' command1 - pp_command' command2 - + fpf + ppf + "%a;%a" + pp_command' + command1 + pp_command' + command2 | And (command1, command2) -> - fpf ppf "%a&&%a" - pp_command' command1 - pp_command' command2 - + fpf + ppf + "%a&&%a" + pp_command' + command1 + pp_command' + command2 | Or (command1, command2) -> - fpf ppf "%a||%a" - pp_command' command1 - pp_command' command2 - + fpf + ppf + "%a||%a" + pp_command' + command1 + pp_command' + command2 | Not command -> - fpf ppf "! %a" - pp_command' command - + fpf + ppf + "! %a" + pp_command' + command | Pipe (command1, command2) -> - fpf ppf "%a|%a" - pp_command' command1 - pp_command' command2 - + fpf + ppf + "%a|%a" + pp_command' + command1 + pp_command' + command2 | Subshell command -> - fpf ppf "(%a)" - pp_command' command - + fpf + ppf + "(%a)" + pp_command' + command | If (test, body, None) -> - fpf ppf "if %a;then %a;fi" - pp_command' test - pp_command' body - + fpf + ppf + "if %a;then %a;fi" + pp_command' + test + pp_command' + body | If (test, body, Some rest) -> - fpf ppf "if %a;then %a;else %a;fi" - pp_command' test - pp_command' body - pp_command' rest - + fpf + ppf + "if %a;then %a;else %a;fi" + pp_command' + test + pp_command' + body + pp_command' + rest | For (variable, None, body) -> - fpf ppf "for %a;do %a;done" - pp_name variable - pp_command' body - + fpf + ppf + "for %a;do %a;done" + pp_name + variable + pp_command' + body | For (variable, Some words, body) -> - fpf ppf "for %a in %a;do %a;done" - pp_name variable - pp_words' words - pp_command' body - + fpf + ppf + "for %a in %a;do %a;done" + pp_name + variable + pp_words' + words + pp_command' + body | Case (word, items) -> - fpf ppf "case %a in" pp_word' word; - List.iter - (fun item -> - match item.Location.value with - | (pattern, None) -> + fpf ppf "case %a in" pp_word' word; + List.iter + ( + fun item -> + match item.Location.value with + | (pattern, None) -> fpf ppf " %a) ;;" pp_pattern' pattern - | (pattern, Some body') -> - fpf ppf " %a) %a;;" pp_pattern' pattern pp_command' body') - items; - fpf ppf " esac" - + | (pattern, Some body') -> + fpf ppf " %a) %a;;" pp_pattern' pattern pp_command' body' + ) + items; + fpf ppf " esac" | While (test, body) -> - fpf ppf "while %a;do %a;done" - pp_command' test - pp_command' body - + fpf + ppf + "while %a;do %a;done" + pp_command' + test + pp_command' + body | Until (test, body) -> - fpf ppf "until %a;do %a;done" - pp_command' test - pp_command' body - + fpf + ppf + "until %a;do %a;done" + pp_command' + test + pp_command' + body | Function (name, body) -> - fpf ppf "%a()%a" - pp_name name - pp_command' body - + fpf + ppf + "%a()%a" + pp_name + name + pp_command' + body | Simple ([], []) -> - failwith "SafePrinter.pp_command': ill-formed command: Simple([], [])" + failwith "SafePrinter.pp_command': ill-formed command: Simple([], [])" | Simple ([], words) -> - fpf ppf "%a" pp_words' words + fpf ppf "%a" pp_words' words | Simple (assignments, words) -> - fpf ppf "%a %a" - pp_assignments' assignments - pp_words' words - + fpf + ppf + "%a %a" + pp_assignments' + assignments + pp_words' + words | Redirection (Some command, descr, kind, file) -> - (* The space is required because "the [descriptor] must be delimited from any preceding text". *) - fpf ppf "%a %d%a%a" - pp_command' command - descr - pp_redirection_kind kind - pp_word' file - + (* The space is required because "the [descriptor] must be delimited from any preceding text". *) + fpf + ppf + "%a %d%a%a" + pp_command' + command + descr + pp_redirection_kind + kind + pp_word' + file | Redirection (None, descr, kind, file) -> - fpf ppf "%d%a%a" - descr - pp_redirection_kind kind - pp_word' file - + fpf + ppf + "%d%a%a" + descr + pp_redirection_kind + kind + pp_word' + file | HereDocument (Some command, descr, delimiter, content) -> - fpf ppf "%a %d<<%a\n%a\n%s\n" - pp_command' command - descr - pp_word delimiter - pp_word' content - (expand_here_document_delimiter delimiter) + fpf + ppf + "%a %d<<%a\n%a\n%s\n" + pp_command' + command + descr + pp_word + delimiter + pp_word' + content + (expand_here_document_delimiter delimiter) | HereDocument (None, descr, delimiter, content) -> - fpf ppf "%d<<%a\n%a\n%s\n" - descr - pp_word delimiter - pp_word' content - (expand_here_document_delimiter delimiter) + fpf + ppf + "%d<<%a\n%a\n%s\n" + descr + pp_word + delimiter + pp_word' + content + (expand_here_document_delimiter delimiter) ); fpf ppf "%s}" (match command with Async _ -> "&" | HereDocument _ -> "" | _ -> ";") @@ -331,16 +425,24 @@ and pp_command' ppf command' = and pp_command_list ppf = function | [] -> () | [command] -> - pp_command ppf command + pp_command ppf command | command :: command_list -> - fpf ppf "%a@\n%a" - pp_command command - pp_command_list command_list + fpf + ppf + "%a@\n%a" + pp_command + command + pp_command_list + command_list and pp_command'_list ppf = function | [] -> () | [command'] -> pp_command' ppf command' | command' :: command'_list -> - fpf ppf "%a@\n%a" - pp_command' command' - pp_command'_list command'_list + fpf + ppf + "%a@\n%a" + pp_command' + command' + pp_command'_list + command'_list diff --git a/src/utilities/testParser.ml b/src/utilities/testParser.ml index 07e759d..8525d7e 100644 --- a/src/utilities/testParser.ml +++ b/src/utilities/testParser.ml @@ -23,27 +23,28 @@ type expression = | And of expression * expression - | Or of expression * expression + | Or of expression * expression | Not of expression - | Binary of string * string * string (* (op,arg_left,arg_right) *) - | Unary of string * string (* (op,arg) *) - | Single of string (* arg *) + | Binary of string * string * string (* (op,arg_left,arg_right) *) + | Unary of string * string (* (op,arg) *) + | Single of string (* arg *) exception Parse_error type token = - | UnOp of string (* unary operators -e, -f, etc. *) - | BinOp of string (* binary operators -eq, =, etc. *) - | AndOp (* -a *) - | OrOp (* -o *) - | NotOp (* ! *) - | ParL (* ( *) - | ParR (* ) *) - | BracketR (* ] *) - | String of string (* all the rest *) + | UnOp of string (* unary operators -e, -f, etc. *) + | BinOp of string (* binary operators -eq, =, etc. *) + | AndOp (* -a *) + | OrOp (* -o *) + | NotOp (* ! *) + | ParL (* ( *) + | ParR (* ) *) + | BracketR (* ] *) + | String of string (* all the rest *) | EOF -let to_token s = match s with +let to_token s = + match s with (* file existence and type *) | "-e" | "-d" | "-f" | "-b" | "-c" | "-h" | "-L" | "-p" | "-S" -> UnOp s (* file attributes *) @@ -62,13 +63,13 @@ let to_token s = match s with | "-t" -> UnOp s | "-a" -> AndOp | "-o" -> OrOp - | "(" -> ParL - | ")" -> ParR - | "]" -> BracketR - | "!" -> NotOp - | _ -> String s + | "(" -> ParL + | ")" -> ParR + | "]" -> BracketR + | "!" -> NotOp + | _ -> String s -let parse ?(bracket=false) wl = +let parse ?(bracket = false) wl = let tokenbuf = wl |> List.map Morbig.remove_quotes @@ -77,15 +78,14 @@ let parse ?(bracket=false) wl = in let lookup () = match !tokenbuf with - | h::_ -> h + | h :: _ -> h | [] -> EOF in let pop () = match !tokenbuf with - | _::r -> tokenbuf := r + | _ :: r -> tokenbuf := r | [] -> assert false in - let rec parse_S () = let exp = parse_S' () in if bracket then @@ -107,7 +107,7 @@ let parse ?(bracket=false) wl = let head = parse_conj () in match parse_disj' () with | None -> head - | Some rest -> Or (head,rest) + | Some rest -> Or (head, rest) and parse_disj' () = match lookup () with @@ -119,7 +119,7 @@ let parse ?(bracket=false) wl = let head = parse_literal () in match parse_conj' () with | None -> head - | Some rest -> And (head, rest) + | Some rest -> And (head, rest) and parse_conj' () = match lookup () with @@ -136,38 +136,44 @@ let parse ?(bracket=false) wl = and parse_atom () = match lookup () with | UnOp op -> - pop (); - (match lookup () with - | String s -> pop (); Unary (op,s) - | _ -> raise Parse_error) + pop (); + ( + match lookup () with + | String s -> pop (); Unary (op, s) + | _ -> raise Parse_error + ) | ParL -> - pop (); - let exp = parse_disj () in - (match lookup () with + pop (); + let exp = parse_disj () in + ( + match lookup () with | ParR -> pop (); exp - | _ -> raise Parse_error) + | _ -> raise Parse_error + ) | String s -> - pop (); - (match parse_atom' () with + pop (); + ( + match parse_atom' () with | None -> Single s - | Some (binop,rightarg) -> Binary (binop,s,rightarg)) + | Some (binop, rightarg) -> Binary (binop, s, rightarg) + ) | _ -> raise Parse_error and parse_atom' () = match lookup () with | AndOp | OrOp | EOF | BracketR -> None | BinOp binop -> - pop (); - (match lookup () with - | String rightarg | UnOp rightarg | BinOp rightarg - -> pop (); Some (binop,rightarg) - | _ -> raise Parse_error) + pop (); + ( + match lookup () with + | String rightarg | UnOp rightarg | BinOp rightarg -> + pop (); Some (binop, rightarg) + | _ -> raise Parse_error + ) | _ -> raise Parse_error in - parse_S () - (* grammar of test expressions: diff --git a/src/utilities/testParser.mli b/src/utilities/testParser.mli index 1e9a68f..d22d365 100644 --- a/src/utilities/testParser.mli +++ b/src/utilities/testParser.mli @@ -23,15 +23,15 @@ type expression = | And of expression * expression - | Or of expression * expression + | Or of expression * expression | Not of expression - | Binary of string * string * string (* (op,arg_left,arg_right) *) - | Unary of string * string (* (op,arg) *) - | Single of string (* arg *) + | Binary of string * string * string (* (op,arg_left,arg_right) *) + | Unary of string * string (* (op,arg) *) + | Single of string (* arg *) exception Parse_error (** [parse ~bracket wl] parses the list of words [wl] as a test expression (or [None] if [wl] is empty). If [bracket] is [true] then the last word of [wl] must be a right bracket. *) -val parse: ?bracket:bool -> string list -> expression option +val parse : ?bracket: bool -> string list -> expression option diff --git a/tests/golden/golden.ml b/tests/golden/golden.ml index c075f5e..e48f2ad 100644 --- a/tests/golden/golden.ml +++ b/tests/golden/golden.ml @@ -38,10 +38,12 @@ let bat_or_cat path = cat %s fi |} - (Filename.quote path) (Filename.quote path) + (Filename.quote path) + (Filename.quote path) let print_test_info ~name ~from_morbig = - pf "Test is:@\n@\n %s `%s`@\n@." + pf + "Test is:@\n@\n %s `%s`@\n@." (if from_morbig then "Morbig's" else "") name @@ -66,7 +68,8 @@ let with_formatter_to_file file f = close_out ochan let print_input_ast path ast = - with_formatter_to_file (Filename.concat path "input-ast.txt") + with_formatter_to_file + (Filename.concat path "input-ast.txt") (fun fmt -> Morsmall.pp_print_debug_noloc fmt ast); pf "Parsed AST is:@\n@."; bat_or_cat (Filename.concat path "input-ast.txt"); @@ -78,27 +81,29 @@ let print_output path = pf "@." let print_output_ast path ast = - with_formatter_to_file (Filename.concat path "output-ast.txt") + with_formatter_to_file + (Filename.concat path "output-ast.txt") (fun fmt -> Morsmall.pp_print_debug_noloc fmt ast); pf "Parsed AST is:@\n@."; bat_or_cat (Filename.concat path "output-ast.txt"); pf "@." let check_test_case ~from_morbig name path = fun () -> - print_test_info ~name ~from_morbig; - skip_if_no_input path; - print_input path; - let ast = Morsmall.parse_file (Filename.concat path "input.sh") in - print_input_ast path ast; - with_formatter_to_file (Filename.concat path "output.sh") - (fun fmt -> Morsmall.pp_print_safe fmt ast); - print_output path; - let ast2 = Morsmall.parse_file (Filename.concat path "output.sh") in - print_output_ast path ast2; - if not (Morsmall.equal_program_noloc ast ast2) then - ( - Alcotest.fail "The outputs are not equal" - ) + print_test_info ~name ~from_morbig; + skip_if_no_input path; + print_input path; + let ast = Morsmall.parse_file (Filename.concat path "input.sh") in + print_input_ast path ast; + with_formatter_to_file + (Filename.concat path "output.sh") + (fun fmt -> Morsmall.pp_print_safe fmt ast); + print_output path; + let ast2 = Morsmall.parse_file (Filename.concat path "output.sh") in + print_output_ast path ast2; + if not (Morsmall.equal_program_noloc ast ast2) then + ( + Alcotest.fail "The outputs are not equal" + ) let rec collect_test_paths name dir = List.flatten @@ -120,14 +125,16 @@ let rec collect_test_paths name dir = let morbig_test_cases = List.map - (fun (name, path) -> - Alcotest.(test_case name `Quick (check_test_case name path ~from_morbig:true)) + ( + fun (name, path) -> + Alcotest.(test_case name `Quick (check_test_case name path ~from_morbig: true)) ) (collect_test_paths "" "morbig/tests/golden/good") let () = Alcotest.run - ~argv:[|"unused"|] (* FIXME: quick hack; cf top of this file *) + ~argv: [|"unused"|] + (* FIXME: quick hack; cf top of this file *) "golden" [ ("morbig", morbig_test_cases); diff --git a/tests/qcheck/generator.ml b/tests/qcheck/generator.ml index 4bf78c6..417ba63 100644 --- a/tests/qcheck/generator.ml +++ b/tests/qcheck/generator.ml @@ -33,21 +33,23 @@ module Gen = struct if s <= 0 then gen_0 else gen_n (s - 1) let rec reject ~(keep_if : 'a -> bool) (gen : 'a t) : 'a t = - gen >>= fun x -> - if keep_if x then - pure x - else - reject ~keep_if gen + gen + >>= fun x -> + if keep_if x then + pure x + else + reject ~keep_if gen (** Tries to map the exception-throwing function on the results of a generator a certain amount of times. If it keeps throwing exceptions, fall back on the other given generator. *) - let rec map_retry ?(max_retries=5) ~(fallback : 'b t) (f : 'a -> 'b) (gen : 'a t) : 'b t = + let rec map_retry ?(max_retries = 5) ~(fallback : 'b t) (f : 'a -> 'b) (gen : 'a t) : 'b t = if max_retries < 0 then fallback else - gen >>= fun x -> - try pure (f x) with _ -> map_retry ~max_retries:(max_retries - 1) ~fallback f gen + gen + >>= fun x -> + try pure (f x) with _ -> map_retry ~max_retries: (max_retries - 1) ~fallback f gen let map2_retry ?max_retries ~fallback f g1 g2 = map_retry ?max_retries ~fallback (fun (x1, x2) -> f x1 x2) (pair g1 g2) @@ -66,147 +68,177 @@ end (* Infix synonyms for `map` and `ap`. *) -let (>|=) = Gen.(>|=) -let (<$>) = Gen.(<$>) -let (<*>) = Gen.(<*>) - -let keywords = [ "for"; "in"; "do"; "done"; "if"; "then"; "else"; "fi"; "while"; - "case"; "esac"; "elif"; "until" ] +let ( >|= ) = Gen.( >|= ) +let ( <$> ) = Gen.( <$> ) +let ( <*> ) = Gen.( <*> ) + +let keywords = + [ + "for"; + "in"; + "do"; + "done"; + "if"; + "then"; + "else"; + "fi"; + "while"; + "case"; + "esac"; + "elif"; + "until" + ] let rec gen_name : name Gen.t = Gen.reject - ~keep_if:(fun name -> not (List.mem name keywords)) - Gen.(string_size ~gen:(char_range 'a' 'z') (int_range 1 20)) + ~keep_if: (fun name -> not (List.mem name keywords)) + Gen.(string_size ~gen: (char_range 'a' 'z') (int_range 1 20)) and gen_attribute : attribute Gen.sized = fun s -> - Gen.sized - s - ( - Gen.oneof [ - Gen.pure noAttribute ; - Gen.pure parameterLength ; - ] - ) - ( - fun s -> - Gen.oneof [ - Gen.map2 (fun also_for_null -> useDefaultValues ~also_for_null) Gen.bool (gen_word s) ; - Gen.map2 (fun also_for_null -> assignDefaultValues ~also_for_null) Gen.bool (gen_word s) ; - Gen.map2 (fun also_for_null -> indicateErrorifNullorUnset ~also_for_null) Gen.bool (gen_word s) ; - Gen.map2 (fun also_for_null -> useAlternativeValue ~also_for_null) Gen.bool (gen_word s) ; - removeSmallestSuffixPattern <$> gen_word s ; - removeLargestSuffixPattern <$> gen_word s ; - removeSmallestPrefixPattern <$> gen_word s ; - removeLargestPrefixPattern <$> gen_word s ; - ] - ) + Gen.sized + s + ( + Gen.oneof + [ + Gen.pure noAttribute; + Gen.pure parameterLength; + ] + ) + ( + fun s -> + Gen.oneof + [ + Gen.map2 (fun also_for_null -> useDefaultValues ~also_for_null) Gen.bool (gen_word s); + Gen.map2 (fun also_for_null -> assignDefaultValues ~also_for_null) Gen.bool (gen_word s); + Gen.map2 (fun also_for_null -> indicateErrorifNullorUnset ~also_for_null) Gen.bool (gen_word s); + Gen.map2 (fun also_for_null -> useAlternativeValue ~also_for_null) Gen.bool (gen_word s); + removeSmallestSuffixPattern <$> gen_word s; + removeLargestSuffixPattern <$> gen_word s; + removeSmallestPrefixPattern <$> gen_word s; + removeLargestPrefixPattern <$> gen_word s; + ] + ) and gen_word_component : word_component Gen.sized = fun s -> - Gen.sized - s - ( - Gen.oneof [ - Gen.pure wGlobAll ; - Gen.pure wGlobAny ; - (* Gen.pure WBracketExpression ; *) - wTildePrefix <$> gen_name ; (* FIXME: better than `gen_name` *) - wUnquoted <$> gen_name ; (* FIXME: better than `gen_name` *) - ] - ) - ( - fun s -> - Gen.oneof [ - Gen.map_retry wDoubleQuoted (gen_word s) - ~fallback:(wDoubleQuoted <$> (Gen.singleton (wUnquoted <$> gen_name))) ; - Gen.map2 (fun attribute -> wVariable ~attribute) (gen_attribute s) gen_name ; - wSubshell <$> gen_program s ; - ] - ) + Gen.sized + s + ( + Gen.oneof + [ + Gen.pure wGlobAll; + Gen.pure wGlobAny; + (* Gen.pure WBracketExpression ; *) + wTildePrefix <$> gen_name; (* FIXME: better than `gen_name` *) + wUnquoted <$> gen_name; (* FIXME: better than `gen_name` *) + ] + ) + ( + fun s -> + Gen.oneof + [ + Gen.map_retry + wDoubleQuoted + (gen_word s) + ~fallback: (wDoubleQuoted <$> (Gen.singleton (wUnquoted <$> gen_name))); + Gen.map2 (fun attribute -> wVariable ~attribute) (gen_attribute s) gen_name; + wSubshell <$> gen_program s; + ] + ) and gen_word : word Gen.sized = fun s -> - Gen.sized - s - (gen_word_component 0 >|= fun word_component -> [word_component]) - ( - fun s -> - (* FIXME: improper use of size *) - Gen.very_small_list (gen_word_component s) - ) + Gen.sized + s + (gen_word_component 0 >|= fun word_component -> [word_component]) + ( + fun s -> + (* FIXME: improper use of size *) + Gen.very_small_list (gen_word_component s) + ) and gen_pattern : pattern Gen.sized = fun s -> - Gen.sized - s - (Gen.pure []) - ( - fun s -> - (* FIXME: improper use of size *) - Gen.very_small_list (gen_word s) - ) + Gen.sized + s + (Gen.pure []) + ( + fun s -> + (* FIXME: improper use of size *) + Gen.very_small_list (gen_word s) + ) and gen_assignment : assignment Gen.sized = fun s -> - Gen.sized - s - (gen_name >|= fun name -> (name, [])) - ( - fun s -> - Gen.pair gen_name (gen_word s) - ) + Gen.sized + s + (gen_name >|= fun name -> (name, [])) + ( + fun s -> + Gen.pair gen_name (gen_word s) + ) and gen_descr : descr Gen.t = Gen.(0 -- 9) and gen_program : program Gen.sized = fun s -> - Gen.sized - s - (Gen.pure []) - ( - fun s -> - (* FIXME: improper use of size *) - Gen.very_small_list (gen_command' s) - ) + Gen.sized + s + (Gen.pure []) + ( + fun s -> + (* FIXME: improper use of size *) + Gen.very_small_list (gen_command' s) + ) and gen_command : command Gen.sized = fun s -> - Gen.sized - s - (gen_word' 0 >|= fun word -> simple [word]) - ( - fun s -> - Gen.oneof [ - Gen.map2_retry (fun assignments -> simple ~assignments) (Gen.very_small_list (gen_assignment' s)) (Gen.very_small_list (gen_word' s)) - ~fallback:(simple ~assignments:[] <$> (Gen.singleton (gen_word' s))) ; - case <$> gen_word' s <*> Gen.very_small_list (gen_case_item' s) ; - async <$> gen_command' s ; - seq <$> gen_command' s <*> gen_command' s ; - and_ <$> gen_command' s <*> gen_command' s ; - or_ <$> gen_command' s <*> gen_command' s ; - not_ <$> gen_command' s ; - pipe <$> gen_command' s <*> gen_command' s ; - subshell <$> gen_command' s ; - Gen.map3 (fun name words command -> for_ name ?words command) gen_name (Gen.option (Gen.very_small_list (gen_word' s))) (gen_command' s) ; - Gen.map3 (fun test then_ else_ -> if_ test ~then_ ?else_) (gen_command' s) (gen_command' s) (Gen.option (gen_command' s)) ; - while_ <$> gen_command' s <*> gen_command' s ; - until <$> gen_command' s <*> gen_command' s ; - function_ <$> gen_name <*> gen_command' s ; - (fun around -> redirection ~around) <$> gen_command' s <*> gen_descr <*> gen_kind <*> gen_word' s ; - Gen.map4_retry (fun around delimiter -> hereDocument ~around ~delimiter) (gen_command' s) (Gen.singleton (wUnquoted <$> gen_name)) gen_descr (gen_word' s) - ~fallback:((fun around delimiter -> hereDocument ~around ~delimiter) <$> gen_command' s <*> (Gen.singleton (wUnquoted <$> gen_name)) <*> gen_descr <*> Gen.pure (Location.locate [])) ; - ] - ) + Gen.sized + s + (gen_word' 0 >|= fun word -> simple [word]) + ( + fun s -> + Gen.oneof + [ + Gen.map2_retry + (fun assignments -> simple ~assignments) + (Gen.very_small_list (gen_assignment' s)) + (Gen.very_small_list (gen_word' s)) + ~fallback: (simple ~assignments: [] <$> (Gen.singleton (gen_word' s))); + case <$> gen_word' s <*> Gen.very_small_list (gen_case_item' s); + async <$> gen_command' s; + seq <$> gen_command' s <*> gen_command' s; + and_ <$> gen_command' s <*> gen_command' s; + or_ <$> gen_command' s <*> gen_command' s; + not_ <$> gen_command' s; + pipe <$> gen_command' s <*> gen_command' s; + subshell <$> gen_command' s; + Gen.map3 (fun name words command -> for_ name ?words command) gen_name (Gen.option (Gen.very_small_list (gen_word' s))) (gen_command' s); + Gen.map3 (fun test then_ else_ -> if_ test ~then_ ?else_) (gen_command' s) (gen_command' s) (Gen.option (gen_command' s)); + while_ <$> gen_command' s <*> gen_command' s; + until <$> gen_command' s <*> gen_command' s; + function_ <$> gen_name <*> gen_command' s; + (fun around -> redirection ~around) <$> gen_command' s <*> gen_descr <*> gen_kind <*> gen_word' s; + Gen.map4_retry + (fun around delimiter -> hereDocument ~around ~delimiter) + (gen_command' s) + (Gen.singleton (wUnquoted <$> gen_name)) + gen_descr + (gen_word' s) + ~fallback: ((fun around delimiter -> hereDocument ~around ~delimiter) <$> gen_command' s <*> (Gen.singleton (wUnquoted <$> gen_name)) <*> gen_descr <*> Gen.pure (Location.locate [])); + ] + ) and gen_case_item : case_item Gen.sized = fun s -> - (* FIXME: improper use of size *) - Gen.pair (gen_pattern' s) (Gen.option (gen_command' s)) + (* FIXME: improper use of size *) + Gen.pair (gen_pattern' s) (Gen.option (gen_command' s)) and gen_kind : kind Gen.t = - Gen.oneof [ - Gen.pure output ; - Gen.pure outputDuplicate ; - Gen.pure outputAppend ; - Gen.pure outputClobber ; - Gen.pure input ; - Gen.pure inputDuplicate ; - Gen.pure inputOutput ; - ] + Gen.oneof + [ + Gen.pure output; + Gen.pure outputDuplicate; + Gen.pure outputAppend; + Gen.pure outputClobber; + Gen.pure input; + Gen.pure inputDuplicate; + Gen.pure inputOutput; + ] and gen_word' = fun s -> Location.locate <$> gen_word s and gen_pattern' = fun s -> Location.locate <$> gen_pattern s diff --git a/tests/qcheck/qcheck.ml b/tests/qcheck/qcheck.ml index 43454e8..4918a43 100644 --- a/tests/qcheck/qcheck.ml +++ b/tests/qcheck/qcheck.ml @@ -22,8 +22,10 @@ let fpf = Format.fprintf let parse_file fname = - try Ok (Morsmall.parse_file fname) - with exn -> Error exn + try + Ok (Morsmall.parse_file fname) + with + | exn -> Error exn let print_to_temp_file program = let (fname, ochan) = Filename.open_temp_file "morsmall-test-input" ".sh" in @@ -34,10 +36,10 @@ let print_to_temp_file program = Stdlib.close_out ochan; Ok fname with - exn -> - Format.pp_print_flush fmt (); - Stdlib.close_out ochan; - Error exn + | exn -> + Format.pp_print_flush fmt (); + Stdlib.close_out ochan; + Error exn let with_formatter_to_string f = let buf = Buffer.create 8 in @@ -63,8 +65,8 @@ let make_test ~name ~print gen fun_ = QCheck_alcotest.to_alcotest ( Test.make - ~count:2000 - ~long_factor:10 + ~count: 2000 + ~long_factor: 10 ~name ~print gen @@ -77,62 +79,79 @@ let result_is_ok = function let print = make_test - ~name:"print" - ~print:(fun program -> - with_formatter_to_string @@ fun fmt -> - fpf fmt "Input AST:@\n@\n@[<2> %a@]@\n" - pp_print_input_ast program) - (Generator.gen_program 4) - @@ - fun input -> - result_is_ok (print_to_temp_file input) + ~name: "print" + ~print: ( + fun program -> + with_formatter_to_string @@ + fun fmt -> + fpf + fmt + "Input AST:@\n@\n@[<2> %a@]@\n" + pp_print_input_ast + program + ) + (Generator.gen_program 4) @@ + fun input -> + result_is_ok (print_to_temp_file input) let print_parse = make_test - ~name:"print and parse" - ~print:( + ~name: "print and parse" + ~print: ( fun program -> - with_formatter_to_string @@ fun fmt -> - fpf fmt "Input AST:@\n@\n@[<2> %a@]@\n@\nAs a Shell script:@\n@\n@[<2> %a@]@\n" - pp_print_input_ast program - pp_print_concrete program + with_formatter_to_string @@ + fun fmt -> + fpf + fmt + "Input AST:@\n@\n@[<2> %a@]@\n@\nAs a Shell script:@\n@\n@[<2> %a@]@\n" + pp_print_input_ast + program + pp_print_concrete + program ) - (Generator.gen_program 1) - @@ - fun input -> - let printing_result = print_to_temp_file input in - Result.is_ok printing_result - ==> result_is_ok (parse_file (Result.get_ok printing_result)) + (Generator.gen_program 1) @@ + fun input -> + let printing_result = print_to_temp_file input in + Result.is_ok printing_result + ==> result_is_ok (parse_file (Result.get_ok printing_result)) let print_parse_equal = make_test - ~name:"print, parse and test equality" - ~print:( + ~name: "print, parse and test equality" + ~print: ( fun program -> - with_formatter_to_string @@ fun fmt -> - fpf fmt "Input AST:@\n@\n@[<2> %a@]@\n@\nAs a Shell script:@\n@\n@[<2> %a@]@\n@\nParsed AST:@\n@\n@[<2> %a@]@\n" - pp_print_input_ast program - pp_print_concrete program - pp_print_parsed_ast program + with_formatter_to_string @@ + fun fmt -> + fpf + fmt + "Input AST:@\n@\n@[<2> %a@]@\n@\nAs a Shell script:@\n@\n@[<2> %a@]@\n@\nParsed AST:@\n@\n@[<2> %a@]@\n" + pp_print_input_ast + program + pp_print_concrete + program + pp_print_parsed_ast + program ) - (Generator.gen_program 1) - @@ - fun input -> - let printing_result = print_to_temp_file input in - Result.is_ok printing_result - ==> ( - let parsing_result = parse_file (Result.get_ok printing_result) in - Result.is_ok parsing_result - ==> (Morsmall.equal_program_noloc input (Result.get_ok parsing_result)) - ) + (Generator.gen_program 1) @@ + fun input -> + let printing_result = print_to_temp_file input in + Result.is_ok printing_result + ==> ( + let parsing_result = parse_file (Result.get_ok printing_result) in + Result.is_ok parsing_result + ==> (Morsmall.equal_program_noloc input (Result.get_ok parsing_result)) + ) let () = Alcotest.run "qcheck" [ - ("", [ + ( + "", + [ print; print_parse; print_parse_equal - ]) + ] + ) ]