Shells in OCaml
While loops and arithmetic expressions
Thanks to Ishaan Ghandi's work in
https://github.com/colis-anr/morbig/pull/120, we now have some limited
support for arithmetic expression handling in the shell. Nothing very
extravagant, but workable.
+193
-3
+25
src/lib/arith.ml
+25
src/lib/arith.ml
···
1
+
(* We handle _very_ simple arithmetic expressions.
2
+
Really nothing crazy yet, hopefully enough to handle
3
+
most [while x < 10 do x = x + 1 done] loops! *)
4
+
5
+
type expr =
6
+
| Int of int
7
+
| Var of string
8
+
| Add of expr * expr
9
+
| Sub of expr * expr
10
+
| Mul of expr * expr
11
+
| Div of expr * expr
12
+
| Neg of expr
13
+
[@@deriving to_yojson]
14
+
15
+
let eval lookup expr =
16
+
let rec calc = function
17
+
| Int i -> i
18
+
| Var v -> lookup v
19
+
| Add (e1, e2) -> calc e1 + calc e2
20
+
| Sub (e1, e2) -> calc e1 - calc e2
21
+
| Div (e1, e2) -> calc e1 / calc e2
22
+
| Mul (e1, e2) -> calc e1 * calc e2
23
+
| Neg n -> Int.neg (calc n)
24
+
in
25
+
calc expr
+31
src/lib/arith_lexer.mll
+31
src/lib/arith_lexer.mll
···
1
+
{
2
+
open Arith_parser
3
+
}
4
+
5
+
let digit = ['0'-'9']
6
+
let alpha = ['a'-'z' 'A'-'Z' '_']
7
+
let ident = alpha (alpha | digit)*
8
+
let var =
9
+
ident
10
+
| '$' ident
11
+
12
+
rule read = parse
13
+
| [' ' '\t' '\n'] { read lexbuf }
14
+
15
+
| '+' { PLUS }
16
+
| '-' { MINUS }
17
+
| '*' { STAR }
18
+
| '/' { SLASH }
19
+
20
+
| '(' { LPAREN }
21
+
| ')' { RPAREN }
22
+
23
+
| digit+ as i { INT (int_of_string i) }
24
+
25
+
| var as v { VAR v }
26
+
27
+
| eof { EOF }
28
+
29
+
| _ as c
30
+
{ failwith ("Unexpected character: " ^ Char.escaped c) }
31
+
+34
src/lib/arith_parser.mly
+34
src/lib/arith_parser.mly
···
1
+
%{
2
+
open Arith
3
+
%}
4
+
5
+
%token <int> INT
6
+
%token <string> VAR
7
+
%token PLUS MINUS STAR SLASH
8
+
%token LPAREN RPAREN
9
+
%token EOF
10
+
11
+
%left PLUS MINUS
12
+
%left STAR SLASH
13
+
%right UMINUS UPLUS
14
+
15
+
%start <Arith.expr> main
16
+
17
+
%%
18
+
19
+
main:
20
+
| expr EOF { $1 }
21
+
22
+
expr:
23
+
| expr PLUS expr { Add ($1, $3) }
24
+
| expr MINUS expr { Sub ($1, $3) }
25
+
| expr STAR expr { Mul ($1, $3) }
26
+
| expr SLASH expr { Div ($1, $3) }
27
+
28
+
| PLUS expr %prec UPLUS { $2 }
29
+
| MINUS expr %prec UMINUS { Neg $2 }
30
+
31
+
| INT { Int $1 }
32
+
| VAR { Var $1 }
33
+
| LPAREN expr RPAREN { $2 }
34
+
+1
src/lib/ast.ml
+1
src/lib/ast.ml
+6
src/lib/dune
+6
src/lib/dune
+31
-1
src/lib/eval.ml
+31
-1
src/lib/eval.ml
···
91
91
Ast.WordName (S.expand ctx.state `Tilde) :: tilde_expansion ctx rest
92
92
| v :: rest -> v :: tilde_expansion ctx rest
93
93
94
+
let rec arithmetic_expansion ctx = function
95
+
| [] -> []
96
+
| Ast.WordArithmeticExpression word :: rest ->
97
+
let expr = Ast.word_components_to_string word in
98
+
let aexpr =
99
+
Arith_parser.main Arith_lexer.read (Lexing.from_string expr)
100
+
in
101
+
let lookup s =
102
+
match S.lookup ctx.state ~param:s with
103
+
| Some [ Ast.WordLiteral n ] when Option.is_some (int_of_string_opt n)
104
+
->
105
+
int_of_string n
106
+
| _ -> 0
107
+
in
108
+
let i = Arith.eval lookup aexpr in
109
+
Ast.WordLiteral (string_of_int i) :: arithmetic_expansion ctx rest
110
+
| v :: rest -> v :: arithmetic_expansion ctx rest
111
+
94
112
let stdout_for_pipeline ~sw ctx = function
95
113
| [] -> (None, `Global ctx.stdout)
96
114
| _ ->
···
615
633
616
634
and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst =
617
635
let cst = tilde_expansion ctx cst in
618
-
parameter_expansion' ctx cst
636
+
let ctx, cst = parameter_expansion' ctx cst in
637
+
(ctx, arithmetic_expansion ctx cst)
619
638
620
639
and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list)
621
640
(c : Ast.cmd_suffix_item list) =
···
749
768
let v = e >|= fun _ -> saved_ctx in
750
769
v
751
770
771
+
and handle_while_clause ctx
772
+
(While ((term, sep), (term', sep')) : Ast.while_clause) =
773
+
let rec loop exit_so_far =
774
+
let running_ctx = Exit.value exit_so_far in
775
+
match exec running_ctx (term, Some sep) with
776
+
| Exit.Nonzero _ -> exit_so_far (* TODO: Context? *)
777
+
| Exit.Zero ctx -> loop (exec ctx (term', Some sep'))
778
+
in
779
+
loop (Exit.zero ctx)
780
+
752
781
and handle_compound_command ctx v : ctx Exit.t =
753
782
match v with
754
783
| Ast.ForClause fc -> handle_for_clause ctx fc
···
756
785
| Ast.BraceGroup (term, sep) -> exec ctx (term, Some sep)
757
786
| Ast.Subshell s -> exec_subshell ctx s
758
787
| Ast.CaseClause cases -> handle_case_clause ctx cases
788
+
| Ast.WhileClause while_ -> handle_while_clause ctx while_
759
789
| _ as c ->
760
790
Fmt.epr "Compound command not supported: %a\n%!" yojson_pp
761
791
(Ast.compound_command_to_yojson c);
+1
src/lib/sast.ml
+1
src/lib/sast.ml
···
125
125
| WordVariable of variable
126
126
| WordGlobAll (* asterisk *)
127
127
| WordGlobAny (* question mark *)
128
+
| WordArithmeticExpression of word
128
129
| WordReBracketExpression of bracket_expression
129
130
(* Empty CST. Useful to represent the absence of relevant CSTs. *)
130
131
| WordEmpty
+25
test/while.t
+25
test/while.t
···
1
+
While clauses.
2
+
3
+
$ cat > test.sh << EOF
4
+
> i=1
5
+
>
6
+
> while [ "\$i" -le 5 ]
7
+
> do
8
+
> echo "Iteration \$i..."
9
+
> i=\$((i + 1))
10
+
> done
11
+
>
12
+
> EOF
13
+
14
+
$ sh test.sh
15
+
Iteration 1...
16
+
Iteration 2...
17
+
Iteration 3...
18
+
Iteration 4...
19
+
Iteration 5...
20
+
$ msh test.sh
21
+
Iteration 1...
22
+
Iteration 2...
23
+
Iteration 3...
24
+
Iteration 4...
25
+
Iteration 5...
+1
vendor/morbig.0.11.0/src/CST.mli
+1
vendor/morbig.0.11.0/src/CST.mli
···
328
328
| WordVariable of variable
329
329
| WordGlobAll (* asterisk *)
330
330
| WordGlobAny (* question mark *)
331
+
| WordArithmeticExpression of word
331
332
| WordReBracketExpression of bracket_expression
332
333
(* Empty CST. Useful to represent the absence of relevant CSTs. *)
333
334
| WordEmpty
+9
-2
vendor/morbig.0.11.0/src/prelexer.mll
+9
-2
vendor/morbig.0.11.0/src/prelexer.mll
···
431
431
}
432
432
433
433
| "$((" {
434
-
let current = push_string current "$((" in
434
+
debug ~rule:"arithmetic-exp" lexbuf current;
435
+
let current = push_arith current in
435
436
let current = next_double_rparen 1 current lexbuf in
436
437
token current lexbuf
437
438
}
···
718
719
let current = push_string current "((" in
719
720
next_double_rparen (dplevel+1) current lexbuf
720
721
}
722
+
| "$((" {
723
+
debug ~rule:"arithmetic-exp" lexbuf current;
724
+
let current = push_arith current in
725
+
let current = next_double_rparen (dplevel+1) current lexbuf in
726
+
current
727
+
}
721
728
| '`' as op | "$" ( '(' as op) {
722
729
let escaping_level = 0 in (* FIXME: Probably wrong. *)
723
730
let current = push_string current (Lexing.lexeme lexbuf) in
···
727
734
next_double_rparen dplevel current lexbuf
728
735
}
729
736
| "))" {
730
-
let current = push_string current "))" in
737
+
let current = pop_arith current in
731
738
if dplevel = 1
732
739
then current
733
740
else if dplevel > 1 then next_double_rparen (dplevel-1) current lexbuf
+28
vendor/morbig.0.11.0/src/prelexerState.ml
+28
vendor/morbig.0.11.0/src/prelexerState.ml
···
22
22
| WordComponent of (string * word_component)
23
23
| QuotingMark of quote_kind
24
24
| AssignmentMark
25
+
| ArithmeticMark
25
26
26
27
and quote_kind = SingleQuote | DoubleQuote | OpeningBrace
27
28
···
218
219
| WordComponent (s, _) -> s
219
220
| AssignmentMark -> "|=|"
220
221
| QuotingMark _ -> "|Q|"
222
+
| ArithmeticMark -> "|+|"
223
+
224
+
let push_arith b =
225
+
let cst = ArithmeticMark in
226
+
let buffer = AtomBuffer.make (cst :: buffer b) in
227
+
{ b with buffer }
228
+
229
+
let pop_arith b =
230
+
let rec aux str_expression expression = function
231
+
| [] ->
232
+
(str_expression, expression, [])
233
+
| ArithmeticMark :: buffer -> (str_expression, expression, buffer)
234
+
| (AssignmentMark | QuotingMark _ ) :: buffer ->
235
+
aux str_expression expression buffer (* FIXME: Check twice. *)
236
+
| WordComponent (w, WordEmpty) :: buffer ->
237
+
aux (w ^ str_expression) expression buffer
238
+
| WordComponent (w, c) :: buffer ->
239
+
aux (w ^ str_expression) (c :: expression) buffer
240
+
in
241
+
let str_expression, expression, buffer = aux "" [] (buffer b) in
242
+
let word = Word (str_expression, expression) in
243
+
let expression = WordArithmeticExpression word in
244
+
let str_expression = "$((" ^ str_expression ^ "))"
245
+
in
246
+
let expression = WordComponent (str_expression, expression) in
247
+
let buffer = AtomBuffer.make (expression :: buffer) in
248
+
{ b with buffer }
221
249
222
250
let contents_of_atom_list atoms =
223
251
String.concat "" (List.rev_map string_of_atom atoms)