Shells in OCaml
Intital functionality
+470
-29
+12
-6
dune-project
+12
-6
dune-project
···
5
5
(generate_opam_files true)
6
6
7
7
(source
8
-
(github username/reponame))
8
+
(uri https://tangled.org/patrick.sirref.org/merry))
9
9
10
-
(authors "Author Name <author@example.com>")
11
-
12
-
(maintainers "Maintainer Name <maintainer@example.com>")
10
+
(authors "Patrick Ferris <patrick@sirref.org>")
11
+
(maintainers "Patrick Ferris <patrick@sirref.org>")
13
12
14
13
(license LICENSE)
15
14
···
17
16
18
17
(package
19
18
(name merry)
20
-
(synopsis "A short synopsis")
21
-
(description "A longer description")
19
+
(synopsis "A shell library")
20
+
(description "A library for writing shells")
22
21
(depends ocaml)
23
22
(tags
24
23
("add topics" "to describe" your project)))
25
24
25
+
(package
26
+
(name osh)
27
+
(synopsis "A shell")
28
+
(description "osh is a shell written completely in OCaml using the merry library")
29
+
(depends
30
+
merry
31
+
eio_main))
26
32
; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html
+5
-7
merry.opam
+5
-7
merry.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
synopsis: "A short synopsis"
4
-
description: "A longer description"
5
-
maintainer: ["Maintainer Name <maintainer@example.com>"]
6
-
authors: ["Author Name <author@example.com>"]
3
+
synopsis: "A shell library"
4
+
description: "A library for writing shells"
5
+
maintainer: ["Patrick Ferris <patrick@sirref.org>"]
6
+
authors: ["Patrick Ferris <patrick@sirref.org>"]
7
7
license: "LICENSE"
8
8
tags: ["add topics" "to describe" "your" "project"]
9
-
homepage: "https://github.com/username/reponame"
10
9
doc: "https://url/to/documentation"
11
-
bug-reports: "https://github.com/username/reponame/issues"
12
10
depends: [
13
11
"dune" {>= "3.20"}
14
12
"ocaml"
···
28
26
"@doc" {with-doc}
29
27
]
30
28
]
31
-
dev-repo: "git+https://github.com/username/reponame.git"
29
+
dev-repo: "https://tangled.org/patrick.sirref.org/merry"
32
30
x-maintenance-intent: ["(latest)"]
+31
osh.opam
+31
osh.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "A shell"
4
+
description:
5
+
"osh is a shell written completely in OCaml using the merry library"
6
+
maintainer: ["Patrick Ferris <patrick@sirref.org>"]
7
+
authors: ["Patrick Ferris <patrick@sirref.org>"]
8
+
license: "LICENSE"
9
+
doc: "https://url/to/documentation"
10
+
depends: [
11
+
"dune" {>= "3.20"}
12
+
"merry"
13
+
"eio_main"
14
+
"odoc" {with-doc}
15
+
]
16
+
build: [
17
+
["dune" "subst"] {dev}
18
+
[
19
+
"dune"
20
+
"build"
21
+
"-p"
22
+
name
23
+
"-j"
24
+
jobs
25
+
"@install"
26
+
"@runtest" {with-test}
27
+
"@doc" {with-doc}
28
+
]
29
+
]
30
+
dev-repo: "https://tangled.org/patrick.sirref.org/merry"
31
+
x-maintenance-intent: ["(latest)"]
+3
-2
src/bin/dune
+3
-2
src/bin/dune
+71
-1
src/bin/main.ml
+71
-1
src/bin/main.ml
···
1
-
let () = print_endline "Hello, World!"
1
+
(* A shell... one day *)
2
+
3
+
module Shell = Merry.Eval.Make (Merry_posix.State) (Merry_posix.Exec)
4
+
5
+
let sh ~command ~dump ~file env =
6
+
let ast =
7
+
match (file, command) with
8
+
| None, None ->
9
+
Fmt.pr "Expected either a file path or a command to run...";
10
+
exit 1
11
+
| Some file, None -> Merry.of_file Eio.Path.(env#fs / file)
12
+
| _, Some c -> Merry.of_string c
13
+
in
14
+
if dump then Merry.Ast.Dump.pp Fmt.stdout ast
15
+
else
16
+
let _ctx, _ast =
17
+
let executor =
18
+
Merry_posix.Exec.
19
+
{
20
+
mgr =
21
+
(env#process_mgr
22
+
:> [ `Generic ] Eio.Process.mgr_ty Eio.Process.mgr);
23
+
}
24
+
in
25
+
Shell.run
26
+
Shell.
27
+
{
28
+
state = Merry_posix.State.make ~home:(Sys.getenv "HOME") ();
29
+
executor;
30
+
}
31
+
ast
32
+
in
33
+
()
34
+
35
+
open Cmdliner
36
+
open Cmdliner.Term.Syntax
37
+
38
+
let command =
39
+
let doc = "command to run" in
40
+
Arg.(value & opt (some string) None & info [ "c"; "C" ] ~doc)
41
+
42
+
let file =
43
+
let doc = "The shell script to execute" in
44
+
Arg.(value & pos 0 (some string) None & info [] ~doc)
45
+
46
+
let dump =
47
+
let doc =
48
+
"dump an internal AST representation to JSON (does nothing in interactive \
49
+
mode)."
50
+
in
51
+
Arg.(value & flag & info [ "d"; "D"; "dump" ] ~doc)
52
+
53
+
let cmd env =
54
+
let doc = "A shell." in
55
+
let man =
56
+
[
57
+
`S Manpage.s_description;
58
+
`P
59
+
"$(cmd) is first a foremost a shell written completely in the OCaml \
60
+
programming language";
61
+
`S Manpage.s_bugs;
62
+
`P "Report bugs at https://tangled.org/patrick.sirref.org/merry/issues.";
63
+
]
64
+
in
65
+
Cmd.make (Cmd.info "osh" ~version:"v0.0.1" ~doc ~man)
66
+
@@
67
+
let+ command = command and+ dump = dump and+ file = file in
68
+
sh ~command ~dump ~file env
69
+
70
+
let main () = Eio_posix.run @@ fun env -> Cmd.eval (cmd env)
71
+
let () = if !Sys.interactive then () else exit (main ())
+8
-10
src/lib/ast.ml
+8
-10
src/lib/ast.ml
···
49
49
let a = and_or a.value in
50
50
Nslist.singleton Nosep a
51
51
52
-
and and_or : CST.and_or -> pipeline and_or_list =
53
-
fun x ->
52
+
and and_or : ?sep:and_or -> CST.and_or -> pipeline and_or_list =
53
+
fun ?(sep = Noand_or) x ->
54
54
match x with
55
55
| AndOr_Pipeline a ->
56
56
let a = pipeline a.value in
57
-
Nslist.singleton Noand_or a
57
+
Nslist.singleton sep a
58
58
| AndOr_AndOr_AndIf_LineBreak_Pipeline (a, _, c) ->
59
-
let rest = and_or a.value in
59
+
let rest = and_or ~sep:And a.value in
60
60
let c = pipeline c.value in
61
-
Nslist.cons And c rest
61
+
Nslist.append rest (Nlist.Singleton (c, sep))
62
62
| AndOr_AndOr_OrIf_LineBreak_Pipeline (a, _, c) ->
63
-
let rest = and_or a.value in
63
+
let rest = and_or ~sep:Or a.value in
64
64
let c = pipeline c.value in
65
-
Nslist.cons Or c rest
65
+
Nslist.append rest (Nlist.Singleton (c, sep))
66
66
67
67
and pipeline : CST.pipeline -> pipeline =
68
68
fun x ->
···
514
514
| SequentialSep_Semicolon_LineBreak _ -> Semicolon
515
515
| SequentialSep_NewLineList _ -> Newline
516
516
517
-
and word : CST.word -> word =
518
-
fun x -> match x with Word (a, b) -> (a, word_cst b)
519
-
517
+
and word : CST.word -> word = fun x -> match x with Word (_, b) -> word_cst b
520
518
and word_cst : CST.word_cst -> word_cst = fun v -> List.map word_component v
521
519
522
520
and word_component : CST.word_component -> word_component =
+4
src/lib/ast.mli
+4
src/lib/ast.mli
+2
-1
src/lib/dune
+2
-1
src/lib/dune
+205
src/lib/eval.ml
+205
src/lib/eval.ml
···
1
+
(*-----------------------------------------------------------------
2
+
Copyright (c) 2025 The merry programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
-----------------------------------------------------------------*)
5
+
open Import
6
+
7
+
(** An evaluator over the AST *)
8
+
module Make (S : Types.State) (E : Types.Exec) = struct
9
+
(* What follows uses the POSIX definition of what a shell does ($ 2.1).
10
+
11
+
It starts from point (4), completing a series of expansions on the AST,
12
+
then redirection is setup, and finally functions/built-ins/commands are
13
+
executed. *)
14
+
15
+
let word_component_to_string : Ast.word_component -> string = function
16
+
| WordName s -> s
17
+
| WordLiteral s -> s
18
+
| v ->
19
+
Fmt.failwith "Conversion of %a" Yojson.Safe.pp
20
+
(Ast.word_component_to_yojson v)
21
+
22
+
class default_map =
23
+
object (_)
24
+
inherit Ast.map
25
+
method string (s : string) = s
26
+
method int (i : int) = i
27
+
method char c = c
28
+
method option f v = Option.map f v
29
+
method nlist__t f t = Nlist.map f t
30
+
method nslist__t f t = Nslist.map f t
31
+
method list f t = List.map f t
32
+
end
33
+
34
+
type ctx = { state : S.t; executor : E.t }
35
+
36
+
class default_ctx_fold =
37
+
object (_)
38
+
inherit [ctx] Ast.fold
39
+
method string _ ctx = ctx
40
+
method char _ ctx = ctx
41
+
method option f v ctx = Option.fold ~none:ctx ~some:(fun i -> f i ctx) v
42
+
method nlist__t f v ctx = Nlist.fold_left (fun acc i -> f i acc) ctx v
43
+
44
+
method nslist__t f g v ctx =
45
+
Nslist.fold_left (fun acc a b -> f a acc |> g b) ctx v
46
+
47
+
method list f v ctx = List.fold_left (fun acc i -> f i acc) ctx v
48
+
end
49
+
50
+
let map_word_components f ast =
51
+
let o =
52
+
object (_)
53
+
inherit default_map
54
+
method! word_component cst = f cst
55
+
end
56
+
in
57
+
o#complete_command ast
58
+
59
+
let map_words f ast =
60
+
let o =
61
+
object (_)
62
+
inherit default_map
63
+
method! word cst = f cst
64
+
end
65
+
in
66
+
o#complete_command ast
67
+
68
+
let tilde_expansion ctx ast =
69
+
( ctx,
70
+
map_word_components
71
+
(function
72
+
| Ast.WordTildePrefix _ -> Ast.WordName (S.expand ctx.state `Tilde)
73
+
| s -> s)
74
+
ast )
75
+
76
+
let parameter_expansion ctx ast =
77
+
( ctx,
78
+
map_words
79
+
(List.concat_map (function
80
+
| Ast.WordVariable v -> (
81
+
match v with
82
+
| Ast.VariableAtom (s, NoAttribute) -> (
83
+
match S.lookup ctx.state ~param:s with
84
+
| None -> [ Ast.WordName "" ]
85
+
| Some cst -> cst)
86
+
| _ -> Fmt.failwith "No support for variable attributes yet!")
87
+
| s -> [ s ]))
88
+
ast )
89
+
90
+
let assignments ctx ast =
91
+
let o =
92
+
object
93
+
inherit default_ctx_fold
94
+
95
+
method! simple_command ast ctx =
96
+
match ast with
97
+
| Ast.Prefixed (cmd_prefix, _, _) ->
98
+
List.fold_left
99
+
(fun ctx -> function
100
+
| Ast.Prefix_assignment (Name param, v) ->
101
+
let state = S.update ctx.state ~param v in
102
+
{ ctx with state }
103
+
| _ -> ctx)
104
+
ctx cmd_prefix
105
+
| _ -> ctx
106
+
end
107
+
in
108
+
(o#complete_command ast ctx, ast)
109
+
110
+
let exec ctx (ast : Ast.complete_command) =
111
+
let command, _ = ast in
112
+
let execute_command p =
113
+
let h = List.hd p in
114
+
match h with
115
+
| Ast.SimpleCommand (Prefixed _) -> None
116
+
| Ast.SimpleCommand (Named (executable, None)) ->
117
+
E.exec ctx.executor (List.map word_component_to_string executable)
118
+
|> Option.some
119
+
| Ast.SimpleCommand (Named (executable, Some suffix)) ->
120
+
let args =
121
+
List.filter_map
122
+
(function
123
+
| Ast.Suffix_word w ->
124
+
Some (List.map word_component_to_string w)
125
+
| Ast.Suffix_redirect _ -> None)
126
+
suffix
127
+
in
128
+
E.exec ctx.executor
129
+
(List.map word_component_to_string executable @ List.concat args)
130
+
|> Option.some
131
+
| v ->
132
+
Fmt.epr "TODO: %a" Yojson.Safe.pp (Ast.command_to_yojson v);
133
+
failwith "Err"
134
+
in
135
+
let pipeline = function
136
+
| Ast.Pipeline p -> (Fun.id, p)
137
+
| Ast.Pipeline_Bang p ->
138
+
(Option.map (fun i -> if Int.equal i 0 then -1 else 0), p)
139
+
in
140
+
let loop : Ast.clist -> int option = function
141
+
| Nlist.Singleton (c, _) ->
142
+
let rec fold :
143
+
Ast.and_or * int option ->
144
+
Ast.pipeline Ast.and_or_list ->
145
+
int option =
146
+
fun (sep, exit_so_far) pipe ->
147
+
match (sep, pipe) with
148
+
| And, Nlist.Singleton (p, _) -> (
149
+
match exit_so_far with
150
+
| Some 0 ->
151
+
let f, p = pipeline p in
152
+
f @@ execute_command p
153
+
| v -> v)
154
+
| Or, Nlist.Singleton (p, _) -> (
155
+
match exit_so_far with
156
+
| Some 0 -> Some 0
157
+
| _ ->
158
+
let f, p = pipeline p in
159
+
f @@ execute_command p)
160
+
| Noand_or, Nlist.Cons ((p, next_sep), rest) ->
161
+
let f, p = pipeline p in
162
+
fold (next_sep, f (execute_command p)) rest
163
+
| And, Nlist.Cons ((p, next_sep), rest) -> (
164
+
match exit_so_far with
165
+
| Some 0 ->
166
+
let f, p = pipeline p in
167
+
fold (next_sep, f (execute_command p)) rest
168
+
| (None | Some _) as v -> v)
169
+
| Or, Nlist.Cons ((p, next_sep), rest) -> (
170
+
match exit_so_far with
171
+
| Some 0 -> fold (next_sep, exit_so_far) rest
172
+
| None | Some _ ->
173
+
let f, p = pipeline p in
174
+
fold (next_sep, f (execute_command p)) rest)
175
+
| _ -> assert false
176
+
in
177
+
fold (Noand_or, None) c
178
+
| _ -> Fmt.failwith "TODO!!!"
179
+
in
180
+
(loop command, ctx, ast)
181
+
182
+
let apply_pair (a, b) f = f a b
183
+
let ( ||> ) = apply_pair
184
+
185
+
let rec expand ctx (ast : Ast.complete_command) : ctx * Ast.complete_command =
186
+
tilde_expansion ctx ast ||> parameter_expansion
187
+
188
+
and redirect ctx (ast : Ast.complete_command) : ctx * Ast.complete_command =
189
+
(ctx, ast)
190
+
191
+
and execute ctx ast = assignments ctx ast ||> exec
192
+
193
+
and run ctx ast =
194
+
let ctx, cs =
195
+
List.fold_left
196
+
(fun (ctx, cs) command ->
197
+
let exit_code, ctx, ast =
198
+
expand ctx command ||> redirect ||> execute
199
+
in
200
+
Option.iter (function 0 -> () | n -> exit n) exit_code;
201
+
(ctx, ast :: cs))
202
+
(ctx, []) ast
203
+
in
204
+
(ctx, List.rev cs)
205
+
end
+10
src/lib/import.ml
+10
src/lib/import.ml
···
24
24
in
25
25
loop v1
26
26
27
+
let fold_left f acc v = to_list v |> List.fold_left f acc
27
28
let ( @ ) = append
28
29
29
30
let to_yojson f v : Yojson.Safe.t =
30
31
let lst = to_list v in
31
32
`List (List.map (fun i -> f i) lst)
33
+
34
+
let pp elt ppf v = to_list v |> Fmt.(list elt) ppf
32
35
end
33
36
34
37
(* Nonempty, separated lists *)
···
37
40
38
41
let singleton sep i = Nlist.Singleton (i, sep)
39
42
let cons sep i v = Nlist.cons (i, sep) v
43
+
let append a b = Nlist.append a b
44
+
45
+
let map f g (v : ('a, 'b) t) : ('c, 'd) t =
46
+
Nlist.map (fun (a, b) -> (f a, g b)) v
47
+
48
+
let fold_left f acc (vs : ('a, 'b) t) =
49
+
Nlist.fold_left (fun acc (a, b) -> f acc a b) acc vs
40
50
end
+19
src/lib/merry.ml
+19
src/lib/merry.ml
···
1
1
module Ast = Ast
2
+
module Types = Types
3
+
module Eval = Eval
4
+
5
+
let of_string s = Morbig.parse_string "-" s |> Ast.of_program
2
6
3
7
let of_file path =
4
8
let fname = Eio.Path.native_exn path in
5
9
Eio.Path.load path |> Morbig.parse_string fname |> Ast.of_program
10
+
11
+
module Variable = struct
12
+
type t
13
+
(** A name for a {! Parameter.t} *)
14
+
end
15
+
16
+
module Function = struct
17
+
type t
18
+
(** Function definitions *)
19
+
end
20
+
21
+
module Trap = struct
22
+
type t
23
+
(** Traps *)
24
+
end
+21
src/lib/merry.mli
+21
src/lib/merry.mli
···
1
1
module Ast = Ast
2
+
module Types = Types
3
+
4
+
val of_string : string -> Ast.t
5
+
(** Construct an AST from a string *)
2
6
3
7
val of_file : _ Eio.Path.t -> Ast.t
4
8
(** Construct an AST from a file path. *)
9
+
10
+
module Eval = Eval
11
+
12
+
module Variable : sig
13
+
type t
14
+
(** A name for a {! Parameter.t} *)
15
+
end
16
+
17
+
module Function : sig
18
+
type t
19
+
(** Function definitions *)
20
+
end
21
+
22
+
module Trap : sig
23
+
type t
24
+
(** Traps *)
25
+
end
+4
src/lib/posix/dune
+4
src/lib/posix/dune
+14
src/lib/posix/merry_posix.ml
+14
src/lib/posix/merry_posix.ml
···
1
+
(* A set of modules for writing shell's that adhere, as past they can,
2
+
to the POSIX standard: https://pubs.opengroup.org/onlinepubs/9699919799/ *)
3
+
module State = State
4
+
5
+
module Exec = struct
6
+
type t = { mgr : [ `Generic ] Eio.Process.mgr_ty Eio.Process.mgr }
7
+
type fork_action = unit
8
+
9
+
let exec ?fork_actions:_ t s =
10
+
Eio.Switch.run @@ fun sw ->
11
+
Eio.Process.spawn ~sw t.mgr s |> Eio.Process.await |> function
12
+
| `Exited n -> n
13
+
| `Signaled n -> n
14
+
end
+22
src/lib/posix/state.ml
+22
src/lib/posix/state.ml
···
1
+
module Variables = Map.Make (String)
2
+
3
+
type t = {
4
+
cwd : string;
5
+
functions : Merry.Function.t list;
6
+
root : int;
7
+
outermost : bool;
8
+
home : string;
9
+
variables : Merry.Ast.word_cst Variables.t;
10
+
}
11
+
12
+
let make ?(cwd = ".") ?(functions = []) ?(root = 0) ?(outermost = true)
13
+
?(home = "/root") ?(variables = Variables.empty) () =
14
+
{ cwd; functions; root; outermost; home; variables }
15
+
16
+
let default = make ()
17
+
let expand t = function `Tilde -> t.home
18
+
let lookup t ~param = Variables.find_opt param t.variables
19
+
20
+
let update t ~param v =
21
+
let variables' = Variables.add param v t.variables in
22
+
{ t with variables = variables' }
+4
-2
src/lib/sast.ml
+4
-2
src/lib/sast.ml
···
13
13
on being executable rather than capturing notions like position, linebreaks etc. *)
14
14
open Import
15
15
16
-
type complete_commands = complete_command list [@@deriving to_yojson]
16
+
type complete_commands = complete_command list
17
+
[@@deriving to_yojson, traverse_map, traverse_fold]
18
+
17
19
and complete_command = clist * separator option
18
20
and and_or = And | Or | Noand_or
19
21
and 'v separator_list = ('v, separator) Nslist.t
···
112
114
and here_end = HereEnd_Word of word
113
115
and separator = Uppersand | Semicolon | Nosep
114
116
and sequential_sep = Semicolon | Newline
115
-
and word = string * word_cst
117
+
and word = word_cst
116
118
and word_cst = word_component list
117
119
118
120
and word_component =
+34
src/lib/types.ml
+34
src/lib/types.ml
···
1
+
module Parameter = struct
2
+
type t =
3
+
| String of string
4
+
| Number of string
5
+
| Special of string
6
+
| Null (** Possible shell parameters *)
7
+
end
8
+
9
+
module type State = sig
10
+
type t
11
+
(** State for the shell and operating system that is carried from one
12
+
evaluation step to the next. *)
13
+
14
+
val expand : t -> [ `Tilde ] -> string
15
+
(** Expansions *)
16
+
17
+
val lookup : t -> param:string -> Ast.word_cst option
18
+
(** Parameter lookup. [None] means [unset]. *)
19
+
20
+
val update : t -> param:string -> Ast.word_cst -> t
21
+
(** Update the state with a new parameter mapping *)
22
+
end
23
+
24
+
module type Exec = sig
25
+
type t
26
+
(** An executor for commands *)
27
+
28
+
type fork_action
29
+
(** A fork action is a piece of C-code to run inbetween the fork and the exec
30
+
*)
31
+
32
+
val exec : ?fork_actions:fork_action list -> t -> string list -> int
33
+
(** Run a command in a child process *)
34
+
end
+1
test.sh
+1
test.sh
···
1
+
ls -jshjk || echo hello && ls =whkjed