From ff9ef30bc83438d732be082975a7b1e5735e1623 Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 14 Jul 2026 17:35:28 -0400 Subject: [PATCH 1/3] fix types to satisfy more stringent checking; formatting fixes --- .github/workflows/build.yml | 1 + libdash.opam | 2 ++ ocaml/ast.ml | 48 +++++++++++++++------------------ ocaml/dash.ml | 51 +++++++++++++++++------------------ ocaml/dash.mli | 10 +++---- ocaml/function_description.ml | 10 +++---- 6 files changed, 58 insertions(+), 64 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index e2ba507..86e116b 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -75,6 +75,7 @@ jobs: - ubuntu-latest ocaml-compiler: - 4.14.x + - 5.5.x runs-on: ${{ matrix.os }} diff --git a/libdash.opam b/libdash.opam index 9278923..a195241 100644 --- a/libdash.opam +++ b/libdash.opam @@ -1,5 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" +version: "0.4.0" synopsis: "Bindings to the dash shell's parser" maintainer: ["michael@greenberg.science"] authors: ["Michael Greenberg"] @@ -11,6 +12,7 @@ depends: [ "ctypes" {>= "0.21.1"} "ctypes-foreign" {>= "0.21.1"} "atdgen" {>= "2.15.0"} + "atdgen-runtime" {>= "2.15.0"} "conf-autoconf" {>= "0.1"} "conf-aclocal" {>= "2"} "conf-automake" {>= "1"} diff --git a/ocaml/ast.ml b/ocaml/ast.ml index 3abdfb2..504a3d7 100644 --- a/ocaml/ast.ml +++ b/ocaml/ast.ml @@ -1,7 +1,7 @@ type linno = int exception ParseException of string - + type t = | Command of (linno * assign list * args * redirection list) (* assign, args, redir *) | Pipe of (bool * t list) (* background?, commands *) @@ -70,14 +70,14 @@ let string_of_var_type = function | TrimR -> "%" | TrimRMax -> "%%" | TrimL -> "#" - | TrimLMax -> "##" - | Length -> "#" + | TrimLMax -> "##" + | Length -> "#" (* Some possible further simplifications: * Drop bool from pipe dash *always* forks for a pipe, but sometimes it waits - * Drop redirection from Command, etc. + * Drop redirection from Command, etc. Just use Redir... though this may affect subshell behavior. NCMD: expredir, pushredir, redirectsafe REDIR_PUSH|REDIR_SAVEFD2 NREDIR: expredir, pushredir, redirectsafe REDIR_PUSH @@ -203,9 +203,9 @@ and redirs (n : node union ptr) = | 19 -> mk_file FromTo (* NAPPEND *) | 20 -> mk_file Append - (* NTOFD *) + (* NTOFD *) | 21 -> mk_dup ToFD - (* NFROMFD *) + (* NFROMFD *) | 22 -> mk_dup FromFD (* NHERE quoted heredoc---no expansion)*) | 23 -> mk_here Here @@ -225,7 +225,7 @@ and to_arg (n : narg structure) : arg = assert (s = []); assert (nullptr bqlist); assert (stack = []); - a + a and parse_arg ?tilde_ok:(tilde_ok=false) ~assign:(assign:bool) (s : char list) (bqlist : nodelist structure ptr) stack = match s,stack with @@ -316,10 +316,10 @@ and parse_tilde acc s = if acc = [] then (None, s) else (Some (implode acc), s) (* ordinary char *) (* TODO 2019-01-03 only characters from the portable character set *) - | c::s' -> parse_tilde (acc @ [c]) s' - + | c::s' -> parse_tilde (acc @ [c]) s' + and arg_char assign c s bqlist stack = - let tilde_ok = + let tilde_ok = match c with | C _ -> assign && (match last s with | Some ':' -> true @@ -351,17 +351,17 @@ and to_assign (n : narg structure) : (string * arg) = assert (nullptr bqlist); assert (stack = []); (v,a) - -and to_assigns n = + +and to_assigns n = if nullptr n - then [] + then [] else (assert (n @-> node_type = 15); let n = n @-> node_narg in to_assign n::to_assigns (getf n narg_next)) - + and to_args (n : node union ptr) : args = if nullptr n - then [] + then [] else (assert (n @-> node_type = 15); let n = n @-> node_narg in to_arg n::to_args (getf n narg_next)) @@ -377,7 +377,7 @@ let background s = "{ " ^ s ^ " & }" let lines = Str.split (Str.regexp "[\n]+") -let fresh_marker heredoc = +let fresh_marker heredoc = let eofs_in_line line = if String.length line > 2 && String.get line 0 = 'E' && String.get line 1 == 'O' then @@ -391,7 +391,7 @@ let fresh_marker heredoc = | line::lines -> find_eofs lines (max max_fs (eofs_in_line line)) in "EOF" ^ String.make (find_eofs heredoc 0) 'F' - + let rec to_string = function | Command (_,assigns,cmds,redirs) -> separated string_of_assign assigns ^ @@ -403,7 +403,7 @@ let rec to_string = function | Redir (_,a,redirs) -> to_string a ^ string_of_redirs redirs | Background (_,a,redirs) -> - (* we translate + (* we translate cmds... & to { cmds & } @@ -434,7 +434,7 @@ let rec to_string = function "case " ^ string_of_arg a ^ " in " ^ separated string_of_case cs ^ " esac" | Defun (_,name,body) -> name ^ "() {\n" ^ to_string body ^ "\n}" - + and string_of_if c t e = "if " ^ to_string c ^ "; then " ^ to_string t ^ @@ -442,7 +442,7 @@ and string_of_if c t e = | Command (-1,[],[],[]) -> "; fi" (* one-armed if *) | If (c,t,e) -> "; el" ^ string_of_if c t e | _ -> "; else " ^ to_string e ^ "; fi") - + and string_of_arg_char ?quote_mode:(quote_mode=QUnquoted) = function | E c -> (* removed ! from chars_to_escape to have the right behavior in non-interactive shells *) @@ -476,12 +476,8 @@ and string_of_arg ?quote_mode:(quote_mode=QUnquoted) = function then "\\$" ^ string_of_arg ~quote_mode a else char ^ string_of_arg ~quote_mode a -and next_is_escaped = function - | E _ :: _ -> true - | _ -> false - and string_of_assign (v,a) = 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 ^ ";;" @@ -499,7 +495,7 @@ and string_of_redir = function let marker = fresh_marker (lines heredoc) in show_unless 0 fd ^ "<<" ^ (if t = XHere then marker else "'" ^ marker ^ "'") ^ "\n" ^ heredoc ^ marker ^ "\n" - + and string_of_redirs rs = let ss = List.map string_of_redir rs in (if List.length ss > 0 then " " else "") ^ intercalate " " ss diff --git a/ocaml/dash.ml b/ocaml/dash.ml index 65215e9..0b56f8b 100644 --- a/ocaml/dash.ml +++ b/ocaml/dash.ml @@ -13,7 +13,7 @@ let init_stack () : stackmark = let pop_stack stack : unit = popstackmark (addr stack) - + let initialize () : unit = initialize_dash_errno (); dash_init () @@ -31,29 +31,27 @@ let setvar (x : string) (v : string) : unit = let addrof p = raw_address_of_ptr (to_voidp p) -let eqptr p1 p2 = addrof p1 = addrof p2 - let nullptr (p : 'a ptr) = addrof p = Nativeint.zero type parse_result = Done | Error | Null | Parsed of (node union ptr) let parse_next ?interactive:(i=false) () = let n = parsecmd_safe (if i then 1 else 0) in - if eqptr n neof + if addrof n = addrof neof then Done - else if eqptr n nerr + else if addrof n = addrof nerr then Error else if nullptr n then Null (* comment or blank line or error ... *) else Parsed n - + let (@->) (s : ('b, 'c) structured ptr) (f : ('a, ('b, 'c) structured) field) = getf (!@ s) f let rec arglist (n : narg structure) : (narg structure) list = let next = getf n narg_next in if nullptr next - then [n] + then [n] else (assert (next @-> node_type = 15); n::arglist (next @-> node_narg)) @@ -62,7 +60,7 @@ let rec nodelist (n : nodelist structure ptr) : (node union ptr) list = if nullptr n then [] else (n @-> nodelist_n)::nodelist (n @-> nodelist_next) - + let rec redirlist (n : node union ptr) = if nullptr n then [] @@ -78,9 +76,9 @@ let rec redirlist (n : node union ptr) = | 19 -> `File (0,"<>",n @-> node_nfile) (* NAPPEND *) | 20 -> `File (1,">>",n @-> node_nfile) - (* NTOFD *) + (* NTOFD *) | 21 -> `Dup (1,">&",n @-> node_ndup) - (* NFROMFD *) + (* NFROMFD *) | 22 -> `Dup (0,"<&",n @-> node_ndup) (* NHERE quoted heredoc---no expansion)*) | 23 -> `Here (0,"<<",false,n @-> node_nhere) @@ -93,11 +91,11 @@ let rec redirlist (n : node union ptr) = let rec caselist (n : node union ptr) = if nullptr n then [] - else + 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 explode s = let rec exp i l = if i < 0 then l else exp (i - 1) (s.[i] :: l) in @@ -112,12 +110,12 @@ let implode l = in imp 0 l; Bytes.unsafe_to_string s - + let rec intercalate p ss = match ss with | [] -> "" | [s] -> s - | s::ss -> s ^ p ^ intercalate p ss + | s::ss -> s ^ p ^ intercalate p ss let lines = Str.split (Str.regexp "[\n\r]+") @@ -125,7 +123,7 @@ 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 - + let rec split_at p xs = match xs with | [] -> ([],[]) @@ -146,10 +144,10 @@ let string_of_vs = function | 0x8 -> (* VSTRIMLEFT ${var#pattern} *) ['#'] | 0x9 -> (* VSTRIMLEFTMAX ${var##pattern} *) ['#';'#'] | vs -> failwith ("Unknown VSTYPE: " ^ string_of_int vs) - + let braces s = "{ " ^ s ^ " ; }" let parens s = "( " ^ s ^ " )" - + let rec show (n : node union ptr) : string = match (n @-> node_type) with (* NCMD *) @@ -164,7 +162,7 @@ let rec show (n : node union ptr) : string = let cmds = nodelist (getf n npipe_cmdlist) in intercalate " | " (List.map show cmds) ^ if (getf n npipe_backgnd) = 0 then "" else " &" (* NREDIR *) - | 2 -> shnredir braces n + | 2 -> shnredir braces n (* NBACKGND *) | 3 -> shnredir braces n ^ " &" (* NSUBSHELL *) @@ -221,11 +219,11 @@ and shif n = else "; else " ^ show else_part ^ "; fi") and shclist clist = intercalate " " (List.map shcase (caselist clist)) (* handles NCLIST = 13 *) - + and shcase (pat,body) = assert (pat @-> node_type = 15); sharg (pat @-> node_narg) ^ ") " ^ show body ^ ";;" - + and shredir (n : node union ptr) : string = let redirs = redirlist n in if redirs = [] @@ -234,7 +232,7 @@ and shredir (n : node union ptr) : string = and show_redir n : string = match n with | `File (src,sym,f) -> show_redir_src (getf f nfile_fd) src ^ sym ^ sharg ((getf f nfile_fname) @-> node_narg) - | `Dup (src,sym,d) -> + | `Dup (src,sym,d) -> let vname = getf d ndup_vname in let tgt = if nullptr vname @@ -250,14 +248,14 @@ and show_redir_src actual expected = if actual = expected then "" else string_of_int actual - + and sharg (n : narg structure) : string = let str,s',bqlist,stack = show_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 = []); - str + str and show_arg (s : char list) (bqlist : nodelist structure ptr) stack = (* we have to look at the string and interpret control characters... *) match s,stack with @@ -266,7 +264,7 @@ and show_arg (s : char list) (bqlist : nodelist structure ptr) stack = | [],`CTLAri::stack' -> failwith "End of string before CTLENDARI" | [],`CTLQuo::stack' -> failwith "End of string before CTLQUOTEMARK" (* CTLESC *) - | '\129'::c::s',_ -> + | '\129'::c::s',_ -> let str,s'',bqlist',stack' = show_arg s' bqlist stack in let c' = match c with | '\'' -> "\\'" @@ -275,7 +273,7 @@ and show_arg (s : char list) (bqlist : nodelist structure ptr) stack = in c' ^ str,s'',bqlist',stack' (* CTLVAR *) - | '\130'::t::s',_ -> + | '\130'::t::s',_ -> let v,s'',bqlist',stack' = show_var (int_of_char t) s' bqlist stack in assert (stack = stack'); let str,s''',bqlist'',stack'' = show_arg s'' bqlist' stack' in @@ -314,7 +312,7 @@ and show_arg (s : char list) (bqlist : nodelist structure ptr) stack = let str,s''',bqlist'',stack'' = show_arg s'' bqlist' stack in "\"" ^ quoted ^ "\"" ^ str, s''', bqlist'', stack'' (* ordinary character *) - | c::s',_ -> + | c::s',_ -> let str,s',bqlist',stack' = show_arg s' bqlist stack in let c' = match c with | '\'' -> "\\'" @@ -343,4 +341,3 @@ and show_var (t : int) (s : char list) (bqlist : nodelist structure ptr) stack = implode (var_name @ vsnul @ string_of_vs vstype) ^ mods, s'', bqlist', stack' | _,c::s' -> failwith ("Expected '=' terminating variable name, found " ^ Char.escaped c) | _,[] -> failwith "Expected '=' terminating variable name, found EOF" - diff --git a/ocaml/dash.mli b/ocaml/dash.mli index a7bf212..4190c7e 100644 --- a/ocaml/dash.mli +++ b/ocaml/dash.mli @@ -1,4 +1,4 @@ -(* dash internals +(* dash internals call initialize before doing anything! *) @@ -17,7 +17,7 @@ val pop_stack : stackmark_t Ctypes.structure -> unit val alloc_stack_string : string -> (char Ctypes.ptr) val free_stack_string : (char Ctypes.ptr) -> unit - + val popfile : unit -> unit val setinputstring : (char Ctypes.ptr) -> unit val setinputtostdin : unit -> unit @@ -28,8 +28,8 @@ val setalias : string -> string -> unit val unalias : string -> unit (* returns -1 when fd was closed; -2 on other errors *) -val freshfd_ge10 : int -> int - +val freshfd_ge10 : int -> int + (* Ctypes mappings of the node types *) type node val node : node Ctypes.union Ctypes.typ @@ -205,8 +205,6 @@ val caselist : list (* useful functions for working with the Ctypes AST *) -val addrof : 'a Ctypes.ptr -> nativeint -val eqptr : 'a Ctypes.ptr -> 'b Ctypes.ptr -> bool val nullptr : 'a Ctypes.ptr -> bool (* useful functions for pretty printing *) diff --git a/ocaml/function_description.ml b/ocaml/function_description.ml index cf65d95..68ec74d 100644 --- a/ocaml/function_description.ml +++ b/ocaml/function_description.ml @@ -23,14 +23,14 @@ module Functions (F : Ctypes.FOREIGN) = struct let raw_setvar = foreign "setvar" (string @-> string @-> int @-> returning (ptr void)) let setalias = foreign "setalias" (string @-> string @-> returning void) - let unalias = foreign "unalias" (string @-> returning void) + let unalias = foreign "unalias" (string @-> returning void) (* Unix/ExtUnix don't let you renumber things the way you want *) let freshfd_ge10 = foreign "freshfd_ge10" (int @-> returning int) let parsecmd_safe = foreign "parsecmd_safe" (int @-> returning (ptr node)) - let neof = foreign_value "tokpushback" node - let nerr = foreign_value "lasttoken" node -end - + (* dummy addresses used inside dash *) + let neof = foreign_value "tokpushback" int + let nerr = foreign_value "lasttoken" int +end From 2e98d0616f7831e1f9c4d6ecb71157470c5f9da5 Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 14 Jul 2026 17:55:46 -0400 Subject: [PATCH 2/3] fix CI runs to be more selective --- .github/workflows/build.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 86e116b..095371a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -5,6 +5,10 @@ on: branches: - master push: + branches: + - master + tags: + - '**' schedule: - cron: '5 14 * * *' From 0684c224bbc29e38f5ff9818d5d42bf17e3a9c6b Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 14 Jul 2026 16:20:09 -0700 Subject: [PATCH 3/3] version bump --- GUIDE.md | 24 +++++++++++++++++------- dune-project | 2 +- pyproject.toml | 2 +- setup.py | 2 +- 4 files changed, 20 insertions(+), 10 deletions(-) diff --git a/GUIDE.md b/GUIDE.md index 6723ef8..55a666b 100644 --- a/GUIDE.md +++ b/GUIDE.md @@ -4,14 +4,14 @@ The dash AST itself is defined in `src/nodes.h` and `src/parser.h` - `union node` in `src/nodes.h` on line 146 for commands/statements node.type type tag - + node.nbinary (AND, OR, SEMI) - + - special characters and codes in `parser.h` on lines 40-64 CTL* for control codes in words breaks multibyte characters/UTF-8 :( - + VS* for variable format metadata The parser in `src/parser.c` is not easy to read, but is a good place @@ -41,13 +41,13 @@ few results: - `Done` when EOF (dash returns the special node `neof`, not `NULL`!) has been reached for the current input. - + - `Error` when parsing failed (dash returns the special node `nerr`, not `NULL`!). - + - `Null` when there was no command, e.g., a blank line (dash returns `NULL` here). - + - `Parsed n` for some `node`, `n`. Note that `n` is a dash AST, i.e., a ctypes structure. @@ -69,4 +69,14 @@ an assignment). Call `Dash.initialize`, then `Dash.parse` with the string you have. Call `Ast.of_node` on the resulting dash AST to get a nice OCaml -structure. +structure. Look at `ocaml/rt.sh` (and the binaries it calls) and +`python/rt.py` for examples. + +# Versioning + +To cut a new release, you must update the version numbers in +`setup.py`, `pyproject.toml`, and `dune-workspace`. A CI lint job will +check to ensure that they are the same. + +PyPI releases are automatic via GH CI. OCaml releases are via +`dune-release`. diff --git a/dune-project b/dune-project index f6d521f..c2a2e4b 100644 --- a/dune-project +++ b/dune-project @@ -10,7 +10,7 @@ (package (name libdash) (synopsis "Bindings to the dash shell's parser") - (version 0.4.0) + (version 0.4.1) (depends ("ctypes" (>= "0.21.1")) ("ctypes-foreign" (>= "0.21.1")) diff --git a/pyproject.toml b/pyproject.toml index bebc0da..e74e592 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -1,6 +1,6 @@ [project] name = "libdash" -version = "0.4.0" +version = "0.4.1" authors = [ { name="Michael Greenberg", email="michael@greenberg.science" }, { name="PaSh contributors" }, diff --git a/setup.py b/setup.py index 4c2a752..a41b5b3 100644 --- a/setup.py +++ b/setup.py @@ -61,7 +61,7 @@ def run(self): setup(name='libdash', packages=['libdash'], cmdclass={'build_py': libdash_build_py}, - version='0.4.0', + version='0.4.1', long_description=long_description, long_description_content_type='text/markdown', include_package_data=True,