Shells in OCaml
Variable attributes
All of the attributes (remove smallest prefix, parameter length etc.).
+428
-38
+1
src/lib/ast.ml
+1
src/lib/ast.ml
+148
-37
src/lib/eval.ml
+148
-37
src/lib/eval.ml
···
89
89
Ast.WordName (S.expand ctx.state `Tilde) :: tilde_expansion ctx rest
90
90
| v :: rest -> v :: tilde_expansion ctx rest
91
91
92
-
let parameter_expansion' ctx =
93
-
let rec expand = function
94
-
| [] -> []
95
-
| Ast.WordVariable v :: rest -> (
96
-
match v with
97
-
| Ast.VariableAtom ("!", NoAttribute) ->
98
-
Ast.WordName ctx.last_background_process :: expand rest
99
-
| Ast.VariableAtom (n, NoAttribute)
100
-
when Option.is_some (int_of_string_opt n) -> (
101
-
let n = int_of_string n in
102
-
match Array.get ctx.argv n with
103
-
| v -> Ast.WordName v :: expand rest
104
-
| exception Invalid_argument _ -> Ast.WordName "" :: expand rest)
105
-
| Ast.VariableAtom (s, NoAttribute) -> (
106
-
match S.lookup ctx.state ~param:s with
107
-
| None -> Ast.WordName "" :: expand rest
108
-
| Some cst -> cst @ expand rest)
109
-
| _ -> Fmt.failwith "No support for variable attributes yet!")
110
-
| Ast.WordDoubleQuoted cst :: rest ->
111
-
Ast.WordDoubleQuoted (expand cst) :: expand rest
112
-
| Ast.WordSingleQuoted cst :: rest ->
113
-
Ast.WordSingleQuoted (expand cst) :: expand rest
114
-
| v :: rest -> v :: expand rest
115
-
in
116
-
(ctx, expand)
117
-
118
92
let stdout_for_pipeline ~sw ctx = function
119
93
| [] -> (None, `Global ctx.stdout)
120
94
| _ ->
···
257
231
| None -> (ctx, [])
258
232
| Some suffix -> expand_redirects (ctx, []) suffix
259
233
in
260
-
let args = args ctx suffix in
234
+
let ctx, args = args ctx suffix in
261
235
let args_as_strings = List.map Ast.word_components_to_string args in
262
236
let some_read, some_write =
263
237
stdout_for_pipeline ~sw:pipeline_switch ctx rest
···
365
339
Exit.zero { ctx with background_jobs = job :: ctx.background_jobs }
366
340
end
367
341
342
+
and parameter_expansion' ctx ast =
343
+
let get_prefix ~pattern ~kind param =
344
+
let _, prefix =
345
+
String.fold_left
346
+
(fun (so_far, acc) c ->
347
+
match acc with
348
+
| Some s when kind = `Smallest -> (so_far, Some s)
349
+
| _ -> (
350
+
let s = so_far ^ String.make 1 c in
351
+
match Glob.test ~pattern [ s ] with
352
+
| [ s ] -> (s, Some s)
353
+
| _ -> (s, acc)))
354
+
("", None) param
355
+
in
356
+
prefix
357
+
in
358
+
let get_suffix ~pattern ~kind param =
359
+
let _, prefix =
360
+
String.fold_left
361
+
(fun (so_far, acc) c ->
362
+
match acc with
363
+
| Some s when kind = `Smallest -> (so_far, Some s)
364
+
| _ -> (
365
+
let s = String.make 1 c ^ so_far in
366
+
match Glob.test ~pattern [ s ] with
367
+
| [ s ] -> (s, Some s)
368
+
| _ -> (s, acc)))
369
+
("", None)
370
+
(String.fold_left (fun acc c -> String.make 1 c ^ acc) "" param)
371
+
in
372
+
prefix
373
+
in
374
+
let rec expand acc ctx = function
375
+
| [] -> (ctx, List.rev acc |> List.concat)
376
+
| Ast.WordVariable v :: rest -> (
377
+
match v with
378
+
| Ast.VariableAtom ("!", NoAttribute) ->
379
+
expand
380
+
([ Ast.WordName ctx.last_background_process ] :: acc)
381
+
ctx rest
382
+
| Ast.VariableAtom (n, NoAttribute)
383
+
when Option.is_some (int_of_string_opt n) -> (
384
+
let n = int_of_string n in
385
+
match Array.get ctx.argv n with
386
+
| v -> expand ([ Ast.WordName v ] :: acc) ctx rest
387
+
| exception Invalid_argument _ ->
388
+
expand ([ Ast.WordName "" ] :: acc) ctx rest)
389
+
| Ast.VariableAtom (s, NoAttribute) -> (
390
+
match S.lookup ctx.state ~param:s with
391
+
| None -> expand ([ Ast.WordName "" ] :: acc) ctx rest
392
+
| Some cst -> expand (cst :: acc) ctx rest)
393
+
| Ast.VariableAtom (s, ParameterLength) -> (
394
+
match S.lookup ctx.state ~param:s with
395
+
| None -> expand ([ Ast.WordLiteral "0" ] :: acc) ctx rest
396
+
| Some cst ->
397
+
expand
398
+
([
399
+
Ast.WordLiteral
400
+
(string_of_int
401
+
(String.length (Ast.word_components_to_string cst)));
402
+
]
403
+
:: acc)
404
+
ctx rest)
405
+
| Ast.VariableAtom (s, UseDefaultValues (_, cst)) -> (
406
+
match S.lookup ctx.state ~param:s with
407
+
| None -> expand (cst :: acc) ctx rest
408
+
| Some cst -> expand (cst :: acc) ctx rest)
409
+
| Ast.VariableAtom
410
+
( s,
411
+
(( RemoveSmallestPrefixPattern cst
412
+
| RemoveLargestPrefixPattern cst ) as v) ) -> (
413
+
let ctx, spp = expand_cst ctx cst in
414
+
let pattern = Ast.word_components_to_string spp in
415
+
match S.lookup ctx.state ~param:s with
416
+
| None -> expand (cst :: acc) ctx rest
417
+
| Some cst -> (
418
+
let kind =
419
+
match v with
420
+
| RemoveSmallestPrefixPattern _ -> `Smallest
421
+
| RemoveLargestPrefixPattern _ -> `Largest
422
+
| _ -> assert false
423
+
in
424
+
let param = Ast.word_components_to_string cst in
425
+
let prefix = get_prefix ~pattern ~kind param in
426
+
match prefix with
427
+
| None -> expand ([ Ast.WordName param ] :: acc) ctx rest
428
+
| Some s -> (
429
+
match String.cut_prefix ~prefix:s param with
430
+
| Some s -> expand ([ Ast.WordName s ] :: acc) ctx rest
431
+
| None -> expand ([ Ast.WordName param ] :: acc) ctx rest)
432
+
))
433
+
| Ast.VariableAtom
434
+
( s,
435
+
(( RemoveSmallestSuffixPattern cst
436
+
| RemoveLargestSuffixPattern cst ) as v) ) -> (
437
+
let ctx, spp = expand_cst ctx cst in
438
+
let pattern = Ast.word_components_to_string spp in
439
+
match S.lookup ctx.state ~param:s with
440
+
| None -> expand (cst :: acc) ctx rest
441
+
| Some cst -> (
442
+
let kind =
443
+
match v with
444
+
| RemoveSmallestSuffixPattern _ -> `Smallest
445
+
| RemoveLargestSuffixPattern _ -> `Largest
446
+
| _ -> assert false
447
+
in
448
+
let param = Ast.word_components_to_string cst in
449
+
let suffix = get_suffix ~pattern ~kind param in
450
+
match suffix with
451
+
| None -> expand ([ Ast.WordName param ] :: acc) ctx rest
452
+
| Some s -> (
453
+
match String.cut_suffix ~suffix:s param with
454
+
| Some s -> expand ([ Ast.WordName s ] :: acc) ctx rest
455
+
| None -> expand ([ Ast.WordName param ] :: acc) ctx rest)
456
+
))
457
+
| Ast.VariableAtom (s, UseAlternativeValue (_, alt)) -> (
458
+
match S.lookup ctx.state ~param:s with
459
+
| Some cst -> expand (cst :: acc) ctx rest
460
+
| None -> expand (alt :: acc) ctx rest)
461
+
| Ast.VariableAtom (s, AssignDefaultValues (_, value)) -> (
462
+
match S.lookup ctx.state ~param:s with
463
+
| Some cst -> expand (cst :: acc) ctx rest
464
+
| None ->
465
+
let state = S.update ctx.state ~param:s value in
466
+
let new_ctx = { ctx with state } in
467
+
expand (value :: acc) new_ctx rest)
468
+
| Ast.VariableAtom (_, IndicateErrorifNullorUnset (_, _)) ->
469
+
Fmt.failwith "TODO: Indicate Error")
470
+
| Ast.WordDoubleQuoted cst :: rest ->
471
+
let new_ctx, cst_acc = expand [] ctx cst in
472
+
expand ([ Ast.WordDoubleQuoted cst_acc ] :: acc) new_ctx rest
473
+
| Ast.WordSingleQuoted cst :: rest ->
474
+
let new_ctx, cst_acc = expand [] ctx cst in
475
+
expand ([ Ast.WordSingleQuoted cst_acc ] :: acc) new_ctx rest
476
+
| v :: rest -> expand ([ v ] :: acc) ctx rest
477
+
in
478
+
expand [] ctx ast
479
+
368
480
and handle_export ctx (assignments : Ast.word_cst list) =
369
481
let rec loop acc_ctx = function
370
482
| [] -> Exit.zero acc_ctx
···
383
495
384
496
and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst =
385
497
let cst = tilde_expansion ctx cst in
386
-
let _, o = parameter_expansion' ctx in
387
-
(ctx, o cst)
498
+
parameter_expansion' ctx cst
388
499
389
500
and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list)
390
501
(c : Ast.cmd_suffix_item list) =
···
546
657
and glob_expand ctx wc =
547
658
let wc = handle_word_cst_subshell ctx wc in
548
659
if Ast.has_glob wc then
549
-
Ast.word_components_to_string wc
550
-
|> Globlon.glob |> Array.to_list
660
+
Ast.word_components_to_string wc |> fun pattern ->
661
+
Glob.glob_dir ~pattern (cwd_of_ctx ctx)
551
662
|> List.map (fun w -> [ Ast.WordName w ])
552
663
else [ wc ]
553
664
···
573
684
| _ -> ctx)
574
685
ctx
575
686
576
-
and args ctx swc : Ast.word_cst list =
577
-
List.concat_map
578
-
(function
579
-
| Ast.Suffix_redirect _ -> []
687
+
and args ctx swc : ctx * Ast.word_cst list =
688
+
List.fold_left
689
+
(fun (ctx, acc) -> function
690
+
| Ast.Suffix_redirect _ -> (ctx, acc)
580
691
| Suffix_word wc ->
581
692
let ctx, cst = expand_cst ctx wc in
582
-
word_glob_expand ctx cst)
583
-
swc
693
+
(ctx, acc @ word_glob_expand ctx cst))
694
+
(ctx, []) swc
584
695
585
696
and handle_built_in (ctx : ctx) = function
586
697
| Built_ins.Cd { path } ->
+6
src/lib/glob/dune
+6
src/lib/glob/dune
+47
src/lib/glob/glob.ml
+47
src/lib/glob/glob.ml
···
1
+
(* From dune-glob library
2
+
3
+
The MIT License
4
+
5
+
Copyright (c) 2016 Jane Street Group, LLC <opensource@janestreet.com>
6
+
7
+
Permission is hereby granted, free of charge, to any person obtaining a copy
8
+
of this software and associated documentation files (the "Software"), to deal
9
+
in the Software without restriction, including without limitation the rights
10
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
11
+
copies of the Software, and to permit persons to whom the Software is
12
+
furnished to do so, subject to the following conditions:
13
+
14
+
The above copyright notice and this permission notice shall be included in all
15
+
copies or substantial portions of the Software.
16
+
17
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
18
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
19
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
20
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
21
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
22
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
23
+
SOFTWARE. *)
24
+
25
+
type t = Re of { re : Re.re; repr : string } | Literal of string
26
+
27
+
let test t s =
28
+
match t with
29
+
| Literal t -> String.equal t s
30
+
| Re { re; repr = _ } -> Re.execp re s
31
+
32
+
let empty = Re { re = Re.compile Re.empty; repr = "\000" }
33
+
let universal = Re { re = Re.compile (Re.rep Re.any); repr = "**" }
34
+
35
+
let of_string_result repr =
36
+
Lexer.parse_string repr
37
+
|> Result.map (function
38
+
| Lexer.Literal s -> Literal s
39
+
| Re re -> Re { re = Re.compile re; repr })
40
+
41
+
let of_string repr =
42
+
match of_string_result repr with
43
+
| Error (_, msg) -> invalid_arg (Printf.sprintf "invalid glob: :%s" msg)
44
+
| Ok t -> t
45
+
46
+
let to_string t = match t with Re { repr; re = _ } -> repr | Literal s -> s
47
+
let hash t = String.hash (to_string t)
+21
src/lib/glob/glob.mli
+21
src/lib/glob/glob.mli
···
1
+
(** Simple glob support library. *)
2
+
3
+
type t
4
+
5
+
val empty : t
6
+
(** A glob that matches nothing *)
7
+
8
+
val universal : t
9
+
(** A glob that matches anything (including the strings starting with a ".") *)
10
+
11
+
val test : t -> string -> bool
12
+
(** Tests if string matches the glob. *)
13
+
14
+
val to_string : t -> string
15
+
(** Returns textual representation of a glob. *)
16
+
17
+
val of_string : string -> t
18
+
(** Converts string to glob. Throws [Invalid_argument] exception if string is
19
+
not a valid glob. *)
20
+
21
+
val hash : t -> int
+91
src/lib/glob/lexer.mll
+91
src/lib/glob/lexer.mll
···
1
+
{
2
+
open Re
3
+
4
+
let string_of_list chars =
5
+
let s = Bytes.make (List.length chars) '0' in
6
+
List.iteri (fun i c -> Bytes.set s i c) chars;
7
+
Bytes.to_string s
8
+
9
+
type t =
10
+
| Literal of string
11
+
| Re of Re.t
12
+
13
+
let no_slash = diff any (char '/')
14
+
let no_slash_no_dot = diff any (set "./")
15
+
16
+
type stack =
17
+
| Bottom
18
+
| Lbrace of stack
19
+
| Char of char * stack
20
+
| Re of Re.t * stack
21
+
| Comma of stack
22
+
23
+
let make_group st =
24
+
let rec loop current_re full_res st =
25
+
match st with
26
+
| Bottom -> failwith "'}' without opening '{'"
27
+
| Re (re, st) -> loop (re :: current_re) full_res st
28
+
| Char (c, st) -> loop (char c :: current_re) full_res st
29
+
| Comma st -> loop [] (seq current_re :: full_res) st
30
+
| Lbrace st -> Re (alt (seq current_re :: full_res), st)
31
+
in
32
+
loop [] [] st
33
+
34
+
let finalize st =
35
+
let rec loop acc st =
36
+
match st with
37
+
| Bottom -> seq (start :: acc)
38
+
| Re (re, st) -> loop (re :: acc) st
39
+
| Char (c, st) -> loop (char c :: acc) st
40
+
| Comma st -> loop (char ',' :: acc) st
41
+
| Lbrace _ -> failwith "unclosed '{'"
42
+
in
43
+
let rec try_str (acc : char list) st =
44
+
match st with
45
+
| Bottom -> Literal (string_of_list acc)
46
+
| Comma st -> try_str (',' :: acc) st
47
+
| Char (c, st) -> try_str (c :: acc) st
48
+
| st ->
49
+
let re =
50
+
let re = [stop] in
51
+
match acc with
52
+
| [] -> re
53
+
| _ :: _ -> str (string_of_list acc) :: re
54
+
in
55
+
Re (loop re st)
56
+
in
57
+
try_str [] st
58
+
}
59
+
60
+
rule initial = parse
61
+
(* | "**" { glob (Re (rep any, Bottom)) lexbuf } *)
62
+
| "*" { glob (Re (rep any, Bottom)) lexbuf }
63
+
| "" { glob Bottom lexbuf }
64
+
65
+
and glob st = parse
66
+
| eof
67
+
| '\\' eof { finalize st }
68
+
| '\\' (_ as c) { glob (Char (c , st)) lexbuf }
69
+
| "**" { glob (Re (seq [no_slash_no_dot; rep no_slash] , st)) lexbuf }
70
+
| '*' { glob (Re (rep no_slash , st)) lexbuf }
71
+
| '?' { glob (Re (no_slash , st)) lexbuf }
72
+
| '{' { glob (Lbrace st ) lexbuf }
73
+
| ',' { glob (Comma st ) lexbuf }
74
+
| '}' { glob (make_group st) lexbuf }
75
+
| '[' { char_set st lexbuf }
76
+
| ']' { failwith "']' without opening '['" }
77
+
| _ as c { glob (Char (c , st)) lexbuf }
78
+
79
+
and char_set st = parse
80
+
| '!' ([^ ']']* as s) "]" { glob (Re (diff any (set s) , st)) lexbuf }
81
+
| ([^ ']']* as s) "]" { glob (Re (set s , st)) lexbuf }
82
+
| "" { failwith "unclosed character set" }
83
+
84
+
{
85
+
let parse_string s =
86
+
let lb = Lexing.from_string s in
87
+
match initial lb with
88
+
| re -> Result.Ok re
89
+
| exception Failure msg ->
90
+
Error (Lexing.lexeme_start lb, msg)
91
+
}
+19
src/lib/import.ml
+19
src/lib/import.ml
···
59
59
end
60
60
61
61
let yojson_pp = Yojson.Safe.pretty_print ~std:true
62
+
63
+
module String = struct
64
+
include String
65
+
66
+
let cut_prefix ~prefix s =
67
+
match Astring.String.cut ~sep:prefix s with
68
+
| Some ("", rest) -> Some rest
69
+
| _ -> None
70
+
71
+
let cut_suffix ~suffix s =
72
+
match Astring.String.cut ~sep:suffix s with
73
+
| Some (start, "") -> Some start
74
+
| _ -> None
75
+
end
76
+
77
+
module Glob = struct
78
+
let test ~pattern s = List.filter Glob.(test (of_string pattern)) s
79
+
let glob_dir ~pattern dir = test ~pattern (Eio.Path.read_dir dir)
80
+
end
+94
test/attr.t
+94
test/attr.t
···
1
+
Attributes on expansions and params.
2
+
3
+
Using default values:
4
+
5
+
$ sh -c "echo \${FOOBAR-hello}"
6
+
hello
7
+
$ msh -c "echo \${FOOBAR-hello}"
8
+
hello
9
+
10
+
Smallest prefix pattern:
11
+
12
+
$ cat > test.sh << EOF
13
+
> x="foobar"
14
+
> echo "\${x#foo}"
15
+
> echo "\${x#f*}"
16
+
> echo "\${x#bar}"
17
+
> EOF
18
+
19
+
$ sh test.sh
20
+
bar
21
+
oobar
22
+
foobar
23
+
$ msh test.sh
24
+
bar
25
+
oobar
26
+
foobar
27
+
28
+
Largest Prefix Pattern:
29
+
30
+
$ cat > test.sh << EOF
31
+
> x=/path/to/my/script.sh
32
+
> echo "\${x##*/}"
33
+
> EOF
34
+
35
+
$ sh test.sh
36
+
script.sh
37
+
$ msh test.sh
38
+
script.sh
39
+
40
+
Smallest suffix pattern:
41
+
42
+
$ cat > test.sh << EOF
43
+
> x="foobar"
44
+
> echo "\${x%bar}"
45
+
> echo "\${x%o*}"
46
+
> echo "\${x%foo}"
47
+
> EOF
48
+
49
+
$ sh test.sh
50
+
foo
51
+
fo
52
+
foobar
53
+
$ msh test.sh
54
+
foo
55
+
fo
56
+
foobar
57
+
58
+
Largest suffix pattern:
59
+
60
+
$ cat > test.sh << EOF
61
+
> x=/path/to/my/script.sh
62
+
> echo "\${x%%*/}"
63
+
> EOF
64
+
65
+
$ sh test.sh
66
+
/path/to/my/script.sh
67
+
$ msh test.sh
68
+
/path/to/my/script.sh
69
+
70
+
Length of param:
71
+
72
+
$ cat > test.sh <<EOF
73
+
> foo=hello
74
+
> echo \${#foo}
75
+
> EOF
76
+
77
+
$ sh test.sh
78
+
5
79
+
$ msh test.sh
80
+
5
81
+
82
+
Assigning on the fly:
83
+
84
+
$ cat > test.sh << EOF
85
+
> echo \${FOO:=bar}
86
+
> echo \$FOO
87
+
> EOF
88
+
89
+
$ sh test.sh
90
+
bar
91
+
bar
92
+
$ msh test.sh
93
+
bar
94
+
bar