diff --git a/.github/workflows/tight-loop.yaml b/.github/workflows/tight-loop.yaml index 2d842d89d..8da96cb09 100644 --- a/.github/workflows/tight-loop.yaml +++ b/.github/workflows/tight-loop.yaml @@ -49,7 +49,7 @@ jobs: cd evaluation/benchmarks/runtime-overhead results=$(bash run.sh) mkdir ~/artifact - echo "$results" > ~/artifact/results.log + echo "$results" | tee ~/artifact/results.log - uses: actions/upload-artifact@v3 with: name: tight-loop-artifact diff --git a/.gitmodules b/.gitmodules index e21a045fb..e69de29bb 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +0,0 @@ -[submodule "parser/libdash"] - path = compiler/parser/libdash - url = https://github.com/angelhof/libdash/ diff --git a/compiler/ast_to_ir.py b/compiler/ast_to_ir.py index 6723aac01..3749dde57 100644 --- a/compiler/ast_to_ir.py +++ b/compiler/ast_to_ir.py @@ -956,7 +956,10 @@ def make_call_to_runtime(ir_filename, sequential_script_file_name, ## TODO: Maybe we need to only do this if there is a change. ## set_arguments = [string_to_argument("eval"), - [['Q', string_to_argument('set -- \\"\\${pash_input_args[@]}\\"')]]] + [['Q', string_to_argument('set -- ') + + [escaped_char('"')] + # The escaped quote + string_to_argument('\\${pash_input_args[@]}') + + [escaped_char('"')]]]] set_args_node = make_command(set_arguments) diff --git a/compiler/definitions/ir/file_id.py b/compiler/definitions/ir/file_id.py index 806326019..215d45c49 100644 --- a/compiler/definitions/ir/file_id.py +++ b/compiler/definitions/ir/file_id.py @@ -88,8 +88,8 @@ def to_ast(self, stdin_dash=False): else: raise NotImplementedError() else: - string = "{}".format(self.resource) - argument = string_to_argument(string) + ## The resource holds an Argument, and we need to get its argument list + argument = self.resource.uri.to_ast() return argument diff --git a/compiler/ir_utils.py b/compiler/ir_utils.py index 890bec029..56ae7a00d 100644 --- a/compiler/ir_utils.py +++ b/compiler/ir_utils.py @@ -171,6 +171,9 @@ def string_to_argument(string): def char_to_arg_char(char): return ['C' , ord(char)] +def escaped_char(char): + return ['E' , ord(char)] + def standard_var_ast(string): return make_kv("V", ["Normal", False, string, []]) diff --git a/compiler/parse.py b/compiler/parse.py index 9ec48273d..2b0bd78be 100644 --- a/compiler/parse.py +++ b/compiler/parse.py @@ -9,22 +9,21 @@ sys.path.append(os.path.join(config.PASH_TOP, "compiler/parser/ceda")) -from ast2shell import * -from parse_to_ast2 import parse_to_ast, ParsingException -#from json_to_shell2 import json_to_shell_string, json_string_to_shell_string +import libdash.parser +import libdash.printer ## Parses straight a shell script to an AST ## through python without calling it as an executable def parse_shell_to_asts(input_script_path): try: - new_ast_objects = parse_to_ast(input_script_path) + new_ast_objects = libdash.parser.parse(input_script_path) return list(new_ast_objects) - except ParsingException as e: + except libdash.parser.ParsingException as e: log("Parsing error!", e) sys.exit(1) def parse_shell_to_asts_interactive(input_script_path: str): - return parse_to_ast(input_script_path) + return libdash.parser.parse(input_script_path) def from_ast_objects_to_shell(asts): shell_list = [] @@ -43,7 +42,7 @@ def from_ast_objects_to_shell(asts): else: serialized_ast = ast - shell_list.append(to_string(serialized_ast)) + shell_list.append(libdash.printer.to_string(serialized_ast)) return "\n".join(shell_list) + "\n" def from_ast_objects_to_shell_file(asts, new_shell_filename): @@ -64,7 +63,7 @@ def parse_shell(input_script_path): ## Simply wraps the ceda string_of_arg def pash_string_of_arg(arg, quoted=False): - return string_of_arg(arg, quoted) + return libdash.printer.string_of_arg(arg, quoted) ### Legacy diff --git a/compiler/parser/.gitignore b/compiler/parser/.gitignore deleted file mode 100644 index 591d4b076..000000000 --- a/compiler/parser/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.dump \ No newline at end of file diff --git a/compiler/parser/Makefile b/compiler/parser/Makefile deleted file mode 100644 index 2296f4030..000000000 --- a/compiler/parser/Makefile +++ /dev/null @@ -1,50 +0,0 @@ -PARSER=parse_to_json -JSON_TO_SHELL=json_to_shell -AST_I=./libdash/ocaml/ast.mli - -.PHONY : all test dependencies libdash libdash-ocaml clean - -all : $(PARSER).native $(PARSER).byte $(JSON_TO_SHELL).native $(JSON_TO_SHELL).byte - -test : $(PARSER).native $(PARSER).byte $(wildcard tests/*) - @echo "TESTING test.native" - @for f in tests/*; do \ - ./round_trip.sh ./$(PARSER).native $$f 2>test.err; \ - done - @echo "TESTING test.byte" - @for f in tests/*; do \ - ./round_trip.sh ./$(PARSER).byte $$f 2>test.err; \ - done - -## TODO: Unify the two rules below -$(PARSER).native : ast_json.ml $(PARSER).ml - ocamlfind ocamlopt -g -package str,dash,ctypes,ctypes.foreign,atdgen,dum \ - -linkpkg $^ -o $(PARSER).native - -$(PARSER).byte : $(PARSER).ml - ocamlfind ocamlcp -p a -package str,dash,ctypes,ctypes.foreign,atdgen,dum \ - -linkpkg -i -i $(AST_I) $^ -o $(PARSER).byte - -$(JSON_TO_SHELL).native : ast_json.ml $(JSON_TO_SHELL).ml - ocamlfind ocamlopt -g -package str,dash,ctypes,ctypes.foreign,atdgen,dum \ - -linkpkg $^ -o $(JSON_TO_SHELL).native - -$(JSON_TO_SHELL).byte : $(JSON_TO_SHELL).ml - ocamlfind ocamlcp -p a -package str,dash,ctypes,ctypes.foreign,atdgen,dum \ - -linkpkg -i -i $(AST_I) $^ -o $(JSON_TO_SHELL).byte - -clean : - rm -f *.o *.cmo *.cmi *.cmx $(PARSER).native $(PARSER).byte \ - $(JSON_TO_SHELL).native $(JSON_TO_SHELL).byte test.err - -libdash: - cd libdash && ./autogen.sh && ./configure && make - -libdash-ocaml: - cd libdash/ocaml && make && make install - -opam-dependencies: - opam install -y ctypes.0.11.5 - opam install -y ctypes-foreign - opam install -y atdgen - opam install -y dum diff --git a/compiler/parser/README.md b/compiler/parser/README.md deleted file mode 100644 index 5ea943909..000000000 --- a/compiler/parser/README.md +++ /dev/null @@ -1,25 +0,0 @@ -## Instructions - -The parser in this directory uses the mgree/libdash posix compliant -parser and outputs the AST in JSON format using atdgen. - -In order to install, one has to execute `make opam-dependencies && make libdash && make`. The first command makes libdash and sets up all the ocaml dependencies. - -Alternatively, one can install libdash (as explained in its README) -and then run `make` here. - -To run the parser, one can run: - -```sh -./parse_to_json.native -``` - -The following process was followed to make the parser output the ast to json. - -* specify the AST definition in `ast_atd.atd`. -* ran `atdgen -j -j-std ast_atd.atd` to produce `ast_atd_j.ml`. -* copy it to `ast_json.ml` (removing the `char` definition). -* also make a small adjustment in the `ast.ml`, `ast.mli` files in `libdash/ocaml`. (?nv) - -This procedure is not automated, and in case the AST definition in -libdash changes, this process has to be done again. diff --git a/compiler/parser/ast_atd.atd b/compiler/parser/ast_atd.atd deleted file mode 100644 index c3fbad4d5..000000000 --- a/compiler/parser/ast_atd.atd +++ /dev/null @@ -1,78 +0,0 @@ -type char = int - -type linno = int - -type t = [ - Command of (linno * assign list * args * redirection list) (* assign, args, redir *) - | Pipe of (bool * t list) (* background?, commands *) - | Redir of (linno * t * redirection list) - | Background of (linno * t * redirection list) - | Subshell of (linno * t * redirection list) - | And of (t * t) - | Or of (t * t) - | Not of t - | Semi of (t * t) - | If of (t * t * t) (* cond, then, else *) - | While of (t * t) (* test, body *) (* until encoded as a While . Not *) - | For of (linno * arg * t * string) (* args, body, var *) - | Case of (linno * arg * case list) - | Defun of (linno * string * t) (* name, body *) -] - -type assign = (string * arg) - -type redirection = [ - File of (redir_type * int * arg) - | Dup of (dup_type * int * arg) - | Heredoc of (heredoc_type * int * arg) -] - -type redir_type = [ - To - | Clobber - | From - | FromTo - | Append -] - -type dup_type = [ - ToFD - | FromFD -] - -type heredoc_type = [ - Here - | XHere (* for when in a quote... not sure when this comes up *) -] - -type args = arg list - -type arg = arg_char list - -type arg_char = [ - C of char - | E of char (* escape... necessary for expansion *) - | T of string option (* tilde *) - | A of arg (* arith *) - | V of (var_type * bool (* VSNUL? *) * string * arg) - | Q of arg (* quoted *) - | B of t (* backquote *) -] - -type var_type = [ - Normal - | Minus - | Plus - | Question - | Assign - | TrimR - | TrimRMax - | TrimL - | TrimLMax - | Length -] - -type case = { - cpattern : arg list; - cbody : t -} \ No newline at end of file diff --git a/compiler/parser/ast_atd_j.ml b/compiler/parser/ast_atd_j.ml deleted file mode 100644 index 86a9261d0..000000000 --- a/compiler/parser/ast_atd_j.ml +++ /dev/null @@ -1,3479 +0,0 @@ -(* Auto-generated from "ast_atd.atd" *) -[@@@ocaml.warning "-27-32-35-39"] - -type char = Ast.char - -type dup_type = Ast.dup_type = ToFD | FromFD - -type heredoc_type = Ast.heredoc_type = Here | XHere - -type linno = Ast.linno - -type redir_type = Ast.redir_type = To | Clobber | From | FromTo | Append - -type var_type = Ast.var_type = - Normal | Minus | Plus | Question | Assign | TrimR | TrimRMax | TrimL - | TrimLMax | Length - - -type arg = Ast.arg - -and arg_char = Ast.arg_char = - C of char - | E of char - | T of string option - | A of arg - | V of (var_type * bool * string * arg) - | Q of arg - | B of t - - -and args = Ast.args - -and assign = Ast.assign - -and case = Ast.case = { cpattern: arg list; cbody: t } - -and redirection = Ast.redirection = - File of (redir_type * int * arg) - | Dup of (dup_type * int * arg) - | Heredoc of (heredoc_type * int * arg) - - -and t = Ast.t = - Command of (linno * assign list * args * redirection list) - | Pipe of (bool * t list) - | Redir of (linno * t * redirection list) - | Background of (linno * t * redirection list) - | Subshell of (linno * t * redirection list) - | And of (t * t) - | Or of (t * t) - | Not of t - | Semi of (t * t) - | If of (t * t * t) - | While of (t * t) - | For of (linno * arg * t * string) - | Case of (linno * arg * case list) - | Defun of (linno * string * t) - - -let write__7 = ( - Atdgen_runtime.Oj_run.write_std_option ( - Yojson.Safe.write_string - ) -) -let string_of__7 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__7 ob x; - Bi_outbuf.contents ob -let read__7 = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "None" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (None : _ option) - | "Some" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Some x : _ option) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "None" -> - (None : _ option) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "Some" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Some x : _ option) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let _7_of_string s = - read__7 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_char = ( - Atdgen_runtime.Oj_run.write_int8 -) -let string_of_char ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_char ob x; - Bi_outbuf.contents ob -let read_char = ( - Atdgen_runtime.Oj_run.read_int8 -) -let char_of_string s = - read_char (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_dup_type : _ -> dup_type -> _ = ( - fun ob x -> - match x with - | ToFD -> Bi_outbuf.add_string ob "\"ToFD\"" - | FromFD -> Bi_outbuf.add_string ob "\"FromFD\"" -) -let string_of_dup_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_dup_type ob x; - Bi_outbuf.contents ob -let read_dup_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "ToFD" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (ToFD : dup_type) - | "FromFD" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (FromFD : dup_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "ToFD" -> - (ToFD : dup_type) - | "FromFD" -> - (FromFD : dup_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let dup_type_of_string s = - read_dup_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_heredoc_type : _ -> heredoc_type -> _ = ( - fun ob x -> - match x with - | Here -> Bi_outbuf.add_string ob "\"Here\"" - | XHere -> Bi_outbuf.add_string ob "\"XHere\"" -) -let string_of_heredoc_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_heredoc_type ob x; - Bi_outbuf.contents ob -let read_heredoc_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "Here" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Here : heredoc_type) - | "XHere" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (XHere : heredoc_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "Here" -> - (Here : heredoc_type) - | "XHere" -> - (XHere : heredoc_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let heredoc_type_of_string s = - read_heredoc_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_linno = ( - Yojson.Safe.write_int -) -let string_of_linno ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_linno ob x; - Bi_outbuf.contents ob -let read_linno = ( - Atdgen_runtime.Oj_run.read_int -) -let linno_of_string s = - read_linno (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_redir_type : _ -> redir_type -> _ = ( - fun ob x -> - match x with - | To -> Bi_outbuf.add_string ob "\"To\"" - | Clobber -> Bi_outbuf.add_string ob "\"Clobber\"" - | From -> Bi_outbuf.add_string ob "\"From\"" - | FromTo -> Bi_outbuf.add_string ob "\"FromTo\"" - | Append -> Bi_outbuf.add_string ob "\"Append\"" -) -let string_of_redir_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_redir_type ob x; - Bi_outbuf.contents ob -let read_redir_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "To" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (To : redir_type) - | "Clobber" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Clobber : redir_type) - | "From" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (From : redir_type) - | "FromTo" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (FromTo : redir_type) - | "Append" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Append : redir_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "To" -> - (To : redir_type) - | "Clobber" -> - (Clobber : redir_type) - | "From" -> - (From : redir_type) - | "FromTo" -> - (FromTo : redir_type) - | "Append" -> - (Append : redir_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let redir_type_of_string s = - read_redir_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_var_type : _ -> var_type -> _ = ( - fun ob x -> - match x with - | Normal -> Bi_outbuf.add_string ob "\"Normal\"" - | Minus -> Bi_outbuf.add_string ob "\"Minus\"" - | Plus -> Bi_outbuf.add_string ob "\"Plus\"" - | Question -> Bi_outbuf.add_string ob "\"Question\"" - | Assign -> Bi_outbuf.add_string ob "\"Assign\"" - | TrimR -> Bi_outbuf.add_string ob "\"TrimR\"" - | TrimRMax -> Bi_outbuf.add_string ob "\"TrimRMax\"" - | TrimL -> Bi_outbuf.add_string ob "\"TrimL\"" - | TrimLMax -> Bi_outbuf.add_string ob "\"TrimLMax\"" - | Length -> Bi_outbuf.add_string ob "\"Length\"" -) -let string_of_var_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_var_type ob x; - Bi_outbuf.contents ob -let read_var_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "Normal" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Normal : var_type) - | "Minus" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Minus : var_type) - | "Plus" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Plus : var_type) - | "Question" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Question : var_type) - | "Assign" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Assign : var_type) - | "TrimR" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimR : var_type) - | "TrimRMax" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimRMax : var_type) - | "TrimL" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimL : var_type) - | "TrimLMax" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimLMax : var_type) - | "Length" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Length : var_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "Normal" -> - (Normal : var_type) - | "Minus" -> - (Minus : var_type) - | "Plus" -> - (Plus : var_type) - | "Question" -> - (Question : var_type) - | "Assign" -> - (Assign : var_type) - | "TrimR" -> - (TrimR : var_type) - | "TrimRMax" -> - (TrimRMax : var_type) - | "TrimL" -> - (TrimL : var_type) - | "TrimLMax" -> - (TrimLMax : var_type) - | "Length" -> - (Length : var_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let var_type_of_string s = - read_var_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let rec write__1 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_assign - ) -) ob x -and string_of__1 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__1 ob x; - Bi_outbuf.contents ob -and write__2 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_redirection - ) -) ob x -and string_of__2 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__2 ob x; - Bi_outbuf.contents ob -and write__3 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_t - ) -) ob x -and string_of__3 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__3 ob x; - Bi_outbuf.contents ob -and write__4 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_case - ) -) ob x -and string_of__4 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__4 ob x; - Bi_outbuf.contents ob -and write__5 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_arg - ) -) ob x -and string_of__5 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__5 ob x; - Bi_outbuf.contents ob -and write__6 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_arg_char - ) -) ob x -and string_of__6 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__6 ob x; - Bi_outbuf.contents ob -and write_arg ob x = ( - write__6 -) ob x -and string_of_arg ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_arg ob x; - Bi_outbuf.contents ob -and write_arg_char : _ -> arg_char -> _ = ( - fun ob x -> - match x with - | C x -> - Bi_outbuf.add_string ob "[\"C\","; - ( - write_char - ) ob x; - Bi_outbuf.add_char ob ']' - | E x -> - Bi_outbuf.add_string ob "[\"E\","; - ( - write_char - ) ob x; - Bi_outbuf.add_char ob ']' - | T x -> - Bi_outbuf.add_string ob "[\"T\","; - ( - write__7 - ) ob x; - Bi_outbuf.add_char ob ']' - | A x -> - Bi_outbuf.add_string ob "[\"A\","; - ( - write_arg - ) ob x; - Bi_outbuf.add_char ob ']' - | V x -> - Bi_outbuf.add_string ob "[\"V\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _, _ = x in - ( - write_var_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _, _ = x in - ( - Yojson.Safe.write_bool - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x, _ = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Q x -> - Bi_outbuf.add_string ob "[\"Q\","; - ( - write_arg - ) ob x; - Bi_outbuf.add_char ob ']' - | B x -> - Bi_outbuf.add_string ob "[\"B\","; - ( - write_t - ) ob x; - Bi_outbuf.add_char ob ']' -) -and string_of_arg_char ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_arg_char ob x; - Bi_outbuf.contents ob -and write_args ob x = ( - write__5 -) ob x -and string_of_args ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_args ob x; - Bi_outbuf.contents ob -and write_assign = ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; -) -and string_of_assign ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_assign ob x; - Bi_outbuf.contents ob -and write_case : _ -> case -> _ = ( - fun ob x -> - Bi_outbuf.add_char ob '{'; - let is_first = ref true in - if !is_first then - is_first := false - else - Bi_outbuf.add_char ob ','; - Bi_outbuf.add_string ob "\"cpattern\":"; - ( - write__5 - ) - ob x.cpattern; - if !is_first then - is_first := false - else - Bi_outbuf.add_char ob ','; - Bi_outbuf.add_string ob "\"cbody\":"; - ( - write_t - ) - ob x.cbody; - Bi_outbuf.add_char ob '}'; -) -and string_of_case ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_case ob x; - Bi_outbuf.contents ob -and write_redirection : _ -> redirection -> _ = ( - fun ob x -> - match x with - | File x -> - Bi_outbuf.add_string ob "[\"File\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_redir_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_int - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Dup x -> - Bi_outbuf.add_string ob "[\"Dup\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_dup_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_int - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Heredoc x -> - Bi_outbuf.add_string ob "[\"Heredoc\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_heredoc_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_int - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' -) -and string_of_redirection ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_redirection ob x; - Bi_outbuf.contents ob -and write_t : _ -> t -> _ = ( - fun ob x -> - match x with - | Command x -> - Bi_outbuf.add_string ob "[\"Command\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _, _ = x in - ( - write__1 - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x, _ = x in - ( - write_args - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Pipe x -> - Bi_outbuf.add_string ob "[\"Pipe\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - Yojson.Safe.write_bool - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write__3 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Redir x -> - Bi_outbuf.add_string ob "[\"Redir\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Background x -> - Bi_outbuf.add_string ob "[\"Background\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Subshell x -> - Bi_outbuf.add_string ob "[\"Subshell\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | And x -> - Bi_outbuf.add_string ob "[\"And\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Or x -> - Bi_outbuf.add_string ob "[\"Or\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Not x -> - Bi_outbuf.add_string ob "[\"Not\","; - ( - write_t - ) ob x; - Bi_outbuf.add_char ob ']' - | Semi x -> - Bi_outbuf.add_string ob "[\"Semi\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | If x -> - Bi_outbuf.add_string ob "[\"If\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | While x -> - Bi_outbuf.add_string ob "[\"While\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | For x -> - Bi_outbuf.add_string ob "[\"For\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _, _ = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, _, x = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Case x -> - Bi_outbuf.add_string ob "[\"Case\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__4 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Defun x -> - Bi_outbuf.add_string ob "[\"Defun\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' -) -and string_of_t ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_t ob x; - Bi_outbuf.contents ob -let rec read__1 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_assign - ) -) p lb -and _1_of_string s = - read__1 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__2 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_redirection - ) -) p lb -and _2_of_string s = - read__2 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__3 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_t - ) -) p lb -and _3_of_string s = - read__3 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__4 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_case - ) -) p lb -and _4_of_string s = - read__4 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__5 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_arg - ) -) p lb -and _5_of_string s = - read__5 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__6 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_arg_char - ) -) p lb -and _6_of_string s = - read__6 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_arg p lb = ( - read__6 -) p lb -and arg_of_string s = - read_arg (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_arg_char = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "C" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (C x : arg_char) - | "E" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (E x : arg_char) - | "T" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read__7 - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (T x : arg_char) - | "A" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (A x : arg_char) - | "V" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_var_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (V x : arg_char) - | "Q" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Q x : arg_char) - | "B" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (B x : arg_char) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "C" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (C x : arg_char) - | "E" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (E x : arg_char) - | "T" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read__7 - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (T x : arg_char) - | "A" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (A x : arg_char) - | "V" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_var_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (V x : arg_char) - | "Q" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Q x : arg_char) - | "B" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (B x : arg_char) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -and arg_char_of_string s = - read_arg_char (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_args p lb = ( - read__5 -) p lb -and args_of_string s = - read_args (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_assign = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); -) -and assign_of_string s = - read_assign (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_case = ( - fun p lb -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_lcurl p lb; - let field_cpattern = ref (Obj.magic (Sys.opaque_identity 0.0)) in - let field_cbody = ref (Obj.magic (Sys.opaque_identity 0.0)) in - let bits0 = ref 0 in - try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_object_end lb; - Yojson.Safe.read_space p lb; - let f = - fun s pos len -> - if pos < 0 || len < 0 || pos + len > String.length s then - invalid_arg "out-of-bounds substring position or length"; - match len with - | 5 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'b' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'd' && String.unsafe_get s (pos+4) = 'y' then ( - 1 - ) - else ( - -1 - ) - ) - | 8 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'p' && String.unsafe_get s (pos+2) = 'a' && String.unsafe_get s (pos+3) = 't' && String.unsafe_get s (pos+4) = 't' && String.unsafe_get s (pos+5) = 'e' && String.unsafe_get s (pos+6) = 'r' && String.unsafe_get s (pos+7) = 'n' then ( - 0 - ) - else ( - -1 - ) - ) - | _ -> ( - -1 - ) - in - let i = Yojson.Safe.map_ident p f lb in - Atdgen_runtime.Oj_run.read_until_field_value p lb; - ( - match i with - | 0 -> - field_cpattern := ( - ( - read__5 - ) p lb - ); - bits0 := !bits0 lor 0x1; - | 1 -> - field_cbody := ( - ( - read_t - ) p lb - ); - bits0 := !bits0 lor 0x2; - | _ -> ( - Yojson.Safe.skip_json p lb - ) - ); - while true do - Yojson.Safe.read_space p lb; - Yojson.Safe.read_object_sep p lb; - Yojson.Safe.read_space p lb; - let f = - fun s pos len -> - if pos < 0 || len < 0 || pos + len > String.length s then - invalid_arg "out-of-bounds substring position or length"; - match len with - | 5 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'b' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'd' && String.unsafe_get s (pos+4) = 'y' then ( - 1 - ) - else ( - -1 - ) - ) - | 8 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'p' && String.unsafe_get s (pos+2) = 'a' && String.unsafe_get s (pos+3) = 't' && String.unsafe_get s (pos+4) = 't' && String.unsafe_get s (pos+5) = 'e' && String.unsafe_get s (pos+6) = 'r' && String.unsafe_get s (pos+7) = 'n' then ( - 0 - ) - else ( - -1 - ) - ) - | _ -> ( - -1 - ) - in - let i = Yojson.Safe.map_ident p f lb in - Atdgen_runtime.Oj_run.read_until_field_value p lb; - ( - match i with - | 0 -> - field_cpattern := ( - ( - read__5 - ) p lb - ); - bits0 := !bits0 lor 0x1; - | 1 -> - field_cbody := ( - ( - read_t - ) p lb - ); - bits0 := !bits0 lor 0x2; - | _ -> ( - Yojson.Safe.skip_json p lb - ) - ); - done; - assert false; - with Yojson.End_of_object -> ( - if !bits0 <> 0x3 then Atdgen_runtime.Oj_run.missing_fields p [| !bits0 |] [| "cpattern"; "cbody" |]; - ( - { - cpattern = !field_cpattern; - cbody = !field_cbody; - } - : case) - ) -) -and case_of_string s = - read_case (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_redirection = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "File" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_redir_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (File x : redirection) - | "Dup" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_dup_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Dup x : redirection) - | "Heredoc" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_heredoc_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Heredoc x : redirection) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "File" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_redir_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (File x : redirection) - | "Dup" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_dup_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Dup x : redirection) - | "Heredoc" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_heredoc_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Heredoc x : redirection) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -and redirection_of_string s = - read_redirection (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_t = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "Command" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__1 - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_args - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Command x : t) - | "Pipe" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__3 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Pipe x : t) - | "Redir" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Redir x : t) - | "Background" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Background x : t) - | "Subshell" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Subshell x : t) - | "And" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (And x : t) - | "Or" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Or x : t) - | "Not" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Not x : t) - | "Semi" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Semi x : t) - | "If" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (If x : t) - | "While" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (While x : t) - | "For" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (For x : t) - | "Case" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__4 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Case x : t) - | "Defun" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Defun x : t) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "Command" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__1 - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_args - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Command x : t) - | "Pipe" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__3 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Pipe x : t) - | "Redir" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Redir x : t) - | "Background" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Background x : t) - | "Subshell" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Subshell x : t) - | "And" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (And x : t) - | "Or" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Or x : t) - | "Not" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Not x : t) - | "Semi" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Semi x : t) - | "If" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (If x : t) - | "While" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (While x : t) - | "For" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (For x : t) - | "Case" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__4 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Case x : t) - | "Defun" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Defun x : t) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -and t_of_string s = - read_t (Yojson.Safe.init_lexer ()) (Lexing.from_string s) diff --git a/compiler/parser/ast_atd_j.mli b/compiler/parser/ast_atd_j.mli deleted file mode 100644 index 647dd238f..000000000 --- a/compiler/parser/ast_atd_j.mli +++ /dev/null @@ -1,319 +0,0 @@ -(* Auto-generated from "ast_atd.atd" *) -[@@@ocaml.warning "-27-32-35-39"] - -type char = Ast.char - -type dup_type = Ast.dup_type = ToFD | FromFD - -type heredoc_type = Ast.heredoc_type = Here | XHere - -type linno = Ast.linno - -type redir_type = Ast.redir_type = To | Clobber | From | FromTo | Append - -type var_type = Ast.var_type = - Normal | Minus | Plus | Question | Assign | TrimR | TrimRMax | TrimL - | TrimLMax | Length - - -type arg = Ast.arg - -and arg_char = Ast.arg_char = - C of char - | E of char - | T of string option - | A of arg - | V of (var_type * bool * string * arg) - | Q of arg - | B of t - - -and args = Ast.args - -and assign = Ast.assign - -and case = Ast.case = { cpattern: arg list; cbody: t } - -and redirection = Ast.redirection = - File of (redir_type * int * arg) - | Dup of (dup_type * int * arg) - | Heredoc of (heredoc_type * int * arg) - - -and t = Ast.t = - Command of (linno * assign list * args * redirection list) - | Pipe of (bool * t list) - | Redir of (linno * t * redirection list) - | Background of (linno * t * redirection list) - | Subshell of (linno * t * redirection list) - | And of (t * t) - | Or of (t * t) - | Not of t - | Semi of (t * t) - | If of (t * t * t) - | While of (t * t) - | For of (linno * arg * t * string) - | Case of (linno * arg * case list) - | Defun of (linno * string * t) - - -val write_char : - Bi_outbuf.t -> char -> unit - (** Output a JSON value of type {!char}. *) - -val string_of_char : - ?len:int -> char -> string - (** Serialize a value of type {!char} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_char : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> char - (** Input JSON data of type {!char}. *) - -val char_of_string : - string -> char - (** Deserialize JSON data of type {!char}. *) - -val write_dup_type : - Bi_outbuf.t -> dup_type -> unit - (** Output a JSON value of type {!dup_type}. *) - -val string_of_dup_type : - ?len:int -> dup_type -> string - (** Serialize a value of type {!dup_type} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_dup_type : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> dup_type - (** Input JSON data of type {!dup_type}. *) - -val dup_type_of_string : - string -> dup_type - (** Deserialize JSON data of type {!dup_type}. *) - -val write_heredoc_type : - Bi_outbuf.t -> heredoc_type -> unit - (** Output a JSON value of type {!heredoc_type}. *) - -val string_of_heredoc_type : - ?len:int -> heredoc_type -> string - (** Serialize a value of type {!heredoc_type} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_heredoc_type : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> heredoc_type - (** Input JSON data of type {!heredoc_type}. *) - -val heredoc_type_of_string : - string -> heredoc_type - (** Deserialize JSON data of type {!heredoc_type}. *) - -val write_linno : - Bi_outbuf.t -> linno -> unit - (** Output a JSON value of type {!linno}. *) - -val string_of_linno : - ?len:int -> linno -> string - (** Serialize a value of type {!linno} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_linno : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> linno - (** Input JSON data of type {!linno}. *) - -val linno_of_string : - string -> linno - (** Deserialize JSON data of type {!linno}. *) - -val write_redir_type : - Bi_outbuf.t -> redir_type -> unit - (** Output a JSON value of type {!redir_type}. *) - -val string_of_redir_type : - ?len:int -> redir_type -> string - (** Serialize a value of type {!redir_type} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_redir_type : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> redir_type - (** Input JSON data of type {!redir_type}. *) - -val redir_type_of_string : - string -> redir_type - (** Deserialize JSON data of type {!redir_type}. *) - -val write_var_type : - Bi_outbuf.t -> var_type -> unit - (** Output a JSON value of type {!var_type}. *) - -val string_of_var_type : - ?len:int -> var_type -> string - (** Serialize a value of type {!var_type} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_var_type : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> var_type - (** Input JSON data of type {!var_type}. *) - -val var_type_of_string : - string -> var_type - (** Deserialize JSON data of type {!var_type}. *) - -val write_arg : - Bi_outbuf.t -> arg -> unit - (** Output a JSON value of type {!arg}. *) - -val string_of_arg : - ?len:int -> arg -> string - (** Serialize a value of type {!arg} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_arg : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> arg - (** Input JSON data of type {!arg}. *) - -val arg_of_string : - string -> arg - (** Deserialize JSON data of type {!arg}. *) - -val write_arg_char : - Bi_outbuf.t -> arg_char -> unit - (** Output a JSON value of type {!arg_char}. *) - -val string_of_arg_char : - ?len:int -> arg_char -> string - (** Serialize a value of type {!arg_char} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_arg_char : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> arg_char - (** Input JSON data of type {!arg_char}. *) - -val arg_char_of_string : - string -> arg_char - (** Deserialize JSON data of type {!arg_char}. *) - -val write_args : - Bi_outbuf.t -> args -> unit - (** Output a JSON value of type {!args}. *) - -val string_of_args : - ?len:int -> args -> string - (** Serialize a value of type {!args} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_args : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> args - (** Input JSON data of type {!args}. *) - -val args_of_string : - string -> args - (** Deserialize JSON data of type {!args}. *) - -val write_assign : - Bi_outbuf.t -> assign -> unit - (** Output a JSON value of type {!assign}. *) - -val string_of_assign : - ?len:int -> assign -> string - (** Serialize a value of type {!assign} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_assign : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> assign - (** Input JSON data of type {!assign}. *) - -val assign_of_string : - string -> assign - (** Deserialize JSON data of type {!assign}. *) - -val write_case : - Bi_outbuf.t -> case -> unit - (** Output a JSON value of type {!case}. *) - -val string_of_case : - ?len:int -> case -> string - (** Serialize a value of type {!case} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_case : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> case - (** Input JSON data of type {!case}. *) - -val case_of_string : - string -> case - (** Deserialize JSON data of type {!case}. *) - -val write_redirection : - Bi_outbuf.t -> redirection -> unit - (** Output a JSON value of type {!redirection}. *) - -val string_of_redirection : - ?len:int -> redirection -> string - (** Serialize a value of type {!redirection} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_redirection : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> redirection - (** Input JSON data of type {!redirection}. *) - -val redirection_of_string : - string -> redirection - (** Deserialize JSON data of type {!redirection}. *) - -val write_t : - Bi_outbuf.t -> t -> unit - (** Output a JSON value of type {!t}. *) - -val string_of_t : - ?len:int -> t -> string - (** Serialize a value of type {!t} - into a JSON string. - @param len specifies the initial length - of the buffer used internally. - Default: 1024. *) - -val read_t : - Yojson.Safe.lexer_state -> Lexing.lexbuf -> t - (** Input JSON data of type {!t}. *) - -val t_of_string : - string -> t - (** Deserialize JSON data of type {!t}. *) - diff --git a/compiler/parser/ast_json.ml b/compiler/parser/ast_json.ml deleted file mode 100644 index 448be3167..000000000 --- a/compiler/parser/ast_json.ml +++ /dev/null @@ -1,3477 +0,0 @@ -(* Auto-generated from "ast_atd.atd" *) -[@@@ocaml.warning "-27-32-35-39"] - -type dup_type = Ast.dup_type = ToFD | FromFD - -type heredoc_type = Ast.heredoc_type = Here | XHere - -type linno = Ast.linno - -type redir_type = Ast.redir_type = To | Clobber | From | FromTo | Append - -type var_type = Ast.var_type = - Normal | Minus | Plus | Question | Assign | TrimR | TrimRMax | TrimL - | TrimLMax | Length - - -type arg = Ast.arg - -and arg_char = Ast.arg_char = - C of char - | E of char - | T of string option - | A of arg - | V of (var_type * bool * string * arg) - | Q of arg - | B of t - - -and args = Ast.args - -and assign = Ast.assign - -and case = Ast.case = { cpattern: arg list; cbody: t } - -and redirection = Ast.redirection = - File of (redir_type * int * arg) - | Dup of (dup_type * int * arg) - | Heredoc of (heredoc_type * int * arg) - - -and t = Ast.t = - Command of (linno * assign list * args * redirection list) - | Pipe of (bool * t list) - | Redir of (linno * t * redirection list) - | Background of (linno * t * redirection list) - | Subshell of (linno * t * redirection list) - | And of (t * t) - | Or of (t * t) - | Not of t - | Semi of (t * t) - | If of (t * t * t) - | While of (t * t) - | For of (linno * arg * t * string) - | Case of (linno * arg * case list) - | Defun of (linno * string * t) - - -let write__7 = ( - Atdgen_runtime.Oj_run.write_std_option ( - Yojson.Safe.write_string - ) -) -let string_of__7 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__7 ob x; - Bi_outbuf.contents ob -let read__7 = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "None" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (None : _ option) - | "Some" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Some x : _ option) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "None" -> - (None : _ option) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "Some" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Some x : _ option) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let _7_of_string s = - read__7 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_char = ( - Atdgen_runtime.Oj_run.write_int8 -) -let string_of_char ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_char ob x; - Bi_outbuf.contents ob -let read_char = ( - Atdgen_runtime.Oj_run.read_int8 -) -let char_of_string s = - read_char (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_dup_type : _ -> dup_type -> _ = ( - fun ob x -> - match x with - | ToFD -> Bi_outbuf.add_string ob "\"ToFD\"" - | FromFD -> Bi_outbuf.add_string ob "\"FromFD\"" -) -let string_of_dup_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_dup_type ob x; - Bi_outbuf.contents ob -let read_dup_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "ToFD" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (ToFD : dup_type) - | "FromFD" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (FromFD : dup_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "ToFD" -> - (ToFD : dup_type) - | "FromFD" -> - (FromFD : dup_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let dup_type_of_string s = - read_dup_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_heredoc_type : _ -> heredoc_type -> _ = ( - fun ob x -> - match x with - | Here -> Bi_outbuf.add_string ob "\"Here\"" - | XHere -> Bi_outbuf.add_string ob "\"XHere\"" -) -let string_of_heredoc_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_heredoc_type ob x; - Bi_outbuf.contents ob -let read_heredoc_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "Here" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Here : heredoc_type) - | "XHere" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (XHere : heredoc_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "Here" -> - (Here : heredoc_type) - | "XHere" -> - (XHere : heredoc_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let heredoc_type_of_string s = - read_heredoc_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_linno = ( - Yojson.Safe.write_int -) -let string_of_linno ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_linno ob x; - Bi_outbuf.contents ob -let read_linno = ( - Atdgen_runtime.Oj_run.read_int -) -let linno_of_string s = - read_linno (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_redir_type : _ -> redir_type -> _ = ( - fun ob x -> - match x with - | To -> Bi_outbuf.add_string ob "\"To\"" - | Clobber -> Bi_outbuf.add_string ob "\"Clobber\"" - | From -> Bi_outbuf.add_string ob "\"From\"" - | FromTo -> Bi_outbuf.add_string ob "\"FromTo\"" - | Append -> Bi_outbuf.add_string ob "\"Append\"" -) -let string_of_redir_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_redir_type ob x; - Bi_outbuf.contents ob -let read_redir_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "To" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (To : redir_type) - | "Clobber" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Clobber : redir_type) - | "From" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (From : redir_type) - | "FromTo" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (FromTo : redir_type) - | "Append" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Append : redir_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "To" -> - (To : redir_type) - | "Clobber" -> - (Clobber : redir_type) - | "From" -> - (From : redir_type) - | "FromTo" -> - (FromTo : redir_type) - | "Append" -> - (Append : redir_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let redir_type_of_string s = - read_redir_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let write_var_type : _ -> var_type -> _ = ( - fun ob x -> - match x with - | Normal -> Bi_outbuf.add_string ob "\"Normal\"" - | Minus -> Bi_outbuf.add_string ob "\"Minus\"" - | Plus -> Bi_outbuf.add_string ob "\"Plus\"" - | Question -> Bi_outbuf.add_string ob "\"Question\"" - | Assign -> Bi_outbuf.add_string ob "\"Assign\"" - | TrimR -> Bi_outbuf.add_string ob "\"TrimR\"" - | TrimRMax -> Bi_outbuf.add_string ob "\"TrimRMax\"" - | TrimL -> Bi_outbuf.add_string ob "\"TrimL\"" - | TrimLMax -> Bi_outbuf.add_string ob "\"TrimLMax\"" - | Length -> Bi_outbuf.add_string ob "\"Length\"" -) -let string_of_var_type ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_var_type ob x; - Bi_outbuf.contents ob -let read_var_type = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "Normal" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Normal : var_type) - | "Minus" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Minus : var_type) - | "Plus" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Plus : var_type) - | "Question" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Question : var_type) - | "Assign" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Assign : var_type) - | "TrimR" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimR : var_type) - | "TrimRMax" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimRMax : var_type) - | "TrimL" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimL : var_type) - | "TrimLMax" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (TrimLMax : var_type) - | "Length" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Length : var_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | "Normal" -> - (Normal : var_type) - | "Minus" -> - (Minus : var_type) - | "Plus" -> - (Plus : var_type) - | "Question" -> - (Question : var_type) - | "Assign" -> - (Assign : var_type) - | "TrimR" -> - (TrimR : var_type) - | "TrimRMax" -> - (TrimRMax : var_type) - | "TrimL" -> - (TrimL : var_type) - | "TrimLMax" -> - (TrimLMax : var_type) - | "Length" -> - (Length : var_type) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -let var_type_of_string s = - read_var_type (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -let rec write__1 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_assign - ) -) ob x -and string_of__1 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__1 ob x; - Bi_outbuf.contents ob -and write__2 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_redirection - ) -) ob x -and string_of__2 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__2 ob x; - Bi_outbuf.contents ob -and write__3 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_t - ) -) ob x -and string_of__3 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__3 ob x; - Bi_outbuf.contents ob -and write__4 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_case - ) -) ob x -and string_of__4 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__4 ob x; - Bi_outbuf.contents ob -and write__5 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_arg - ) -) ob x -and string_of__5 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__5 ob x; - Bi_outbuf.contents ob -and write__6 ob x = ( - Atdgen_runtime.Oj_run.write_list ( - write_arg_char - ) -) ob x -and string_of__6 ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write__6 ob x; - Bi_outbuf.contents ob -and write_arg ob x = ( - write__6 -) ob x -and string_of_arg ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_arg ob x; - Bi_outbuf.contents ob -and write_arg_char : _ -> arg_char -> _ = ( - fun ob x -> - match x with - | C x -> - Bi_outbuf.add_string ob "[\"C\","; - ( - write_char - ) ob x; - Bi_outbuf.add_char ob ']' - | E x -> - Bi_outbuf.add_string ob "[\"E\","; - ( - write_char - ) ob x; - Bi_outbuf.add_char ob ']' - | T x -> - Bi_outbuf.add_string ob "[\"T\","; - ( - write__7 - ) ob x; - Bi_outbuf.add_char ob ']' - | A x -> - Bi_outbuf.add_string ob "[\"A\","; - ( - write_arg - ) ob x; - Bi_outbuf.add_char ob ']' - | V x -> - Bi_outbuf.add_string ob "[\"V\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _, _ = x in - ( - write_var_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _, _ = x in - ( - Yojson.Safe.write_bool - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x, _ = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Q x -> - Bi_outbuf.add_string ob "[\"Q\","; - ( - write_arg - ) ob x; - Bi_outbuf.add_char ob ']' - | B x -> - Bi_outbuf.add_string ob "[\"B\","; - ( - write_t - ) ob x; - Bi_outbuf.add_char ob ']' -) -and string_of_arg_char ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_arg_char ob x; - Bi_outbuf.contents ob -and write_args ob x = ( - write__5 -) ob x -and string_of_args ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_args ob x; - Bi_outbuf.contents ob -and write_assign = ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; -) -and string_of_assign ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_assign ob x; - Bi_outbuf.contents ob -and write_case : _ -> case -> _ = ( - fun ob x -> - Bi_outbuf.add_char ob '{'; - let is_first = ref true in - if !is_first then - is_first := false - else - Bi_outbuf.add_char ob ','; - Bi_outbuf.add_string ob "\"cpattern\":"; - ( - write__5 - ) - ob x.cpattern; - if !is_first then - is_first := false - else - Bi_outbuf.add_char ob ','; - Bi_outbuf.add_string ob "\"cbody\":"; - ( - write_t - ) - ob x.cbody; - Bi_outbuf.add_char ob '}'; -) -and string_of_case ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_case ob x; - Bi_outbuf.contents ob -and write_redirection : _ -> redirection -> _ = ( - fun ob x -> - match x with - | File x -> - Bi_outbuf.add_string ob "[\"File\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_redir_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_int - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Dup x -> - Bi_outbuf.add_string ob "[\"Dup\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_dup_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_int - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Heredoc x -> - Bi_outbuf.add_string ob "[\"Heredoc\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_heredoc_type - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_int - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' -) -and string_of_redirection ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_redirection ob x; - Bi_outbuf.contents ob -and write_t : _ -> t -> _ = ( - fun ob x -> - match x with - | Command x -> - Bi_outbuf.add_string ob "[\"Command\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _, _ = x in - ( - write__1 - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x, _ = x in - ( - write_args - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Pipe x -> - Bi_outbuf.add_string ob "[\"Pipe\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - Yojson.Safe.write_bool - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write__3 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Redir x -> - Bi_outbuf.add_string ob "[\"Redir\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Background x -> - Bi_outbuf.add_string ob "[\"Background\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Subshell x -> - Bi_outbuf.add_string ob "[\"Subshell\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__2 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | And x -> - Bi_outbuf.add_string ob "[\"And\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Or x -> - Bi_outbuf.add_string ob "[\"Or\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Not x -> - Bi_outbuf.add_string ob "[\"Not\","; - ( - write_t - ) ob x; - Bi_outbuf.add_char ob ']' - | Semi x -> - Bi_outbuf.add_string ob "[\"Semi\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | If x -> - Bi_outbuf.add_string ob "[\"If\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | While x -> - Bi_outbuf.add_string ob "[\"While\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | For x -> - Bi_outbuf.add_string ob "[\"For\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _, _ = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x, _ = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, _, x = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Case x -> - Bi_outbuf.add_string ob "[\"Case\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - write_arg - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write__4 - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' - | Defun x -> - Bi_outbuf.add_string ob "[\"Defun\","; - ( - fun ob x -> - Bi_outbuf.add_char ob '['; - (let x, _, _ = x in - ( - write_linno - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, x, _ = x in - ( - Yojson.Safe.write_string - ) ob x - ); - Bi_outbuf.add_char ob ','; - (let _, _, x = x in - ( - write_t - ) ob x - ); - Bi_outbuf.add_char ob ']'; - ) ob x; - Bi_outbuf.add_char ob ']' -) -and string_of_t ?(len = 1024) x = - let ob = Bi_outbuf.create len in - write_t ob x; - Bi_outbuf.contents ob -let rec read__1 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_assign - ) -) p lb -and _1_of_string s = - read__1 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__2 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_redirection - ) -) p lb -and _2_of_string s = - read__2 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__3 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_t - ) -) p lb -and _3_of_string s = - read__3 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__4 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_case - ) -) p lb -and _4_of_string s = - read__4 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__5 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_arg - ) -) p lb -and _5_of_string s = - read__5 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read__6 p lb = ( - Atdgen_runtime.Oj_run.read_list ( - read_arg_char - ) -) p lb -and _6_of_string s = - read__6 (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_arg p lb = ( - read__6 -) p lb -and arg_of_string s = - read_arg (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_arg_char = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "C" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (C x : arg_char) - | "E" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (E x : arg_char) - | "T" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read__7 - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (T x : arg_char) - | "A" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (A x : arg_char) - | "V" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_var_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (V x : arg_char) - | "Q" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Q x : arg_char) - | "B" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (B x : arg_char) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "C" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (C x : arg_char) - | "E" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_char - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (E x : arg_char) - | "T" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read__7 - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (T x : arg_char) - | "A" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (A x : arg_char) - | "V" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_var_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (V x : arg_char) - | "Q" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_arg - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Q x : arg_char) - | "B" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (B x : arg_char) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -and arg_char_of_string s = - read_arg_char (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_args p lb = ( - read__5 -) p lb -and args_of_string s = - read_args (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_assign = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); -) -and assign_of_string s = - read_assign (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_case = ( - fun p lb -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_lcurl p lb; - let field_cpattern = ref (Obj.magic (Sys.opaque_identity 0.0)) in - let field_cbody = ref (Obj.magic (Sys.opaque_identity 0.0)) in - let bits0 = ref 0 in - try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_object_end lb; - Yojson.Safe.read_space p lb; - let f = - fun s pos len -> - if pos < 0 || len < 0 || pos + len > String.length s then - invalid_arg "out-of-bounds substring position or length"; - match len with - | 5 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'b' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'd' && String.unsafe_get s (pos+4) = 'y' then ( - 1 - ) - else ( - -1 - ) - ) - | 8 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'p' && String.unsafe_get s (pos+2) = 'a' && String.unsafe_get s (pos+3) = 't' && String.unsafe_get s (pos+4) = 't' && String.unsafe_get s (pos+5) = 'e' && String.unsafe_get s (pos+6) = 'r' && String.unsafe_get s (pos+7) = 'n' then ( - 0 - ) - else ( - -1 - ) - ) - | _ -> ( - -1 - ) - in - let i = Yojson.Safe.map_ident p f lb in - Atdgen_runtime.Oj_run.read_until_field_value p lb; - ( - match i with - | 0 -> - field_cpattern := ( - ( - read__5 - ) p lb - ); - bits0 := !bits0 lor 0x1; - | 1 -> - field_cbody := ( - ( - read_t - ) p lb - ); - bits0 := !bits0 lor 0x2; - | _ -> ( - Yojson.Safe.skip_json p lb - ) - ); - while true do - Yojson.Safe.read_space p lb; - Yojson.Safe.read_object_sep p lb; - Yojson.Safe.read_space p lb; - let f = - fun s pos len -> - if pos < 0 || len < 0 || pos + len > String.length s then - invalid_arg "out-of-bounds substring position or length"; - match len with - | 5 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'b' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'd' && String.unsafe_get s (pos+4) = 'y' then ( - 1 - ) - else ( - -1 - ) - ) - | 8 -> ( - if String.unsafe_get s pos = 'c' && String.unsafe_get s (pos+1) = 'p' && String.unsafe_get s (pos+2) = 'a' && String.unsafe_get s (pos+3) = 't' && String.unsafe_get s (pos+4) = 't' && String.unsafe_get s (pos+5) = 'e' && String.unsafe_get s (pos+6) = 'r' && String.unsafe_get s (pos+7) = 'n' then ( - 0 - ) - else ( - -1 - ) - ) - | _ -> ( - -1 - ) - in - let i = Yojson.Safe.map_ident p f lb in - Atdgen_runtime.Oj_run.read_until_field_value p lb; - ( - match i with - | 0 -> - field_cpattern := ( - ( - read__5 - ) p lb - ); - bits0 := !bits0 lor 0x1; - | 1 -> - field_cbody := ( - ( - read_t - ) p lb - ); - bits0 := !bits0 lor 0x2; - | _ -> ( - Yojson.Safe.skip_json p lb - ) - ); - done; - assert false; - with Yojson.End_of_object -> ( - if !bits0 <> 0x3 then Atdgen_runtime.Oj_run.missing_fields p [| !bits0 |] [| "cpattern"; "cbody" |]; - ( - { - cpattern = !field_cpattern; - cbody = !field_cbody; - } - : case) - ) -) -and case_of_string s = - read_case (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_redirection = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "File" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_redir_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (File x : redirection) - | "Dup" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_dup_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Dup x : redirection) - | "Heredoc" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_heredoc_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Heredoc x : redirection) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "File" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_redir_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (File x : redirection) - | "Dup" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_dup_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Dup x : redirection) - | "Heredoc" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_heredoc_type - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_int - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_arg - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Heredoc x : redirection) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -and redirection_of_string s = - read_redirection (Yojson.Safe.init_lexer ()) (Lexing.from_string s) -and read_t = ( - fun p lb -> - Yojson.Safe.read_space p lb; - match Yojson.Safe.start_any_variant p lb with - | `Edgy_bracket -> ( - match Yojson.Safe.read_ident p lb with - | "Command" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__1 - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_args - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Command x : t) - | "Pipe" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__3 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Pipe x : t) - | "Redir" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Redir x : t) - | "Background" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Background x : t) - | "Subshell" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Subshell x : t) - | "And" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (And x : t) - | "Or" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Or x : t) - | "Not" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Not x : t) - | "Semi" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Semi x : t) - | "If" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (If x : t) - | "While" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (While x : t) - | "For" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (For x : t) - | "Case" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__4 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Case x : t) - | "Defun" -> - Atdgen_runtime.Oj_run.read_until_field_value p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_gt p lb; - (Defun x : t) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Double_quote -> ( - match Yojson.Safe.finish_string p lb with - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) - | `Square_bracket -> ( - match Atdgen_runtime.Oj_run.read_string p lb with - | "Command" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__1 - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_args - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Command x : t) - | "Pipe" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - Atdgen_runtime.Oj_run.read_bool - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read__3 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Pipe x : t) - | "Redir" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Redir x : t) - | "Background" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Background x : t) - | "Subshell" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__2 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Subshell x : t) - | "And" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (And x : t) - | "Or" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Or x : t) - | "Not" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - read_t - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Not x : t) - | "Semi" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Semi x : t) - | "If" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (If x : t) - | "While" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (While x : t) - | "For" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x3 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2, x3) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2; 3 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (For x : t) - | "Case" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - read_arg - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read__4 - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Case x : t) - | "Defun" -> - Yojson.Safe.read_space p lb; - Yojson.Safe.read_comma p lb; - Yojson.Safe.read_space p lb; - let x = ( - fun p lb -> - Yojson.Safe.read_space p lb; - let std_tuple = Yojson.Safe.start_any_tuple p lb in - let len = ref 0 in - let end_of_tuple = ref false in - (try - let x0 = - let x = - ( - read_linno - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x1 = - let x = - ( - Atdgen_runtime.Oj_run.read_string - ) p lb - in - incr len; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - x - in - let x2 = - let x = - ( - read_t - ) p lb - in - incr len; - (try - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - with Yojson.End_of_tuple -> end_of_tuple := true); - x - in - if not !end_of_tuple then ( - try - while true do - Yojson.Safe.skip_json p lb; - Yojson.Safe.read_space p lb; - Yojson.Safe.read_tuple_sep2 p std_tuple lb; - done - with Yojson.End_of_tuple -> () - ); - (x0, x1, x2) - with Yojson.End_of_tuple -> - Atdgen_runtime.Oj_run.missing_tuple_fields p !len [ 0; 1; 2 ]); - ) p lb - in - Yojson.Safe.read_space p lb; - Yojson.Safe.read_rbr p lb; - (Defun x : t) - | x -> - Atdgen_runtime.Oj_run.invalid_variant_tag p x - ) -) -and t_of_string s = - read_t (Yojson.Safe.init_lexer ()) (Lexing.from_string s) diff --git a/compiler/parser/ceda/ArgCharList.c b/compiler/parser/ceda/ArgCharList.c deleted file mode 100644 index d4f6b74e4..000000000 --- a/compiler/parser/ceda/ArgCharList.c +++ /dev/null @@ -1,118 +0,0 @@ -#include -#include -#include - -#include "ArgCharList.h" - - -struct argCharList { - struct argCharNode* head; - struct argCharNode* last; - - int length; -}; - - -struct argCharNode { - void* arg_char; // Translate OCaml 'arg_char' - - struct argCharNode* next; -}; - - -ArgCharList newArgCharList (void) { - ArgCharList myList = malloc (sizeof (struct argCharList)); - assert (myList != NULL); - - myList->head = NULL; - myList->last = NULL; - myList->length = 0; - - return (myList); -} - - -int isArgCharListEmpty (ArgCharList myList) { - assert (myList != NULL); - - if (myList->length == 0) { - assert (myList->head == NULL); - assert (myList->last == NULL); - } else { - assert (myList->head != NULL); - assert (myList->last != NULL); - } - - return (myList->head == NULL); -} - - -int argCharListLength (ArgCharList myList) { - assert (myList != NULL); - - return (myList->length); -} - - -void* argCharListHead (ArgCharList myList) { - assert (myList != NULL); - - assert (myList->head != NULL); - - return (myList->head->arg_char); -} - - -void argCharListTail (ArgCharList myList) { - assert (myList != NULL); - - assert (myList->length > 0); - - assert (myList->head != NULL); - - struct argCharNode* oldHead = myList->head; - myList->head = oldHead->next; - - free (oldHead); - - if (myList->head == NULL) { - myList->last = NULL; - } else if (myList->head->next == NULL) { - myList->last = myList->head; - } - - myList->length = myList->length - 1; -} - - -// Add to end of the list. -void appendArgCharList (ArgCharList myList, void* new_arg_char) { - assert (myList != NULL); - - struct argCharNode* newLast = malloc (sizeof (struct argCharNode)); - assert (newLast != NULL); - - newLast->arg_char = new_arg_char; - newLast->next = NULL; - - if (myList->head == NULL) { - myList->head = newLast; - myList->last = newLast; - } else { - myList->last->next = newLast; - myList->last = newLast; - } - - myList->length = myList->length + 1; -} - - -void destroyArgCharList (ArgCharList myList) { - assert (myList != NULL); - - while (! isArgCharListEmpty (myList)) { - argCharListTail (myList); - } - - free (myList); -} diff --git a/compiler/parser/ceda/ArgCharList.h b/compiler/parser/ceda/ArgCharList.h deleted file mode 100644 index 23bea7ff7..000000000 --- a/compiler/parser/ceda/ArgCharList.h +++ /dev/null @@ -1,10 +0,0 @@ -typedef struct argCharList* ArgCharList; - - -ArgCharList newArgCharList (void); -int isArgCharListEmpty (ArgCharList myList); -int argCharListLength (ArgCharList myList); -void* argCharListHead (ArgCharList myList); -void argCharListTail (ArgCharList myList); -void appendArgCharList (ArgCharList myList, void* new_arg_char); -void destroyArgCharList (ArgCharList myList); diff --git a/compiler/parser/ceda/ArgCharStack.h b/compiler/parser/ceda/ArgCharStack.h deleted file mode 100644 index 8383d03bb..000000000 --- a/compiler/parser/ceda/ArgCharStack.h +++ /dev/null @@ -1,11 +0,0 @@ -typedef struct argCharStack* ArgCharStack; - -ArgCharStack newArgCharStack (void); -int isArgCharStackEmpty (ArgCharStack myArgCharStack); -void pushArgCharStack (ArgCharStack myArgCharStack, void* newChar); -void* popArgCharStack (ArgCharStack myArgCharStack); -void* topArgCharStack (ArgCharStack myArgCharStack); -void* secondTopArgCharStack (ArgCharStack myArgCharStack); -unsigned int getArgCharStackSize (ArgCharStack myArgCharStack); -void reverseArgCharStack (ArgCharStack myArgCharStack); -void destroyArgCharStack (ArgCharStack myArgCharStack); diff --git a/compiler/parser/ceda/ArgCharStack2.c b/compiler/parser/ceda/ArgCharStack2.c deleted file mode 100644 index a812dc309..000000000 --- a/compiler/parser/ceda/ArgCharStack2.c +++ /dev/null @@ -1,125 +0,0 @@ -#include -#include -#include - -#include "ArgCharStack.h" - - -#define TRUE 1 -#define FALSE 0 - - -#define INIT_STACK_SIZE 32 - - -struct argCharStack { - unsigned int allocSize; - unsigned int usedSize; - - void** items; -}; - - -ArgCharStack newArgCharStack (void) { - ArgCharStack myArgCharStack = malloc (sizeof (struct argCharStack)); - assert (myArgCharStack != NULL); - - myArgCharStack->allocSize = INIT_STACK_SIZE; - myArgCharStack->usedSize = 0; - - myArgCharStack->items = malloc (sizeof (void*) * myArgCharStack->allocSize); - assert (myArgCharStack->items != NULL); - - return myArgCharStack; -} - - - -int isArgCharStackEmpty (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - return (myArgCharStack->usedSize == 0); -} - - -void pushArgCharStack (ArgCharStack myArgCharStack, void* item) { - assert (myArgCharStack != NULL); - - if (myArgCharStack->usedSize >= myArgCharStack->allocSize) { - myArgCharStack->allocSize = myArgCharStack->allocSize * 2; - myArgCharStack->items = realloc (myArgCharStack->items, sizeof (void*) * myArgCharStack->allocSize); - assert (myArgCharStack->items != NULL); - } - - myArgCharStack->items [myArgCharStack->usedSize] = item; - myArgCharStack->usedSize ++; -} - - -void* popArgCharStack (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - assert (myArgCharStack->usedSize > 0); - - myArgCharStack->usedSize --; - void* item = myArgCharStack->items [myArgCharStack->usedSize]; - // Don't bother shrinking stack - - return item; -} - - -void* topArgCharStack (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - assert (myArgCharStack->usedSize > 0); - - void* item = myArgCharStack->items [myArgCharStack->usedSize - 1]; - - return (item); -} - - -void* secondTopArgCharStack (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - assert (myArgCharStack->usedSize > 1); - - void* item = myArgCharStack->items [myArgCharStack->usedSize - 2]; - - return (item); -} - - -unsigned int getArgCharStackSize (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - return (myArgCharStack->usedSize); -} - - -void reverseArgCharStack (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - assert (myArgCharStack->items != NULL); - - for (int i = 0; i < myArgCharStack->usedSize / 2; i++) { - void* left = myArgCharStack->items [i]; - -// fprintf (stderr, "%d %p, %d %p\n", i, myArgCharStack->items [i], -// myArgCharStack->usedSize - 1 - i, myArgCharStack->items [myArgCharStack->usedSize - 1 - i]); - myArgCharStack->items [i] = myArgCharStack->items [myArgCharStack->usedSize - 1 - i]; - - myArgCharStack->items [myArgCharStack->usedSize - 1 - i] = left; - } -} - - -void destroyArgCharStack (ArgCharStack myArgCharStack) { - assert (myArgCharStack != NULL); - - assert (myArgCharStack->items != NULL); - free (myArgCharStack->items); - - free (myArgCharStack); -} diff --git a/compiler/parser/ceda/CharList.c b/compiler/parser/ceda/CharList.c deleted file mode 100644 index c95d13632..000000000 --- a/compiler/parser/ceda/CharList.c +++ /dev/null @@ -1,219 +0,0 @@ -#include -#include -#include - -#include "CharList.h" - - -struct charList { - struct charNode* head; - struct charNode* last; - - int length; -}; - - -struct charNode { - char c; // Translate OCaml 's : char list' - - struct charNode* next; -}; - - -//------------------------------------------------------------------------------------------- -// char or arg_char - - -static void checkList (CharList myList) { - return; - - assert (myList != NULL); - - int len = 0; - struct charNode* cur = myList->head; - - if (myList->head == NULL) { - assert (myList->last == NULL); - assert (myList->length == 0); - } else { - while (cur != NULL) { - if (cur->next == NULL) { - assert (cur == myList->last); - } - - len ++; - cur = cur->next; - } - - assert (len == myList->length); - } -} - - -CharList newCharList (void) { - CharList myList = malloc (sizeof (struct charList)); - assert (myList != NULL); - - myList->head = NULL; - myList->last = NULL; - myList->length = 0; - - checkList (myList); - - return (myList); -} - - -int isCharListEmpty (CharList myList) { - assert (myList != NULL); - - if (myList->length == 0) { - assert (myList->head == NULL); - assert (myList->last == NULL); - } else { - assert (myList->head != NULL); - assert (myList->last != NULL); - } - - checkList (myList); - - return (myList->head == NULL); -} - - -int charListLength (CharList myList) { - assert (myList != NULL); - -// checkList (myList); - - return (myList->length); -} - - -void charListTail (CharList myList) { - assert (myList != NULL); - - assert (myList->length > 0); - - assert (myList->head != NULL); - assert (myList->last != NULL); - - struct charNode* oldHead = myList->head; - myList->head = oldHead->next; - - free (oldHead); - - if (myList->head == NULL) { - // [] - myList->last = NULL; - } - - myList->length = myList->length - 1; - - checkList (myList); -} - - -void destroyCharList (CharList myList) { - assert (myList != NULL); - - checkList (myList); - - while (! isCharListEmpty (myList)) { - charListTail (myList); - } - - free (myList); -} - - -//------------------------------------------------------------------------------------------- -// char - - -void prependCharList_char (CharList myList, char newChar) { - assert (myList != NULL); - - struct charNode* newHead = malloc (sizeof (struct charNode)); - assert (newHead != NULL); - - newHead->c = newChar; - newHead->next = myList->head; - - if (isCharListEmpty (myList)) { - myList->last = newHead; - } - - myList->head = newHead; - myList->length = myList->length + 1; -} - - -void appendCharList_char (CharList myList, char newChar) { - assert (myList != NULL); - - struct charNode* newLast = malloc (sizeof (struct charNode)); - assert (newLast != NULL); - - newLast->c = newChar; - newLast->next = NULL; - - if (isCharListEmpty (myList)) { - myList->head = newLast; - } else { - myList->last->next = newLast; - } - - myList->last = newLast; - myList->length = myList->length + 1; -} - - -char charListHead_char (CharList myList) { - assert (myList != NULL); - - assert (myList->head != NULL); - assert (myList->last != NULL); - - return (myList->head->c); -} - - -char charListSecond_char (CharList myList) { - assert (myList != NULL); - - assert (myList->head != NULL); - assert (myList->head->next != NULL); - - return (myList->head->next->c); -} - - -char charListLast_char (CharList myList) { - assert (myList != NULL); - - assert (myList->head != NULL); - assert (myList->last != NULL); - - return (myList->last->c); -} - - -// Returns the first half of the list, divided by the separator (which stays in the original list). -CharList split_at (CharList myList, char separator) { - assert (myList != NULL); - - CharList leftList = newCharList (); - - while (myList != NULL) { - if (charListHead_char (myList) == separator) { - break; // Ugh - } - - appendCharList_char (leftList, charListHead_char (myList)); - - charListTail (myList); - } - - return (leftList); -} diff --git a/compiler/parser/ceda/CharList.h b/compiler/parser/ceda/CharList.h deleted file mode 100644 index e4354cf74..000000000 --- a/compiler/parser/ceda/CharList.h +++ /dev/null @@ -1,16 +0,0 @@ -typedef struct charList* CharList; - - -CharList newCharList (void); -int isCharListEmpty (CharList myList); -int charListLength (CharList myList); -void charListTail (CharList myList); -void charListInit (CharList myList); -void destroyCharList (CharList myList); - -void prependCharList_char (CharList myList, char newChar); -void appendCharList_char (CharList myList, char newChar); -char charListHead_char (CharList myList); -char charListSecond_char (CharList myList); -CharList split_at (CharList myList, char separator); -// int existsInCharList (CharList myList, char key); diff --git a/compiler/parser/ceda/Makefile b/compiler/parser/ceda/Makefile deleted file mode 100644 index 8a021292f..000000000 --- a/compiler/parser/ceda/Makefile +++ /dev/null @@ -1,58 +0,0 @@ -JSON_C_DIR=/pash/json-c-0.15/install/ -SCRIPTS_DIR=/pash/ - -CC=gcc -CFLAGS=-fPIC -g -O2 -Wall -Werror -I"$(JSON_C_DIR)/include/json-c" -I"../libdash/src" -LDFLAGS=-ljson-c -L"$(JSON_C_DIR)/lib" -Wl,-rpath="$(JSON_C_DIR)/lib" - - -all: parse_to_json2 json_to_shell2 prettyprint_json libdash2.so - - -# C binaries -parse_to_json2: parse_to_json2.o ast2a.o ast2json.o dash2.o Stack2.o arg_char.o ArgCharStack2.o - $(CC) $(CFLAGS) $^ -o $@ $(LDFLAGS) -ldash - -json_to_shell2: json_to_shell2.o ast2b.o - $(CC) $(CFLAGS) $^ -o $@ $(LDFLAGS) - -prettyprint_json: prettyprint_json.o - $(CC) $(CFLAGS) $^ -o $@ $(LDFLAGS) - - -# Shared objects -libdash2.so: dash2.o - $(CC) -shared $^ -o $@ $(LDFLAGS) -ldash - - -# Tests for C binaries -testsA: parse_to_json2 - @find "$(SCRIPTS_DIR)" | grep '[.]sh$$' | while read f; do sh test_parse_to_JSON2.sh "$$f"; done | tee /tmp/cdashA.log - @echo - @cat /tmp/cdashA.log | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c - -testsB: json_to_shell2 - @find "$(SCRIPTS_DIR)" | grep '[.]sh$$' | while read f; do sh test_JSON_to_shell2.sh "$$f"; done | tee /tmp/cdashB.log - @echo - @cat /tmp/cdashB.log | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c - -testsRT: test_rt.sh parse_to_json2 json_to_shell2 - @find "$(SCRIPTS_DIR)" | grep '[.]sh$$' | while read f; do sh test_rt.sh "$$f"; done | tee /tmp/cdash_rt.log - @echo - @cat /tmp/cdash_rt.log | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c - -# Tests for Python scripts -testsRT_py: test_rt_py.sh - @find "$(SCRIPTS_DIR)" | grep '[.]sh$$' | while read f; do sh test_rt_py.sh "$$f"; done | tee /tmp/cdash_rt_py.log - @echo - @cat /tmp/cdash_rt_py.log | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c - -#testsB_py: test_ast2shell_py.sh -# @find "$(SCRIPTS_DIR)" | grep '[.]sh$$' | while read f; do sh test_ast2shell_py.sh "$$f"; done | tee /tmp/cdashB_py.log -# @echo -# @cat /tmp/cdashB_py.log | egrep '^[A-Z]+:' | cut -d ':' -f 1 | sort | uniq -c - - -# Clean -clean: - rm parse_to_json2 json_to_shell2 *.o *.so diff --git a/compiler/parser/ceda/README.md b/compiler/parser/ceda/README.md deleted file mode 100644 index 580610e64..000000000 --- a/compiler/parser/ceda/README.md +++ /dev/null @@ -1,236 +0,0 @@ -# Shell scripts <-> Pash AST (without OCaml) - - - -## Overall status - -* Shell script <-> JSON - * Shell script -> JSON, C implementation: 99.9% complete - * JSON -> shell script, C implementation: 99.9% complete - -N.B. Pash already has functions for JSON <-> Past AST (*). - -* Shell script <-> Pash AST, skipping JSON entirely - * Shell script -> Pash AST, Python implementation: not started - * Pash AST -> shell script, Python implementation: 99.9% complete - -(*) The Pash AST is defined as the data structure obtained -from `parse_json_ast_string (json)`, and which can be used as -input to `serialize_asts_to_json (asts)`. - - - -## Design Notes - -The libdash unparser is actually pure OCaml code, without any calls to the C dash library; i.e., the current pipeline from Pash Python AST to shell script is: -1. Pash Python AST -> JSON (json_ast: serialize_asts_to_json) -2. JSON -> libdash OCaml AST (Ast_json.t_of_string, auto-generated by atdgen) -3. libdash OCaml AST -> shell script (the second half of ast.ml) -which does not use the Dash C AST at all. - -This is simpler than the parsing direction, which requires the (lib)dash C library i.e., -1. shell script -> Dash C AST (most of the bindings in dash.ml, calling libdash's underlying C code) -2. Dash C AST -> libdash OCaml AST (the first half of ast.ml) -3. libdash OCaml AST -> JSON (Ast_json.string_of_t, auto-generated by atdgen) -4. JSON -> Pash Python AST (json_ast: parse_json_ast_string) - -The upshot of this is that, if we skip the JSON step, the unparsing pipeline can be simplified to: -1. Pash Python AST -> shell script - -which can be done in pure Python code. Voila: https://github.com/andromeda/pash/blob/ceda/compiler/parser/ceda/ast2shell.py - -Compare to the to_string function of the libdash OCaml unparser: https://github.com/angelhof/libdash/blob/ef6302502b904e33dd4cc686d71142fb1a87bbbd/ocaml/ast.ml) - -The parsing pipeline, sans JSON, would still require the C dash library (albeit without OCaml): -1. shell script -> Dash C AST -4. Dash C AST -> Pash Python AST - - - -## Pre-requisites for C implementations - -* json-c v0.15: - -``` -cd /pash -wget https://s3.amazonaws.com/json-c_releases/releases/json-c-0.15.tar.gz -tar zxf json-c-0.15.tar.gz -cd json-c-0.15 -mkdir build -cd build/ -cmake -DCMAKE_INSTALL_PREFIX=/pash/json-c-0.15/install ../ -make install -``` - - - -## Usage - -### Shell script -> JSON (C implementation) - -It has the same usage as `parse_to_json` i.e., -`./parse_to_json2 SCRIPT_FILE_NAME` or `./parse_to_json2 < SCRIPT_FILE_NAME` - -e.g., -``` -$ ./parse_to_json2 /pash/evaluation/hello-world.sh -``` - -### JSON -> shell script (C implementation) - -It has the same usage as `json_to_shell` i.e., -`./json_to_shell2 JSON_FILE_NAME` or `./json_to_shell2 < JSON_FILE_NAME` - -e.g., - -``` -$ cat /pash/evaluation/hello-world.sh | ./parse_to_json2 | ./json_to_shell2 -if [ $(uname) = "Darwin" ]; then a=/usr/share/dict/web2; else a=/usr/share/dict/words; fi -if [ -f ${a} ]; then cat ${a} ${a} ${a} ${a} ${a} ${a} ${a} ${a} | grep "\\(.\\).*\\1\\(.\\).*\\2\\(.\\).*\\3\\(.\\).*\\4" | wc -l; else echo "Dictionary file ${a} not found.."; fi -``` - -### Shell script -> Pash AST (TODO) - -### Pash AST -> shell script (Python implementation) - -ast2shell.py :: string_of - -See the misleadingly-named rt.py for example usage - -* Secret sauce: `export PYTHONIOENCODING=charmap` - -## Testing (with an individual test case) - -### Shell script -> JSON (C implementation) - -``` -sh test_parse_to_JSON2.sh SOME_SCRIPT_FILE -``` - -This applies the OCaml implementation of `parse_to_json` to the specified script file, and compares the output against this re-implementation. - -Output: -* `INVALID_INPUT_1` means the shell script cannot be parsed to JSON by the reference implementation. -* `ABORT` or `FAIL` means there's a bug in Thurston's code. -* `PASS` is good. - -### JSON -> shell script (C implementation) - -``` -sh test_JSON_to_shell2.sh SOME_SCRIPT_FILE -``` - -This applies the OCaml implementation of `parse_to_json` to the specified script file, then compares the OCaml `json_to_shell` against this re-implementation. - -Output: -* `INVALID_INPUT_1` or `INVALID_INPUT_2` means the shell script cannot be parsed to or from JSON by the reference implementation. -* `ABORT` or `FAIL` means there's a bug in Thurston's code. -* `PASS` is good. - -### Combo: shell script -> JSON -> shell script (C implementation) - -``` -sh test_rt.sh SOME_SCRIPT_FILE -``` - -This compares the output of the OCaml pipeline (parse_to_json + json_to_shell) against the C reimplementation (parse_to_json2 + json_to_shell2). - - - -## Testing (with all the scripts in /pash/) - -This includes `test_JSON_to_shell2.sh` and any other helper scripts in my local copy of PaSh, hence -the number of scripts may vary on your system. - - -``` -make testsRT # Uses test_rt.sh - -make testsA # Uses test_parse_to_json2.sh -make testsB # Uses test_parse_to_json2.sh - -make testsB_py # Uses test_ast2shell_py.sh -``` - -### testsRT: parse_to_json2.c + json_to_shell2.c round-trip results -``` - 341 PASS - 33 REF_ABORT_1 -``` - -### testsA: parse_to_json2.c results - -Failures are because the Background line number is not initialized by dash for some shell scripts -(the libdash OCaml implementation returns "random" values). As discussed via email, this is not relevant to -PaSh. - -``` - 11 FAIL - 33 INVALID_INPUT - 330 PASS -``` - -### testsB: json_to_shell2.c results - -All shell scripts that the OCaml implementation works on are regenerated, byte-for-byte identical: -``` - 33 INVALID_INPUT_1 - 341 PASS -``` - -### testsB_py: ast2shell.py results - -When using ASCII or UTF-8 encoding, there are three failures/aborts, due to weird non-ASCII -characters that don't play nicely with Python: -``` - 3 ABORT - 338 PASS - 33 REF_ABORT_1 -``` - -``` -ABORT: '/pash/evaluation/poets/pipelines.sh' | /tmp/rt_ocaml.28692 /tmp/rt_py.28692 -ABORT: '/pash/compiler/parser/run_parser_on_scripts.sh' | /tmp/rt_ocaml.29910 /tmp/rt_py.29910 -ABORT: '/pash/compiler/parser/libdash/ltmain.sh' -``` - -The two failures/aborts (depending on the settings) - disappear when we use `export PYTHONIOENCODING=charmap`. -The remaining "ABORT" case (ltmain.sh) actually happens in parse.py::parse_shell even with -the OCaml implementation i.e., not in ast2shell.py. - -## Mapping of Files between C and OCaml implementations - -* arg_char.c => ast.ml (part 1A: just the arg_char type and associated functions, used for parsing to JSON) -* ast2a.c => ast.ml (part 1B: everything else for parsing to JSON) -* ast2b.c => ast.ml (part 2: everything for serializing JSON to shell) - -* dash2.c => dash.ml - -* ast2json.c => Ast_json.ml - * OCaml version was auto-generated by atdgen - * Notice that we did not implement converting JSON to our AST; json_to_shell2 directly serializes the JSON data structures. - -* json_to_shell2.c => json_to_shell.ml -* parse_to_json2.c => parse_to_json.ml - -* CharList.c, Stack.c => basic data structures that OCaml has built-in - -For testing only: -* prettyprint_json.c - -## Known Bugs - -### parse_to_json2.c -* Memory leaks galore -* To keep the code somewhat resembling OCaml, I've left in recursion instead of eliminating tail calls. I'm hoping the C compiler will optimize them away; if not, the stack may overflow. -* Not Python - -### json_to_shell2.c -* `fresh_marker` for heredocs. This is really obscure and a pain to implement in C. For real-world, non-adversarial settings, just change the marker from "EOF" to some random text. -* Same issue with tail calls -* Not Python - -### ast2shell.py -* `fresh_marker` for heredocs -* Non-ASCII characters diff --git a/compiler/parser/ceda/Stack.c b/compiler/parser/ceda/Stack.c deleted file mode 100644 index 137391efa..000000000 --- a/compiler/parser/ceda/Stack.c +++ /dev/null @@ -1,226 +0,0 @@ -#include -#include -#include - -#include "Stack.h" - - -#define TRUE 1 -#define FALSE 0 - - -struct node { - char c; - struct node* next; -}; - - -struct stack { - int size; - struct node* head; -}; - - -Stack newStack (void) { - Stack myStack = malloc (sizeof (struct stack)); - assert (myStack != NULL); - - myStack->size = 0; - myStack->head = NULL; - - return myStack; -} - - - -int isStackEmpty (Stack myStack) { - assert (myStack != NULL); - - return (myStack->size == 0); -} - - -void pushStack (Stack myStack, char newChar) { - assert (myStack != NULL); - - myStack->size ++; - - struct node* myNode = malloc (sizeof (struct node)); - assert (myNode != NULL); - - myNode->c = newChar; - myNode->next = myStack->head; - - myStack->head = myNode; -} - - -char popStack (Stack myStack) { - assert (myStack != NULL); - - myStack->size --; - assert (myStack->head != NULL); - - struct node* oldHead = myStack->head; - - char myChar = myStack->head->c; - myStack->head = myStack->head->next; - - free (oldHead); - - return myChar; -} - - - -char topStack (Stack myStack) { - assert (myStack != NULL); - - assert (myStack->head != NULL); - - return (myStack->head->c); -} - - -char secondTopStack (Stack myStack) { - assert (myStack != NULL); - - assert (myStack->head != NULL); - assert (myStack->head->next != NULL); - - return (myStack->head->next->c); -} - - -unsigned int getStackSize (Stack myStack) { - assert (myStack != NULL); - - return (myStack->size); -} - - -void destroyStack (Stack myStack) { - assert (myStack != NULL); - - while (! isStackEmpty (myStack)) { - popStack (myStack); - } - - free (myStack); -} - - -char* serializeStack (Stack myStack) { - assert (myStack != NULL); - - char* str = malloc (myStack->size + 1); - assert (str != NULL); - - int i = 0; - struct node* cur = myStack->head; - while (cur != NULL) { - str [i] = cur->c; - - i ++; - cur = cur->next; - } - str [i] = '\0'; - - return str; -} - - -int existsInStack (Stack myStack, char key) { - assert (myStack != NULL); - - struct node* head = myStack->head; - while (head != NULL) { - if (head->c == key) { - return TRUE; - } - - head = head->next; - } - - return FALSE; -} - - - -Stack explode (char* str) { - assert (str != NULL); - - Stack list = newStack (); - - int len = strlen (str); - for (int i = len - 1; i >= 0; i--) { -// for (int i = 0; i < len; i++) { - pushStack (list, str [i]); - } - - return (list); -} - - -char* implode (Stack myList) { - assert (myList != NULL); - - char* str = malloc (getStackSize (myList) + 1); - assert (str != NULL); - - int i = 0; - while (getStackSize (myList) > 0) { - str [i] = popStack (myList); - - i ++; - } - - str [i] = '\0'; - - destroyStack (myList); - - return (str); -} - - - -// Returns the first half of the list, divided by the separator (which stays in the original list). -Stack split_at (Stack myStack, char separator) { - assert (myStack != NULL); - - Stack leftStack = newStack (); - - while (getStackSize (myStack) > 0) { - if (topStack (myStack) == separator) { - break; // Ugh - } - - pushStack (leftStack, popStack (myStack)); - } - - Stack revLeftStack = newStack (); - while (getStackSize (leftStack) > 0) { - pushStack (revLeftStack, popStack (leftStack)); - } - - return (revLeftStack); -} - - -/* -Stack split_at (Stack oldStack, char separator) { - assert (oldStack != NULL); - - Stack myStack = newStack (); - assert (myStack != NULL); - - for (int i = 0; i < oldStack->usedSize; i++) { - if (oldStack->items [i] == separator) { - - } - } - - assert (! "Separator not found"); - return NULL; -} -*/ diff --git a/compiler/parser/ceda/Stack.h b/compiler/parser/ceda/Stack.h deleted file mode 100644 index 7da265ab8..000000000 --- a/compiler/parser/ceda/Stack.h +++ /dev/null @@ -1,18 +0,0 @@ -typedef struct stack* Stack; - -Stack newStack (void); -int isStackEmpty (Stack myStack); -void pushStack (Stack myStack, char newChar); -char popStack (Stack myStack); -char topStack (Stack myStack); -char secondTopStack (Stack myStack); -unsigned int getStackSize (Stack myStack); -void destroyStack (Stack myStack); - -char* serializeStack (Stack myStack); -int existsInStack (Stack myStack, char key); - -Stack explode_rev (char* str); -char* implode_rev (Stack myStack); - -Stack split_at (Stack myStack, char separator); diff --git a/compiler/parser/ceda/Stack2.c b/compiler/parser/ceda/Stack2.c deleted file mode 100644 index 6d164fa6c..000000000 --- a/compiler/parser/ceda/Stack2.c +++ /dev/null @@ -1,259 +0,0 @@ -#include -#include -#include - -#include "Stack.h" - - -#define TRUE 1 -#define FALSE 0 - - -#define INIT_STACK_SIZE 32 - - -struct stack { - unsigned int allocSize; - unsigned int usedSize; - - char* items; -}; - - -Stack newStack (void) { - Stack myStack = malloc (sizeof (struct stack)); - assert (myStack != NULL); - - myStack->allocSize = INIT_STACK_SIZE; - myStack->usedSize = 0; - - myStack->items = malloc (sizeof (char) * myStack->allocSize); - assert (myStack->items != NULL); - - return myStack; -} - - - -int isStackEmpty (Stack myStack) { - assert (myStack != NULL); - - return (myStack->usedSize == 0); -} - - -void pushStack (Stack myStack, char item) { - assert (myStack != NULL); - - if (myStack->usedSize >= myStack->allocSize) { - myStack->allocSize = myStack->allocSize * 2; - myStack->items = realloc (myStack->items, sizeof (char) * myStack->allocSize); - assert (myStack->items != NULL); - } - - myStack->items [myStack->usedSize] = item; - myStack->usedSize ++; -} - - -char popStack (Stack myStack) { - assert (myStack != NULL); - - assert (myStack->usedSize > 0); - - myStack->usedSize --; - char item = myStack->items [myStack->usedSize]; - // Don't bother shrinking stack - - return item; -} - - -char topStack (Stack myStack) { - assert (myStack != NULL); - - assert (myStack->usedSize > 0); - - char item = myStack->items [myStack->usedSize - 1]; - - return (item); -} - - -char secondTopStack (Stack myStack) { - assert (myStack != NULL); - - assert (myStack->usedSize > 1); - - char item = myStack->items [myStack->usedSize - 2]; - - return (item); -} - - -unsigned int getStackSize (Stack myStack) { - assert (myStack != NULL); - - return (myStack->usedSize); -} - - -void destroyStack (Stack myStack) { - assert (myStack != NULL); - - assert (myStack->items != NULL); - free (myStack->items); - - free (myStack); -} - - -char* serializeStack (Stack myStack) { - assert (myStack != NULL); - - char* str = malloc (myStack->usedSize + 1); - assert (str != NULL); - - memcpy (str, myStack->items, sizeof (char) * myStack->usedSize); - str [myStack->usedSize] = '\0'; - - return str; -} - - -int existsInStack (Stack myStack, char key) { - assert (myStack != NULL); - - for (int i = 0; i < myStack->usedSize; i++) { - if (myStack->items [i] == key) { - return TRUE; - } - } - - return FALSE; -} - - -// Generic implementation -// Deliberately reversed -Stack explode_rev0 (char* str) { - assert (str != NULL); - - Stack list = newStack (); - - int len = strlen (str); - for (int i = len - 1; i >= 0; i--) { -// for (int i = 0; i < len; i++) { - pushStack (list, str [i]); - } - - return (list); -} - - -// Deliberately reversed -Stack explode_rev (char* str) { - assert (str != NULL); - - Stack myStack = newStack (); - assert (myStack != NULL); - - int len = strlen (str); - - if (myStack->allocSize < len) { - myStack->allocSize = len; - myStack->items = realloc (myStack->items, sizeof (char) * myStack->allocSize); - assert (myStack->items != NULL); - } - - for (int i = 0; i < len; i++) { - myStack->items [len - 1 - i] = str [i]; - } - - myStack->usedSize = len; - - return (myStack); -} - - -char* implode0 (Stack myList) { - assert (myList != NULL); - - char* str = malloc (getStackSize (myList) + 1); - assert (str != NULL); - - int i = 0; - while (getStackSize (myList) > 0) { - str [i] = popStack (myList); - - i ++; - } - - str [i] = '\0'; - - destroyStack (myList); - - return (str); -} - - -char* implode_rev (Stack myStack) { - assert (myStack != NULL); - - int len = getStackSize (myStack); - char* str = malloc (sizeof (char) * (len + 1)); - assert (str != NULL); - - for (int i = 0; i < len; i++) { - str [i] = myStack->items [len - 1 - i]; - } - str [len] = '\0'; - - return (str); -} - - -// Returns the first half of the list, divided by the separator (which stays in the original list). -Stack split_at (Stack myStack, char separator) { - assert (myStack != NULL); - - Stack leftStack = newStack (); - - while (getStackSize (myStack) > 0) { - if (topStack (myStack) == separator) { - break; // Ugh - } - - pushStack (leftStack, popStack (myStack)); - } - - Stack revLeftStack = newStack (); - while (getStackSize (leftStack) > 0) { - pushStack (revLeftStack, popStack (leftStack)); - } - - return (revLeftStack); -} - - -/* - - - -// Returns the first half of the list, divided by the separator (which stays in the original list). -Stack split_at (Stack myStack, char separator) { - assert (myStack != NULL); - - Stack leftStack = newStack (); - - while (getStackSize (myStack) > 0) { - if (topStack (myStack) == separator) { - break; // Ugh - } - - pushStack (leftStack, popStack (myStack)); - } - - return (leftStack); -} -*/ diff --git a/compiler/parser/ceda/archive.sh b/compiler/parser/ceda/archive.sh deleted file mode 100644 index dbfe62708..000000000 --- a/compiler/parser/ceda/archive.sh +++ /dev/null @@ -1,6 +0,0 @@ -timestamp=`date +"%Y%m%d%H%M%S"` - -tar cf cdash.tar \ - *.c *.h *.sh *.py Makefile - -cp -p cdash.tar "cdash-${timestamp}.tar" diff --git a/compiler/parser/ceda/arg_char.c b/compiler/parser/ceda/arg_char.c deleted file mode 100644 index 87b5e2f14..000000000 --- a/compiler/parser/ceda/arg_char.c +++ /dev/null @@ -1,81 +0,0 @@ -#include -#include - -#include "arg_char.h" - - -// Strings instead of char for convenient JSON serialization -const char* SERIALIZE_TYPE_ARG_CHAR [] = {"C", "E", "T", "A", "V", "Q", "B"}; - - -struct arg_char_TYPE* newArgCharC (char c) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_C; - a->C.c = c; - - return a; -} - - -struct arg_char_TYPE* newArgCharE (char c) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_E; - a->E.c = c; - - return a; -} - - -struct arg_char_TYPE* newArgCharT (char* str) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_T; - a->T.str = str; - - return a; -} - - -struct arg_char_TYPE* newArgCharA (arg_TYPE arg) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_A; - a->A.arg = arg; - - return a; -} - - -struct arg_char_TYPE* newArgCharV (int var_type, int vsnul, char* str, arg_TYPE arg) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_V; - a->V.var_type = var_type; - a->V.vsnul = vsnul; - a->V.str = str; - a->V.arg = arg; - - return a; -} - - -struct arg_char_TYPE* newArgCharQ (arg_TYPE arg) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_Q; - a->Q.arg = arg; - - return a; -} - - -struct arg_char_TYPE* newArgCharB (struct t_TYPE* t) { - struct arg_char_TYPE* a = malloc (sizeof (struct arg_char_TYPE)); - assert (a != NULL); - a->type = TYPE_ARG_CHAR_B; - a->B.t = t; - - return a; -} diff --git a/compiler/parser/ceda/arg_char.h b/compiler/parser/ceda/arg_char.h deleted file mode 100644 index a3f2e508d..000000000 --- a/compiler/parser/ceda/arg_char.h +++ /dev/null @@ -1,83 +0,0 @@ -#include "ArgCharStack.h" - - -#define TYPE_ARG_CHAR_C 0 -#define TYPE_ARG_CHAR_E 1 -#define TYPE_ARG_CHAR_T 2 -#define TYPE_ARG_CHAR_A 3 -#define TYPE_ARG_CHAR_V 4 -#define TYPE_ARG_CHAR_Q 5 -#define TYPE_ARG_CHAR_B 6 - - -// typedef ArgCharList arg_TYPE; // arg = arg_char list -typedef ArgCharStack arg_TYPE; // arg = arg_char list - - -extern const char* SERIALIZE_TYPE_ARG_CHAR []; - - -//------------------------------------------------------------------------------------------ -// arg_char = ... - - -// | C of char -struct arg_char_C { - unsigned char c; -}; - -// | E of char (* escape... necessary for expansion *) -struct arg_char_E { - unsigned char c; -}; - -// | T of string option (* tilde *) -struct arg_char_T { - char* str; -}; - -// | A of arg (* arith *) -struct arg_char_A { - arg_TYPE arg; -}; - -// | V of var_type * bool (* VSNUL? *) * string * arg -struct arg_char_V { - int var_type; - int vsnul; - char* str; - arg_TYPE arg; -}; - -// | Q of arg (* quoted *) -struct arg_char_Q { - arg_TYPE arg; -}; - -// | B of t (* backquote *) -struct arg_char_B { - struct t_TYPE* t; -}; - -struct arg_char_TYPE { - int type; - - union { - struct arg_char_C C; - struct arg_char_E E; - struct arg_char_T T; - struct arg_char_A A; - struct arg_char_V V; - struct arg_char_Q Q; - struct arg_char_B B; - }; -}; - - -struct arg_char_TYPE* newArgCharC (char c); -struct arg_char_TYPE* newArgCharE (char c); -struct arg_char_TYPE* newArgCharT (char* str); -struct arg_char_TYPE* newArgCharA (arg_TYPE arg); -struct arg_char_TYPE* newArgCharV (int var_type, int vsnul, char* str, arg_TYPE arg); -struct arg_char_TYPE* newArgCharQ (arg_TYPE arg); -struct arg_char_TYPE* newArgCharB (struct t_TYPE* t); diff --git a/compiler/parser/ceda/ast2a.c b/compiler/parser/ceda/ast2a.c deleted file mode 100644 index d1a1de4d0..000000000 --- a/compiler/parser/ceda/ast2a.c +++ /dev/null @@ -1,1183 +0,0 @@ -/* - - - ast2a.c : Exports 'of_node' which, analogously to the function in - libdash's ast.ml, converts an ordinary shell script into - a C-approximation of the libdash AST. - - The functions here intentionally closely match ast.ml; - relevant OCaml snippets are included as comments. - - - N.B. this leaks memory - don't use it for a persistent process. - - -*/ - - -#include -#include -#include -#include -#include - -#include "shell.h" - -#include "init.h" -#include "input.h" -#include "main.h" -#include "memalloc.h" -#include "nodes.h" -#include "parser.h" - -#include "dash2.h" -#include "ast2a.h" -#include "ast2json.h" - -#include "json_object.h" - -#include "arg_char.h" -#include "Stack.h" - - -//---------------------------------------------------------------------------------------------------------------------- - -int var_type (int vstype); - -int needs_escaping (char c); - -void mk_file (struct redirection_TYPE* redirection, union node* n, int ty); -void mk_dup (struct redirection_TYPE* redirection, union node* n, int ty); -void mk_here (struct redirection_TYPE* redirection, union node* n, int ty); -struct redirectionList* redirs (union node* n); -arg_TYPE to_arg (struct narg* n); -arg_TYPE parse_arg (Stack s, struct nodelist** bqlist, Stack stack); -char* parse_tilde (Stack s); -arg_TYPE arg_char_FUNC (struct arg_char_TYPE* c, Stack s, struct nodelist** bqlist, Stack stack); -struct assign_TYPE* to_assign (ArgCharStack ca); -struct assign_list* to_assigns (union node* assign); -struct args_TYPE* to_args (union node* n); - -//---------------------------------------------------------------------------------------------------------------------- - - -const char* SERIALIZE_TYPE_T [] - = { - "Command", "Pipe", "Redir", "Background", "Subshell", - "And", "Or", "Not", "Semi", - "If", "While", "For", "Case", "Defun" - }; - -const char* SERIALIZE_VAR_TYPE [] - = { - "Normal", // 0x0 - "UNUSED", - "Minus", // 0x2 - "Plus", // 0x3 - "Question", // 0x4 - "Assign", // 0x5 - "TrimR", // 0x6 - "TrimRMax", // 0x7 - "TrimL", // 0x8 - "TrimLMax", // 0x9 - "Length" // 0xA - }; - -const char* SERIALIZE_REDIRECTION_TYPE [] = {"File", "Dup", "Heredoc"}; - -const char* SERIALIZE_REDIR_TYPE [] = {"To", "Clobber", "From", "FromTo", "Append"}; - -const char* SERIALIZE_DUP_TYPE [] = {"ToFD", "FromFD"}; - -const char* SERIALIZE_HEREDOC_TYPE [] = {"Here", "XHere"}; - - -//---------------------------------------------------------------------------------------------------------------------- - - -int var_type (int vstype) { - // We don't have algebraic data types (e.g., 0x0 -> `Normal); instead, we have - // defined VAR_TYPE_ such that this is the identity function. - - return (vstype); -} - - -// ------------------------------------------------------------------------------------- - - -// let special_chars : char list = explode "|&;<>()$`\\\"'" - - -// let needs_escaping c = List.mem c special_chars -int needs_escaping (char c) { - - // Would be more efficient as a lookup table - switch (c) { - case '|': - case '&': - case ';': - case '<': - case '>': - case '(': - case ')': - case '$': - case '`': - case '\\': - case '"': - case '\'': - return TRUE; - default: - return FALSE; - } -} - - -// ------------------------------------------------------------------------------------- - - -// OCaml code excerpts inlined -struct t_TYPE* of_node (union node* n) { - // printf ("[of_node] %s\n", NODE_NAMES [n->type]); - - struct t_TYPE* t = malloc (sizeof (struct t_TYPE)); - assert (t != NULL); - - /* - let skip = Command (-1,[],[],[]) - - if nullptr n - then skip - */ - if (n == NULL) { - t->type = TYPE_T_COMMAND; - t->Command.linno = -1; - t->Command.assign = NULL; - t->Command.args = NULL; - t->Command.redirect = NULL; - } else { - switch (n->type) { - case NCMD: { - (void) 0; - /* - let n = n @-> node_ncmd in - Command (getf n ncmd_linno, - to_assigns (getf n ncmd_assign), - to_args (getf n ncmd_args), - redirs (getf n ncmd_redirect)) - */ - - t->type = TYPE_T_COMMAND; - t->Command.linno = n->ncmd.linno; - t->Command.assign = to_assigns (n->ncmd.assign); - t->Command.args = to_args (n->ncmd.args); - t->Command.redirect = redirs (n->ncmd.redirect); - } - break; // Should be unreachable but we leave it in for clarity - - case NPIPE: { - /* - let n = n @-> node_npipe in - Pipe (getf n npipe_backgnd <> 0, - List.map of_node (nodelist (getf n npipe_cmdlist))) - */ - - t->type = TYPE_T_PIPE; - t->Pipe.background = (n->npipe.backgnd != 0); - t->Pipe.spill = NULL; - - struct t_list* last = NULL; - struct nodelist* cmdlist = n->npipe.cmdlist; - while (cmdlist != NULL) { - struct t_list* newLast = malloc (sizeof (struct t_list)); - assert (newLast != NULL); - - newLast->t = of_node (cmdlist->n); - newLast->next = NULL; - - if (last == NULL) { - t->Pipe.spill = newLast; - last = newLast; - } else { - last->next = newLast; - last = newLast; - } - - cmdlist = cmdlist->next; - } - } - break; - - case NREDIR: { - /* - let (ty,fd,arg) = of_nredir n in Redir (ty,fd,arg) - - - and of_nredir (n : node union ptr) = - let n = n @-> node_nredir in - (getf n nredir_linno, of_node (getf n nredir_n), redirs (getf n nredir_redirect)) - */ - - // Inline 'Redir' function - t->type = TYPE_T_REDIR; - t->Redir.linno = n->nredir.linno; - t->Redir.t = of_node (n->nredir.n); - t->Redir.redirect = redirs (n->nredir.redirect); - } - break; - - case NBACKGND: { - // let (ty,fd,arg) = of_nredir n in Background (ty,fd,arg) - - // Inline 'Redir' function - t->type = TYPE_T_BACKGROUND; - t->Background.linno = n->nredir.linno; - t->Background.t = of_node (n->nredir.n); - t->Background.redirect = redirs (n->nredir.redirect); - } - break; - - case NSUBSHELL: { - // let (ty,fd,arg) = of_nredir n in Subshell (ty,fd,arg) - - // Inline 'Redir' function - t->type = TYPE_T_SUBSHELL; - t->Subshell.linno = n->nredir.linno; - t->Subshell.t = of_node (n->nredir.n); - t->Subshell.redirect = redirs (n->nredir.redirect); - } - break; - - case NAND: { - // let (l,r) = of_binary n in And (l,r) - // - // Manually inlined 'of_binary': - // of_binary (n : node union ptr) = - // let n = n @-> node_nbinary in - // (of_node (getf n nbinary_ch1), of_node (getf n nbinary_ch2)) - - t->type = TYPE_T_AND; - t->And.left = of_node (n->nbinary.ch1); - t->And.right = of_node (n->nbinary.ch2); - } - break; - - - case NOR: { - // let (l,r) = of_binary n in Or (l,r) - - t->type = TYPE_T_OR; - t->Or.left = of_node (n->nbinary.ch1); - t->Or.right = of_node (n->nbinary.ch2); - } - break; - - case NSEMI: { - // let (l,r) = of_binary n in Semi (l,r) - - t->type = TYPE_T_SEMI; - t->Semi.left = of_node (n->nbinary.ch1); - t->Semi.right = of_node (n->nbinary.ch2); - } - break; - - case NIF: { - /* - let n = n @-> node_nif in - If (of_node (getf n nif_test), - of_node (getf n nif_ifpart), - of_node (getf n nif_elsepart)) - */ - - t->type = TYPE_T_IF; - t->If.test = of_node (n->nif.test); - t->If.ifpart = of_node (n->nif.ifpart); - t->If.elsepart = of_node (n->nif.elsepart); - } - break; - - case NWHILE: { - // let (t,b) = of_binary n in While (t,b) - - t->type = TYPE_T_WHILE; - t->While.test = of_node (n->nbinary.ch1); - t->While.body = of_node (n->nbinary.ch2); - } - break; - - case NUNTIL: { - // let (t,b) = of_binary n in While (Not t,b) - - struct t_TYPE* not_node = malloc (sizeof (struct t_TYPE)); - assert (not_node != NULL); - not_node->type = TYPE_T_NOT; - not_node->Not.t = of_node (n->nbinary.ch1); - - t->type = TYPE_T_WHILE; - t->While.test = not_node; - t->While.body = of_node (n->nbinary.ch2); - } - break; - - case NFOR: { - /* - let n = n @-> node_nfor in - For (getf n nfor_linno, - to_arg (getf n nfor_args @-> node_narg), - of_node (getf n nfor_body), - getf n nfor_var) - */ - - t->type = TYPE_T_FOR; - t->For.linno = n->nfor.linno; - t->For.arg = to_arg (&(n->nfor.args->narg)); - t->For.body = of_node (n->nfor.body); - t->For.var = n->nfor.var; - } - break; - - case NCASE: { - /* - let rec caselist (n : node union ptr) = - if nullptr n - then [] - else - let n = n @-> node_nclist in - assert (getf n nclist_type = 13); (* NCLIST *) - (getf n nclist_pattern, getf n nclist_body)::caselist (getf n nclist_next) - - let n = n @-> node_ncase in - Case (getf n ncase_linno, - to_arg (getf n ncase_expr @-> node_narg), - List.map - (fun (pattern,body) -> - { cpattern = to_args pattern; - cbody = of_node body}) - (caselist (getf n ncase_cases))) - */ - - t->type = TYPE_T_CASE; - t->Case.linno = n->ncase.linno; - t->Case.arg = to_arg (&(n->ncase.expr->narg)); - - struct case_list* cases_ceda = NULL; - struct case_list* cases_ceda_tail = cases_ceda; - - union node* case_head = n->ncase.cases; - while (case_head != NULL) { - assert (case_head->type == NCLIST); - - struct case_TYPE* newCase = malloc (sizeof (struct case_TYPE)); - assert (newCase != NULL); - - newCase->cpattern = to_args (case_head->nclist.pattern); - newCase->cbody = of_node (case_head->nclist.body); - - if (cases_ceda == NULL) { - cases_ceda = malloc (sizeof (struct case_list)); - assert (cases_ceda != NULL); - - cases_ceda_tail = cases_ceda; - } else { - cases_ceda_tail->next = malloc (sizeof (struct case_list)); - assert (cases_ceda_tail->next != NULL); - - cases_ceda_tail = cases_ceda_tail->next; - } - - cases_ceda_tail->casey = newCase; - cases_ceda_tail->next = NULL; - - case_head = case_head->nclist.next; - } - - t->Case.cases = cases_ceda; - } - break; - - case NDEFUN: { - /* - let n = n @-> node_ndefun in - Defun (getf n ndefun_linno, - getf n ndefun_text, - of_node (getf n ndefun_body)) - */ - t->type = TYPE_T_DEFUN; - t->Defun.linno = n->ndefun.linno; - t->Defun.name = n->ndefun.text; - t->Defun.body = of_node (n->ndefun.body); - } - break; - - case NNOT: { - // Not (of_node (getf (n @-> node_nnot) nnot_com)) - t->type = TYPE_T_NOT; - t->Not.t = of_node (n->nbinary.ch1); - } - break; - - default: { - assert (! "of_node: unexpected node type"); - } - break; - } - } - - return t; -} - - - -/* - of_nredir (n : node union ptr) = - let n = n @-> node_nredir in - (getf n nredir_linno, of_node (getf n nredir_n), redirs (getf n nredir_redirect)) -*/ -// Manually inlined - - -/* - let mk_file ty = - let n = n @-> node_nfile in - File (ty,getf n nfile_fd,to_arg (getf n nfile_fname @-> node_narg)) in -*/ -void mk_file (struct redirection_TYPE* redirection, union node* n, int ty) { - assert (redirection != NULL); - assert (n != NULL); - - redirection->type = REDIRECTION_TYPE_FILE; - - redirection->file.redir_type = ty; - redirection->file.fd = n->nfile.fd; - redirection->file.a = to_arg (&(n->nfile.fname->narg)); -} - - -/* - let mk_dup ty = - let n = n @-> node_ndup in - let vname = getf n ndup_vname in - let tgt = - if nullptr vname - then let dupfd = getf n ndup_dupfd in - if dupfd = -1 - then [C '-'] - else List.map (fun c -> C c) (explode (string_of_int dupfd)) - else to_arg (vname @-> node_narg) - in - Dup (ty,getf n ndup_fd,tgt) in -*/ -void mk_dup (struct redirection_TYPE* redirection, union node* n, int ty) { - assert (redirection != NULL); - assert (n != NULL); - - union node* vname = n->ndup.vname; - - arg_TYPE tgt; - if (vname == NULL) { - tgt = newArgCharStack (); - - int dupfd = n->ndup.dupfd; - - if (dupfd == -1) { - pushArgCharStack (tgt, newArgCharC ('-')); - } else { - // List.map (fun c -> C c) (explode (string_of_int dupfd)) - // Use string instead of list - - char dupfd_str [640]; - sprintf (dupfd_str, "%d", dupfd); - - int i = 0; - while ((i < 100) && (dupfd_str [i] != '\0')) { - pushArgCharStack (tgt, newArgCharC (dupfd_str [i])); - i ++; - } - } - } else { - tgt = to_arg (&(vname->narg)); // Not used! - } - - redirection->type = REDIRECTION_TYPE_DUP; - - redirection->dup.dup_type = ty; - redirection->dup.fd = n->ndup.fd; - redirection->dup.tgt = tgt; -} - - -/* - let mk_here ty = - let n = n @-> node_nhere in - Heredoc (ty,getf n nhere_fd,to_arg (getf n nhere_doc @-> node_narg)) in -*/ -void mk_here (struct redirection_TYPE* redirection, union node* n, int ty) { - assert (redirection != NULL); - assert (n != NULL); - - redirection->type = REDIRECTION_TYPE_HEREDOC; - - redirection->heredoc.heredoc_type = ty; - redirection->heredoc.fd = n->nhere.fd; - redirection->heredoc.a = to_arg (&(n->nhere.doc->narg)); -} - - -/* - redirs (n : node union ptr) = - if nullptr n - then [] - else - - let h = match n @-> node_type with - ... - - in - h :: redirs (getf (n @-> node_nfile) nfile_next) -*/ -struct redirectionList* redirs (union node* n) { - struct redirectionList* headRL = NULL; - struct redirectionList* lastRL = NULL; - - while (n != NULL) { - struct redirection_TYPE* redirection = malloc (sizeof (struct redirection_TYPE)); - assert (redirection != NULL); - - switch (n->type) { - case NTO: { - // (* NTO *) - // | 16 -> mk_file To - - redirection->type = REDIRECTION_TYPE_FILE; - mk_file (redirection, n, REDIR_TYPE_TO); - } - break; - - case NCLOBBER: { - // (* NCLOBBER *) - // | 17 -> mk_file Clobber - - redirection->type = REDIRECTION_TYPE_FILE; - mk_file (redirection, n, REDIR_TYPE_CLOBBER); - } - break; - - case NFROM: { - // (* NFROM *) - // | 18 -> mk_file From - redirection->type = REDIRECTION_TYPE_FILE; - mk_file (redirection, n, REDIR_TYPE_FROM); - } - break; - - case NFROMTO: { - // (* NFROMTO *) - // | 19 -> mk_file FromTo - redirection->type = REDIRECTION_TYPE_FILE; - mk_file (redirection, n, REDIR_TYPE_FROMTO); - } - break; - - case NAPPEND: { - // (* NAPPEND *) - // | 20 -> mk_file Append - redirection->type = REDIRECTION_TYPE_FILE; - mk_file (redirection, n, REDIR_TYPE_APPEND); - } - break; - - case NTOFD: { - // (* NTOFD *) - // | 21 -> mk_dup ToFD - - redirection->type = REDIRECTION_TYPE_DUP; - mk_dup (redirection, n, DUP_TYPE_TOFD); - } - break; - - case NFROMFD: { - // (* NFROMFD *) - // | 22 -> mk_dup FromFD - - redirection->type = REDIRECTION_TYPE_DUP; - mk_dup (redirection, n, DUP_TYPE_FROMFD); - } - break; - - case NHERE: { - // (* NHERE quoted heredoc---no expansion)*) - // | 23 -> mk_here Here - - redirection->type = REDIRECTION_TYPE_HEREDOC; - mk_here (redirection, n, HEREDOC_TYPE_HERE); - } - break; - - case NXHERE: { - // (* NXHERE unquoted heredoc (param/command/arith expansion) *) - // | 24 -> mk_here XHere - redirection->type = REDIRECTION_TYPE_HEREDOC; - mk_here (redirection, n, HEREDOC_TYPE_XHERE); - } - break; - - default: { - // | nt -> failwith ("unexpected node_type in redirlist: " ^ string_of_int nt) - assert (! "Invalid redirs type"); - } - break; - } - - struct redirectionList* newRL = malloc (sizeof (struct redirectionList)); - assert (newRL != NULL); - newRL->redir = redirection; - newRL->next = NULL; - - if (headRL == NULL) { - headRL = newRL; - lastRL = newRL; - } else { - lastRL->next = newRL; - lastRL = newRL; - } - - n = n->nfile.next; - } - - return headRL; -} - - -/* - of_binary (n : node union ptr) = - let n = n @-> node_nbinary in - (of_node (getf n nbinary_ch1), of_node (getf n nbinary_ch2)) -*/ -// MANUALLY INLINED -// struct t_TYPE* of_binary (union node* n) { - - -/* - to_arg (n : narg structure) : arg = - let a,s,bqlist,stack = parse_arg (explode (getf n narg_text)) (getf n narg_backquote) [] in - (* we should have used up the string and have no backquotes left in our list *) - assert (s = []); - assert (nullptr bqlist); - assert (stack = []); - a -*/ -arg_TYPE to_arg (struct narg* n) { - Stack s = explode_rev (n->text); - - struct nodelist* bqlist = n->backquote; - Stack stack = newStack (); - - ArgCharStack a = parse_arg (s, &bqlist, stack); - - assert (isStackEmpty (s)); - assert (bqlist == NULL); - assert (isStackEmpty (stack)); - - // destroyStack (stack); - - return (a); -} - - -/* - parse_arg (s : char list) (bqlist : nodelist structure ptr) stack = - match s,stack with - ... -*/ -arg_TYPE parse_arg (Stack s, struct nodelist** bqlist, Stack stack) { - ArgCharStack acc = newArgCharStack (); - while (TRUE) { - int s_len = getStackSize (s); - - if ((s_len == 0) && isStackEmpty (stack)) { - // | [],[] -> [],[],bqlist,[] - reverseArgCharStack (acc); - return acc; - - } else if (s_len == 0) { // We know that len (stack) > 0! - if (topStack (stack) == STACK_CTLVar) { - // | [],`CTLVar::_ -> failwith "End of string before CTLENDVAR" - assert (! "End of string before CTLENDVAR"); - } else if (topStack (stack) == STACK_CTLAri) { - // | [],`CTLAri::_ -> failwith "End of string before CTLENDARI" - assert (! "End of string before CTLENDARI"); - } else if (topStack (stack) == STACK_CTLQuo) { - // | [],`CTLQuo::_ -> failwith "End of string before CTLQUOTEMARK" - assert (! "End of string before CTLENDQUOTEMARK"); - } else { - printf ("Top of stack is %d\n", topStack (stack)); - assert (! "Invalid stack"); - } - } else { // We know that s_len > 0 - if ((s_len >= 2) && (topStack (s) == CTLESC)) { - // | '\129'::c::s,_ -> arg_char (E c) s bqlist stack - popStack (s); - - char c = popStack (s); - - pushArgCharStack (acc, newArgCharE (c)); - } else if ((s_len >= 2) && (topStack (s) == CTLVAR)) { - /* - Lightly reformatted - - | '\130'::t::s,_ -> - let var_name,s = split_at (fun c -> c = '=') s in - let t = int_of_char t in - - let v,s,bqlist,stack - = match t land 0x0f, s with - ... - in - - arg_char v s bqlist stack - */ - - popStack (s); - char t = popStack (s); - char tM = t & 0xF; - - Stack var_name = split_at (s, '='); - - struct arg_char_TYPE* v = NULL; - - if ( (tM == 0x1) - && (getStackSize (s) >= 1) - && (topStack (s) == '=')) { - /* - (* VSNORMAL and VSLENGTH get special treatment - neither ever gets VSNUL - VSNORMAL is terminated just with the =, without a CTLENDVAR *) - (* VSNORMAL *) - | 0x1,'='::s -> - V (Normal,false,implode var_name,[]),s,bqlist,stack - */ - - popStack (s); - - v = newArgCharV (VAR_TYPE_NORMAL, FALSE, implode_rev (var_name), newArgCharStack ()); - } else if ( (tM == 0xA) - && (getStackSize (s) >= 2) - && (topStack (s) == '=') - && (secondTopStack (s) == CTLENDVAR)) { - /* - (* VSLENGTH *) - | 0xa,'='::'\131'::s -> - V (Length,false,implode var_name,[]),s,bqlist,stack - */ - - popStack (s); - popStack (s); // Drop two - - v = newArgCharV (VAR_TYPE_LENGTH, FALSE, implode_rev (var_name), newArgCharStack ()); - } else if ((tM == 0x1 || tM == 0xA) && (getStackSize (s) >= 0)) { - /* - | 0x1,c::_ | 0xa,c::_ -> - failwith ("Missing CTLENDVAR for VSNORMAL/VSLENGTH, found " ^ Char.escaped c) - */ - - assert (! "Missing CTLENDVAR for VSNORMAL/VSLENGTH"); - } else if ( (getStackSize (s) >= 1) - && (topStack (s) == '=')) { - /* - (* every other VSTYPE takes mods before CTLENDVAR *) - | vstype,'='::s -> - let a,s,bqlist,stack' = parse_arg s bqlist (`CTLVar::stack) in - V (var_type vstype,t land 0x10 = 0x10,implode var_name,a), s, bqlist, stack' - */ - - popStack (s); - char vstype = tM; - - pushStack (stack, STACK_CTLVar); - arg_TYPE a = parse_arg (s, bqlist, stack); - - v = newArgCharV (var_type (vstype), ((t & 0x10) == 0x10), implode_rev (var_name), a); - } else if (getStackSize (s) >= 1) { - // | _,c::_ -> failwith ("Expected '=' terminating variable name, found " ^ Char.escaped c) - assert (! "Expected '=' terminating variable name"); - } else { - // | _,[] -> failwith "Expected '=' terminating variable name, found EOF" - assert ("Expected '=' terminating variable name, found EOF"); - } - - // 'implode' has already destroyed the list - // destroyStack (var_name); - - pushArgCharStack (acc, v); - - } else if ( FALSE /* match Pash's version of libdash */ - && (! isStackEmpty (s)) - && (topStack (s) == CTLVAR)) { - // | '\130'::_, _ -> raise (ParseException "bad substitution (missing variable name in ${}?") - assert (! "bad substitution (missing variable name in ${}?"); - - } else if (topStack (s) == CTLENDVAR) { - if (isStackEmpty (stack)) { - // | '\131'::_,[] -> failwith "Saw CTLENDVAR outside of CTLVAR" - assert (! "Saw CTLENDVAR outside of CTLVAR"); - } else if (topStack (stack) == STACK_CTLVar) { - // | '\131'::s,`CTLVar::stack' -> [],s,bqlist,stack' - popStack (s); - popStack (stack); - - reverseArgCharStack (acc); - return acc; - } else if (topStack (stack) == STACK_CTLAri) { - // | '\131'::_,`CTLAri::_ -> failwith "Saw CTLENDVAR before CTLENDARI" - assert (! "Saw CTLENDVAR before CTLENDARI"); - } else if (topStack (stack) == STACK_CTLQuo) { - // | '\131'::_,`CTLQuo::_ -> failwith "Saw CTLENDVAR before CTLQUOTEMARK" - assert (! "Saw CTLENDVAR before CTLQUOTEMARK"); - } else { - assert (! "Unexpected stack contents"); - } - - } else if (topStack (s) == CTLBACKQ) { - /* - (* CTLBACKQ *) - | '\132'::s,_ -> - if nullptr bqlist - then failwith "Saw CTLBACKQ but bqlist was null" - else arg_char (B (of_node (bqlist @-> nodelist_n))) s (bqlist @-> nodelist_next) stack - */ - - popStack (s); - - if (bqlist == NULL) { - assert (! "Saw CTLBACKQ but bqlist was null"); - } else { - struct arg_char_TYPE* a = newArgCharB (of_node ((*bqlist)->n)); - *bqlist = (*bqlist)->next; - - pushArgCharStack (acc, a); - } - - } else if (topStack (s) == CTLARI) { - /* - (* CTLARI *) - | '\134'::s,_ -> - let a,s,bqlist,stack' = parse_arg s bqlist (`CTLAri::stack) in - assert (stack = stack'); - arg_char (A a) s bqlist stack' - */ - - popStack (s); - -// char* oldStackStr = serializeStack (stack); - - pushStack (stack, STACK_CTLAri); - - struct arg_char_TYPE* a = newArgCharA (parse_arg (s, bqlist, stack)); - -// char* newStackStr = serializeStack (stack); -// assert (strcmp (oldStackStr, newStackStr) == 0); -// free (oldStackStr); -// free (newStackStr); - - pushArgCharStack (acc, a); - - } else if (topStack (s) == CTLENDARI) { - if (isStackEmpty (stack)) { - // | '\135'::_,[] -> failwith "Saw CTLENDARI outside of CTLARI" - assert (! "Saw CTLENDARI outside of CTLARI"); - } else if (topStack (stack) == STACK_CTLAri) { - // | '\135'::s,`CTLAri::stack' -> [],s,bqlist,stack' - popStack (s); - popStack (stack); - - reverseArgCharStack (acc); - return acc; - } else if (topStack (stack) == STACK_CTLVar) { - // | '\135'::_,`CTLVar::_' -> failwith "Saw CTLENDARI before CTLENDVAR" - assert (! "Saw CTLENDARI before CTLENDVAR"); - } else if (topStack (stack) == STACK_CTLQuo) { - // | '\135'::_,`CTLQuo::_' -> failwith "Saw CTLENDARI before CTLQUOTEMARK" - assert (! "Saw CTLENDARI before CTLQUOTEMARK"); - } else { - assert (! "Unexpected stack contents"); - } - - } else if (topStack (s) == CTLQUOTEMARK) { - popStack (s); // See below - - if ((! isStackEmpty (stack)) && (topStack (stack) == STACK_CTLQuo)) { - // | '\136'::s,`CTLQuo::stack' -> [],s,bqlist,stack' - - popStack (stack); - - reverseArgCharStack (acc); - return acc; - } else { - /* - (* CTLQUOTEMARK *) - | '\136'::s,_ -> - let a,s,bqlist,stack' = parse_arg s bqlist (`CTLQuo::stack) in - assert (stack' = stack); - arg_char (Q a) s bqlist stack' - */ - -// char* oldStackStr = serializeStack (stack); - - pushStack (stack, STACK_CTLQuo); - - struct arg_char_TYPE* a = newArgCharQ (parse_arg (s, bqlist, stack)); - -// char* newStackStr = serializeStack (stack); -// assert (strcmp (oldStackStr, newStackStr) == 0); -// free (oldStackStr); -// free (newStackStr); - - pushArgCharStack (acc, a); - } - - } else if (topStack (s) == '~') { - /* - (* tildes *) - | '~'::s,stack -> - if List.exists (fun m -> m = `CTLQuo || m = `CTLAri) stack - then (* we're in arithmetic or double quotes, so tilde is ignored *) - arg_char (C '~') s bqlist stack - else - let uname,s' = parse_tilde [] s in - arg_char (T uname) s' bqlist stack - */ - - popStack (s); - if ( existsInStack (stack, STACK_CTLQuo) - || existsInStack (stack, STACK_CTLAri)) { - // N.B. Would be more efficient to search for both simultaneously - - pushArgCharStack (acc, newArgCharC ('~')); - } else { - char* uname = parse_tilde (s); - - pushArgCharStack (acc, newArgCharT (uname)); - } - - } else { - /* - (* ordinary character *) - | c::s,_ -> - arg_char (C c) s bqlist stack - */ - char c = popStack (s); - - pushArgCharStack (acc, newArgCharC (c)); - } - } - } -} - - -/* -static char* implodeOrNull (Stack acc) { - if (isStackEmpty (acc)) { - return NULL; - } else { - return implode (acc); - } -} -*/ - - -static char* stringOrNull (char* str, int i) { - if (i == 0) { - free (str); - - return NULL; - } else { - str [i] = '\0'; - return str; - } -} - - -// Note: we encode "None" as NULL, and "Some String" as char* -// The OCaml-style serialization will be handled by ast2json.c. -/* - parse_tilde acc = - let ret = if acc = [] then None else Some (implode acc) in - function - ... -*/ -char* parse_tilde (Stack s) { - char* acc_str = malloc (1 + getStackSize (s)); - assert (acc_str != NULL); - - int i = 0; - - // C does not have lazy evaluation - // hence we can't afford to define 'ret' here - - while (TRUE) { - if (isStackEmpty (s)) { - // | [] -> (ret , []) - return stringOrNull (acc_str, i); - } else if (topStack (s) == CTLESC) { - // (* CTLESC *) - // | '\129'::_ as s -> None, s - return NULL; - } else if (topStack (s) == CTLQUOTEMARK) { - // (* CTLQUOTEMARK *) - // | '\136'::_ as s -> None, s - return NULL; - } else if ( (topStack (s) == CTLENDVAR) - || (topStack (s) == ':') - || (topStack (s) == '/')) { - // (* terminal: CTLENDVAR, /, : *) - // | '\131'::_ as s -> ret, s - // | ':'::_ as s -> ret, s - // | '/'::_ as s -> ret, s - return stringOrNull (acc_str, i); - } else { - // (* ordinary char *) - // (* TODO 2019-01-03 only characters from the portable character set *) - // | c::s' -> parse_tilde (acc @ [c]) s' - - char c = popStack (s); - - acc_str [i] = c; - } - - i ++; - } -} - - -/* - arg_char c s bqlist stack = - let a,s,bqlist,stack = parse_arg s bqlist stack in - (c::a,s,bqlist,stack) -*/ -// Note that, in ast.ml, arg_char is both a type and a function! -/* -arg_TYPE arg_char_FUNC (struct arg_char_TYPE* c, Stack s, struct nodelist** bqlist, Stack stack) { - arg_TYPE a = parse_arg (s, bqlist, stack); - - if (c != NULL) { - prependStack_arg_char (a, (void*) c); // Intentional preprend - } - - return (a); -} -*/ - - -/* - Lightly edited to invalid, but more readable OCaml syntax: - - to_assign v ca = - | v [] -> failwith ("Never found an '=' sign in assignment, got " ^ implode v) - | v (C '=') :: a -> (implode v,a) - | v (C c ) :: a -> to_assign (v @ [c]) a - | v _ -> failwith "Unexpected special character in assignment" -*/ -struct assign_TYPE* to_assign (ArgCharStack ca) { - char* v_str = malloc (1 + getArgCharStackSize (ca)); - assert (v_str != NULL); - - int i = 0; - - while (! isArgCharStackEmpty (ca)) { - struct arg_char_TYPE* c = popArgCharStack (ca); - - ArgCharStack a = ca; - - if (c->type != TYPE_ARG_CHAR_C) { - printf ("Type %d\n", c->type); - assert (! "Unexpected special character in assignment"); - } - - if (c->C.c == '=') { - struct assign_TYPE* assign = malloc (sizeof (struct assign_TYPE)); - assert (assign != NULL); - - v_str [i] = '\0'; - - assign->string = v_str; - assign->arg = a; - - return (assign); - } else { - v_str [i] = c->C.c; - } - - i ++; - } - - assert (! "Never found an '=' sign in assignment"); - - return NULL; // Reachable if NDEBUG -} - - -// to_assigns n = List.map (to_assign []) (to_args n) -struct assign_list* to_assigns (union node* n) { - struct args_TYPE* args = to_args (n); - - struct assign_list* assigns = NULL; - struct assign_list* assignsLast = NULL; - - while (args != NULL) { - struct assign_TYPE* assign = to_assign (args->arg); - - struct assign_list* curr = malloc (sizeof (struct assign_list)); - assert (curr != NULL); - curr->assign = assign; - curr->next = NULL; - - if (assigns == NULL) { - assigns = curr; - } else { - assignsLast->next = curr; - } - assignsLast = curr; - - struct args_TYPE* next = args->next; - free (args); - args = next; - } - - free (args); - - return assigns; -} - - -/* - to_args (n : node union ptr) : args = - if nullptr n - then [] - else (assert (n @-> node_type = 15); - let n = n @-> node_narg in - to_arg n::to_args (getf n narg_next)) -*/ -struct args_TYPE* to_args (union node* n) { - struct args_TYPE* args = NULL; - struct args_TYPE* last = NULL; - - while (n != NULL) { - assert (n->type == NARG); - - struct args_TYPE* curr = malloc (sizeof (struct args_TYPE)); - assert (curr != NULL); - curr->arg = to_arg (&(n->narg)); - curr->next = NULL; - - if (last == NULL) { - args = curr; - } else { - last->next = curr; - } - last = curr; - - n = (n->narg).next; - } - - return (args); -} diff --git a/compiler/parser/ceda/ast2a.h b/compiler/parser/ceda/ast2a.h deleted file mode 100644 index 73553afb9..000000000 --- a/compiler/parser/ceda/ast2a.h +++ /dev/null @@ -1,344 +0,0 @@ -#ifndef AST2_H -#define AST2_H - - -#include "ArgCharStack.h" - - -#define TRUE 1 -#define FALSE 0 - - -//------------------------------------------------------------------------------------------ - - -#define STACK_CTLVar 100 -#define STACK_CTLAri 101 -#define STACK_CTLQuo 102 - - -//------------------------------------------------------------------------------------------ - - -#define TYPE_T_COMMAND 0 -#define TYPE_T_PIPE 1 -#define TYPE_T_REDIR 2 -#define TYPE_T_BACKGROUND 3 -#define TYPE_T_SUBSHELL 4 -#define TYPE_T_AND 5 -#define TYPE_T_OR 6 -#define TYPE_T_NOT 7 -#define TYPE_T_SEMI 8 -#define TYPE_T_IF 9 -#define TYPE_T_WHILE 10 -#define TYPE_T_FOR 11 -#define TYPE_T_CASE 12 -#define TYPE_T_DEFUN 13 - -extern const char* SERIALIZE_TYPE_T []; - - -/* - var_type = - | Normal - | Minus - | Plus - | Question - | Assign - | TrimR - | TrimRMax - | TrimL - | TrimLMax - | Length -*/ -#define VAR_TYPE_NORMAL 0x0 -#define VAR_TYPE_MINUS 0x2 -#define VAR_TYPE_PLUS 0x3 -#define VAR_TYPE_QUESTION 0x4 -#define VAR_TYPE_ASSIGN 0x5 -#define VAR_TYPE_TRIMR 0x6 -#define VAR_TYPE_TRIMRMAX 0x7 -#define VAR_TYPE_TRIML 0x8 -#define VAR_TYPE_TRIMLMAX 0x9 -#define VAR_TYPE_LENGTH 0xA - -extern const char* SERIALIZE_VAR_TYPE []; - - -/* - redirection = - | File of redir_type * int * arg - | Dup of dup_type * int * arg - | Heredoc of heredoc_type * int * arg -*/ -// Don't mix up with REDIR_TYPE_*! -#define REDIRECTION_TYPE_FILE 0x0 -#define REDIRECTION_TYPE_DUP 0x1 -#define REDIRECTION_TYPE_HEREDOC 0x2 - -extern const char* SERIALIZE_REDIRECTION_TYPE []; - - -// redir_type = To | Clobber | From | FromTo | Append -#define REDIR_TYPE_TO 0x0 -#define REDIR_TYPE_CLOBBER 0x1 -#define REDIR_TYPE_FROM 0x2 -#define REDIR_TYPE_FROMTO 0x3 -#define REDIR_TYPE_APPEND 0x4 - -extern const char* SERIALIZE_REDIR_TYPE []; - - -// dup_type = ToFD | FromFD -#define DUP_TYPE_TOFD 0x0 -#define DUP_TYPE_FROMFD 0x1 - -extern const char* SERIALIZE_DUP_TYPE []; - - -// heredoc_type = Here | XHere (* for when in a quote... not sure when this comes up *) -#define HEREDOC_TYPE_HERE 0x0 -#define HEREDOC_TYPE_XHERE 0x1 - -extern const char* SERIALIZE_HEREDOC_TYPE []; - - -// Duplicates arg_char.h -typedef ArgCharStack arg_TYPE; // arg = arg_char list - - -//------------------------------------------------------------------------------------------ -// SIMPLE LIST TYPES - - -struct t_list { - struct t_TYPE* t; - struct t_list* next; -}; - -struct assign_list { - struct assign_TYPE* assign; - struct assign_list* next; -}; - -struct redirectionList { - struct redirection_TYPE* redir; - struct redirectionList* next; -}; - -// args = arg list -// Note that 'arg_TYPE' is typedef'ed above as a CharList -struct args_TYPE { - arg_TYPE arg; - struct args_TYPE* next; -}; - -struct case_list { - struct case_TYPE* casey; - struct case_list* next; -}; - - -//------------------------------------------------------------------------------------------ - - -// assign = string * arg -struct assign_TYPE { - char* string; - arg_TYPE arg; -}; - - -// | File of redir_type * int * arg -// -// Not to be mistaken with 's FILE -struct file_TYPE { - int redir_type; - int fd; - arg_TYPE a; -}; - - -// | Dup of dup_type * int * arg -struct dup_TYPE { - int dup_type; - int fd; - arg_TYPE tgt; -}; - - -// | Heredoc of heredoc_type * int * arg -struct heredoc_TYPE { - int heredoc_type; - int fd; - arg_TYPE a; -}; - - -/* - redirection = - | File of redir_type * int * arg - | Dup of dup_type * int * arg - | Heredoc of heredoc_type * int * arg -*/ -struct redirection_TYPE { - int type; - - union { - struct file_TYPE file; - struct dup_TYPE dup; - struct heredoc_TYPE heredoc; - }; -}; - - -// case = { cpattern : arg list; cbody : t } -// -// Note: the hash table is useful only for JSON serialization/deserialization -// purposes; we don't store it that way internally. -struct case_TYPE { - struct args_TYPE* cpattern; - struct t_TYPE* cbody; -}; - - -//------------------------------------------------------------------------------------------ -// type t = ... - - -// | Command of linno * assign list * args * redirection list (* assign, args, redir *) -struct Command_TYPE { - unsigned int linno; - struct assign_list* assign; - struct args_TYPE* args; - struct redirectionList* redirect; -}; - - -// | Pipe of bool * t list (* background?, commands *) -struct Pipe_TYPE { - int background; - struct t_list* spill; -}; - - -// | Redir of linno * t * redirection list -struct Redir_TYPE { - unsigned int linno; - struct t_TYPE* t; - struct redirectionList* redirect; -}; - - -// | Background of linno * t * redirection list -struct Background_TYPE { - unsigned int linno; - struct t_TYPE* t; - struct redirectionList* redirect; -}; - - -// | Subshell of linno * t * redirection list -struct Subshell_TYPE { - unsigned int linno; - struct t_TYPE* t; - struct redirectionList* redirect; -}; - - -// | And of t * t -struct And_TYPE { - struct t_TYPE* left; - struct t_TYPE* right; -}; - - -// | Or of t * t -struct Or_TYPE { - struct t_TYPE* left; - struct t_TYPE* right; -}; - - -// | Not of t -struct Not_TYPE { - struct t_TYPE* t; -}; - - -// | Semi of t * t -struct Semi_TYPE { - struct t_TYPE* left; - struct t_TYPE* right; -}; - - -// | If of t * t * t (* cond, then, else *) -struct If_TYPE { - struct t_TYPE* test; - struct t_TYPE* ifpart; - struct t_TYPE* elsepart; -}; - - -// | While of t * t (* test, body *) (* until encoded as a While . Not *) -struct While_TYPE { - struct t_TYPE* test; - struct t_TYPE* body; -}; - - -// | For of linno * arg * t * string (* args, body, var *) -struct For_TYPE { - unsigned int linno; - arg_TYPE arg; - struct t_TYPE* body; - char* var; -}; - - -// | Case of linno * arg * case list -struct Case_TYPE { - unsigned int linno; - arg_TYPE arg; - struct case_list* cases; -}; - - -// | Defun of linno * string * t (* name, body *) -struct Defun_TYPE { - unsigned int linno; - char* name; - struct t_TYPE* body; -}; - - -struct t_TYPE { - int type; - - union { - struct Command_TYPE Command; - struct Pipe_TYPE Pipe; - struct Redir_TYPE Redir; - struct Background_TYPE Background; - struct Subshell_TYPE Subshell; - struct And_TYPE And; - struct Or_TYPE Or; - struct Not_TYPE Not; - struct Semi_TYPE Semi; - struct If_TYPE If; - struct While_TYPE While; - struct For_TYPE For; - struct Case_TYPE Case; - struct Defun_TYPE Defun; - }; -}; - - -//------------------------------------------------------------------------------------------ - - -struct t_TYPE* of_node (union node* n); - - -#endif diff --git a/compiler/parser/ceda/ast2a.py b/compiler/parser/ceda/ast2a.py deleted file mode 100644 index 239b70fea..000000000 --- a/compiler/parser/ceda/ast2a.py +++ /dev/null @@ -1,565 +0,0 @@ -# import os; -import sys; -from dash2 import *; - - -# parser.h -CTLESC = 129; -CTLVAR = 130; -CTLENDVAR = 131; -CTLBACKQ = 132; -CTLARI = 134; -CTLENDARI = 135; -CTLQUOTEMARK = 136; - -# Internal use only -STACK_CTLVAR = 100; -STACK_CTLARI = 101; -STACK_CTLQUO = 102; - - -VAR_TYPES \ - = [ - "Normal", # 0x0 - "UNUSED", - "Minus", # 0x2 - "Plus", # 0x3 - "Question", # 0x4 - "Assign", # 0x5 - "TrimR", # 0x6 - "TrimRMax", # 0x7 - "TrimL", # 0x8 - "TrimLMax", # 0x9 - "Length" # 0xa - ]; - - -SKIP_COMMAND = ["Command", [-1, [], [], []]]; - -ORD_TILDE = ord ('~'); -ORD_EQUALS = ord ('='); -ORD_MINUS = ord ('-'); -ORD_COLON = ord (':'); -ORD_SLASH = ord ('/'); - - -def var_type (i): - return VAR_TYPES [i]; - - -# Inline 'list (map (of_node, nodelist (nl)))' -def map_ofnode_nodelist (nl): - snek = []; - - # ctypes has different semantics for POINTER vs. c_void_p - # See https://groups.google.com/g/nzpug/c/5CJxaWjuQro - while (nl): - snek.append (of_node (nl.contents.n)); - nl = nl.contents.next; - - return snek; - - -def of_node (n_ptr): - if (not n_ptr): - return SKIP_COMMAND; - else: - n = n_ptr.contents; - -# print (""); -# print ("###" + str (n.type)); -# print (""); - - # 4412 0 NCMD - # 2442 7 NSEMI - # 517 8 NIF - # 255 12 NCASE - # 252 5 NAND - # 152 6 NOR - # 126 11 NFOR - # 119 14 NDEFUN - # 107 1 NPIPE - # 16 4 NSUBSHELL - # 14 9 NWHILE - # 4 2 NREDIR - # 2 10 NUNTIL - - if (n.type == NCMD): - return (["Command", - [n.ncmd.linno, - to_assigns (n.ncmd.assign), - to_args (n.ncmd.args), - redirs (n.ncmd.redirect)]]); - elif (n.type == NSEMI): - return ["Semi", of_binary (n)]; - elif (n.type == NIF): - return (["If", - [of_node (n.nif.test), - of_node (n.nif.ifpart), - of_node (n.nif.elsepart)]]); - elif (n.type == NCASE): - cases_hashes = []; # Poetic - - for case in caselist (n.ncase.cases): - (pattern, body) = case; - - current_case \ - = {'cpattern' : to_args (pattern), - 'cbody' : of_node (body)}; - - cases_hashes.append (current_case); - - return (["Case", - [n.ncase.linno, - to_arg (n.ncase.expr.contents.narg), - cases_hashes]]); - elif (n.type == NAND): - return ["And", of_binary (n)]; - elif (n.type == NOR): - return ["Or", of_binary (n)]; - elif (n.type == NFOR): - return ["For", - [n.nfor.linno, - to_args (n.nfor.args), - of_node (n.nfor.body), - n.nfor.var.decode ("charmap")]]; - elif (n.type == NDEFUN): - return ["Defun", - [n.ndefun.linno, - n.ndefun.text.decode ("charmap"), - of_node (n.ndefun.body)]]; - elif (n.type == NPIPE): - return (["Pipe", - [n.npipe.backgnd != 0, - map_ofnode_nodelist (n.npipe.cmdlist)]]); - # list (map (of_node, nodelist (n.npipe.cmdlist)))]]); - elif (n.type == NSUBSHELL): - return ["Subshell", of_nredir (n)]; - elif (n.type == NWHILE): - return ["While", of_binary (n)]; - elif (n.type == NREDIR): - return ["Redir", of_nredir (n)]; - elif (n.type == NUNTIL): - (t, b) = of_binary (n); - return ["While", [["Not", t], b]]; - - elif (n.type == NBACKGND): - return ["Background", of_nredir (n)]; - elif (n.type == NNOT): - return ["Not", of_node (n.nnot.com)]; - else: - print ("Unexpected type"); - sys.stdout.flush (); - os.abort (); - - -def of_nredir (n): - return ([n.nredir.linno, of_node (n.nredir.n), redirs (n.nredir.redirect)]); - - -def mk_file (ty, n): - arg = to_arg (n.nfile.fname.contents.narg); - - return ["File", [ty, n.nfile.fd, arg]]; - - -def mk_dup(ty, n): - ndup = n.ndup - vname = ndup.vname - - tgt = [] - - if (not vname): - dupfd = ndup.dupfd - if (dupfd == -1): - tgt.append(["C", ORD_MINUS]) - else: - dupfd_str = str(dupfd) - - for i in range(len(dupfd_str)): - tgt.append(["C", ord(dupfd_str[i])]) - else: - tgt = to_arg(vname.contents.narg) - - return (["Dup", [ty, ndup.fd, tgt]]) - - -def mk_here (ty, n): - return ["Heredoc", [ty, n.nhere.fd, to_arg (n.nhere.doc.contents.narg)]]; - - -def redirs (n_ptr): - rlist = []; - - while (n_ptr): - h = []; - - n = n_ptr.contents; - - if (n.type == NTO): - h = mk_file ("To", n); - elif (n.type == NCLOBBER): - h = mk_file ("Clobber", n); - elif (n.type == NFROM): - h = mk_file ("From", n); - elif (n.type == NFROMTO): - h = mk_file ("FromTo", n); - elif (n.type == NAPPEND): - h = mk_file ("Append", n); - elif (n.type == NTOFD): - h = mk_dup ("ToFD", n); - elif (n.type == NFROMFD): - h = mk_dup ("FromFD", n); - elif (n.type == NHERE): - h = mk_here ("Here", n); - elif (n.type == NXHERE): - h = mk_here ("XHere", n); - else: - print ("unexpected node_type in redirlist"); - os.abort (); - - rlist.append (h); - - n_ptr = n.nfile.next; - - return rlist; - - -def of_binary (n): - return [of_node (n.nbinary.ch1), of_node (n.nbinary.ch2)]; - - -def to_arg (narg): - s = explode_rev (narg.text); - bqlist = narg.backquote; - stack = []; - - a = parse_arg (s, bqlist, stack); - - assert (len (s) == 0); - # assert (nullptr bqlist) -# if (bqlist): -# print ("bqlist is not null"); -# print (bqlist); -# os.abort (); - assert (len (stack) == 0); - - return (a); - - -def parse_arg (s, bqlist, stack): - acc = []; - - while (True): - s_len = len (s); - # stack_len = len (stack); - - # | [],[] -> [],[],bqlist,[] - if ((s_len == 0) and (len (stack) == 0)): - return (acc); - # | [],`CTLVar::_ -> failwith "End of string before CTLENDVAR" - - elif (s_len == 0): # We know that len (stack) > 0! - if (stack [-1] == STACK_CTLVAR): - print ("End of string before CTLENDVAR"); - os.abort (); - # | [],`CTLAri::_ -> failwith "End of string before CTLENDARI" - elif (stack [-1] == STACK_CTLARI): - print (s); - print (stack); - - print ("End of string before CTLENDARI"); - os.abort (); - # | [],`CTLQuo::_ -> failwith "End of string before CTLQUOTEMARK" - elif (stack [-1] == STACK_CTLQUO): - print (s); - print (stack); - - print ("End of string before CTLENDQUOTEMARK"); - os.abort (); - else: - print ("Invalid stack"); - os.abort (); - - else: # We know that len (s) > 0 - # (* CTLESC *) - # | '\129'::c::s,_ -> arg_char (E c) s bqlist stack - if ((s_len >= 2) and (s [-1] == CTLESC)): - s.pop (); - c = s.pop (); - - acc.append (["E", c]); - - # (* CTLVAR *) - # | '\130'::t::s,_ -> - elif ((s_len >= 2) and (s [-1] == CTLVAR)): - s.pop (); - t = s.pop (); - - # let var_name,s = split_at (fun c -> c = '=') s in - var_name = ""; - while ((len (s) > 0) and (s [-1] != ORD_EQUALS)): - c = s.pop (); - var_name = var_name + chr (c); - - v = []; - - if (((t & 0xf) == 0x1) and (len (s) >= 1) and (s [-1] == ORD_EQUALS)): - s.pop (); - - v = ["V", ["Normal", False, var_name, []]]; - elif (((t & 0xf) == 0xa) and (len (s) >= 2) and (s [-1] == ORD_EQUALS) and (s [-2] == 131)): - s.pop (); - s.pop (); - - v = ["V", ["Length", False, var_name, []]]; - elif ((((t & 0xf) == 0x1) or ((t & 0xf) == 0xa)) and (len (s) >= 1)): - print ("Missing CTLENDVAR for VSNORMAL/VSLENGTH"); - os.abort (); - elif ((len (s) >= 1) and (s [-1] == ORD_EQUALS)): - s.pop (); - - vstype = t & 0xf; - - stack.append (STACK_CTLVAR); - - a = parse_arg (s, bqlist, stack); - - v = ["V", [var_type (vstype), (t & 0x10 == 0x10), var_name, a]]; - elif (len (s) >= 1): - print (s); - print (stack); - - print ("Expected '=' terminating variable name"); - os.abort (); - elif (len (s) == 0): - print ("Expected '=' terminating variable name, found EOF"); - os.abort (); - else: - print ("This shouldn't be reachable"); - os.abort (); - - acc.append (v); - - # | '\130'::_, _ -> raise (ParseException "bad substitution (missing variable name in ${}?") - elif (False and (s [-1] == CTLVAR)): # Disable to match PaSH's version of libdash - print (s); - print (stack); - - print ("bad substitution (missing variable name in ${}?"); - os.abort (); - - # (* CTLENDVAR *) - # | '\131'::s,`CTLVar::stack' -> [],s,bqlist,stack' - elif (s [-1] == CTLENDVAR): - if (len (stack) >= 1): - if (stack [-1] == STACK_CTLVAR): - s.pop (); - stack.pop (); - - return (acc); - # | '\131'::_,`CTLAri::_ -> failwith "Saw CTLENDVAR before CTLENDARI" - elif (stack [-1] == STACK_CTLARI): - print ("Saw CTLENDVAR before CTLENDARI"); - os.abort (); - # | '\131'::_,`CTLQuo::_ -> failwith "Saw CTLENDVAR before CTLQUOTEMARK" - elif (stack [-1] == STACK_CTLQUO): - print ("Saw CTLENDVAR before CTLQUOTEMARK"); - os.abort (); - # | '\131'::_,[] -> failwith "Saw CTLENDVAR outside of CTLVAR" - else: - print ("Saw CTLENDVAR outside of CTLVAR"); - os.abort (); - - # (* CTLBACKQ *) - # | '\132'::s,_ -> - elif (s [-1] == CTLBACKQ): - s.pop (); - - if (not bqlist): - print (bqlist); - print ("Saw CTLBACKQ but bqlist was null"); - os.abort (); - else: - acc.append (["B", of_node (bqlist.contents.n)]); - - bqlist = bqlist.contents.next; - - # (* CTLARI *) - # | '\134'::s,_ -> - elif (s [-1] == CTLARI): - s.pop (); - - stack.append (STACK_CTLARI); - - a = parse_arg (s, bqlist, stack); - - # TODO: assert (stack = stack'); - - acc.append (["A", a]); - - # (* CTLENDARI *) - # | '\135'::s,`CTLAri::stack' -> [],s,bqlist,stack' - elif (s [-1] == CTLENDARI): - if (len (stack) >= 1): - if (stack [-1] == STACK_CTLARI): - s.pop (); - stack.pop (); - - return (acc); - # | '\135'::_,`CTLVar::_' -> failwith "Saw CTLENDARI before CTLENDVAR" - elif (stack [-1] == STACK_CTLVAR): - print ("Saw CTLENDARI before CTLENDVAR"); - os.abort (); - # | '\135'::_,`CTLQuo::_' -> failwith "Saw CTLENDARI before CTLQUOTEMARK" - elif (stack [-1] == STACK_CTLQUO): - print ("Saw CTLENDARI before CTLQUOTEMARK"); - os.abort (); - # | '\135'::_,[] -> failwith "Saw CTLENDARI outside of CTLARI" - else: - print ("Saw CTLENDARI outside of CTLARI"); - os.abort (); - - # (* CTLQUOTEMARK *) - # | '\136'::s,`CTLQuo::stack' -> [],s,bqlist,stack' - elif (s [-1] == CTLQUOTEMARK): - if ((len (stack) >= 1) and (stack [-1] == STACK_CTLQUO)): - s.pop (); - stack.pop (); - - return (acc); - # | '\136'::s,_ -> - else: - s.pop (); - stack.append (STACK_CTLQUO); - - a = parse_arg (s, bqlist, stack); - - acc.append (["Q", a]); - - # (* tildes *) - # | '~'::s,stack -> - elif (s [-1] == ORD_TILDE): - s.pop (); - - if ((STACK_CTLQUO in stack) or (STACK_CTLARI in stack)): - acc.append (["C", ORD_TILDE]); - else: - uname = parse_tilde (s); - - acc.append (["T", uname]); - - # (* ordinary character *) - # | c::s,_ -> arg_char (C c) s bqlist stack - else: - c = s.pop (); - - acc.append (["C", c]); - - -def stringOrNull (acc_str): - if (acc_str == ""): - return "None"; - else: - return ["Some", acc_str]; - - -def parse_tilde (s): - acc_str = ""; - - while (True): - if (s == []): - return stringOrNull (acc_str); - else: - s_last = s [-1]; - - if (s_last == CTLESC): - return ("None"); - elif (s_last == CTLQUOTEMARK): - return ("None"); - elif (s_last == CTLENDVAR): - return (stringOrNull (acc_str)); - elif (s_last == ORD_COLON): - return (stringOrNull (acc_str)); - elif (s_last == ORD_SLASH): - return (stringOrNull (acc_str)); - else: - c = s.pop (); - acc_str = acc_str + chr (c); - - -def to_assign (a_rev): - v_str = ""; - - while (len (a_rev) > 0): - if (a_rev [-1][0] != 'C'): - print ("Unexpected special character in assignment"); - sys.stdout.flush (); - os.abort (); - - if (a_rev [-1][1] == ORD_EQUALS): - a_rev.pop (); - - a_rev.reverse (); - return (v_str, a_rev); - - # return (v_str, reversed (a_rev)); - else: - c = a_rev [-1][1]; - a_rev.pop (); - - v_str = v_str + chr (c); - - print ("Never found an '=' sign in assignment"); - os.abort (); - - -# Inlined to_args -# to_assigns n = List.map (to_assign []) (to_args n) -def to_assigns (n): - assigns = []; - - while (n): - if (n.contents.type != NARG): - print ("Unexpected type: " + n.contents.type); - sys.stdout.flush (); - os.abort (); - - arg = to_arg (n.contents.narg); - - arg.reverse (); - assigns.append (to_assign (arg)); - - n = n.contents.narg.next; - - return (assigns); - - -# to_assigns n = List.map (to_assign []) (to_args n) -def to_assigns_classic (n): - assigns = [] - - for a in (to_args (n)): - a.reverse (); - assigns.append (to_assign (a)); - - return (assigns); - - -def to_args (n): - snek = []; - - # ctypes has different semantics for POINTER vs. c_void_p - # See https://groups.google.com/g/nzpug/c/5CJxaWjuQro - while (n): - if (n.contents.type != NARG): - print ("Unexpected type: " + n.contents.type); - sys.stdout.flush (); - os.abort (); - - arg = to_arg (n.contents.narg); - snek.append (arg); - - n = n.contents.narg.next; - - return snek; diff --git a/compiler/parser/ceda/ast2b.c b/compiler/parser/ceda/ast2b.c deleted file mode 100644 index 4fa7ddbb1..000000000 --- a/compiler/parser/ceda/ast2b.c +++ /dev/null @@ -1,1057 +0,0 @@ -/* - - - ast2b.c : Exports 'to_string' which, analogously to the function in - libdash's ast.ml, converts a JSON representation of the - libdash AST into an ordinary shell script. - - The functions here intentionally closely match ast.ml; - relevant OCaml snippets are included as comments. - - -*/ - - -#include -#include -#include -#include - -#include "ast2b.h" - -#include "json_tokener.h" - - -#define TRUE 1 -#define FALSE 0 - - -// Helper functions for debugging JSON -static void debug_jsonI (json_object* jobj, int depth); - -// Helper functions for pattern-matching JSON -static int JSONMatchesStr (json_object* obj, char* magicWord); -static int JSONArrayStartsWithStr (json_object* obj, char* magicWord); -static int isJSONArrayOfLength (json_object* obj, int len); -static int isEmptyJSONArray (json_object* obj); - -// Helper functions that move out complicated cases from 'to_string' -static void string_of_commandI (json_object* assigns, json_object* cmds, json_object* redirs); -static void string_of_pipeI (json_object* bg, json_object* ps); - -// Helper functions that correspond fairly closing to ast.ml. -// Note that some simple functions (e.g., separated/background) -// have been manually inlined. -static void string_of_var_type (json_object* vt); -static void show_unless (int expected, int actual); -static void string_of_if (json_object* c, json_object* t, json_object* e); -static void string_of_arg_char (json_object* first, json_object* second); -static void string_of_arg (json_object* arg1); -static void string_of_assign (json_object* va); -static void string_of_case (json_object* c); -static void string_of_redir (json_object* r); -static void string_of_redirs (json_object* rs); - - -// ---------------------------------------------------------------------------- - - -void debug_json (json_object* jobj) { - printf ("\n"); - printf ("-----\n"); - debug_jsonI (jobj, 0); - printf ("-----\n"); - printf ("\n"); -} - - -// ---------------------------------------------------------------------------- - - -static void debug_jsonI (json_object* jobj, int depth) { - for (int i = 0; i < depth; i++) { - printf (" "); - } - - switch (json_object_get_type (jobj)) { - case json_type_null: - printf ("null\n"); - break; - - case json_type_boolean: - printf ("boolean\n"); - break; - - case json_type_double: - printf ("double\n"); - break; - - case json_type_int: - printf ("int: %d\n", json_object_get_int (jobj)); - break; - - case json_type_object: - printf ("object\n"); - break; - - case json_type_array: - printf ("array\n"); - - for (int i = 0; i < json_object_array_length (jobj); i++) { - debug_jsonI (json_object_array_get_idx (jobj, i), depth + 1); - } - break; - - case json_type_string: - (void) 0; // Avoid compiler 'error: a label can only be part of a statement' - const char* str = json_object_get_string (jobj); - - printf ("string: %s\n", str); - break; - - default: - assert ("! Unexpected case"); - break; - } -} - - -// string: -static int JSONMatchesStr (json_object* obj, char* magicWord) { - return (json_object_get_type (obj) == json_type_string) - && (strcmp (json_object_get_string (obj), magicWord) == 0); -} - - -/* - array - string: - ... -*/ -static int JSONArrayStartsWithStr (json_object* obj, char* magicWord) { - return (json_object_get_type (obj) == json_type_array) - && (json_object_array_length (obj) >= 1) - && (JSONMatchesStr (json_object_array_get_idx (obj, 0), magicWord)); -} - - -static int isJSONArrayOfLength (json_object* obj, int len) { - return (json_object_get_type (obj) == json_type_array) - && (json_object_array_length (obj) == len); -} - - -// array -static int isEmptyJSONArray (json_object* obj) { - return isJSONArrayOfLength (obj, 0); -} - - -// ---------------------------------------------------------------------------- - - -int json_object_get_flex_boolean (json_object* bg) { - int truth = FALSE; - - if (json_object_get_type (bg) == json_type_boolean) { - truth = json_object_get_boolean (bg); - } else if (json_object_get_type (bg) == json_type_string) { - if (strcmp (json_object_get_string (bg), "false") == 0) { - truth = FALSE; - } else if (strcmp (json_object_get_string (bg), "true") == 0) { - truth = TRUE; - } else { - abort (); - } - } - - return (truth); -} - - -// string_of_commandI contains code moved out of the OCaml 'to_string' for clarity -/* - | Command (_,assigns,cmds,redirs) -> - separated string_of_assign assigns ^ - (if List.length assigns = 0 || List.length cmds = 0 then "" else " ") ^ - separated string_of_arg cmds ^ string_of_redirs redirs -*/ -void string_of_commandI (json_object* assigns, json_object* cmds, json_object* redirs) { - assert (assigns != NULL); - assert (cmds != NULL); - assert (redirs != NULL); - - assert (json_object_get_type (assigns) == json_type_array); - assert (json_object_get_type (cmds) == json_type_array); - assert (json_object_get_type (redirs) == json_type_array); - - for (int i = 0; i < json_object_array_length (assigns); i++) { - if (i > 0) { - putchar (' '); // Inline 'separated' - } - string_of_assign (json_object_array_get_idx (assigns, i)); - } - - if ( (json_object_array_length (assigns) != 0) - && (json_object_array_length (cmds) != 0)) { // De Morgan's law - putchar (' '); - } - - for (int i = 0; i < json_object_array_length (cmds); i++) { - if (i > 0) { - putchar (' '); // Inline 'separated' - } - string_of_arg (json_object_array_get_idx (cmds, i)); - } - - string_of_redirs (redirs); -} - - -// string_of_pipeI contains code moved out of the OCaml 'to_string' for clarity -/* - background s = "{ " ^ s ^ " & }" - - | Pipe (bg,ps) -> - let p = intercalate " | " (List.map to_string ps) in - if bg then background p else p -*/ -void string_of_pipeI (json_object* bg, json_object* ps) { - assert (bg != NULL); - assert (ps != NULL); - - assert (json_object_get_type (ps) == json_type_array); - - if (json_object_get_flex_boolean (bg)) { // Inline 'background' - printf ("{ "); - } - - for (int i = 0; i < json_object_array_length (ps); i++) { - if (i > 0) { - printf (" | "); // Inline 'intercalate " | "' - } - to_string (json_object_array_get_idx (ps, i)); - } - - if (json_object_get_flex_boolean (bg)) { // Inline 'background' - printf (" & }"); - } -} - - -// ---------------------------------------------------------------------------- - - -/* - let string_of_var_type = function - | Normal -> "" - | Minus -> "-" - | Plus -> "+" - | Question -> "?" - | Assign -> "=" - | TrimR -> "%" - | TrimRMax -> "%%" - | TrimL -> "#" - | TrimLMax -> "##" - | Length -> "#" -*/ -void string_of_var_type (json_object* vt) { - assert (vt != NULL); - - assert (json_object_get_type (vt) == json_type_string); - - const char* vt_str = json_object_get_string (vt); - if (strcmp (vt_str, "Normal") == 0) { - // No-op - } else if (strcmp (vt_str, "Minus") == 0) { - putchar ('-'); - } else if (strcmp (vt_str, "Plus") == 0) { - putchar ('+'); - } else if (strcmp (vt_str, "Question") == 0) { - putchar ('?'); - } else if (strcmp (vt_str, "Assign") == 0) { - putchar ('='); - } else if (strcmp (vt_str, "TrimR") == 0) { - putchar ('%'); - } else if (strcmp (vt_str, "TrimRMax") == 0) { - putchar ('%'); - putchar ('%'); - } else if (strcmp (vt_str, "TrimL") == 0) { - putchar ('#'); - } else if (strcmp (vt_str, "TrimLMax") == 0) { - putchar ('#'); - putchar ('#'); - } else if (strcmp (vt_str, "Length") == 0) { - putchar ('#'); - } else { - debug_json (vt); - - assert (! "Unexpected type for string_of_var_type\n"); - } -} - - -/* -void separated (void) { - assert (! "This function has been manually inlined\n"); -} -*/ - - -/* - let show_unless expected actual = - if expected = actual - then "" - else string_of_int actual -*/ -void show_unless (int expected, int actual) { - if (expected != actual) { - printf ("%d", actual); - } -} - - -/* -void background (void) { - assert (! "This function has been manually inlined\n"); -} -*/ - - -void json_text_to_string (char* json_text) { - // Nesting can be very deep e.g., scripts/intermediary/web-index_p2_1_funs.sh.json - struct json_tokener* tok = json_tokener_new_ex (JSON_MAX_DEPTH); - - // Based on http://json-c.github.io/json-c/json-c-current-release/doc/html/json__tokener_8h.html - json_object* jobj = json_tokener_parse_ex(tok, json_text, strlen (json_text)); - enum json_tokener_error jerr = json_tokener_get_error(tok); - if (jerr != json_tokener_success) { - fprintf (stderr, "Error: %s\n", json_tokener_error_desc (jerr)); - abort (); - } - - assert (jobj != NULL); - to_string (jobj); -} - - -// OCaml function body is marvelous but this comment is too narrow to contain it -void to_string (json_object* jobj) { - switch (json_object_get_type (jobj)) { - case json_type_array: - assert (json_object_array_length (jobj) == 2); - - json_object* obj1 = json_object_array_get_idx (jobj, 0); - assert (obj1 != NULL); - assert (json_object_get_type (obj1) == json_type_string); - - const char* str1 = json_object_get_string (obj1); - assert (str1 != NULL); - - json_object* obj2 = json_object_array_get_idx (jobj, 1); - assert (obj2 != NULL); - assert (json_object_get_type (obj2) == json_type_array); - - if (strcmp (str1, "Command") == 0) { - assert (json_object_array_length (obj2) == 4); - - string_of_commandI (// First param (lineno) is ignored! - json_object_array_get_idx (obj2, 1), // assigns - json_object_array_get_idx (obj2, 2), // cmds - json_object_array_get_idx (obj2, 3)); // redirs - } else if (strcmp (str1, "Pipe") == 0) { - assert (json_object_array_length (obj2) == 2); - - string_of_pipeI (json_object_array_get_idx (obj2, 0), - json_object_array_get_idx (obj2, 1)); - } else if (strcmp (str1, "Redir") == 0) { - /* - | Redir (_,a,redirs) -> - to_string a ^ string_of_redirs redirs - */ - - assert (json_object_array_length (obj2) == 3); - // First param is ignored - json_object* a = json_object_array_get_idx (obj2, 1); - json_object* redirs = json_object_array_get_idx (obj2, 2); - - to_string (a); - string_of_redirs (redirs); - } else if (strcmp (str1, "Background") == 0) { - // | Background (_,a,redirs) -> - // background (to_string a ^ string_of_redirs redirs) - - assert (json_object_array_length (obj2) == 3); - // First param is ignored - json_object* a = json_object_array_get_idx (obj2, 1); - json_object* redirs = json_object_array_get_idx (obj2, 2); - - printf ("{ "); // Inline 'background' - to_string (a); - string_of_redirs (redirs); - printf (" & }"); // Inline 'background' - } else if (strcmp (str1, "Subshell") == 0) { - // | Subshell (_,a,redirs) -> - // parens (to_string a ^ string_of_redirs redirs) - // - // let parens s = "( " ^ s ^ " )" - - assert (json_object_array_length (obj2) == 3); - // First param is ignored - json_object* a = json_object_array_get_idx (obj2, 1); - json_object* redirs = json_object_array_get_idx (obj2, 2); - - printf ("( "); // Inline 'parens' - to_string (a); - string_of_redirs (redirs); - printf (" )"); // Inline 'parens' - } else if (strcmp (str1, "And") == 0) { - // | And (a1,a2) -> to_string a1 ^ " && " ^ to_string a2 - - assert (json_object_array_length (obj2) == 2); - json_object* a1 = json_object_array_get_idx (obj2, 0); - json_object* a2 = json_object_array_get_idx (obj2, 1); - - to_string (a1); - printf (" && "); - to_string (a2); - } else if (strcmp (str1, "Or") == 0) { - // | Or (a1,a2) -> to_string a1 ^ " || " ^ to_string a2 - - assert (json_object_array_length (obj2) == 2); - json_object* a1 = json_object_array_get_idx (obj2, 0); - json_object* a2 = json_object_array_get_idx (obj2, 1); - - to_string (a1); - printf (" || "); - to_string (a2); - } else if (strcmp (str1, "Not") == 0) { - // | Not a -> "! " ^ braces (to_string a) - // - // let braces s = "{ " ^ s ^ " ; }" - - printf ("! "); - printf ("{ "); // Inline 'braces' - to_string (obj2); - printf (" ; }"); // Inline 'braces' - } else if (strcmp (str1, "Semi") == 0) { - // | Semi (a1,a2) -> to_string a1 ^ " ; " ^ to_string a2 - assert (json_object_array_length (obj2) == 2); - json_object* a1 = json_object_array_get_idx (obj2, 0); - json_object* a2 = json_object_array_get_idx (obj2, 1); - - to_string (a1); - printf (" ; "); - to_string (a2); - } else if (strcmp (str1, "If") == 0) { - assert (json_object_array_length (obj2) == 3); - - string_of_if (json_object_array_get_idx (obj2, 0), - json_object_array_get_idx (obj2, 1), - json_object_array_get_idx (obj2, 2)); - } else if (strcmp (str1, "While") == 0) { - /* - | While (Not t,b) -> - "until " ^ to_string t ^ "; do " ^ to_string b ^ "; done " - | While (t,b) -> - "while " ^ to_string t ^ "; do " ^ to_string b ^ "; done " - */ - assert (json_object_array_length (obj2) == 2); - json_object* obj2_0 = json_object_array_get_idx (obj2, 0); - json_object* obj2_1 = json_object_array_get_idx (obj2, 1); - - if (JSONArrayStartsWithStr (obj2_0, "Not")) { - // | While (Not t,b) -> - // "until " ^ to_string t ^ "; do " ^ to_string b ^ "; done " - assert (json_object_array_length (obj2_0) == 2); - - // obj2_0_0 is "Not" - json_object* t = json_object_array_get_idx (obj2_0, 1); - json_object* b = obj2_1; - - printf ("until "); - to_string (t); - printf ("; do "); - to_string (b); - printf ("; done "); - } else { - // | While (t,b) -> - // "while " ^ to_string t ^ "; do " ^ to_string b ^ "; done " - json_object* t = obj2_0; - json_object* b = obj2_1; - - printf ("while "); - to_string (t); - printf ("; do "); - to_string (b); - printf ("; done "); - // Trailing space can look ugly but we keep it for consistency - // with ast.ml (which probably has a good reason for it) for: - // - scripts/circular/sine.sh' - // - scripts/circular/incr.sh' - // - scripts/usecases/shellcheck/distrotest_funs.sh - // - scripts/intermediary/web-index_p2_1_funs.sh - } - } else if (strcmp (str1, "For") == 0) { - /* - | For (_,a,body,var) -> - "for " ^ var ^ " in " ^ string_of_arg a ^ "; do " ^ - to_string body ^ "; done" - */ - - assert (json_object_array_length (obj2) == 4); - // First param is ignored - json_object* a = json_object_array_get_idx (obj2, 1); - json_object* body = json_object_array_get_idx (obj2, 2); - json_object* var = json_object_array_get_idx (obj2, 3); - - assert (json_object_get_type (var) == json_type_string); - - printf ("for "); - printf ("%s", json_object_get_string (var)); - printf (" in "); - string_of_arg (a); - printf ("; do "); - to_string (body); - printf ("; done"); - } else if (strcmp (str1, "Case") == 0) { - /* - | Case (_,a,cs) -> - "case " ^ string_of_arg a ^ " in " ^ - separated string_of_case cs ^ " esac" - */ - - assert (json_object_array_length (obj2) == 3); - // First param is ignored - json_object* a = json_object_array_get_idx (obj2, 1); - json_object* cs = json_object_array_get_idx (obj2, 2); - - printf ("case "); - string_of_arg (a); - printf (" in "); - - assert (json_object_get_type (cs) == json_type_array); - for (int i = 0; i < json_object_array_length (cs); i++) { - if (i > 0) { - putchar (' '); // Inline 'separated' - } - string_of_case (json_object_array_get_idx (cs, i)); - } - printf (" esac"); - } else if (strcmp (str1, "Defun") == 0) { - // | Defun (_,name,body) -> name ^ "() {\n" ^ to_string body ^ "\n}" - - assert (json_object_array_length (obj2) == 3); - // First param is ignored - json_object* name = json_object_array_get_idx (obj2, 1); - json_object* body = json_object_array_get_idx (obj2, 2); - - assert (json_object_get_type (name) == json_type_string); - - printf ("%s", json_object_get_string (name)); - printf ("() {\n"); - to_string (body); - printf ("\n}"); - } else { - debug_json (obj2); - printf ("Type: %s\n", str1); - assert (! "Unexpected case"); - } - - break; - - case json_type_null: - case json_type_boolean: - case json_type_double: - case json_type_int: - case json_type_object: - case json_type_string: - assert (! "Unexpected type at top-level of to_string\n"); - break; - - default: - assert ("! Not a valid json_type"); - break; - } -} - - -/* - string_of_if c t e = - "if " ^ to_string c ^ - "; then " ^ to_string t ^ - (match e with - | Command (-1,[],[],[]) -> "; fi" (* one-armed if *) - | If (c,t,e) -> "; el" ^ string_of_if c t e - | _ -> "; else " ^ to_string e ^ "; fi") -*/ -void string_of_if (json_object* c, json_object* t, json_object* e) { - assert (c != NULL); - assert (t != NULL); - assert (e != NULL); - - printf ("if "); - to_string (c); - printf ("; then "); - to_string (t); - - assert (json_object_get_type (e) == json_type_array); - assert (json_object_array_length (e) >= 1); - - json_object* e1 = json_object_array_get_idx (e, 0); - assert (e1 != NULL); - assert (json_object_get_type (e1) == json_type_string); - - const char* e1_str = json_object_get_string (e1); - - // | Command (-1,[],[],[]) -> "; fi" (* one-armed if *) - int done = FALSE; - if (json_object_array_length (e) == 2) { - json_object* e2 = json_object_array_get_idx (e, 1); - - if ( (strcmp (e1_str, "Command") == 0) - && (json_object_get_type (e2) == json_type_array) - - && (json_object_get_type (json_object_array_get_idx (e2, 0)) == json_type_int) - && (json_object_get_int (json_object_array_get_idx (e2, 0)) == -1) - - && isEmptyJSONArray (json_object_array_get_idx (e2, 1)) - && isEmptyJSONArray (json_object_array_get_idx (e2, 2)) - && isEmptyJSONArray (json_object_array_get_idx (e2, 3))) { - printf ("; fi"); - done = TRUE; - } - } - - if (strcmp (e1_str, "If") == 0) { - // | If (c,t,e) -> "; el" ^ string_of_if c t e - assert (json_object_array_length (e) == 2); - json_object* e2 = json_object_array_get_idx (e, 1); - - assert (isJSONArrayOfLength (e2, 3)); - - // Rename c/t/e to avoid confusion (even though lexical scoping allows it) - json_object* cI = json_object_array_get_idx (e2, 0); - json_object* tI = json_object_array_get_idx (e2, 1); - json_object* eI = json_object_array_get_idx (e2, 2); - - printf ("; el"); - string_of_if (cI, tI, eI); - } else if (! done) { - printf ("; else "); - to_string (e); - printf ("; fi"); - } -} - - -/* - string_of_arg_char = function - | E '\'' -> "\\'" - | E '\"' -> "\\\"" - | E '(' -> "\\(" - | E ')' -> "\\)" - | E '{' -> "\\{" - | E '}' -> "\\}" - | E '$' -> "\\$" - | E '!' -> "\\!" - | E '&' -> "\\&" - | E '|' -> "\\|" - | E ';' -> "\\;" - | C c -> String.make 1 c - | E c -> Char.escaped c - | T None -> "~" - | T (Some u) -> "~" ^ u - | A a -> "$((" ^ string_of_arg a ^ "))" - | V (Length,_,name,_) -> "${#" ^ name ^ "}" - | V (vt,nul,name,a) -> - "${" ^ name ^ (if nul then ":" else "") ^ string_of_var_type vt ^ string_of_arg a ^ "}" - | Q a -> "\"" ^ string_of_arg a ^ "\"" - | B t -> "$(" ^ to_string t ^ ")" -*/ -void string_of_arg_char (json_object* first, json_object* second) { - assert (first != NULL); - assert (second != NULL); - - assert (json_object_get_type (first) == json_type_string); - const char* firstStr = json_object_get_string (first); - if (strcmp (firstStr, "E") == 0) { - assert (json_object_get_type (second) == json_type_int); - - int second_int = json_object_get_int (second); - switch (second_int) { - case '\'': - printf ("\\'"); - break; - case '"': - printf ("\\\""); - break; - case '(': - printf ("\\("); - break; - case ')': - printf ("\\)"); - break; - case '{': - printf ("\\{"); - break; - case '}': - printf ("\\}"); - break; - case '$': - printf ("\\$"); - break; - case '!': - printf ("\\!"); - break; - case '&': - printf ("\\&"); - break; - case '|': - printf ("\\|"); - break; - case ';': - printf ("\\;"); - break; - - // | E c -> Char.escaped c - // - // "All characters outside the ASCII printable range (32..126) - // are escaped, as well as backslash, double-quote, and - // single-quote." - // -- https://ocaml.org/releases/4.07/htmlman/libref/Char.html - case '\\': // Special case - printf ("\\\\"); - break; - case '\t': - printf ("\\t"); - break; - - default: - if (second_int < 32 || second_int > 126) { - putchar ('\\'); - printf ("%d", second_int); - } else { - printf ("%c", second_int); - } - - break; - } - } else if (strcmp (firstStr, "C") == 0) { - assert (json_object_get_type (second) == json_type_int); - putchar (json_object_get_int (second)); - } else if (strcmp (firstStr, "T") == 0) { - /* - | T None -> "~" - | T (Some u) -> "~" ^ u - */ - - if (json_object_get_type (second) == json_type_string) { - assert (strcmp (json_object_get_string (second), "None") == 0); // Left beef - - putchar ('~'); - } else if (json_object_get_type (second) == json_type_array) { - assert (json_object_array_length (second) == 2); - - json_object* Some = json_object_array_get_idx (second, 0); - json_object* u = json_object_array_get_idx (second, 1); - - if (! JSONMatchesStr (Some, "Some")) { - assert (! "Was not None or Some"); - exit (1); - } - - assert (json_object_get_type (u) == json_type_string); - - putchar ('~'); - printf ("%s", json_object_get_string (u)); - } else { - debug_json (second); - - assert (! "Unexpected pattern for T"); - } - } else if (strcmp (firstStr, "A") == 0) { - // | A a -> "$((" ^ string_of_arg a ^ "))" - assert (json_object_get_type (second) == json_type_array); - json_object* a = second; - - printf ("$(("); - string_of_arg (a); - printf ("))"); - } else if (strcmp (firstStr, "V") == 0) { - assert (isJSONArrayOfLength (second, 4)); - - json_object* vt = json_object_array_get_idx (second, 0); - json_object* nul = json_object_array_get_idx (second, 1); - json_object* name = json_object_array_get_idx (second, 2); - json_object* a = json_object_array_get_idx (second, 3); - - assert (json_object_get_type (vt) == json_type_string); - assert (json_object_get_type (name) == json_type_string); - - if (strcmp (json_object_get_string (vt), "Length") == 0) { - // | V (Length,_,name,_) -> "${#" ^ name ^ "}" - - printf ("${#"); - printf ("%s", json_object_get_string (name)); - printf ("}"); - - // assert (! "TODO: This case has been implemented but never tested"); - } else { - // | V (vt,nul,name,a) -> - // "${" ^ name ^ (if nul then ":" else "") ^ string_of_var_type vt ^ string_of_arg a ^ "}" - - printf ("${"); - printf ("%s", json_object_get_string (name)); - - if (json_object_get_flex_boolean (nul)) { - printf (":"); - } - - string_of_var_type (vt); - string_of_arg (a); - printf ("}"); - } - } else if (strcmp (firstStr, "Q") == 0) { - putchar ('"'); - string_of_arg (second); - putchar ('"'); - } else if (strcmp (firstStr, "B") == 0) { - printf ("$("); - to_string (second); - printf (")"); - } else { - assert (! "Unexpected arg_char"); - } -} - - -/* - string_of_arg = function - | [] -> "" - | c :: a -> string_of_arg_char c ^ string_of_arg a -*/ -void string_of_arg (json_object* arg1) { - assert (arg1 != NULL); - - assert (json_object_get_type (arg1) == json_type_array); - for (int i = 0; i < json_object_array_length (arg1); i++) { - json_object* ch = json_object_array_get_idx (arg1, i); - - assert (ch != NULL); - assert (isJSONArrayOfLength (ch, 2)); - - json_object* ch1 = json_object_array_get_idx (ch, 0); - assert (ch1 != NULL); - assert (json_object_get_type (ch1) == json_type_string); - - json_object* ch2 = json_object_array_get_idx (ch, 1); - assert (ch2 != NULL); - - string_of_arg_char (ch1, ch2); - } -} - - -// string_of_assign (v,a) = v ^ "=" ^ string_of_arg a -void string_of_assign (json_object* va) { - assert (va != NULL); - - assert (isJSONArrayOfLength (va, 2)); - - json_object* v = json_object_array_get_idx (va, 0); - assert (v != NULL); - assert (json_object_get_type (v) == json_type_string); - - printf ("%s", json_object_get_string (v)); - putchar ('='); - - json_object* a = json_object_array_get_idx (va, 1); - assert (a != NULL); - assert (json_object_get_type (a) == json_type_array); - string_of_arg (a); -} - - -/* - string_of_case c = - let pats = List.map string_of_arg c.cpattern in - intercalate "|" pats ^ ") " ^ to_string c.cbody ^ ";;" -*/ -// This case is unique because it uses JSON key/value. -void string_of_case (json_object* c) { - assert (json_object_get_type (c) == json_type_object); - - json_object* cpattern; - json_object* cbody; - - assert (json_object_object_get_ex (c, "cpattern", &cpattern)); - assert (json_object_object_get_ex (c, "cbody", &cbody)); - - assert (json_object_get_type (cpattern) == json_type_array); - assert (json_object_get_type (cbody) == json_type_array); - - for (int i = 0; i < json_object_array_length (cpattern); i++) { - if (i > 0) { - putchar ('|'); // Inline 'intercalate' - } - string_of_arg (json_object_array_get_idx (cpattern, i)); - } - - printf (") "); - to_string (cbody); - printf (";;"); -} - - -/* - string_of_redir = function - | File (To,fd,a) -> show_unless 1 fd ^ ">" ^ string_of_arg a - | File (Clobber,fd,a) -> show_unless 1 fd ^ ">|" ^ string_of_arg a - | File (From,fd,a) -> show_unless 0 fd ^ "<" ^ string_of_arg a - | File (FromTo,fd,a) -> show_unless 0 fd ^ "<>" ^ string_of_arg a - | File (Append,fd,a) -> show_unless 1 fd ^ ">>" ^ string_of_arg a - | Dup (ToFD,fd,tgt) -> show_unless 1 fd ^ ">&" ^ string_of_arg tgt - | Dup (FromFD,fd,tgt) -> show_unless 0 fd ^ "<&" ^ string_of_arg tgt - | Heredoc (t,fd,a) -> - let heredoc = string_of_arg a in - let marker = fresh_marker (lines heredoc) "EOF" in - show_unless 0 fd ^ "<<" ^ - (if t = XHere then marker else "'" ^ marker ^ "'") ^ "\n" ^ heredoc ^ marker ^ "\n" -*/ -void string_of_redir (json_object* r) { - assert (isJSONArrayOfLength (r, 2)); - - // File (To, fd, a) - // -r1- --- r2 ---- - - json_object* r1 = json_object_array_get_idx (r, 0); - assert (r1 != NULL); - assert (json_object_get_type (r1) == json_type_string); - - json_object* r2 = json_object_array_get_idx (r, 1); - assert (r2 != NULL); - assert (json_object_get_type (r2) == json_type_array); - - const char* r1_str = json_object_get_string (r1); - if ( (strcmp (r1_str, "File") == 0) - || (strcmp (r1_str, "Dup") == 0) - || (strcmp (r1_str, "Heredoc") == 0)) { - assert (json_object_array_length (r2) == 3); - - json_object* direction = json_object_array_get_idx (r2, 0); - json_object* fd = json_object_array_get_idx (r2, 1); - json_object* a = json_object_array_get_idx (r2, 2); - - assert (direction != NULL); - assert (json_object_get_type (direction) == json_type_string); - - assert (fd != NULL); - assert (json_object_get_type (fd) == json_type_int); - - assert (a != NULL); - assert (json_object_get_type (a) == json_type_array); - - const char* direction_str = json_object_get_string (direction); - - if (strcmp (r1_str, "File") == 0) { - if (strcmp (direction_str, "To") == 0) { - show_unless (1, json_object_get_int (fd)); - printf (">"); - string_of_arg (a); - } else if (strcmp (direction_str, "Clobber") == 0) { - show_unless (1, json_object_get_int (fd)); - printf (">|"); - string_of_arg (a); - } else if (strcmp (direction_str, "From") == 0) { - show_unless (0, json_object_get_int (fd)); - printf ("<"); - string_of_arg (a); - } else if (strcmp (direction_str, "FromTo") == 0) { - show_unless (0, json_object_get_int (fd)); - printf ("<>"); - string_of_arg (a); - } else if (strcmp (direction_str, "Append") == 0) { - show_unless (1, json_object_get_int (fd)); - printf (">>"); - string_of_arg (a); - } else { - assert (! "Invalid File case"); - } - } else if (strcmp (r1_str, "Dup") == 0) { - if (strcmp (direction_str, "ToFD") == 0) { - show_unless (1, json_object_get_int (fd)); - printf (">&"); - string_of_arg (a); - } else if (strcmp (direction_str, "FromFD") == 0) { - show_unless (0, json_object_get_int (fd)); - printf ("<&"); - string_of_arg (a); - } else { - debug_json (r1); - debug_json (r2); - - assert (! "Invalid Dup case"); - } - } else if (strcmp (r1_str, "Heredoc") == 0) { - /* - | Heredoc (t,fd,a) -> - let heredoc = string_of_arg a in - let marker = fresh_marker (lines heredoc) "EOF" in - show_unless 0 fd ^ "<<" ^ - (if t = XHere then marker else "'" ^ marker ^ "'") ^ "\n" ^ heredoc ^ marker ^ "\n" - - let lines = Str.split (Str.regexp "[\n\r]+") - - // If one of the lines contains the marker "EOF", keep appending 'F' until it's a unique marker - let rec fresh_marker ls s = - if List.mem s ls - then fresh_marker ls (s ^ (String.sub s (String.length s - 1) 1)) - else s - */ - - show_unless (0, json_object_get_int (fd)); - printf ("<<"); - - // TODO: implement fresh_marker. Kludge would be to simply use a long, obscure piece of text. - char* marker = "EOF"; - - if (strcmp (direction_str, "XHere") == 0) { - printf ("%s", marker); - } else { - putchar ('\''); - printf ("%s", marker); - putchar ('\''); - } - printf ("\n"); - string_of_arg (a); - printf ("%s", marker); - printf ("\n"); - } else { - assert (! "This case shouldn't happen"); - } - } else { - debug_json (r1); - debug_json (r2); - - assert (! "Invalid redir case"); - } -} - - -/* - string_of_redirs rs = - let ss = List.map string_of_redir rs in - (if List.length ss > 0 then " " else "") ^ intercalate " " ss -*/ -void string_of_redirs (json_object* rs) { - assert (rs != NULL); - - assert (json_object_get_type (rs) == json_type_array); - for (int i = 0; i < json_object_array_length (rs); i++) { - // Inlined 'intercalate " "' and - // optimized out special case whitespace - putchar (' '); - string_of_redir (json_object_array_get_idx (rs, i)); - } -} diff --git a/compiler/parser/ceda/ast2b.h b/compiler/parser/ceda/ast2b.h deleted file mode 100644 index f28d35bff..000000000 --- a/compiler/parser/ceda/ast2b.h +++ /dev/null @@ -1,9 +0,0 @@ -#include "json_object.h" - - -#define JSON_MAX_DEPTH 640 - - -void debug_json (json_object* jobj); -void json_text_to_string (char* json_text); -void to_string (json_object* jobj); diff --git a/compiler/parser/ceda/ast2json.c b/compiler/parser/ceda/ast2json.c deleted file mode 100644 index 906302145..000000000 --- a/compiler/parser/ceda/ast2json.c +++ /dev/null @@ -1,413 +0,0 @@ -/* - - - ast2json.c : Walks through our C-approximation of the libdash AST, and - uses JSON-C to generate a JSON representation that closely - matches the OCaml output (notably, including quirks such - as (None | Some str). - - -*/ - - -#include -#include -#include -#include -#include - -#include "shell.h" - -#include "init.h" -#include "input.h" -#include "main.h" -#include "memalloc.h" -#include "nodes.h" -#include "parser.h" - -#include "dash2.h" -#include "ast2a.h" -#include "ast2json.h" - -#include "json_object.h" - -#include "arg_char.h" -#include "ArgCharStack.h" -#include "Stack.h" - - -//---------------------------------------------------------------------------------------------------------------------- - -static struct json_object* json_arg_char_TYPE (struct arg_char_TYPE* head); -static struct json_object* json_assign_list (struct assign_list* assign); -static struct json_object* json_arg_TYPE (arg_TYPE arg); -static struct json_object* json_args_TYPE (struct args_TYPE* args); -static struct json_object* json_redirectionList (struct redirectionList* redirect); -static struct json_object* json_t_TYPE (struct t_TYPE* t); - - -//---------------------------------------------------------------------------------------------------------------------- - - -static struct json_object* json_arg_char_TYPE (struct arg_char_TYPE* head) { - struct json_object* root = json_object_new_array (); - assert (root != NULL); - - assert (head->type >= 0); - // TODO: bounds check - // assert (head->type < sizeof (SERIALIZE_TYPE_ARG_CHAR) / sizeof (char*)); - json_object_array_add (root, json_object_new_string (SERIALIZE_TYPE_ARG_CHAR [head->type])); - - switch (head->type) { - case TYPE_ARG_CHAR_C: { - json_object_array_add (root, json_object_new_int (head->C.c)); - } - break; - - case TYPE_ARG_CHAR_E: { - json_object_array_add (root, json_object_new_int (head->E.c)); - } - break; - - case TYPE_ARG_CHAR_T: { - if (head->T.str == NULL) { - json_object_array_add (root, json_object_new_string ("None")); - } else { - struct json_object* nest = json_object_new_array (); - assert (nest != NULL); - - json_object_array_add (nest, json_object_new_string ("Some")); - json_object_array_add (nest, json_object_new_string (head->T.str)); - - json_object_array_add (root, nest); - } - } - break; - - case TYPE_ARG_CHAR_A: { - json_object_array_add (root, json_arg_TYPE (head->A.arg)); - } - break; - - case TYPE_ARG_CHAR_V: { - struct json_object* nest = json_object_new_array (); - assert (nest != NULL); - - json_object_array_add (nest, json_object_new_string (SERIALIZE_VAR_TYPE [head->V.var_type])); - json_object_array_add (nest, json_object_new_boolean (head->V.vsnul)); - json_object_array_add (nest, json_object_new_string (head->V.str)); - json_object_array_add (nest, json_arg_TYPE (head->V.arg)); - - json_object_array_add (root, nest); - } - break; - - case TYPE_ARG_CHAR_Q: { - json_object_array_add (root, json_arg_TYPE (head->Q.arg)); - } - break; - - case TYPE_ARG_CHAR_B: { - json_object_array_add (root, json_t_TYPE (head->B.t)); - } - break; - - default: - break; - } - - return (root); -} - - -static struct json_object* json_assign_list (struct assign_list* assigns) { - struct json_object* root = json_object_new_array (); - assert (root != NULL); - - while (assigns != NULL) { - struct assign_TYPE* assign = assigns->assign; - - struct json_object* nest = json_object_new_array (); - assert (nest != NULL); - - json_object_array_add (nest, json_object_new_string (assign->string)); - json_object_array_add (nest, json_arg_TYPE (assign->arg)); - - json_object_array_add (root, nest); - - assigns = assigns->next; - } - - return (root); -} - - -static struct json_object* json_arg_TYPE (arg_TYPE arg) { - struct json_object* root = json_object_new_array (); - assert (root != NULL); - - // arg is a list of arg_char, but stored in CharList - while (! isArgCharStackEmpty (arg)) { - struct arg_char_TYPE* arg_char = popArgCharStack (arg); - json_object_array_add (root, json_arg_char_TYPE (arg_char)); - } - - return (root); -} - - -static struct json_object* json_args_TYPE (struct args_TYPE* args) { - struct json_object* root = json_object_new_array (); - assert (root != NULL); - - while (args != NULL) { - json_object_array_add (root, json_arg_TYPE (args->arg)); - - args = args->next; - } - - return (root); -} - - -// Explicitly specify root so that the recursive step doesn't add extra nesting -static struct json_object* json_redirectionListI (struct redirectionList* redirect, - json_object* root) { - struct json_object* nest = json_object_new_array (); - assert (nest != NULL); - - if (redirect == NULL) { - } else { - // TODO: bounds check - json_object_array_add (nest, json_object_new_string (SERIALIZE_REDIRECTION_TYPE [redirect->redir->type])); - - struct json_object* nest2 = json_object_new_array (); - assert (nest2 != NULL); - - - switch (redirect->redir->type) { - case REDIRECTION_TYPE_FILE: { - json_object_array_add (nest2, json_object_new_string (SERIALIZE_REDIR_TYPE [redirect->redir->file.redir_type])); - json_object_array_add (nest2, json_object_new_int (redirect->redir->file.fd)); - json_object_array_add (nest2, json_arg_TYPE (redirect->redir->file.a)); - } - break; - - case REDIRECTION_TYPE_DUP: { - json_object_array_add (nest2, json_object_new_string (SERIALIZE_DUP_TYPE [redirect->redir->dup.dup_type])); - json_object_array_add (nest2, json_object_new_int (redirect->redir->dup.fd)); - json_object_array_add (nest2, json_arg_TYPE (redirect->redir->dup.tgt)); - } - break; - - case REDIRECTION_TYPE_HEREDOC: { - json_object_array_add (nest2, json_object_new_string (SERIALIZE_HEREDOC_TYPE [redirect->redir->heredoc.heredoc_type])); - json_object_array_add (nest2, json_object_new_int (redirect->redir->heredoc.fd)); - json_object_array_add (nest2, json_arg_TYPE (redirect->redir->heredoc.a)); - } - break; - - default: - assert (! "Invalid redirection type"); - break; - } - - json_object_array_add (nest, nest2); - json_object_array_add (root, nest); - - json_redirectionListI (redirect->next, root); - } - - return (root); -} - - -static struct json_object* json_redirectionList (struct redirectionList* redirect) { - struct json_object* root = json_object_new_array (); - assert (root != NULL); - - return (json_redirectionListI (redirect, root)); -} - - -static struct json_object* json_t_TYPE (struct t_TYPE* t) { - struct json_object* root = json_object_new_array (); - assert (root != NULL); - - if (t == NULL) { - return root; - } - - assert (t->type >= 0); - // TODO: bounds check - // assert (t->type < sizeof (SERIALIZE_TYPE_T) / sizeof (char*)); - json_object_array_add (root, json_object_new_string (SERIALIZE_TYPE_T [t->type])); - - struct json_object* nest = json_object_new_array (); - assert (nest != NULL); - - switch (t->type) { - case TYPE_T_COMMAND: { - json_object_array_add (nest, json_object_new_int (t->Command.linno)); - json_object_array_add (nest, json_assign_list (t->Command.assign)); - json_object_array_add (nest, json_args_TYPE (t->Command.args)); - json_object_array_add (nest, json_redirectionList (t->Command.redirect)); - - break; - } - - case TYPE_T_PIPE: { - json_object_array_add (nest, json_object_new_boolean (t->Pipe.background)); - - struct t_list* spill = t->Pipe.spill; - - struct json_object* nest2 = json_object_new_array (); - assert (nest2 != NULL); - - while (spill != NULL) { - json_object_array_add (nest2, json_t_TYPE (spill->t)); - spill = spill->next; - } - - json_object_array_add (nest, nest2); - - break; - } - - case TYPE_T_REDIR: { - json_object_array_add (nest, json_object_new_int (t->Redir.linno)); - json_object_array_add (nest, json_t_TYPE (t->Redir.t)); - json_object_array_add (nest, json_redirectionList (t->Redir.redirect)); - - break; - } - - case TYPE_T_BACKGROUND: { - json_object_array_add (nest, json_object_new_int (t->Background.linno)); - json_object_array_add (nest, json_t_TYPE (t->Background.t)); - json_object_array_add (nest, json_redirectionList (t->Background.redirect)); - - break; - } - - case TYPE_T_SUBSHELL: { - json_object_array_add (nest, json_object_new_int (t->Background.linno)); - json_object_array_add (nest, json_t_TYPE (t->Subshell.t)); - json_object_array_add (nest, json_redirectionList (t->Subshell.redirect)); - - break; - } - - case TYPE_T_AND: { - json_object_array_add (nest, json_t_TYPE (t->And.left)); - json_object_array_add (nest, json_t_TYPE (t->And.right)); - break; - } - - case TYPE_T_OR: { - json_object_array_add (nest, json_t_TYPE (t->Or.left)); - json_object_array_add (nest, json_t_TYPE (t->Or.right)); - break; - } - - case TYPE_T_NOT: { - json_object_array_add (root /* not nested */, json_t_TYPE (t->Not.t)); - break; - } - - case TYPE_T_SEMI: { - json_object_array_add (nest, json_t_TYPE (t->Or.left)); - json_object_array_add (nest, json_t_TYPE (t->Or.right)); - - break; - } - - case TYPE_T_IF: { - json_object_array_add (nest, json_t_TYPE (t->If.test)); - json_object_array_add (nest, json_t_TYPE (t->If.ifpart)); - json_object_array_add (nest, json_t_TYPE (t->If.elsepart)); - - break; - } - - case TYPE_T_WHILE: { - json_object_array_add (nest, json_t_TYPE (t->While.test)); - json_object_array_add (nest, json_t_TYPE (t->While.body)); - - break; - } - - case TYPE_T_FOR: { - json_object_array_add (nest, json_object_new_int (t->For.linno)); - json_object_array_add (nest, json_arg_TYPE (t->For.arg)); - json_object_array_add (nest, json_t_TYPE (t->For.body)); - json_object_array_add (nest, json_object_new_string (t->For.var)); - - break; - } - - case TYPE_T_CASE: { - json_object_array_add (nest, json_object_new_int (t->Case.linno)); - json_object_array_add (nest, json_arg_TYPE (t->Case.arg)); - - struct json_object* nest2 = json_object_new_array (); - assert (nest2 != NULL); - - struct case_list* cases_head = t->Case.cases; - while (cases_head != NULL) { - struct json_object* nest3 = json_object_new_object (); - assert (nest3 != NULL); - - struct case_TYPE* casey = cases_head->casey; - - struct json_object* nest4 = json_object_new_array (); - assert (nest4 != NULL); - - struct args_TYPE* cpattern_head = casey->cpattern; - while (cpattern_head != NULL) { - json_object_array_add (nest4, json_arg_TYPE (cpattern_head->arg)); - - cpattern_head = cpattern_head->next; - } - json_object_object_add_ex (nest3, "cpattern", nest4, 0); - json_object_object_add_ex (nest3, "cbody", json_t_TYPE (casey->cbody), 0); - - json_object_array_add (nest2, nest3); - cases_head = cases_head->next; - } - - json_object_array_add (nest, nest2); - - break; - } - - case TYPE_T_DEFUN: { - json_object_array_add (nest, json_object_new_int (t->Defun.linno)); - json_object_array_add (nest, json_object_new_string (t->Defun.name)); - - json_object_array_add (nest, json_t_TYPE (t->Defun.body)); - - break; - } - - default: - assert (! "Invalid t type"); - break; - } - - if (t->type != TYPE_T_NOT) { - json_object_array_add (root, nest); - } - - return (root); -} - - -void pour_the_t (struct t_TYPE* t) { - struct json_object* root = json_t_TYPE (t); - - // const char* text = json_object_to_json_string_ext (root, JSON_C_TO_STRING_PRETTY); - // const char* text = json_object_to_json_string_ext (root, JSON_C_TO_STRING_SPACED); - const char* text = json_object_to_json_string_ext (root, JSON_C_TO_STRING_PLAIN); - printf ("%s", text); -} diff --git a/compiler/parser/ceda/ast2json.h b/compiler/parser/ceda/ast2json.h deleted file mode 100644 index 6f3160279..000000000 --- a/compiler/parser/ceda/ast2json.h +++ /dev/null @@ -1 +0,0 @@ -void pour_the_t (struct t_TYPE* t); diff --git a/compiler/parser/ceda/ast2shell.py b/compiler/parser/ceda/ast2shell.py deleted file mode 100644 index 5d60c19da..000000000 --- a/compiler/parser/ceda/ast2shell.py +++ /dev/null @@ -1,561 +0,0 @@ -#!/usr/bin/python3 - - -import os; -# from os import abort; - - -STRING_OF_VAR_TYPE_DICT = { - "Normal" : "", - "Minus" : "-", - "Plus" : "+", - "Question" : "?", - "Assign" : "=", - "TrimR" : "%", - "TrimRMax" : "%%", - "TrimL" : "#", - "TrimLMax" : "##", - "Length" : "#" -}; - - -# dash.ml -# -# let rec intercalate p ss = -# match ss with -# | [] -> "" -# | [s] -> s -# | s::ss -> s ^ p ^ intercalate p ss -def intercalate (p, ss): - str = p.join (ss); - -# str = ""; -# -# i = 0; -# for s in ss: -# if (i > 0): -# str = str + p; -# -# str = str + s; -# -# i = i + 1; - - return (str); - - -# dash.ml -# -# let braces s = "{ " ^ s ^ " ; }" -def braces (s): - return "{ " + s + " ; }"; - - -# dash.ml -# -# let parens s = "( " ^ s ^ " )" -def parens (s): - return "( " + s + " )"; - - -# let string_of_var_type = function -# | Normal -> "" -# | Minus -> "-" -# | Plus -> "+" -# | Question -> "?" -# | Assign -> "=" -# | TrimR -> "%" -# | TrimRMax -> "%%" -# | TrimL -> "#" -# | TrimLMax -> "##" -# | Length -> "#" -def string_of_var_type (var_type): - if (var_type in STRING_OF_VAR_TYPE_DICT): - return (STRING_OF_VAR_TYPE_DICT [var_type]); - - exit (1); - - -# let separated f l = intercalate " " (List.map f l) -def separated (f, l): - return " ".join (map (f, l)); - - -# let show_unless expected actual = -# if expected = actual -# then "" -# else string_of_int actual -def show_unless (expected, actual): - if (expected == actual): - return ""; - else: - return (str (actual)); - - -# let background s = "{ " ^ s ^ " & }" -def background (s): - return ("{ " + s + " & }"); - - -# let rec to_string = function -# | Command (_,assigns,cmds,redirs) -> -# separated string_of_assign assigns ^ -# (if List.length assigns = 0 || List.length cmds = 0 then "" else " ") ^ -# separated string_of_arg cmds ^ string_of_redirs redirs -# | Pipe (bg,ps) -> -# let p = intercalate " | " (List.map to_string ps) in -# if bg then background p else p -# | Redir (_,a,redirs) -> -# to_string a ^ string_of_redirs redirs -# | Background (_,a,redirs) -> -# (* we translate -# cmds... & -# to -# { cmds & } -# this avoids issues with parsing; in particular, -# cmd1 & ; cmd2 & ; cmd3 -# doesn't parse; it must be: -# cmd1 & cmd2 & cmd3 -# it's a little too annoying to track "was the last thing -# backgrounded?" so the braces resolve the issue. testing -# indicates that they're semantically equivalent. -# *) -# background (to_string a ^ string_of_redirs redirs) -# | Subshell (_,a,redirs) -> -# parens (to_string a ^ string_of_redirs redirs) -# | And (a1,a2) -> to_string a1 ^ " && " ^ to_string a2 -# | Or (a1,a2) -> to_string a1 ^ " || " ^ to_string a2 -# | Not a -> "! " ^ braces (to_string a) -# | Semi (a1,a2) -> to_string a1 ^ " ; " ^ to_string a2 -# | If (c,t,e) -> string_of_if c t e -# | While (Not t,b) -> -# "until " ^ to_string t ^ "; do " ^ to_string b ^ "; done " -# | While (t,b) -> -# "while " ^ to_string t ^ "; do " ^ to_string b ^ "; done " -# | For (_,a,body,var) -> -# "for " ^ var ^ " in " ^ string_of_arg a ^ "; do " ^ -# to_string body ^ "; done" -# | Case (_,a,cs) -> -# "case " ^ string_of_arg a ^ " in " ^ -# separated string_of_case cs ^ " esac" -# | Defun (_,name,body) -> name ^ "() {\n" ^ to_string body ^ "\n}" -def to_string (ast): - # print (ast); - - if (len (ast) == 0): - pass; - else: - (type, params) = ast; - - if (type == "Command"): - (_, assigns, cmds, redirs) = params; - str = separated (string_of_assign, assigns); - if ((len (assigns) == 0) or (len (cmds) == 0)): - pass; - else: - str += " "; - str += separated (string_of_arg, cmds) + string_of_redirs (redirs); - - return (str); - elif (type == "Pipe"): - (bg, ps) = params; - p = intercalate (" | ", (map (to_string, ps))); - - if (bg): - return (background (p)); - else: - return (p); - elif (type == "Redir"): - (_, a, redirs) = params; - - return to_string (a) + string_of_redirs (redirs); - elif (type == "Background"): - (_, a, redirs) = params; - - return background (to_string (a) + string_of_redirs (redirs)); - elif (type == "Subshell"): - (_, a, redirs) = params; - - return parens (to_string (a) + string_of_redirs (redirs)); - elif (type == "And"): - (a1, a2) = params - - return braces(to_string(a1)) + " && " + braces(to_string(a2)) - elif (type == "Or"): - (a1, a2) = params - - return braces(to_string(a1)) + " || " + braces(to_string(a2)) - elif (type == "Not"): - (a) = params - - return "! " + braces(to_string(a)) - elif (type == "Semi"): - (a1, a2) = params - - return braces(to_string(a1)) + " \n " + braces(to_string(a2)) - elif (type == "If"): - (c, t, e) = params; - return string_of_if (c, t, e); - elif (type == "While"): - (first, b) = params; - - if (first [0] == "Not"): - (_, t) = first; - - return "until " + to_string (t) + "; do " + to_string (b) + "; done "; - else: - t = first; - - return "while " + to_string (t) + "; do " + to_string (b) + "; done "; - elif (type == "For"): - (_, a, body, var) = params; - - return "for " + var + " in " + separated (string_of_arg, a) + "; do " + \ - to_string (body) + "; done"; - elif (type == "Case"): - (_, a, cs) = params; - - return "case " + string_of_arg (a) + " in " + \ - separated (string_of_case, cs) + " esac"; - abort (); - elif (type == "Defun"): - (_, name, body) = params; - - return name + "() {\n" + to_string (body) + "\n}"; - else: - print ("Invalid type: %s" % type); - abort (); - - -# and string_of_if c t e = -# "if " ^ to_string c ^ -# "; then " ^ to_string t ^ -# (match e with -# | Command (-1,[],[],[]) -> "; fi" (* one-armed if *) -# | If (c,t,e) -> "; el" ^ string_of_if c t e -# | _ -> "; else " ^ to_string e ^ "; fi") -def string_of_if (c, t, e): - str1 = "if " + to_string (c) + \ - "; then " + to_string (t); - - # ['Command', [-1, [], [], []]] - if ( (len (e) == 2) \ - and (e [0] == "Command") \ - and (len (e [1]) == 4) \ - and (e [1][0] == -1)) \ - and (len (e [1][1]) == 0) \ - and (len (e [1][2]) == 0) \ - and (len (e [1][3]) == 0): - str1 = str1 + "; fi"; - elif ( e [0] == "If" \ - and (len (e [1]) == 3)): - (c2, t2, e2) = e [1]; - - str1 += "; el" + string_of_if (c2, t2, e2); - else: - str1 += "; else " + to_string (e) + "; fi"; - - return (str1); - - -# https://github.com/ocaml/ocaml/blob/trunk/stdlib/char.ml -# let escaped = function -# | '\'' -> "\\'" -# | '\\' -> "\\\\" -# | '\n' -> "\\n" -# | '\t' -> "\\t" -# | '\r' -> "\\r" -# | '\b' -> "\\b" -# | ' ' .. '~' as c -> -# let s = bytes_create 1 in -# bytes_unsafe_set s 0 c; -# unsafe_to_string s -# | c -> -# let n = code c in -# let s = bytes_create 4 in -# bytes_unsafe_set s 0 '\\'; -# bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100)); -# bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10)); -# bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10)); -# unsafe_to_string s -def escaped (param): - char = chr (param) - - if (char == "'"): - return "\\'"; - elif (char == "\\"): - return "\\\\"; - elif (char == "\n"): - return "\\n"; - elif (char == "\t"): - return "\\t"; - elif (char == "\r"): - return "\\r"; - elif (char == "\b"): - return "\\b"; - elif ((param >= ord (' ')) and (param <= ord ('~'))): - return char; - else: -# str1 = "\\" \ -# + chr (48 + int (param / 100)) \ -# + chr (48 + ((int (param / 10)) % 10)) \ -# + chr (48 + (param % 10)); - return ("\\" + str (param)); - - -# and string_of_arg_char = function -# | E '\'' -> "\\'" -# | E '\"' -> "\\\"" -# | E '(' -> "\\(" -# | E ')' -> "\\)" -# | E '{' -> "\\{" -# | E '}' -> "\\}" -# | E '$' -> "\\$" -# | E '!' -> "\\!" -# | E '&' -> "\\&" -# | E '|' -> "\\|" -# | E ';' -> "\\;" -# | C c -> String.make 1 c -# | E c -> Char.escaped c -# | T None -> "~" -# | T (Some u) -> "~" ^ u -# | A a -> "$((" ^ string_of_arg a ^ "))" -# | V (Length,_,name,_) -> "${#" ^ name ^ "}" -# | V (vt,nul,name,a) -> -# "${" ^ name ^ (if nul then ":" else "") ^ string_of_var_type vt ^ string_of_arg a ^ "}" -# | Q a -> "\"" ^ string_of_arg a ^ "\"" -# | B t -> "$(" ^ to_string t ^ ")" -def string_of_arg_char (c, is_quoted=False): - (type, param) = c; - - if (type == "E"): - char = chr (param); - - ## MMG 2021-09-20 It might be safe to move everything except for " in the second list, but no need to do it if the tests pass - ## Chars to escape unconditionally - chars_to_escape = ["'", '"', '`', '(', ')', '{', '}', '$', '&', '|', ';'] - ## Chars to escape only when not quoted - chars_to_escape_when_no_quotes = ['*', '?', '[', ']', '#', '<', '>', '~', '!', ' '] - if char in chars_to_escape: - return '\\' + char - elif char in chars_to_escape_when_no_quotes and not is_quoted: - return '\\' + char - else: - return escaped (param) - elif (type == "C"): - return chr (param); - elif (type == "T"): - if (param == "None"): - return "~"; - elif (len (param) == 2): - if (param [0] == "Some"): - (_, u) = param; - - return "~" + u; - else: - abort (); - else: - print ("Unexpected param for T: %s" % param); - abort (); - elif (type == "A"): - return "$((" + string_of_arg (param, is_quoted) + "))"; - elif (type == "V"): - assert (len (param) == 4); - if (param [0] == "Length"): - (_, _, name, _) = param; - return "${#" + name + "}"; - else: - (vt, nul, name, a) = param; - - stri = "${" + name; - - # Depending on who generated the JSON, nul may be - # a string or a boolean! In Python, non-empty strings - # to True. - if (str (nul).lower () == "true"): - stri += ":"; - elif (str (nul).lower () == "false"): - pass; - else: - os.abort (); # For my own sanity - - stri += string_of_var_type (vt) + string_of_arg (a, is_quoted) + "}"; - - return stri; - elif (type == "Q"): - return "\"" + string_of_arg (param, is_quoted=True) + "\""; - elif (type == "B"): - return "$(" + to_string (param) + ")"; - else: - abort (); - - -# and string_of_arg = function -# | [] -> "" -# | c :: a -> string_of_arg_char c ^ string_of_arg a -def string_of_arg (args, is_quoted=False): - # print ("Unparsing:", args, " -- is quoted:", is_quoted) - - i = 0 - text = [] - while i < len(args): - c = string_of_arg_char(args[i], is_quoted) - - # dash will parse '$?' as - # [(C, '$'), (E, '?')] - # but we don't normally want to escape ? - # - # so we check up after the fact: if the character after $ is escaped, - # we'll escape the $, too - if c == "$" and (i+1 < len(args)) and args[i+1][0] == "E": - c = "\\$" - text.append(c) - - i = i+1 - - text = "".join(text) - - # print("To text:", text) - - return (text) - - -# and string_of_assign (v,a) = v ^ "=" ^ string_of_arg a -def string_of_assign (both): - (v, a) = both; - return v + "=" + string_of_arg (a); - - -# and string_of_case c = -# let pats = List.map string_of_arg c.cpattern in -# intercalate "|" pats ^ ") " ^ to_string c.cbody ^ ";;" -def string_of_case (c): - pats = map (string_of_arg, c ['cpattern']); - - return intercalate ("|", pats) + ") " + to_string (c ['cbody']) + ";;"; - - - -# let rec fresh_marker ls s = -# if List.mem s ls -# then fresh_marker ls (s ^ (String.sub s (String.length s - 1) 1)) -# else s -# -# OCaml implementation above is O(n^1.5). Algorithm below is linear. -def fresh_marker (heredoc): - respectsFound = {}; - - for line in heredoc.split ('\n'): - respects = 0; - - if ((len (line) > 2) and (line [0] == 'E') and (line [1] == 'O')): - for i in range (2, len (line)): - if (line [i] == 'F'): - respects = i - 2; - - respectsFound [respects] = 1; - - i = 0; - while (True): - if (not (i in respectsFound)): - return "EOF" + ("F" * i); - - i = i + 1; - - -# This version may give an unnecessarily long EOFFFF... (and therefore won't -# match the OCaml output but it is still correct w.r.t. giving a fresh -# marker, and uses less memory than fresh_marker above). -def fresh_marker0 (heredoc): - maxRespects = 0; - - for line in heredoc.split ('\n'): - respects = 0; - - if ((len (line) > 2) and (line [0] == 'E') and (line [1] == 'O')): - for i in range (2, len (line)): - if (line [i] == 'F'): - respects = i - 1; - - maxRespects = max (maxRespects, respects); - - return "EOF" + ("F" * maxRespects); - - -# and string_of_redir = function -# | File (To,fd,a) -> show_unless 1 fd ^ ">" ^ string_of_arg a -# | File (Clobber,fd,a) -> show_unless 1 fd ^ ">|" ^ string_of_arg a -# | File (From,fd,a) -> show_unless 0 fd ^ "<" ^ string_of_arg a -# | File (FromTo,fd,a) -> show_unless 0 fd ^ "<>" ^ string_of_arg a -# | File (Append,fd,a) -> show_unless 1 fd ^ ">>" ^ string_of_arg a - -# | Dup (ToFD,fd,tgt) -> show_unless 1 fd ^ ">&" ^ string_of_arg tgt -# | Dup (FromFD,fd,tgt) -> show_unless 0 fd ^ "<&" ^ string_of_arg tgt -# | Heredoc (t,fd,a) -> -# let heredoc = string_of_arg a in -# let marker = fresh_marker (lines heredoc) "EOF" in -# show_unless 0 fd ^ "<<" ^ -# (if t = XHere then marker else "'" ^ marker ^ "'") ^ "\n" ^ heredoc ^ marker ^ "\n" -def string_of_redir (redir): - assert (len (redir) == 2); - - (type, params) = redir; - if (type == "File"): - (subtype, fd, a) = params; - if (subtype == "To"): - return (show_unless (1, fd) + ">" + string_of_arg (a)); - elif (subtype == "Clobber"): - return (show_unless (1, fd) + ">|" + string_of_arg (a)); - elif (subtype == "From"): - return (show_unless (0, fd) + "<" + string_of_arg (a)); - elif (subtype == "FromTo"): - return (show_unless (0, fd) + "<>" + string_of_arg (a)); - elif (subtype == "Append"): - return (show_unless (1, fd) + ">>" + string_of_arg (a)); - else: - abort (); - elif (type == "Dup"): - (subtype, fd, tgt) = params; - - if (subtype == "ToFD"): - return (show_unless (1, fd) + ">&" + string_of_arg (tgt)); - elif (subtype == "FromFD"): - return (show_unless (0, fd) + "<&" + string_of_arg (tgt)); - else: - abort (); - elif (type == "Heredoc"): - (t, fd, a) = params; - - heredoc = string_of_arg (a); - marker = fresh_marker (heredoc); - - stri = show_unless (0, fd) + "<<"; - if (t == "XHere"): - stri += marker; - else: - stri += "'" + marker + "'"; - - stri += "\n" + heredoc + marker + "\n"; - - return (stri); - else: - print ("Invalid type: %s" % type); - abort (); - - -# and string_of_redirs rs = -# let ss = List.map string_of_redir rs in -# (if List.length ss > 0 then " " else "") ^ intercalate " " ss -def string_of_redirs (rs): -# if (rs == []): -# return ""; -# -# ss = map (string_of_redir, rs); -# -# return intercalate (" ", ss); - - str = ""; - - for redir in rs: - str = str + " " + string_of_redir (redir); - - return (str); diff --git a/compiler/parser/ceda/ceda_rt.py b/compiler/parser/ceda/ceda_rt.py deleted file mode 100755 index af60914e5..000000000 --- a/compiler/parser/ceda/ceda_rt.py +++ /dev/null @@ -1,33 +0,0 @@ -import sys; - -from parse_to_ast2 import parse_to_ast; -from ast2shell import to_string; - -sys.setrecursionlimit (9001); - -def print_asts (new_asts): - for ast in new_asts: - print (to_string (ast)); -# to_string (ast); - - -init = True - -#cProfile.runctx ("parse_to_ast (sys.argv [1], init)", globals (), locals ()); -#sys.exit (0); - -for f in range (10): - if (len (sys.argv) == 1): - new_asts = parse_to_ast ("-", init); - else: - new_asts = parse_to_ast (sys.argv [1], init); - - init = False; - -#print ("NEW IMPLEMENTATION:"); -#print (new_asts); -#print (""); - - print_asts (new_asts); - -# cProfile.runctx ("print_asts (new_asts)", globals (), locals ()); diff --git a/compiler/parser/ceda/dash2.c b/compiler/parser/ceda/dash2.c deleted file mode 100644 index 9a5795c83..000000000 --- a/compiler/parser/ceda/dash2.c +++ /dev/null @@ -1,149 +0,0 @@ -#include -#include - -#include "shell.h" - -#include "alias.h" -#include "init.h" -#include "input.h" -#include "main.h" -#include "memalloc.h" -#include "mystring.h" -#include "nodes.h" -#include "parser.h" -#include "redir.h" -#include "var.h" - -#include "dash2.h" - - -// As a poor man's namespace, we prepend everything with "Dash_" -// Sometimes, Dash_x is the same as x (e.g., popfile), but sometimes -// they are subtly different (e.g., setvar), hence we always make a -// separate Dash_ shim. - - -struct stackmark* Dash_init_stack (void) { - /* memalloc.h - - struct stackmark { - struct stack_block *stackp; - char *stacknxt; - size_t stacknleft; - }; - */ - - struct stackmark* smark = malloc (sizeof (struct stackmark)); - assert (smark != NULL); - - setstackmark (smark); - - return (smark); -} - - -void Dash_pop_stack (struct stackmark* smark) { - popstackmark (smark); -} - - - -char* Dash_alloc_stack_string (char* str) { - return sstrdup (str); -} - - -void Dash_free_stack_string (char* str) { - stunalloc (str); -} - - -// Closely map to libdash/ocaml/dash.ml -void Dash_dash_init (void) { - init (); -} - - -void Dash_initialize_dash_errno (void) { - initialize_dash_errno (); -} - - -void Dash_initialize (void) { - Dash_initialize_dash_errno (); - - Dash_dash_init (); -} - - -void Dash_popfile (void) { - popfile (); -} - - -void Dash_setinputstring (char* str) { - setinputstring (str); -} - - -void Dash_setinputtostdin (void) { - setinputfd (0, 0); // fd, push -} - - -int Dash_setinputfile (char* str, int push) { - return setinputfile (str, push ? 1 : 0); -} - - -void* Dash_setvar (const char* name, const char* val) { - // struct var *setvar(const char *name, const char *val, int flags) - return setvar (name, val, 0); -} - - -void Dash_setalias (const char *name, const char *val) { - setalias (name, val); -} - - -void Dash_unalias (const char* name) { - unalias (name); -} - - -int Dash_freshfd_ge10 (int fd) { - return freshfd_ge10 (fd); -} - - -union node* Dash_parsecmd_safe (int interact) { - // let parsecmd_safe : int -> node union ptr = - // foreign "parsecmd_safe" (int @-> returning (ptr node)) - - return parsecmd_safe (interact); -} - - -/* -let parse_next ?interactive:(i=false) () = - let n = parsecmd_safe (if i then 1 else 0) in - if eqptr n neof - then Done - else if eqptr n nerr - then Error - else if nullptr n - then Null (* comment or blank line or error ... *) - else Parsed n - -*/ -union node* Dash_parse_next (int interactive) { - union node* n = Dash_parsecmd_safe (interactive); - - // We use the parser.h types directly instead of using the OCaml types - // e.g., - // let nerr : node union ptr = foreign_value "lasttoken" node - // parser.h:#define NERR ((union node *)&lasttoken) - - return n; -} diff --git a/compiler/parser/ceda/dash2.h b/compiler/parser/ceda/dash2.h deleted file mode 100644 index b518bbcc3..000000000 --- a/compiler/parser/ceda/dash2.h +++ /dev/null @@ -1,18 +0,0 @@ -struct stackmark* Dash_init_stack (void); -void Dash_pop_stack (struct stackmark* smark); -char* Dash_alloc_stack_string (char* str); -void Dash_free_stack_string (char* str); -void Dash_dash_init (void); -void Dash_initialize_dash_errno (void); -void Dash_initialize (void); -void Dash_popfile (void); -void Dash_setinputstring (char* str); -void Dash_setinputtostdin (void); -int Dash_setinputfile (char* str, int push); -void* Dash_setvar (const char* name, const char* val); -void Dash_setalias (const char *name, const char *val); -void Dash_unalias (const char* name); -int Dash_freshfd_ge10 (int fd); - -union node* Dash_parsecmd_safe (int interact); -union node* Dash_parse_next (int interactive); diff --git a/compiler/parser/ceda/dash2.py b/compiler/parser/ceda/dash2.py deleted file mode 100644 index bb1519087..000000000 --- a/compiler/parser/ceda/dash2.py +++ /dev/null @@ -1,335 +0,0 @@ -from ctypes import * - - -# nodes.h -NCMD = 0; -NPIPE = 1; -NREDIR = 2; -NBACKGND = 3; -NSUBSHELL = 4; -NAND = 5; -NOR = 6; -NSEMI = 7; -NIF = 8; -NWHILE = 9; -NUNTIL = 10; -NFOR = 11; -NCASE = 12; -NCLIST = 13; -NDEFUN = 14; -NARG = 15; -NTO = 16; -NCLOBBER = 17; -NFROM = 18; -NFROMTO = 19; -NAPPEND = 20; -NTOFD = 21; -NFROMFD = 22; -NHERE = 23; -NXHERE = 24; -NNOT = 25; - - -# struct stackmark { -# struct stack_block *stackp; -# char *stacknxt; -# size_t stacknleft; -# }; -# -# We only care about getting the struct size correct, not the contents. -class stackmark (Structure): - _fields_ = [("stackp", c_void_p), - ("nxt", c_void_p), - ("size", c_size_t)]; - -def init_stack (libdash): - stack = create_string_buffer (sizeof (stackmark)); - - libdash.setstackmark.argtypes = [c_void_p]; # Pretend we don't know the contents - libdash.setstackmark.restypes = None; - libdash.setstackmark (stack); - - return (stack); - -def pop_stack (libdash, smark): - # Inefficient, we should only initialize once - - libdash.popstackmark.argtypes = [c_void_p]; # Again, hide the contents - libdash.popstackmark.restype = None; - - return (libdash.popstackmark (smark)); - - -def dash_init (libdash): - libdash.init.argtypes = []; - libdash.init.restype = None; - - libdash.init (); - - -def initialize_dash_errno (libdash): - libdash.initialize_dash_errno.argtypes = []; - libdash.initialize_dash_errno.restype = None; - - libdash.initialize_dash_errno (); - - -def initialize (libdash): - initialize_dash_errno (libdash); - dash_init (libdash); - - -def setinputtostdin (libdash): - libdash.setinputfd.argtypes = [c_int, c_int]; - libdash.setinputfd.restype = None; - - libdash.setinputfd (0, 0); - - -# TODO: allow push parameter -def setinputfile (libdash, filename): - libdash.setinputfile.argtypes = [c_char_p, c_int]; - libdash.setinputfile.restypes = c_int; - libdash.setinputfile (filename.encode ('utf-8'), 0); - - -def parsecmd_safe (libdash, interactive): - libdash.parsecmd_safe.argtypes = [c_int]; - libdash.parsecmd_safe.restype = c_void_p; - - return (libdash.parsecmd_safe (int (interactive))); - - -# Forward declarations to break recursive dependencies -class union_node (Union): - pass; - -class nodelist (Structure): - pass; - - -class ncmd (Structure): - _fields_ = [("type", c_int), - ("linno", c_int), - ("assign", POINTER (union_node)), - ("args", POINTER (union_node)), - ("redirect", POINTER (union_node))]; - -class npipe (Structure): - _fields_ = [("type", c_int), - ("backgnd", c_int), - ("cmdlist", POINTER (nodelist))]; - -class nredir (Structure): - _fields_ = [("type", c_int), - ("linno", c_int), - ("n", POINTER (union_node)), - ("redirect", POINTER (union_node))]; - -class nbinary (Structure): - _fields_ = [("type", c_int), - ("ch1", POINTER (union_node)), - ("ch2", POINTER (union_node))]; - -class nif (Structure): - _fields_ = [("type", c_int), - ("test", POINTER (union_node)), - ("ifpart", POINTER (union_node)), - ("elsepart", POINTER (union_node))]; - -class nfor (Structure): - _fields_ = [("type", c_int), - ("linno", c_int), - ("args", POINTER (union_node)), - ("body", POINTER (union_node)), - ("var", c_char_p)]; - -class ncase (Structure): - _fields_ = [("type", c_int), - ("linno", c_int), - ("expr", POINTER (union_node)), - ("cases", POINTER (union_node))]; - -class nclist (Structure): - _fields_ = [("type", c_int), - ("next", POINTER (union_node)), - ("pattern", POINTER (union_node)), - ("body", POINTER (union_node))]; - -class ndefun (Structure): - _fields_ = [("type", c_int), - ("linno", c_int), - ("text", c_char_p), - ("body", POINTER (union_node))]; - -class narg (Structure): - _fields_ = [("type", c_int), - ("next", POINTER (union_node)), - ("text", c_char_p), - ("backquote", POINTER (nodelist))]; - -class nfile (Structure): - _fields_ = [("type", c_int), - ("next", POINTER (union_node)), - ("fd", c_int), - ("fname", POINTER (union_node)), - ("expfname", c_char_p)] - -class ndup (Structure): - _fields_ = [("type", c_int), - ("next", POINTER (union_node)), - ("fd", c_int), - ("dupfd", c_int), - ("vname", POINTER (union_node))]; - -class nhere (Structure): - _fields_ = [("type", c_int), - ("next", POINTER (union_node)), - ("fd", c_int), - ("doc", POINTER (union_node))]; - -class nnot (Structure): - _fields_ = [("type", c_int), - ("com", POINTER (union_node))]; - - -nodelist._fields_ = [("next", POINTER (nodelist)), - ("n", POINTER (union_node))]; - -union_node._fields_ = [("type", c_int), - ("ncmd", ncmd), - ("npipe", npipe), - ("nredir", nredir), - ("nbinary", nbinary), - ("nif", nif), - ("nfor", nfor), - ("ncase", ncase), - ("nclist", nclist), - ("ndefun", ndefun), - ("narg", narg), - ("nfile", nfile), - ("ndup", ndup), - ("nhere", nhere), - ("nnot", nnot)]; - - -class strpush (Structure): - pass; - -# struct strpush { -# struct strpush *prev; /* preceding string on stack */ -# char *prevstring; -# int prevnleft; -# struct alias *ap; /* if push was associated with an alias */ -# char *string; /* remember the string since it may change */ -# -# /* Remember last two characters for pungetc. */ -# int lastc[2]; -# -# /* Number of outstanding calls to pungetc. */ -# int unget; -# }; -strpush._fields_ = [("prev", POINTER (strpush)), - ("prevstring", c_char_p), - ("prevnleft", c_int), - ("ap", c_void_p), - ("string", c_char_p), - ("lastc", 2 * c_int), - ("unget", c_int)]; - -class parsefile (Structure): - pass; - -# struct parsefile { -# struct parsefile *prev; /* preceding file on stack */ -# int linno; /* current line */ -# int fd; /* file descriptor (or -1 if string) */ -# int nleft; /* number of chars left in this line */ -# int lleft; /* number of chars left in this buffer */ -# char *nextc; /* next char in buffer */ -# char *buf; /* input buffer */ -# struct strpush *strpush; /* for pushing strings at this level */ -# struct strpush basestrpush; /* so pushing one is fast */ -# -# /* Remember last two characters for pungetc. */ -# int lastc[2]; -# -# /* Number of outstanding calls to pungetc. */ -# int unget; -# }; -parsefile._fields_ = [("prev", POINTER (parsefile)), - ("linno", c_int), - ("fd", c_int), - ("nleft", c_int), - ("lleft", c_int), - ("nextc", POINTER (c_char)), # NOT c_char_p! - ("buf", c_char_p), - ("strpush", POINTER (strpush)), - ("basestrpush", strpush), - ("lastc", 2 * c_int), - ("unget", c_int)]; - - -# dash.ast -# let rec nodelist (n : nodelist structure ptr) : (node union ptr) list = -# if nullptr n -# then [] -# else (n @-> nodelist_n)::nodelist (n @-> nodelist_next) -def nodelist (nl): - snek = []; - - # ctypes has different semantics for POINTER vs. c_void_p - # See https://groups.google.com/g/nzpug/c/5CJxaWjuQro - while (nl): - snek.append (nl.contents.n); - nl = nl.contents.next; - - return snek; - - -def caselist (n): - cases = []; - - while (n): - nclist = n.contents.nclist; - - assert (nclist.type == 13); - - cases.append ((nclist.pattern, nclist.body)); - - n = nclist.next; - - return (cases); - - -def explode_rev (bytes): - charlist = explode (bytes); - charlist.reverse (); - - return (charlist); - - -def explode (bytes): - s = bytes.decode ("charmap"); - - charlist = []; - - for i in range (len (s)): - charlist.append (ord (s [i])); - - return (charlist); - - -def implode_rev (l): - s = implode (reversed (l)); - - return (s); - - -def implode (l): - s = ""; - - for c in l: - s = s + chr (c); - - return (s); diff --git a/compiler/parser/ceda/json_to_shell2.c b/compiler/parser/ceda/json_to_shell2.c deleted file mode 100644 index ab155b48c..000000000 --- a/compiler/parser/ceda/json_to_shell2.c +++ /dev/null @@ -1,37 +0,0 @@ -#include -#include -#include -#include -#include - -#include "ast2b.h" - - -// 640MB ought to be enough for anybody -// With copy-on-write, the large malloc practically doesn't cost anything -// until it's actually used. -#define MAX_LINE_LENGTH (640 * 1024 * 1024) - - -int main (int argc, char* argv []) { - FILE* fp = stdin; - - if (argc == 2) { - if (strcmp (argv [1], "-") != 0) { - fp = fopen (argv [1], "r"); - assert (fp != NULL); - } - } - - char* buf = malloc (MAX_LINE_LENGTH * sizeof (char)); - assert (buf != NULL); - - while (fgets (buf, MAX_LINE_LENGTH, fp) != NULL) { - json_text_to_string (buf); - putchar ('\n'); - } - - free (buf); // Pointless since we exit immediately - - return 0; -} diff --git a/compiler/parser/ceda/json_to_shell2.py b/compiler/parser/ceda/json_to_shell2.py deleted file mode 100755 index e6491e575..000000000 --- a/compiler/parser/ceda/json_to_shell2.py +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/env python3 - -import os -import sys - -if 'PASH_TOP' in os.environ: - PASH_TOP = os.environ['PASH_TOP'] -else: - GIT_TOP_CMD = [ 'git', 'rev-parse', '--show-toplevel', '--show-superproject-working-tree'] - PASH_TOP = subprocess.run(GIT_TOP_CMD, stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True).stdout.rstrip() - -sys.path.append(os.path.join(PASH_TOP, "compiler")) - -from json_ast import parse_json_ast, parse_json_ast_string -from ast2shell import * - - -def main (): - if (len (sys.argv) == 1): - asts = parse_json_ast ("/dev/stdin") - else: - asts = parse_json_ast (sys.argv [1]) - - for ast in asts: - print (to_string (ast)) - -def json_string_to_shell_string(json_string): - asts = parse_json_ast_string(json_string) - shell_list = [] - for ast in asts: - shell_list.append(to_string(ast)) - return "\n".join(shell_list) + "\n" - -def json_to_shell_string(input_filename): - with open(input_filename) as json_file: - json_string = json_file.read() - return json_string_to_shell_string(json_string) - -if __name__ == "__main__": - main () diff --git a/compiler/parser/ceda/parse_to_ast2.py b/compiler/parser/ceda/parse_to_ast2.py deleted file mode 100644 index 7738d13fe..000000000 --- a/compiler/parser/ceda/parse_to_ast2.py +++ /dev/null @@ -1,93 +0,0 @@ -import os -import subprocess -from ctypes import * -from ast2a import of_node -from dash2 import * - -if 'PASH_TOP' in os.environ: - PASH_TOP = os.environ['PASH_TOP'] -else: - GIT_TOP_CMD = [ 'git', 'rev-parse', '--show-toplevel', '--show-superproject-working-tree'] - PASH_TOP = subprocess.run(GIT_TOP_CMD, stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True).stdout.rstrip() - - -LIBDASH_LIBRARY_PATH = os.path.join(PASH_TOP, "compiler/parser/libdash/src/.libs/libdash.so") - - -EOF_NLEFT = -99; # libdash/src/input.c - -class ParsingException(Exception): - def __init__(self, message='ParseError'): - # Call the base class constructor with the parameters it needs - super(ParsingException, self).__init__(message) - -# This is a mix of dash.ml:parse_next and parse_to_json.ml. -def parse_to_ast (inputPath, init=True): - lines = [] - - libdash = CDLL (LIBDASH_LIBRARY_PATH) - - if (init): - initialize (libdash) - - if (inputPath == "-"): - setinputtostdin (libdash) - else: - setinputfile (libdash, inputPath) - - fp = open (inputPath, 'r') - for line in fp: - lines.append (line) - fp.close() - - # struct parsefile *parsefile = &basepf; /* current input file */ - # Get the value of parsefile (not &parsefile)! - parsefile_ptr_ptr = addressof (parsefile.in_dll (libdash, "parsefile")) - parsefile_ptr = cast (parsefile_ptr_ptr, POINTER (POINTER (parsefile))) - parsefile_var = parsefile_ptr.contents - - smark = init_stack (libdash) - - NEOF = addressof (c_int.in_dll (libdash, "tokpushback")) - NERR = addressof (c_int.in_dll (libdash, "lasttoken")) - - while (True): - linno_before = parsefile_var.contents.linno - 1; # libdash is 1-indexed - - n_ptr_C = parsecmd_safe (libdash, False) - - linno_after = parsefile_var.contents.linno - 1; # libdash is 1-indexed - nleft_after = parsefile_var.contents.nleft - - if (n_ptr_C == None): # Dash.Null - pass - elif (n_ptr_C == NEOF): # Dash.Done - break - elif (n_ptr_C == NERR): # Dash.Error - raise ParsingException() - else: - if (nleft_after == EOF_NLEFT): - linno_after = linno_after + 1; # The last line wasn't counted - - if (inputPath != "-"): - ## Both of these assertions check "our" assumption with respect to the final parser state - ## and are therefore not necessary if they become an issue. - assert((linno_after == len (lines)) or (linno_after == len (lines) + 1)) - - # Last line did not have a newline - assert(len (lines [-1]) > 0 and (lines [-1][-1] != '\n')) - else: - assert (nleft_after == 0); # Read whole lines - - n_ptr = cast (n_ptr_C, POINTER (union_node)) - new_ast = of_node (n_ptr) - - if (inputPath != "-"): - parsedLines = "".join(lines[linno_before:linno_after]) - else: - ## When parsing from stdin there is no way to save the lines - parsedLines = None - - yield (new_ast, parsedLines, linno_before, linno_after) - - pop_stack (libdash, smark) diff --git a/compiler/parser/ceda/parse_to_json2.c b/compiler/parser/ceda/parse_to_json2.c deleted file mode 100644 index 47f94b844..000000000 --- a/compiler/parser/ceda/parse_to_json2.c +++ /dev/null @@ -1,88 +0,0 @@ -#include -#include -#include -#include -#include - -#include "nodes.h" -#include "parser.h" - -#include "dash2.h" -#include "ast2a.h" -#include "ast2json.h" - -#include "json.h" - - -#define TRUE 1 -#define FALSE 0 - - -void parse_args (void) { -} - - - -void set_input_src (char* inputPath) { - // TODO: allow file input - if (inputPath == NULL) { - Dash_setinputtostdin (); - } else { - Dash_setinputfile (inputPath, 0); - } -} - - -void parse_all (void) { - struct stackmark* smark = Dash_init_stack (); - - while (1) { // Dijkstra would not approve - union node* n = Dash_parse_next (0); // not interactive - - if (n == NEOF) { // Dash.Done - break; - - // [] - } else if (n == NERR) { // Dash.Error - break; - - // raise Parse_error - } else if (n == NULL) { // Dash.Null -// printf ("null\n"); - } else { // Dash.Parsed - struct t_TYPE* t = of_node (n); - - assert (t != NULL); - pour_the_t (t); - - printf ("\n"); - - Dash_pop_stack (smark); - } - } -} - - -int main (int argc, char* argv []) { - Dash_initialize (); - -// parse_args (); - - char* inputPath = NULL; - - if (argc == 2) { - if (strcmp (argv [1], "-") != 0) { - inputPath = argv [1]; - } - } - -for (int i = 0; i < 1; i++) { - set_input_src (inputPath); - - parse_all (); -} - - // TODO: print_ast (JSON output) - - return 0; -} diff --git a/compiler/parser/ceda/parse_to_json2.py b/compiler/parser/ceda/parse_to_json2.py deleted file mode 100755 index dd5f1aceb..000000000 --- a/compiler/parser/ceda/parse_to_json2.py +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/env python3 - -import os -import sys -import subprocess -from parse_to_ast2 import parse_to_ast - -if 'PASH_TOP' in os.environ: - PASH_TOP = os.environ['PASH_TOP'] -else: - GIT_TOP_CMD = [ 'git', 'rev-parse', '--show-toplevel', '--show-superproject-working-tree'] - PASH_TOP = subprocess.run(GIT_TOP_CMD, stdout=subprocess.PIPE, stderr=subprocess.PIPE, universal_newlines=True).stdout.rstrip() - -sys.path.append(os.path.join(PASH_TOP, "compiler")) -from json_ast import serialize_asts_to_json - -## -## This is not part of the main flow anymore and is only used for debugging and testing purposes. -## - -def main (): - sys.setrecursionlimit (90001) - - if (len (sys.argv) == 1): - inputPath = "-" - else: - inputPath = sys.argv [1] - - new_asts = [] - for output in (parse_to_ast (inputPath, True)): - (new_ast, verbatim, linno_before, linno_after) = output; - new_asts.append (new_ast); - - # Debugging - if (False): - print ("### Parsed lines [%d, %d)" % (linno_before, linno_after)); - print ("--------------------"); - print (verbatim, end=''); - print ("--------------------"); - - json = serialize_asts_to_json (new_asts) - print (json) - -if __name__ == "__main__": - main () diff --git a/compiler/parser/ceda/pay_respects.sh b/compiler/parser/ceda/pay_respects.sh deleted file mode 100644 index e566c8bf5..000000000 --- a/compiler/parser/ceda/pay_respects.sh +++ /dev/null @@ -1,13 +0,0 @@ -#!/bin/sh - - -cat < -#include -#include -#include -#include - -#include "ast2b.h" - - -#include "json_tokener.h" - - -// 640KB ought to be enough for anybody -#define MAX_LINE_LENGTH (640 * 1024) - - -json_object* json_text_to_jobj (char* json_text) { - // Nesting can be very deep e.g., scripts/intermediary/web-index_p2_1_funs.sh.json - struct json_tokener* tok = json_tokener_new_ex (JSON_MAX_DEPTH); - - // Based on http://json-c.github.io/json-c/json-c-current-release/doc/html/json__tokener_8h.html - json_object* jobj = json_tokener_parse_ex(tok, json_text, strlen (json_text)); - enum json_tokener_error jerr = json_tokener_get_error(tok); - if (jerr != json_tokener_success) { - fprintf (stderr, "Error: %s\n", json_tokener_error_desc (jerr)); - abort (); - } - - assert (jobj != NULL); - return (jobj); -} - - -int main (int argc, char* argv []) { - FILE* fp = stdin; - - if (argc == 2) { - if (strcmp (argv [1], "-") != 0) { - fp = fopen (argv [1], "r"); - assert (fp != NULL); - } - } - - char* buf = malloc (MAX_LINE_LENGTH * sizeof (char)); - assert (buf != NULL); - - while (fgets (buf, 640 * 1024, fp) != NULL) { - json_object* root = json_text_to_jobj (buf); - const char* text = json_object_to_json_string_ext (root, JSON_C_TO_STRING_PRETTY); - printf ("%s\n", text); - putchar ('\n'); - } - - free (buf); // Pointless since we exit immediately - - return 0; -} diff --git a/compiler/parser/ceda/rt.py b/compiler/parser/ceda/rt.py deleted file mode 100644 index 7d9ee5108..000000000 --- a/compiler/parser/ceda/rt.py +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/python3 - -import sys -# export PYTHONIOENCODING=charmap - -# sys.stdout = codecs.getwriter('charmap')(sys.stdout) - -sys.path.append("/pash/compiler") - -from parse import parse_shell#, from_ir_to_shell, from_ir_to_shell_file -from json_ast import parse_json_ast_string#, serialize_asts_to_json, json_to_shell -from ast2shell import to_string - - -if (len (sys.argv) != 2): - print ("Usage: rt.py shell.sh"); - exit (1); - -inputFile = sys.argv [1]; - -# json_ast_string = parse_shell (...) -# json = parse_json_ast (inputFile); -# from_ir_to_shell - -json = parse_shell (inputFile); -#print ("Shell script -> JSON:"); -#print (json); - -if (len (json) == 0): - sys.exit (0); - -asts = parse_json_ast_string (json); -#print ("JSON -> Pash AST:"); -#print (asts); -#print (); - -#print ("TODO: directly convert AST to shell script\n"); - -#json_rt = serialize_asts_to_json (asts) -#print ("JSON round-trip: %s" % json_rt); -#print (); - - -#shell_rt = json_to_shell (json_rt); -#print ("Shell round-trip: %s" % shell_rt); - -#print ("to_string"); -for ast in asts: - str1 = to_string (ast); - shell_direct = str1; -# shell_direct = str.encode ("utf-8") + str1; - - # Some shell scripts have characters with ASCII value >= 128, - # which disagrees with the default Python print. - print (shell_direct); - -# sys.stdout.buffer.write (shell_direct.encode ('utf-8')); - -# newline = (10).to_bytes (1, byteorder='little'); -# sys.stdout.buffer.write (newline); - -# sys.stdout.buffer.write ( - -# shell_direct_bytes = shell_direct.encode ('utf-8').strip (); -# -# print (len (shell_direct_bytes)); -# for b in range (len (shell_direct_bytes)): -# print ("%s" % chr (shell_direct_bytes [b]), end =""); - -# sys.stdout.write (shell_direct); -# print (shell_direct); -# print (shell_direct.encode ('utf8')); -# sys.stdout.buffer.write (shell_direct); diff --git a/compiler/parser/ceda/test_JSON_to_shell2.sh b/compiler/parser/ceda/test_JSON_to_shell2.sh deleted file mode 100644 index 45c99f993..000000000 --- a/compiler/parser/ceda/test_JSON_to_shell2.sh +++ /dev/null @@ -1,62 +0,0 @@ -#!/bin/sh - - -SHELL_TO_JSON_OCAML=/pash/compiler/parser/parse_to_json.native -JSON_TO_SHELL_OCAML=/pash/compiler/parser/json_to_shell.native -JSON_TO_SHELL_C=./json_to_shell2 - - -if [ $# -ne 1 ] -then - echo "Usage: $0 testFile" - echo - exit 1 -fi - - -testFile="$1" - - -if [ ! -f "$testFile" ] -then - echo "Error: cannot read '$testFile'!" - echo - exit 1 -fi - - -"$SHELL_TO_JSON_OCAML" < "$testFile" > /tmp/json.$$ -if [ $? -ne 0 ] -then - echo "INVALID_INPUT_1: '$testFile' | Unable to run '$SHELL_TO_JSON_OCAML' on '$testFile'" - exit 1 -fi - -"$JSON_TO_SHELL_OCAML" < /tmp/json.$$ > /tmp/rt_ocaml.$$ -if [ $? -ne 0 ] -then - echo "INVALID_INPUT_2: '$testFile' | Unable to run '$JSON_TO_SHELL_OCAML' on '/tmp/json.$$'" - exit 1 -fi - -"$JSON_TO_SHELL_C" < /tmp/json.$$ > /tmp/rt_c.$$ -if [ $? -ne 0 ] -then - echo "ABORT: '$testFile' | Unable to run '$JSON_TO_SHELL_C' on '/tmp/json.$$'" - exit 1 -fi - -diff /tmp/rt_ocaml.$$ /tmp/rt_c.$$ -if [ $? -ne 0 ] -then - diff -w /tmp/rt_ocaml.$$ /tmp/rt_c.$$ - if [ $? -ne 0 ] - then - echo "FAIL: '$testFile' | /tmp/json.$$ /tmp/rt_ocaml.$$ /tmp/rt_c.$$" - else - echo "FAIL_WHITESPACE: '$testFile' | /tmp/json.$$ /tmp/rt_ocaml.$$ /tmp/rt_c.$$" - fi - exit 1 -fi - -echo "PASS: '$testFile' | /tmp/json.$$ /tmp/rt_ocaml.$$ /tmp/rt_c.$$" diff --git a/compiler/parser/ceda/test_ast2shell_py.sh b/compiler/parser/ceda/test_ast2shell_py.sh deleted file mode 100644 index a765aec2a..000000000 --- a/compiler/parser/ceda/test_ast2shell_py.sh +++ /dev/null @@ -1,66 +0,0 @@ -#!/bin/sh - - -SHELL_TO_JSON_OCAML=/pash/compiler/parser/parse_to_json.native -JSON_TO_SHELL_OCAML=/pash/compiler/parser/json_to_shell.native - -RT_PY="rt.py" - - -if [ $# -ne 1 ] -then - echo "Usage: $0 testFile" - echo - exit 1 -fi - - -testFile="$1" - - -if [ ! -f "$testFile" ] -then - echo "Error: cannot read '$testFile'!" - echo - exit 1 -fi - - -"$SHELL_TO_JSON_OCAML" < "$testFile" > /tmp/json_ocaml.$$ -if [ $? -ne 0 ] -then - echo "REF_ABORT_1: '$testFile'" - exit 1 -fi - -"$JSON_TO_SHELL_OCAML" < /tmp/json_ocaml.$$ > /tmp/rt_ocaml.$$ -if [ $? -ne 0 ] -then - echo "REF_ABORT_2: '$testFile' | /tmp/json_ocaml.$$" - exit 1 -fi - -# python3 "$RT_PY" < "$testFile" > /tmp/rt_py.$$ -python3 "$RT_PY" "$testFile" > /tmp/rt_py.$$ -if [ $? -ne 0 ] -then - echo "ABORT: '$testFile'" - exit 1 -fi - -diff /tmp/rt_ocaml.$$ /tmp/rt_py.$$ > /dev/null -if [ $? -ne 0 ] -then - diff -w /tmp/rt_ocaml.$$ /tmp/rt_py.$$ > /dev/null - if [ $? -ne 0 ] - then - diff -w /tmp/rt_ocaml.$$ /tmp/rt_py.$$ - echo "FAIL: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_py.$$" - else - diff /tmp/rt_ocaml.$$ /tmp/rt_py.$$ - echo "FAIL_WHITESPACE: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_py.$$" - fi - exit 1 -fi - -echo "PASS: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_py.$$" diff --git a/compiler/parser/ceda/test_parse_to_JSON2.sh b/compiler/parser/ceda/test_parse_to_JSON2.sh deleted file mode 100644 index 5edc87fe5..000000000 --- a/compiler/parser/ceda/test_parse_to_JSON2.sh +++ /dev/null @@ -1,75 +0,0 @@ -#!/bin/sh - - -SHELL_TO_JSON_OCAML=../parse_to_json.native - -PRETTYPRINT_JSON=./prettyprint_json - -SHELL_TO_JSON_C=./parse_to_json2 - - -if [ $# -ne 1 ] -then - echo "Usage: $0 testFile" - echo - exit 1 -fi - - -testFile="$1" - - -if [ ! -f "$testFile" ] -then - echo "Error: cannot read '$testFile'!" - echo - exit 1 -fi - - -json_ocaml="/tmp/json_ocaml.$$" -json_ocaml_pretty="/tmp/json_ocaml_pretty.$$" -json_c="/tmp/json_c.$$" - - -"$SHELL_TO_JSON_OCAML" < "$testFile" > "${json_ocaml}" -if [ $? -ne 0 ] -then - echo "INVALID_INPUT: '$testFile' | Unable to run '$SHELL_TO_JSON_OCAML' on '$testFile'" - exit 1 -fi - -"$SHELL_TO_JSON_C" < "$testFile" > "${json_c}" -if [ $? -ne 0 ] -then - echo "ABORT: '$testFile' | Unable to run '$SHELL_TO_JSON_C' on '$testFile'" - exit 1 -fi - - -diff "${json_ocaml}" "${json_c}" > /dev/null -if [ $? -ne 0 ] -then - for f in "${json_ocaml}" "${json_c}" - do - "$PRETTYPRINT_JSON" < "${f}" > "${f}.pretty" - if [ $? -ne 0 ] - then - echo "PRETTYPRINT_FAIL: '$testFile' | Unable to run '$PRETTYPRINT_JSON' on '${f}'" - exit 1 - fi - done - - diff -w "${json_ocaml}.pretty" "${json_c}.pretty" > /dev/null - if [ $? -ne 0 ] - then - diff -w "${json_ocaml}.pretty" "${json_c}.pretty" - echo "FAIL: '$testFile' | ${json_ocaml} ${json_c} ${json_ocaml}.pretty ${json_c}.pretty" - else - diff "${json_ocaml}" "${json_c}" - echo "FAIL_WHITESPACE: '$testFile' | ${json_ocaml} ${json_c} ${json_ocaml}.pretty ${json_c}.pretty" - fi - exit 1 -fi - -echo "PASS: '$testFile' | ${json_ocaml} ${json_c} ${json_ocaml}.pretty ${json_c}.pretty" diff --git a/compiler/parser/ceda/test_rt.sh b/compiler/parser/ceda/test_rt.sh deleted file mode 100644 index 81f67f3d4..000000000 --- a/compiler/parser/ceda/test_rt.sh +++ /dev/null @@ -1,71 +0,0 @@ -#!/bin/sh - - -SHELL_TO_JSON_OCAML=../parse_to_json.native -JSON_TO_SHELL_OCAML=../json_to_shell.native - -SHELL_TO_JSON_C=./parse_to_json2 -JSON_TO_SHELL_C=./json_to_shell2 - - -if [ $# -ne 1 ] -then - echo "Usage: $0 testFile" - echo - exit 1 -fi - - -testFile="$1" - - -if [ ! -f "$testFile" ] -then - echo "Error: cannot read '$testFile'!" - echo - exit 1 -fi - - -"$SHELL_TO_JSON_OCAML" < "$testFile" > /tmp/json_ocaml.$$ -if [ $? -ne 0 ] -then - echo "REF_ABORT_1: '$testFile'" - exit 1 -fi - -"$JSON_TO_SHELL_OCAML" < /tmp/json_ocaml.$$ > /tmp/rt_ocaml.$$ -if [ $? -ne 0 ] -then - echo "REF_ABORT_2: '$testFile' | /tmp/json_ocaml.$$" - exit 1 -fi - -"$SHELL_TO_JSON_C" < "$testFile" > /tmp/json_c.$$ -if [ $? -ne 0 ] -then - echo "ABORT_1: '$testFile'" - exit 1 -fi - -"$JSON_TO_SHELL_C" < /tmp/json_c.$$ > /tmp/rt_c.$$ -if [ $? -ne 0 ] -then - echo "ABORT_2: '$testFile' | /tmp/json_c.$$" - exit 1 -fi - -diff /tmp/rt_ocaml.$$ /tmp/rt_c.$$ -if [ $? -ne 0 ] -then - diff -w /tmp/rt_ocaml.$$ /tmp/rt_c.$$ - if [ $? -ne 0 ] - then - echo "FAIL: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_c.$$" - else - echo "FAIL_WHITESPACE: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_c.$$" - fi - exit 1 -fi - -echo "PASS: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_c.$$" diff --git a/compiler/parser/ceda/test_rt_py.sh b/compiler/parser/ceda/test_rt_py.sh deleted file mode 100644 index a95e0b3d4..000000000 --- a/compiler/parser/ceda/test_rt_py.sh +++ /dev/null @@ -1,65 +0,0 @@ -#!/bin/sh - - -SHELL_TO_JSON_OCAML=../parse_to_json.native -JSON_TO_SHELL_OCAML=../json_to_shell.native - -RT_PYTHON=./ceda_rt.py - - -if [ $# -ne 1 ] -then - echo "Usage: $0 testFile" - echo - exit 1 -fi - - -testFile="$1" - - -if [ ! -f "$testFile" ] -then - echo "Error: cannot read '$testFile'!" - echo - exit 1 -fi - - -"$SHELL_TO_JSON_OCAML" < "$testFile" > /tmp/json_ocaml.$$ -if [ $? -ne 0 ] -then - echo "REF_ABORT_1: '$testFile'" - exit 1 -fi - -"$JSON_TO_SHELL_OCAML" < /tmp/json_ocaml.$$ > /tmp/rt_ocaml.$$ -if [ $? -ne 0 ] -then - echo "REF_ABORT_2: '$testFile' | /tmp/json_ocaml.$$" - exit 1 -fi - -python3 "$RT_PYTHON" < "$testFile" > /tmp/rt_python.$$ -if [ $? -ne 0 ] -then - echo "ABORT_1: '$testFile'" - exit 1 -fi - -diff /tmp/rt_ocaml.$$ /tmp/rt_python.$$ > /dev/null -if [ $? -ne 0 ] -then - diff -w /tmp/rt_ocaml.$$ /tmp/rt_python.$$ > /dev/null - if [ $? -ne 0 ] - then - diff -w /tmp/rt_ocaml.$$ /tmp/rt_python.$$ - echo "FAIL: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_python.$$" - else - diff /tmp/rt_ocaml.$$ /tmp/rt_python.$$ - echo "FAIL_WHITESPACE: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_python.$$" - fi - exit 1 -fi - -echo "PASS: '$testFile' | /tmp/rt_ocaml.$$ /tmp/rt_python.$$" diff --git a/compiler/parser/ceda/timing-JSON.sh b/compiler/parser/ceda/timing-JSON.sh deleted file mode 100644 index 00485e3d8..000000000 --- a/compiler/parser/ceda/timing-JSON.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/sh - - -input_script='/pash/compiler/parser/libdash/ltmain.sh' - - -if [ $# -eq 1 ] -then - input_script="$1" -fi - - -echo "Input script: $input_script" -echo - -echo "OCaml:" -time (../parse_to_json.native "$input_script" | tee /tmp/json.$$ | md5sum) -echo - -echo "C:" -time (./parse_to_json2 "$input_script" | tee /tmp/json.$$ | md5sum) -echo - -echo "Python (ROUND-TRIP):" -time (python3 ceda_rt.py "$input_script" | md5sum) -echo - diff --git a/compiler/parser/ceda/timing.sh b/compiler/parser/ceda/timing.sh deleted file mode 100644 index 1d793641a..000000000 --- a/compiler/parser/ceda/timing.sh +++ /dev/null @@ -1,31 +0,0 @@ -#!/bin/sh - - -input_script='/pash/compiler/parser/libdash/ltmain.sh' - - -if [ $# -eq 1 ] -then - input_script="$1" -fi - - -echo "Input script: $input_script" -echo - -echo "OCaml (dash C AST -> libdash OCaml AST -> JSON -> Pash Python AST -> JSON -> shell:" -time (../parse_to_json.native "$input_script" > /tmp/json.$$; cat /tmp/json.$$ | ../json_to_shell.native | md5sum) -echo - -echo "C (dash C AST -> libdash C AST -> JSON -> Pash Python AST -> JSON -> shell):" -time (./parse_to_json2 "$input_script" > /tmp/json.$$ 2>/dev/null; cat /tmp/json.$$ | ./json_to_shell2 | md5sum) -echo - -echo "Python (dash C AST -> libdash C AST -> JSON -> Pash Python AST -> JSON -> shell):" -time (python3 ./parse_to_json2.py "$input_script" > /tmp/json.$$ 2>/dev/null; cat /tmp/json.$$ | python3 ./json_to_shell2.py | md5sum) -echo - -echo "Python (dash C AST -> Pash Python AST -> shell):" -time (python3 ceda_rt.py "$input_script" | md5sum) -echo - diff --git a/compiler/parser/json_to_shell.ml b/compiler/parser/json_to_shell.ml deleted file mode 100644 index 7f4103315..000000000 --- a/compiler/parser/json_to_shell.ml +++ /dev/null @@ -1,38 +0,0 @@ -(* This is straight-up copied from the libdash tests *) - -let verbose = ref false -let input_src : string option ref = ref None - -let parse_args () = - Arg.parse - [("-v",Arg.Set verbose,"verbose mode")] - (function | "-" -> input_src := None | f -> input_src := Some f) - "Final argument should be either a filename or empty (for STDIN); only the last such argument is used" - -let read_channel chan = -let lines = ref [] in -try - while true; do - lines := input_line chan :: !lines - done; !lines -with End_of_file -> - close_in chan; - List.rev !lines - -let read_lines () = - match !input_src with - | None -> read_channel stdin - | Some filename -> read_channel (open_in filename) - -let parse_lines () : Ast.t list = - let lines = read_lines () in - List.map (fun line -> Ast_json.t_of_string line) lines - - -let main () = - parse_args (); - let cs = parse_lines () in - List.map (fun c -> print_endline (Ast.to_string c)) cs -;; - -main () diff --git a/compiler/parser/libdash b/compiler/parser/libdash deleted file mode 160000 index ef6302502..000000000 --- a/compiler/parser/libdash +++ /dev/null @@ -1 +0,0 @@ -Subproject commit ef6302502b904e33dd4cc686d71142fb1a87bbbd diff --git a/compiler/parser/parse_to_json.ml b/compiler/parser/parse_to_json.ml deleted file mode 100644 index 7499e1b22..000000000 --- a/compiler/parser/parse_to_json.ml +++ /dev/null @@ -1,48 +0,0 @@ -(* This is straight-up copied from the libdash tests *) - -let verbose = ref false -let pretty_print = ref false -let input_src : string option ref = ref None - -let set_input_src () = - match !input_src with - | None -> Dash.setinputtostdin () - | Some f -> Dash.setinputfile f - -let parse_args () = - Arg.parse - [("-v",Arg.Set verbose,"verbose mode"); - ("-p", Arg.Set pretty_print, "pretty ocaml print")] - (function | "-" -> input_src := None | f -> input_src := Some f) - "Final argument should be either a filename or - (for STDIN); only the last such argument is used" - -exception Parse_error - -let rec parse_all () : Ast.t list = - let stackmark = Dash.init_stack () in - match Dash.parse_next ~interactive:false () with - | Dash.Done -> Dash.pop_stack stackmark; [] - | Dash.Error -> Dash.pop_stack stackmark; raise Parse_error - | Dash.Null -> Dash.pop_stack stackmark; parse_all () - | Dash.Parsed n -> - (* translate to our AST *) - let c = Ast.of_node n in - (* deallocate *) - Dash.pop_stack stackmark; - (* keep calm and carry on *) - c::parse_all () - -let print_ast c = - match !pretty_print with - | true -> Dum.to_stdout c - | false -> print_endline (Ast_json.string_of_t c) - -let main () = - Dash.initialize (); - parse_args (); - set_input_src (); - let cs = parse_all () in - List.map print_ast cs -;; - -main () diff --git a/compiler/parser/run_parser_on_scripts.sh b/compiler/parser/run_parser_on_scripts.sh deleted file mode 100755 index 42996ee0a..000000000 --- a/compiler/parser/run_parser_on_scripts.sh +++ /dev/null @@ -1,10 +0,0 @@ -#! /bin/bash - -SCRIPTS_DIR="../scripts/" - -for script in "$SCRIPTS_DIR"*.sh -do - echo "Parsing $script..." - output=${script/"scripts"/"scripts/json"}.json - ./parse_to_json.native "$script" > "$output" -done diff --git a/compiler/pash_init_setup.sh b/compiler/pash_init_setup.sh index a2d41c9e8..c1c402300 100644 --- a/compiler/pash_init_setup.sh +++ b/compiler/pash_init_setup.sh @@ -1,5 +1,5 @@ # source the local pash config -source ~/.pash_init +[ -f ~/.pash_init ] && source ~/.pash_init ## File directory export RUNTIME_DIR=$(dirname "${BASH_SOURCE[0]}") ## TODO: Is there a better way to do this? diff --git a/docs/install/README.md b/docs/install/README.md index abf6c63cb..63192d5c9 100644 --- a/docs/install/README.md +++ b/docs/install/README.md @@ -3,7 +3,7 @@ On Ubuntu, Fedora, Debian, or Arch, run `curl up.pash.ndr.md | sh` to get PaSh up and running. If on other environments or prefer manual setup, there are essentially three steps required to set PaSh up: -1. Clone repo: `git clone --depth 1 git@github.com:binpash/pash.git` +1. Clone repo: `git clone git@github.com:binpash/pash.git` 2. Run `distro-deps.sh` (with `sudo`) and `setup-pash.sh` 3. Export `PASH_TOP` and, optionally, add it to your `PATH` @@ -18,7 +18,7 @@ Quick Jump: [Clone & Setup](#) | [Manual Setup](#manual-setup) | [Docker Setup]( The following steps clone the repo, set up dependencies (e.g., compilers), and then build PaSh: ```sh -git clone --depth 1 git@github.com:binpash/pash.git +git clone git@github.com:binpash/pash.git sudo pash/scripts/distro-deps.sh ./pash/scripts/setup-pash.sh ``` @@ -36,7 +36,7 @@ automake bc bsdmainutils curl gcc git libffi-dev libtool locales locales-all m4 Then clone the PaSh repository and run `setup-pash.sh` as follows: ```sh -git clone --depth 1 git@github.com:binpash/pash.git +git clone git@github.com:binpash/pash.git ./pash/scripts/setup-pash.sh ``` @@ -60,7 +60,7 @@ We refresh this image (as well as other images) on every major release. _Build Image (Latest Commit):_ To build the latest Docker container, run `docker build` in [scripts/docker](https://github.com/binpash/pash/tree/main/scripts/docker): ```sh -git clone --depth 1 git@github.com:binpash/pash.git +git clone git@github.com:binpash/pash.git cd pash/scripts/docker/ docker build -f ./ubuntu/Dockerfile -t "pash:latest" . ``` diff --git a/evaluation/intro/test.sh b/evaluation/intro/test.sh index a72232832..3563fb315 100755 --- a/evaluation/intro/test.sh +++ b/evaluation/intro/test.sh @@ -17,10 +17,10 @@ run_test() local test=$1 echo -n "Running $test..." TIMEFORMAT="${test%%.*}:%3R" # %3U %3S" - { time $bash "$test" > "$output_dir/$test.bash.out"; } 2>> $output_dir/results.time_bash + { time $bash "$test" > "$output_dir/$test.bash.out"; } 2> >(tee -a $output_dir/results.time_bash) test_bash_ec=$? TIMEFORMAT="%3R" # %3U %3S" - { time $pash "$test" > "$output_dir/$test.pash.out"; } 2>> $output_dir/results.time_pash + { time $pash "$test" > "$output_dir/$test.pash.out"; } 2> >(tee -a $output_dir/results.time_pash) test_pash_ec=$? diff "$output_dir/$test.bash.out" "$output_dir/$test.pash.out" test_diff_ec=$? diff --git a/scripts/distro-deps.sh b/scripts/distro-deps.sh index b7c394d07..56d1a5b7d 100755 --- a/scripts/distro-deps.sh +++ b/scripts/distro-deps.sh @@ -32,7 +32,8 @@ fi # convert to lowercase distro=$(printf '%s\n' "$distro" | LC_ALL=C tr '[:upper:]' '[:lower:]') # compile the list of the shared required packages -pkgs="automake bc curl gcc git graphviz libtool m4 python sudo wget" +pkgs="bc curl git graphviz python sudo wget" +#libdash_pkgs="automake gcc libtool m4" # now do different things depending on distro case "$distro" in ubuntu*) diff --git a/scripts/setup-pash.sh b/scripts/setup-pash.sh index 586a1d302..2668b5188 100755 --- a/scripts/setup-pash.sh +++ b/scripts/setup-pash.sh @@ -3,21 +3,9 @@ set -e cd "$(dirname "$0")" -# check the git status of the project -if git rev-parse --git-dir > /dev/null 2>&1; then - # we have cloned from the git repo, so all the .git related files/metadata are available - git submodule init - git submodule update - # set PASH_TOP - PASH_TOP=${PASH_TOP:-$(git rev-parse --show-toplevel)} -else - # set PASH_TOP to the root folder of the project if it is not available - PASH_TOP=${PASH_TOP:-$PWD/..} - # remove previous installation if it exists - rm -rf $PASH_TOP/compiler/parser/libdash - # we are in package mode, no .git information is available - git clone --depth 1 https://github.com/angelhof/libdash/ $PASH_TOP/compiler/parser/libdash -fi +# set PASH_TOP +PASH_TOP=${PASH_TOP:-$(git rev-parse --show-toplevel)} + cd $PASH_TOP . "$PASH_TOP/scripts/utils.sh" read_cmd_args $@ @@ -30,61 +18,6 @@ rm -rf $PYTHON_PKG_DIR # create the new folder mkdir -p $PYTHON_PKG_DIR -echo "Building parser..." -cd compiler/parser - -if type lsb_release >/dev/null 2>&1 ; then - distro=$(lsb_release -i -s) -elif [ -e /etc/os-release ] ; then - distro=$(awk -F= '$1 == "ID" {print $2}' /etc/os-release) -fi - -echo "|-- making libdash..." -# convert to lowercase -distro=$(printf '%s\n' "$distro" | LC_ALL=C tr '[:upper:]' '[:lower:]') -# save distro in the init file -echo "export distro=$distro" > ~/.pash_init -# now do different things depending on distro -case "$distro" in - freebsd*) - gsed -i 's/ make/ gmake/g' Makefile - gmake libdash &> $LOG_DIR/make_libdash.log - echo "Building runtime..." - # Build runtime tools: eager, split - cd ../../runtime/ - gmake &> $LOG_DIR/make.log - ;; - *) - make libdash &> $LOG_DIR/make_libdash.log - echo "Building runtime..." - # Build runtime tools: eager, split - cd ../../runtime/ - make &> $LOG_DIR/make.log - if [ -f /.dockerenv ]; then - # issue with docker only - python3 -m pip install -U --force-reinstall pip - cp "$PASH_TOP"/pa.sh /usr/bin/ - fi - ;; -esac - -## This was the old parser installation that required opam. -# # Build the parser (requires libtool, m4, automake, opam) -# echo "Building parser..." -# eval $(opam config env) -# cd compiler/parser -# echo "|-- installing opam dependencies..." -# make opam-dependencies &> $LOG_DIR/make_opam_dependencies.log -# echo "|-- making libdash... (requires sudo)" -# ## TODO: How can we get rid of that `sudo make install` in here? -# make libdash &> $LOG_DIR/make_libdash.log -# make libdash-ocaml &>> $LOG_DIR/make_libdash.log -# echo "|-- making parser..." -# make &> $LOG_DIR/make.log -# cd ../../ - -cd ../ - echo "Installing python dependencies..." python3 -m pip install jsonpickle --root $PYTHON_PKG_DIR --ignore-installed #&> $LOG_DIR/pip_install_jsonpickle.log @@ -92,6 +25,8 @@ python3 -m pip install pexpect --root $PYTHON_PKG_DIR --ignore-installed #&> $LO python3 -m pip install graphviz --root $PYTHON_PKG_DIR --ignore-installed #&> $LOG_DIR/pip_install_graphviz.log python3 -m pip install numpy --root $PYTHON_PKG_DIR --ignore-installed #&> $LOG_DIR/pip_install_numpy.log python3 -m pip install matplotlib --root $PYTHON_PKG_DIR --ignore-installed #&> $LOG_DIR/pip_install_matplotlib.log +# TODO 2022-08-01 if libdash wheel isn't available, we need autmake etc. +python3 -m pip install libdash --root $PYTHON_PKG_DIR --ignore-installed #&> $LOG_DIR/pip_install_libdash.log # clean the python packages cd $PYTHON_PKG_DIR @@ -102,6 +37,24 @@ for directory in $pkg_path; do $(which cp) -r $directory/* ${PYTHON_PKG_DIR}/ done + +# Build runtime tools: eager, split +echo "Building runtime tools..." +cd "$PASH_TOP/runtime/" +case "$distro" in + freebsd*) + gmake &> $LOG_DIR/make.log + ;; + *) + make &> $LOG_DIR/make.log + if [ -f /.dockerenv ]; then + # issue with docker only + python3 -m pip install -U --force-reinstall pip + cp "$PASH_TOP"/pa.sh /usr/bin/ + fi + ;; +esac + echo "Generating input files..." $PASH_TOP/evaluation/tests/input/setup.sh diff --git a/scripts/up.sh b/scripts/up.sh index 32e8e593a..f55e36dc2 100755 --- a/scripts/up.sh +++ b/scripts/up.sh @@ -13,10 +13,10 @@ if [ "$PLATFORM" = "darwin" ]; then fi set +e -git clone --depth 1 git@github.com:binpash/pash.git +git clone git@github.com:binpash/pash.git if [ $? -ne 0 ]; then echo 'SSH clone failed; attempting HTTPS' - git clone --depth 1 https://github.com/binpash/pash.git + git clone https://github.com/binpash/pash.git fi set -e