From 7b4e2a5587f9593959b6356d905d57a13c5016da Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Thu, 14 Dec 2023 20:07:12 -0500 Subject: [PATCH 1/7] like lawrence before me, i have conquered the dunes --- .gitignore | 7 + dune | 36 +++++ dune-project | 3 + dune-workspace | 4 + ocaml/ast.ml | 12 +- ocaml/ast_atd.atd | 26 ++-- ocaml/dash.ml | 241 ++-------------------------------- ocaml/dash.mli | 6 +- ocaml/dune | 52 ++++++++ ocaml/function_description.ml | 36 +++++ ocaml/json_to_shell.ml | 1 + ocaml/shell_to_json.ml | 2 + ocaml/type_description.ml | 191 +++++++++++++++++++++++++++ src/type_description.ml | 184 ++++++++++++++++++++++++++ 14 files changed, 550 insertions(+), 251 deletions(-) create mode 100644 dune create mode 100644 dune-project create mode 100644 dune-workspace create mode 100644 ocaml/dune create mode 100644 ocaml/function_description.ml create mode 100644 ocaml/type_description.ml create mode 100644 src/type_description.ml diff --git a/.gitignore b/.gitignore index 742690a..18939bd 100644 --- a/.gitignore +++ b/.gitignore @@ -22,8 +22,15 @@ Makefile /stamp-h1 # generated by make +/src/builtins.h +/src/nodes.h +/src/syntax.h +/src/token.h /src/token_vars.h +# generated by dune +_build + # Apple debug symbol bundles *.dSYM/ diff --git a/dune b/dune new file mode 100644 index 0000000..7ca799c --- /dev/null +++ b/dune @@ -0,0 +1,36 @@ +(data_only_dirs src) + +(rule + (deps (source_tree src) configure.ac Makefile.am) + (targets libdash.a dlldash.so + builtins.h nodes.h syntax.h token.h token_vars.h + ) + (action + (bash + "\ + \n set -e\ + \n if [ \"$(uname -s)\" = \"Darwin\" ]; then glibtoolize; else libtoolize; fi\ + \n aclocal && autoheader && automake --add-missing && autoconf\ + \n ./configure --prefix=\"$(pwd)\"\ + \n %{make}\ + \n %{make} install\ + \n cp lib/libdash.a libdash.a\ + \n cp lib/dlldash.so dlldash.so\ + \n cp src/{builtins,nodes,syntax,token,token_vars}.h .\ + \n"))) + +(subdir src + (rule + (deps ../builtins.h ../nodes.h ../syntax.h ../token.h ../token_vars.h) + (targets builtins.h nodes.h syntax.h token.h token_vars.h) + (action + (progn + (copy ../builtins.h builtins.h) + (copy ../nodes.h nodes.h) + (copy ../syntax.h syntax.h) + (copy ../token.h token.h) + (copy ../token_vars.h token_vars.h))))) + +(library + (name dash) + (foreign_archives dash)) diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..12634e1 --- /dev/null +++ b/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.12) +(name libdash) +(using ctypes 0.3) \ No newline at end of file diff --git a/dune-workspace b/dune-workspace new file mode 100644 index 0000000..42ee224 --- /dev/null +++ b/dune-workspace @@ -0,0 +1,4 @@ +(lang dune 3.12) +(env + (dev + (flags (:standard -warn-error -27)))) \ No newline at end of file diff --git a/ocaml/ast.ml b/ocaml/ast.ml index 8127b51..9205e83 100644 --- a/ocaml/ast.ml +++ b/ocaml/ast.ml @@ -86,25 +86,20 @@ let string_of_var_type = function open Ctypes -open Foreign open Dash let rec last = function | [] -> None | [x] -> Some x - | x::xs -> last xs + | _::xs -> last xs let skip = Command (-1,[],[],[]) -let special_chars : char list = explode "|&;<>()$`\\\"'" - type quote_mode = QUnquoted | QQuoted | QHeredoc -let needs_escaping c = List.mem c special_chars - let rec of_node (n : node union ptr) : t = if nullptr n then skip @@ -225,7 +220,7 @@ and of_binary (n : node union ptr) = (of_node (getf n nbinary_ch1), of_node (getf n nbinary_ch2)) and to_arg (n : narg structure) : arg = - let a,s,bqlist,stack = parse_arg ~tilde_ok:true ~assign:false (explode (getf n narg_text)) (getf n narg_backquote) [] in + let a,s,bqlist,stack = parse_arg ~assign:false (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); @@ -304,6 +299,7 @@ and parse_arg ?tilde_ok:(tilde_ok=false) ~assign:(assign:bool) (s : char list) ( then (* we're in arithmetic or double quotes, so tilde is ignored *) arg_char assign (C '~') s bqlist stack else + let _ = tilde_ok in (* unused? *) let uname,s' = parse_tilde [] s in arg_char assign (T uname) s' bqlist stack (* ordinary character *) @@ -325,7 +321,7 @@ and parse_tilde acc s = and arg_char assign c s bqlist stack = let tilde_ok = match c with - | C c -> assign && (match last s with + | C _ -> assign && (match last s with | Some ':' -> true | _ -> false) | _ -> false diff --git a/ocaml/ast_atd.atd b/ocaml/ast_atd.atd index 647a1de..989789b 100644 --- a/ocaml/ast_atd.atd +++ b/ocaml/ast_atd.atd @@ -1,8 +1,8 @@ -type char = int +type char = int -type linno = int +type linno = int -type t = [ +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) @@ -19,15 +19,15 @@ type t = [ | Defun of (linno * string * t) (* name, body *) ] -type assign = (string * arg) +type assign = (string * arg) -type redirection = [ +type redirection = [ File of (redir_type * int * arg) | Dup of (dup_type * int * arg) | Heredoc of (heredoc_type * int * arg) ] -type redir_type = [ +type redir_type = [ To | Clobber | From @@ -35,21 +35,21 @@ type redir_type = [ | Append ] -type dup_type = [ +type dup_type = [ ToFD | FromFD ] -type heredoc_type = [ +type heredoc_type = [ Here | XHere (* for when in a quote... not sure when this comes up *) ] -type args = arg list +type args = arg list -type arg = arg_char list +type arg = arg_char list -type arg_char = [ +type arg_char = [ C of char | E of char (* escape... necessary for expansion *) | T of string option (* tilde *) @@ -59,7 +59,7 @@ type arg_char = [ | B of t (* backquote *) ] -type var_type = [ +type var_type = [ Normal | Minus | Plus @@ -72,7 +72,7 @@ type var_type = [ | Length ] -type case = { +type case = { cpattern : arg list; cbody : t } \ No newline at end of file diff --git a/ocaml/dash.ml b/ocaml/dash.ml index ec0f33f..65215e9 100644 --- a/ocaml/dash.ml +++ b/ocaml/dash.ml @@ -1,246 +1,33 @@ -open Printf open Ctypes -open Ctypes_types -open Foreign +include Cdash.Functions +include Cdash.Types (* First, some dash trivia. *) - -type stackmark - -let stackmark : stackmark structure typ = structure "stackmark" -let stackp = field stackmark "stackp" (ptr void) -let nxt = field stackmark "nxt" string -let size = field stackmark "stacknleft" PosixTypes.size_t -let () = seal stackmark -let init_stack () = - let stack = make stackmark in - foreign "setstackmark" (ptr stackmark @-> returning void) (addr stack); - stack - -let pop_stack stack = - foreign "popstackmark" (ptr stackmark @-> returning void) (addr stack) +type stackmark_t = Stackmark.stackmark -let alloc_stack_string = - foreign "sstrdup" (string @-> returning (ptr char)) - -let free_stack_string s = - foreign "stunalloc" (ptr char @-> returning void) s - -let dash_init : unit -> unit = foreign "init" (void @-> returning void) -let initialize_dash_errno : unit -> unit = - foreign "initialize_dash_errno" (void @-> returning void) +let init_stack () : stackmark = + let stack = Ctypes.make stackmark in + setstackmark (addr stack); + stack -let initialize () = +let pop_stack stack : unit = + popstackmark (addr stack) + +let initialize () : unit = initialize_dash_errno (); dash_init () -let popfile : unit -> unit = - foreign "popfile" (void @-> returning void) - -let setinputstring : char ptr -> unit = - foreign "setinputstring" (ptr char @-> returning void) - let setinputtostdin () : unit = - foreign "setinputfd" (int @-> int @-> returning void) 0 0 (* don't both pushing the file *) + setinputfd 0 0 (* don't bother pushing the file *) let setinputfile ?push:(push=false) (s : string) : unit = - let _ = foreign "setinputfile" (string @-> int @-> returning int) s (if push then 1 else 0) in + let _ = raw_setinputfile s (if push then 1 else 0) in () let setvar (x : string) (v : string) : unit = - let _ = foreign "setvar" (string @-> string @-> int @-> returning (ptr void)) x v 0 in + let _ = raw_setvar x v 0 in () - -let setalias (name : string) (mapping : string) : unit = - foreign "setalias" (string @-> string @-> returning void) name mapping - -let unalias (name : string) : unit = - foreign "unalias" (string @-> returning void) name - -(* Next, a utility function that isn't in Unix or ExtUnix. *) - -let freshfd_ge10 (fd : int) : int = - foreign "freshfd_ge10" (int @-> returning int) fd - -(* Actual AST stuff begins here. *) -(* first, we define the node type... *) - -type node -let node : node union typ = union "node" -let node_type = field node "type" int -(* but we don't seal it yet! *) - -type nodelist -let nodelist : nodelist structure typ = structure "nodelist" -let nodelist_next = field nodelist "next" (ptr nodelist) -let nodelist_n = field nodelist "n" (ptr node) -let () = seal nodelist - -type ncmd - -let ncmd : ncmd structure typ = structure "ncmd" -let ncmd_type = field ncmd "type" int -let ncmd_linno = field ncmd "linno" int -let ncmd_assign = field ncmd "assign" (ptr node) -let ncmd_args = field ncmd "args" (ptr node) -let ncmd_redirect = field ncmd "redirect" (ptr node) -let () = seal ncmd - -let node_ncmd = field node "ncmd" ncmd - -type npipe - -let npipe : npipe structure typ = structure "npipe" -let npipe_type = field npipe "type" int -let npipe_backgnd = field npipe "backgnd" int -let npipe_cmdlist = field npipe "cmdlist" (ptr nodelist) -let () = seal npipe - -let node_npipe = field node "npipe" npipe - -type nredir - -let nredir : nredir structure typ = structure "nredir" -let nredir_type = field nredir "type" int -let nredir_linno = field nredir "linno" int -let nredir_n = field nredir "n" (ptr node) -let nredir_redirect = field nredir "redirect" (ptr node) -let () = seal nredir - -let node_nredir = field node "nredir" nredir - -type nbinary - -let nbinary : nbinary structure typ = structure "nbinary" -let nbinary_type = field nbinary "type" int -let nbinary_ch1 = field nbinary "ch1" (ptr node) -let nbinary_ch2 = field nbinary "ch2" (ptr node) -let () = seal nbinary - -let node_nbinary = field node "nbinary" nbinary - -type nif - -let nif : nif structure typ = structure "nif" -let nif_type = field nif "type" int -let nif_test = field nif "test" (ptr node) -let nif_ifpart = field nif "ifpart" (ptr node) -let nif_elsepart = field nif "elsepart" (ptr node) -let () = seal nif - -let node_nif = field node "nif" nif - -type nfor - -let nfor : nfor structure typ = structure "nfor" -let nfor_type = field nfor "type" int -let nfor_linno = field nfor "linno" int -let nfor_args = field nfor "args" (ptr node) -let nfor_body = field nfor "body" (ptr node) -let nfor_var = field nfor "var" string -let () = seal nfor - -let node_nfor = field node "nfor" nfor - -type ncase - -let ncase : ncase structure typ = structure "ncase" -let ncase_type = field ncase "type" int -let ncase_linno = field ncase "linno" int -let ncase_expr = field ncase "expr" (ptr node) -let ncase_cases = field ncase "cases" (ptr node) -let () = seal ncase - -let node_ncase = field node "ncase" ncase - -type nclist - -let nclist : nclist structure typ = structure "nclist" -let nclist_type = field nclist "type" int -let nclist_next = field nclist "next" (ptr node) -let nclist_pattern = field nclist "pattern" (ptr node) -let nclist_body = field nclist "body" (ptr node) -let () = seal nclist - -let node_nclist = field node "nclist" nclist - -type ndefun - -let ndefun : ndefun structure typ = structure "ndefun" -let ndefun_type = field ndefun "type" int -let ndefun_linno = field ndefun "linno" int -let ndefun_text = field ndefun "text" string -let ndefun_body = field ndefun "body" (ptr node) -let () = seal ndefun - -let node_ndefun = field node "ndefun" ndefun - -type narg - -let narg : narg structure typ = structure "narg" -let narg_type = field narg "type" int -let narg_next = field narg "next" (ptr node) -let narg_text = field narg "text" string -let narg_backquote = field narg "backquote" (ptr nodelist) -let () = seal narg - -let node_narg = field node "narg" narg - -type nfile - -let nfile : nfile structure typ = structure "nfile" -let nfile_type = field nfile "type" int -let nfile_next = field nfile "next" (ptr node) -let nfile_fd = field nfile "fd" int -let nfile_fname = field nfile "fname" (ptr node) -let nfile_expfname = field nfile "expfname" string -let () = seal nfile - -let node_nfile = field node "nfile" nfile - -type ndup - -let ndup : ndup structure typ = structure "ndup" -let ndup_type = field ndup "type" int -let ndup_next = field ndup "next" (ptr node) -let ndup_fd = field ndup "fd" int -let ndup_dupfd = field ndup "dupfd" int -let ndup_vname = field ndup "vname" (ptr node) -let () = seal ndup - -let node_ndup = field node "ndup" ndup - -type nhere - -let nhere : nhere structure typ = structure "nhere" -let nhere_type = field nhere "type" int -let nhere_next = field nhere "next" (ptr node) -let nhere_fd = field nhere "fd" int -let nhere_doc = field nhere "doc" (ptr node) -let () = seal nhere - -let node_nhere = field node "nhere" nhere - -type nnot - -let nnot : nnot structure typ = structure "nnot" -let nnot_type = field nnot "type" int -let nnot_com = field nnot "com" (ptr node) -let () = seal nnot - -let node_nnot = field node "nnot" nnot -let () = seal node - -let parsecmd_safe : int -> node union ptr = - foreign "parsecmd_safe" (int @-> returning (ptr node)) - -let parse s = - setinputstring s; (* TODO set stack mark? *) - parsecmd_safe 0 - -let neof : node union ptr = foreign_value "tokpushback" node -let nerr : node union ptr = foreign_value "lasttoken" node let addrof p = raw_address_of_ptr (to_voidp p) diff --git a/ocaml/dash.mli b/ocaml/dash.mli index f18c119..a7bf212 100644 --- a/ocaml/dash.mli +++ b/ocaml/dash.mli @@ -11,9 +11,9 @@ val initialize : unit -> unit see libdash/test/test.ml for an example usage in parse_all *) -type stackmark -val init_stack : unit -> stackmark Ctypes.structure -val pop_stack : stackmark Ctypes.structure -> unit +type stackmark_t +val init_stack : unit -> stackmark_t Ctypes.structure +val pop_stack : stackmark_t Ctypes.structure -> unit val alloc_stack_string : string -> (char Ctypes.ptr) val free_stack_string : (char Ctypes.ptr) -> unit diff --git a/ocaml/dune b/ocaml/dune new file mode 100644 index 0000000..b0ebca6 --- /dev/null +++ b/ocaml/dune @@ -0,0 +1,52 @@ +(executables + (names shell_to_json json_to_shell) + (public_names shell_to_json json_to_shell) + (modules shell_to_json json_to_shell ast_json) + (modes (native exe)) + (libraries libdash yojson atdgen)) + +(library + (name libdash) + (public_name libdash) + (modes native) + (modules (:standard \ json_to_shell shell_to_json ast_json)) + (libraries ctypes ctypes.foreign) +; (library_flags (-linkall)) + (foreign_archives ../dash) + (ctypes + (external_library_name dash) + (build_flags_resolver (vendored (c_flags :standard) (c_library_flags :standard))) + (deps (glob_files ../src/*.h) ../src/builtins.h ../src/nodes.h ../src/syntax.h ../src/token.h ../src/token_vars.h) + (headers (preamble + "\ + \n#include \"../src/shell.h\"\ + \n#include \"../src/memalloc.h\"\ + \n#include \"../src/mystring.h\"\ + \n#include \"../src/init.h\"\ + \n#include \"../src/main.h\"\ + \n#include \"../src/input.h\"\ + \n#include \"../src/var.h\"\ + \n#include \"../src/alias.h\"\ + \n#include \"../src/redir.h\"\ + \n#include \"../src/parser.h\"\ + \n#include \"../src/nodes.h\"\ + \n")) + (type_description + (instance Types) + (functor Type_description)) + (function_description + (instance Functions) + (functor Function_description)) + (generated_types Types_generated) + (generated_entry_point Cdash))) + +(rule + (targets ast_json.mli ast_json.ml) + (deps ast_atd.atd) + (action + (progn + (run atdgen -j -j-std ast_atd.atd) + (run sed -i -e "/type char = Libdash.Ast.char/d" ast_atd_j.ml) + (run sed -i -e "/type char = Libdash.Ast.char/d" ast_atd_j.mli) + (run mv ast_atd_j.ml ast_json.ml) + (run mv ast_atd_j.mli ast_json.mli)))) diff --git a/ocaml/function_description.ml b/ocaml/function_description.ml new file mode 100644 index 0000000..cf65d95 --- /dev/null +++ b/ocaml/function_description.ml @@ -0,0 +1,36 @@ +open Ctypes + +module Types = Types_generated +open Types + +module Functions (F : Ctypes.FOREIGN) = struct + open F + + let setstackmark = foreign "setstackmark" (ptr stackmark @-> returning void) + let popstackmark = foreign "popstackmark" (ptr stackmark @-> returning void) + + let alloc_stack_string = foreign "sstrdup" (string @-> returning (ptr char)) + let free_stack_string = foreign "stunalloc" (ptr char @-> returning void) + + let dash_init = foreign "init" (void @-> returning void) + let initialize_dash_errno = foreign "initialize_dash_errno" (void @-> returning void) + + let popfile = foreign "popfile" (void @-> returning void) + let setinputstring = foreign "setinputstring" (ptr char @-> returning void) + let setinputfd = foreign "setinputfd" (int @-> int @-> returning void) + let raw_setinputfile = foreign "setinputfile" (string @-> int @-> returning int) + + 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) + + (* 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 + + diff --git a/ocaml/json_to_shell.ml b/ocaml/json_to_shell.ml index 7f41033..2474e8c 100644 --- a/ocaml/json_to_shell.ml +++ b/ocaml/json_to_shell.ml @@ -1,4 +1,5 @@ (* This is straight-up copied from the libdash tests *) +open Libdash let verbose = ref false let input_src : string option ref = ref None diff --git a/ocaml/shell_to_json.ml b/ocaml/shell_to_json.ml index d170e5c..29f32ac 100644 --- a/ocaml/shell_to_json.ml +++ b/ocaml/shell_to_json.ml @@ -1,5 +1,7 @@ (* This is straight-up copied from the libdash tests *) +open Libdash + let verbose = ref false let input_src : string option ref = ref None diff --git a/ocaml/type_description.ml b/ocaml/type_description.ml new file mode 100644 index 0000000..ef6a134 --- /dev/null +++ b/ocaml/type_description.ml @@ -0,0 +1,191 @@ +open Ctypes + +module Types (F : Ctypes.TYPE) = struct + open F + + (* stackmarks [used for string allocation in dash] *) + module Stackmark = struct + + type stackmark + type t = stackmark Ctypes.structure + + let t : stackmark structure typ = structure "stackmark" + let stackp = field t "stackp" (ptr void) + let nxt = field t "stacknxt" string + let size = field t "stacknleft" F.size_t + let () = seal t + end + + type stackmark = Stackmark.t + let stackmark = Stackmark.t + + (* AST nodes *) + + (* define the node type... *) + type node + let node : node union typ = union "node" + let node_type = field node "type" int + (* ...but don't seal it yet! *) + + type nodelist + let nodelist : nodelist structure typ = structure "nodelist" + let nodelist_next = field nodelist "next" (ptr nodelist) + let nodelist_n = field nodelist "n" (ptr node) + let () = seal nodelist + + type ncmd + + let ncmd : ncmd structure typ = structure "ncmd" + let ncmd_type = field ncmd "type" int + let ncmd_linno = field ncmd "linno" int + let ncmd_assign = field ncmd "assign" (ptr node) + let ncmd_args = field ncmd "args" (ptr node) + let ncmd_redirect = field ncmd "redirect" (ptr node) + let () = seal ncmd + + let node_ncmd = field node "ncmd" ncmd + + type npipe + + let npipe : npipe structure typ = structure "npipe" + let npipe_type = field npipe "type" int + let npipe_backgnd = field npipe "backgnd" int + let npipe_cmdlist = field npipe "cmdlist" (ptr nodelist) + let () = seal npipe + + let node_npipe = field node "npipe" npipe + + type nredir + + let nredir : nredir structure typ = structure "nredir" + let nredir_type = field nredir "type" int + let nredir_linno = field nredir "linno" int + let nredir_n = field nredir "n" (ptr node) + let nredir_redirect = field nredir "redirect" (ptr node) + let () = seal nredir + + let node_nredir = field node "nredir" nredir + + type nbinary + + let nbinary : nbinary structure typ = structure "nbinary" + let nbinary_type = field nbinary "type" int + let nbinary_ch1 = field nbinary "ch1" (ptr node) + let nbinary_ch2 = field nbinary "ch2" (ptr node) + let () = seal nbinary + + let node_nbinary = field node "nbinary" nbinary + + type nif + + let nif : nif structure typ = structure "nif" + let nif_type = field nif "type" int + let nif_test = field nif "test" (ptr node) + let nif_ifpart = field nif "ifpart" (ptr node) + let nif_elsepart = field nif "elsepart" (ptr node) + let () = seal nif + + let node_nif = field node "nif" nif + + type nfor + + let nfor : nfor structure typ = structure "nfor" + let nfor_type = field nfor "type" int + let nfor_linno = field nfor "linno" int + let nfor_args = field nfor "args" (ptr node) + let nfor_body = field nfor "body" (ptr node) + let nfor_var = field nfor "var" string + let () = seal nfor + + let node_nfor = field node "nfor" nfor + + type ncase + + let ncase : ncase structure typ = structure "ncase" + let ncase_type = field ncase "type" int + let ncase_linno = field ncase "linno" int + let ncase_expr = field ncase "expr" (ptr node) + let ncase_cases = field ncase "cases" (ptr node) + let () = seal ncase + + let node_ncase = field node "ncase" ncase + + type nclist + + let nclist : nclist structure typ = structure "nclist" + let nclist_type = field nclist "type" int + let nclist_next = field nclist "next" (ptr node) + let nclist_pattern = field nclist "pattern" (ptr node) + let nclist_body = field nclist "body" (ptr node) + let () = seal nclist + + let node_nclist = field node "nclist" nclist + + type ndefun + + let ndefun : ndefun structure typ = structure "ndefun" + let ndefun_type = field ndefun "type" int + let ndefun_linno = field ndefun "linno" int + let ndefun_text = field ndefun "text" string + let ndefun_body = field ndefun "body" (ptr node) + let () = seal ndefun + + let node_ndefun = field node "ndefun" ndefun + + type narg + + let narg : narg structure typ = structure "narg" + let narg_type = field narg "type" int + let narg_next = field narg "next" (ptr node) + let narg_text = field narg "text" string + let narg_backquote = field narg "backquote" (ptr nodelist) + let () = seal narg + + let node_narg = field node "narg" narg + + type nfile + + let nfile : nfile structure typ = structure "nfile" + let nfile_type = field nfile "type" int + let nfile_next = field nfile "next" (ptr node) + let nfile_fd = field nfile "fd" int + let nfile_fname = field nfile "fname" (ptr node) + let nfile_expfname = field nfile "expfname" string + let () = seal nfile + + let node_nfile = field node "nfile" nfile + + type ndup + + let ndup : ndup structure typ = structure "ndup" + let ndup_type = field ndup "type" int + let ndup_next = field ndup "next" (ptr node) + let ndup_fd = field ndup "fd" int + let ndup_dupfd = field ndup "dupfd" int + let ndup_vname = field ndup "vname" (ptr node) + let () = seal ndup + + let node_ndup = field node "ndup" ndup + + type nhere + + let nhere : nhere structure typ = structure "nhere" + let nhere_type = field nhere "type" int + let nhere_next = field nhere "next" (ptr node) + let nhere_fd = field nhere "fd" int + let nhere_doc = field nhere "doc" (ptr node) + let () = seal nhere + + let node_nhere = field node "nhere" nhere + + type nnot + + let nnot : nnot structure typ = structure "nnot" + let nnot_type = field nnot "type" int + let nnot_com = field nnot "com" (ptr node) + let () = seal nnot + + let node_nnot = field node "nnot" nnot + let () = seal node + +end diff --git a/src/type_description.ml b/src/type_description.ml new file mode 100644 index 0000000..7ee7915 --- /dev/null +++ b/src/type_description.ml @@ -0,0 +1,184 @@ +open Ctypes + +module Types (F : Ctypes.TYPE) = struct + open F + + (* stackmarks [used for string allocation in dash] *) + type stackmark + + let stackmark : stackmark structure typ = structure "stackmark" + let stackp = field stackmark "stackp" (ptr void) + let nxt = field stackmark "nxt" string + let size = field stackmark "stacknleft" F.size_t + let () = seal stackmark + + (* AST nodes *) + + (* define the node type... *) + type node + let node : node union typ = union "node" + let node_type = field node "type" int + (* ...but don't seal it yet! *) + + type nodelist + let nodelist : nodelist structure typ = structure "nodelist" + let nodelist_next = field nodelist "next" (ptr nodelist) + let nodelist_n = field nodelist "n" (ptr node) + let () = seal nodelist + + type ncmd + + let ncmd : ncmd structure typ = structure "ncmd" + let ncmd_type = field ncmd "type" int + let ncmd_linno = field ncmd "linno" int + let ncmd_assign = field ncmd "assign" (ptr node) + let ncmd_args = field ncmd "args" (ptr node) + let ncmd_redirect = field ncmd "redirect" (ptr node) + let () = seal ncmd + + let node_ncmd = field node "ncmd" ncmd + + type npipe + + let npipe : npipe structure typ = structure "npipe" + let npipe_type = field npipe "type" int + let npipe_backgnd = field npipe "backgnd" int + let npipe_cmdlist = field npipe "cmdlist" (ptr nodelist) + let () = seal npipe + + let node_npipe = field node "npipe" npipe + + type nredir + + let nredir : nredir structure typ = structure "nredir" + let nredir_type = field nredir "type" int + let nredir_linno = field nredir "linno" int + let nredir_n = field nredir "n" (ptr node) + let nredir_redirect = field nredir "redirect" (ptr node) + let () = seal nredir + + let node_nredir = field node "nredir" nredir + + type nbinary + + let nbinary : nbinary structure typ = structure "nbinary" + let nbinary_type = field nbinary "type" int + let nbinary_ch1 = field nbinary "ch1" (ptr node) + let nbinary_ch2 = field nbinary "ch2" (ptr node) + let () = seal nbinary + + let node_nbinary = field node "nbinary" nbinary + + type nif + + let nif : nif structure typ = structure "nif" + let nif_type = field nif "type" int + let nif_test = field nif "test" (ptr node) + let nif_ifpart = field nif "ifpart" (ptr node) + let nif_elsepart = field nif "elsepart" (ptr node) + let () = seal nif + + let node_nif = field node "nif" nif + + type nfor + + let nfor : nfor structure typ = structure "nfor" + let nfor_type = field nfor "type" int + let nfor_linno = field nfor "linno" int + let nfor_args = field nfor "args" (ptr node) + let nfor_body = field nfor "body" (ptr node) + let nfor_var = field nfor "var" string + let () = seal nfor + + let node_nfor = field node "nfor" nfor + + type ncase + + let ncase : ncase structure typ = structure "ncase" + let ncase_type = field ncase "type" int + let ncase_linno = field ncase "linno" int + let ncase_expr = field ncase "expr" (ptr node) + let ncase_cases = field ncase "cases" (ptr node) + let () = seal ncase + + let node_ncase = field node "ncase" ncase + + type nclist + + let nclist : nclist structure typ = structure "nclist" + let nclist_type = field nclist "type" int + let nclist_next = field nclist "next" (ptr node) + let nclist_pattern = field nclist "pattern" (ptr node) + let nclist_body = field nclist "body" (ptr node) + let () = seal nclist + + let node_nclist = field node "nclist" nclist + + type ndefun + + let ndefun : ndefun structure typ = structure "ndefun" + let ndefun_type = field ndefun "type" int + let ndefun_linno = field ndefun "linno" int + let ndefun_text = field ndefun "text" string + let ndefun_body = field ndefun "body" (ptr node) + let () = seal ndefun + + let node_ndefun = field node "ndefun" ndefun + + type narg + + let narg : narg structure typ = structure "narg" + let narg_type = field narg "type" int + let narg_next = field narg "next" (ptr node) + let narg_text = field narg "text" string + let narg_backquote = field narg "backquote" (ptr nodelist) + let () = seal narg + + let node_narg = field node "narg" narg + + type nfile + + let nfile : nfile structure typ = structure "nfile" + let nfile_type = field nfile "type" int + let nfile_next = field nfile "next" (ptr node) + let nfile_fd = field nfile "fd" int + let nfile_fname = field nfile "fname" (ptr node) + let nfile_expfname = field nfile "expfname" string + let () = seal nfile + + let node_nfile = field node "nfile" nfile + + type ndup + + let ndup : ndup structure typ = structure "ndup" + let ndup_type = field ndup "type" int + let ndup_next = field ndup "next" (ptr node) + let ndup_fd = field ndup "fd" int + let ndup_dupfd = field ndup "dupfd" int + let ndup_vname = field ndup "vname" (ptr node) + let () = seal ndup + + let node_ndup = field node "ndup" ndup + + type nhere + + let nhere : nhere structure typ = structure "nhere" + let nhere_type = field nhere "type" int + let nhere_next = field nhere "next" (ptr node) + let nhere_fd = field nhere "fd" int + let nhere_doc = field nhere "doc" (ptr node) + let () = seal nhere + + let node_nhere = field node "nhere" nhere + + type nnot + + let nnot : nnot structure typ = structure "nnot" + let nnot_type = field nnot "type" int + let nnot_com = field nnot "com" (ptr node) + let () = seal nnot + + let node_nnot = field node "nnot" nnot + let () = seal node + +end From 893b1f2216d01e46fe6d50a458d386b5341a7cbf Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 19 Dec 2023 09:14:43 -0500 Subject: [PATCH 2/7] use standard opam dune build --- libdash.opam | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/libdash.opam b/libdash.opam index 811fd1b..f32347f 100644 --- a/libdash.opam +++ b/libdash.opam @@ -16,23 +16,6 @@ depends: [ "conf-automake" {build} "conf-libtool" {build} ] -build: [ - ["libtoolize"] {os != "macos"} - ["glibtoolize"] {os = "macos"} - ["aclocal"] - ["autoheader"] - ["automake" "--add-missing"] - ["autoconf"] - ["mkdir" "_build"] - ["./configure" "--prefix=%{build}%/_build"] - [make] - [make "install"] # into _build - ["ocaml/mk_meta.sh" "%{_:lib}%"] # pass along the lib directory for the rpath in the META - [make "-C" "ocaml" "all"] - ["./mk_dot_install.sh"] - ["./ldconfig.sh"] # fix up .so files if ldconfig didn't do it - [make "-C" "ocaml" "test"] {with-test} -] dev-repo: "git+https:///github.com/mgree/libdash" url { src: "https://github.com/mgree/libdash/archive/v0.3.tar.gz" From f823f48e232ab42093df206c3840ef921f91c732 Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 19 Dec 2023 09:40:36 -0500 Subject: [PATCH 3/7] tests in dune, fixup ci --- .github/workflows/build.yml | 4 ++-- ocaml/dune | 10 ++++++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 693e518..16794cf 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -85,10 +85,10 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-compiler }} - name: Install OCaml bindings - run: opam install . + run: dune install - name: Test OCaml bindings - run: opam exec -- make -C ocaml test + run: dune test # we don't reuse the wheels so that all of the CI runs can happen concurrently - name: Install Python directly diff --git a/ocaml/dune b/ocaml/dune index b0ebca6..6bad39e 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -50,3 +50,13 @@ (run sed -i -e "/type char = Libdash.Ast.char/d" ast_atd_j.mli) (run mv ast_atd_j.ml ast_json.ml) (run mv ast_atd_j.mli ast_json.mli)))) + +(rule + (alias runtest) + (deps (glob_files ../test/tests/*) (glob_files ../test/pash_tests/*) rt.sh %{bin:json_to_shell} %{bin:shell_to_json}) + (action + (setenv + JSON_TO_SHELL %{bin:json_to_shell} + (setenv + SHELL_TO_JSON %{bin:shell_to_json} + (bash "{ find ../test/tests ../test/pash_tests -type f | while read f; do ../test/round_trip.sh ./rt.sh \"$f\"; done | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c | grep ':' ; } && echo FAILED && exit 1 || exit 0"))))) From b0e1ac94355f57240eab32e49205e5ca41e856a4 Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 19 Dec 2023 09:50:00 -0500 Subject: [PATCH 4/7] send dunes --- .github/workflows/build.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 16794cf..97377ac 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -83,12 +83,13 @@ jobs: uses: avsm/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} + dune-cache: true - name: Install OCaml bindings - run: dune install + run: opam exec -- dune install - name: Test OCaml bindings - run: dune test + run: opam exec -- dune test # we don't reuse the wheels so that all of the CI runs can happen concurrently - name: Install Python directly From 3d74b5e6da6f0332020da0fa93b8bf34e635545a Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 19 Dec 2023 10:32:48 -0500 Subject: [PATCH 5/7] try building in ci --- ocaml/dune | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ocaml/dune b/ocaml/dune index 6bad39e..aac4ee1 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -53,10 +53,11 @@ (rule (alias runtest) - (deps (glob_files ../test/tests/*) (glob_files ../test/pash_tests/*) rt.sh %{bin:json_to_shell} %{bin:shell_to_json}) + (deps (glob_files ../test/tests/*) (glob_files ../test/pash_tests/*) + ../test/round_trip.sh rt.sh %{bin:json_to_shell} %{bin:shell_to_json}) (action (setenv JSON_TO_SHELL %{bin:json_to_shell} (setenv SHELL_TO_JSON %{bin:shell_to_json} - (bash "{ find ../test/tests ../test/pash_tests -type f | while read f; do ../test/round_trip.sh ./rt.sh \"$f\"; done | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c | grep ':' ; } && echo FAILED && exit 1 || exit 0"))))) + (bash "{ find ../test/tests ../test/pash_tests -type f | while read f; do ../test/round_trip.sh ./rt.sh \"$f\"; done | egrep '^[A-Z0-9_]+:' | cut -d ':' -f 1 | sort | uniq -c | grep ':' ; } && echo FAILED && exit 1 || { echo OK; exit 0; }"))))) From 7037dbd8010c3bddb9ded0b3d6482a9e6f20806b Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 19 Dec 2023 10:48:42 -0500 Subject: [PATCH 6/7] trying leaving out foreign archives --- .github/workflows/build.yml | 4 ++-- dune-project | 21 +++++++++++++++++- libdash.opam | 43 +++++++++++++++++++++++-------------- ocaml/dune | 3 +-- 4 files changed, 50 insertions(+), 21 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 97377ac..01c1b2a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -86,10 +86,10 @@ jobs: dune-cache: true - name: Install OCaml bindings - run: opam exec -- dune install + run: opam exec -- dune build -p libdash @install - name: Test OCaml bindings - run: opam exec -- dune test + run: opam exec -- dune build -p libdash @test # we don't reuse the wheels so that all of the CI runs can happen concurrently - name: Install Python directly diff --git a/dune-project b/dune-project index 12634e1..fd6c868 100644 --- a/dune-project +++ b/dune-project @@ -1,3 +1,22 @@ (lang dune 3.12) (name libdash) -(using ctypes 0.3) \ No newline at end of file +(using ctypes 0.3) + +(source (github mgree/libdash)) +(license BSD-3-Clause) +(authors "Michael Greenberg") +(maintainers "michael@greenberg.science") + +(package + (name libdash) + (synopsis "Bindings to the dash shell's parser") + (depends + ("ctypes" (>= "0.21.1")) + ("ctypes-foreign" (>= "0.21.1")) + ("atdgen" (>= "2.15.0")) + ("conf-autoconf" (>= 0.1)) + ("conf-aclocal" (>= 2)) + ("conf-automake" (>= 1)) + ("conf-libtool" (>= 1)))) + +(generate_opam_files) \ No newline at end of file diff --git a/libdash.opam b/libdash.opam index f32347f..9278923 100644 --- a/libdash.opam +++ b/libdash.opam @@ -1,23 +1,34 @@ +# This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Bindings to the dash shell's parser" -maintainer: "Michael Greenberg " -authors: "Michael Greenberg " +maintainer: ["michael@greenberg.science"] +authors: ["Michael Greenberg"] license: "BSD-3-Clause" homepage: "https://github.com/mgree/libdash" bug-reports: "https://github.com/mgree/libdash/issues" depends: [ - "ocaml" {>= "4.07"} - "ocamlfind" {>= "1.8.0"} - "ctypes" {>= "0.18.0"} - "ctypes-foreign" {>= "0.18.0"} - "atdgen" {>= "2.3.2"} - "conf-autoconf" {build} - "conf-aclocal" {build} - "conf-automake" {build} - "conf-libtool" {build} + "dune" {>= "3.12"} + "ctypes" {>= "0.21.1"} + "ctypes-foreign" {>= "0.21.1"} + "atdgen" {>= "2.15.0"} + "conf-autoconf" {>= "0.1"} + "conf-aclocal" {>= "2"} + "conf-automake" {>= "1"} + "conf-libtool" {>= "1"} + "odoc" {with-doc} ] -dev-repo: "git+https:///github.com/mgree/libdash" -url { - src: "https://github.com/mgree/libdash/archive/v0.3.tar.gz" -} - +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/mgree/libdash.git" diff --git a/ocaml/dune b/ocaml/dune index aac4ee1..0df89cd 100644 --- a/ocaml/dune +++ b/ocaml/dune @@ -3,6 +3,7 @@ (public_names shell_to_json json_to_shell) (modules shell_to_json json_to_shell ast_json) (modes (native exe)) + (foreign_archives ../dash) (libraries libdash yojson atdgen)) (library @@ -11,8 +12,6 @@ (modes native) (modules (:standard \ json_to_shell shell_to_json ast_json)) (libraries ctypes ctypes.foreign) -; (library_flags (-linkall)) - (foreign_archives ../dash) (ctypes (external_library_name dash) (build_flags_resolver (vendored (c_flags :standard) (c_library_flags :standard))) From 9e953f6d560217489cfb7c9b713cce5c5dc43d7e Mon Sep 17 00:00:00 2001 From: Michael Greenberg Date: Tue, 19 Dec 2023 10:55:15 -0500 Subject: [PATCH 7/7] use opam, not dune --- .github/workflows/build.yml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 01c1b2a..8282400 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -85,12 +85,9 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-compiler }} dune-cache: true - - name: Install OCaml bindings - run: opam exec -- dune build -p libdash @install + - name: Install and test OCaml bindings + run: opam install --with-test --working-dir . - - name: Test OCaml bindings - run: opam exec -- dune build -p libdash @test - # we don't reuse the wheels so that all of the CI runs can happen concurrently - name: Install Python directly run: sudo pip3 install .