Shells in OCaml
Arithmetic Expressions
The initial engine for handling arithmetic expressions. There are plenty
more operators to add, but those shouldn't be too hard. The real
challenge is to fix the shell parser for consuming the expressions, it
is currently broken w.r.t double left parens appearing inside the
expression itself, e.g. $(( ((1 + 1) * 4) )).
+148
-58
+47
-15
src/lib/arith.ml
+47
-15
src/lib/arith.ml
···
1
1
(* We handle _very_ simple arithmetic expressions.
2
2
Really nothing crazy yet, hopefully enough to handle
3
3
most [while x < 10 do x = x + 1 done] loops! *)
4
+
type operator = Add | Sub | Mul | Div | Mod | Lt | Gt | Eq
5
+
[@@deriving to_yojson]
6
+
7
+
let exec_op = function
8
+
| Add -> Int.add
9
+
| Sub -> Int.sub
10
+
| Mul -> Int.mul
11
+
| Div -> Int.div
12
+
| Mod -> ( mod )
13
+
| Lt -> fun a b -> if a < b then 1 else 0
14
+
| Gt -> fun a b -> if a > b then 1 else 0
15
+
| Eq -> fun a b -> if Int.equal a b then 1 else 0
4
16
5
17
type expr =
6
18
| Int of int
7
19
| Var of string
8
-
| Add of expr * expr
9
-
| Sub of expr * expr
10
-
| Mul of expr * expr
11
-
| Div of expr * expr
20
+
| Binop of operator * expr * expr
12
21
| Neg of expr
22
+
| Assign of operator * string * expr
23
+
| Ternary of (expr * expr * expr)
13
24
[@@deriving to_yojson]
14
25
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
26
+
module Make (S : Types.State) = struct
27
+
let eval initial_state expr =
28
+
let lookup state s =
29
+
match S.lookup state ~param:s with
30
+
| Some [ Ast.WordLiteral n ] when Option.is_some (int_of_string_opt n) ->
31
+
int_of_string n
32
+
| _ -> 0
33
+
in
34
+
let update state s i =
35
+
S.update state ~param:s [ Ast.WordLiteral (string_of_int i) ]
36
+
in
37
+
let rec calc state = function
38
+
| Int i -> (state, i)
39
+
| Var v -> (state, lookup state v)
40
+
| Binop (op, e1, e2) ->
41
+
let state, v1 = calc state e1 in
42
+
let state, v2 = calc state e2 in
43
+
(state, exec_op op v1 v2)
44
+
| Neg n ->
45
+
let state, v1 = calc state n in
46
+
(state, Int.neg v1)
47
+
| Assign (op, var, e) ->
48
+
let current_v = lookup state var in
49
+
let state, v1 = calc state e in
50
+
let nv = exec_op op current_v v1 in
51
+
(update state var nv, nv)
52
+
| Ternary (e1, e2, e3) ->
53
+
let state, v1 = calc state e1 in
54
+
if Int.equal v1 Int.zero then calc state e3 else calc state e2
55
+
in
56
+
calc initial_state expr
57
+
end
+20
-3
src/lib/arith_lexer.mll
+20
-3
src/lib/arith_lexer.mll
···
3
3
}
4
4
5
5
let digit = ['0'-'9']
6
+
let oct_digit = ['0'-'7']
7
+
let hex_digit = ['0'-'9' 'a'-'f' 'A'-'F']
6
8
let alpha = ['a'-'z' 'A'-'Z' '_']
7
9
let ident = alpha (alpha | digit)*
8
10
let var =
···
12
14
rule read = parse
13
15
| [' ' '\t' '\n'] { read lexbuf }
14
16
17
+
| "+=" { PLUSEQ }
18
+
| "-=" { MINUSEQ }
19
+
| "/=" { DIVEQ }
20
+
| "*=" { MULEQ }
21
+
| "%=" { MODEQ }
22
+
| "==" { EQEQ }
23
+
| '=' { EQ }
24
+
15
25
| '+' { PLUS }
16
26
| '-' { MINUS }
17
-
| '*' { STAR }
18
-
| '/' { SLASH }
27
+
| '*' { MUL }
28
+
| '/' { DIV }
29
+
| '?' { QUESTION }
30
+
| ':' { COLON }
31
+
| '>' { GT }
32
+
| '<' { LT }
19
33
20
34
| '(' { LPAREN }
21
35
| ')' { RPAREN }
22
-
36
+
37
+
| "0x" hex_digit+ as s { INT (int_of_string s) }
38
+
| "0X" hex_digit+ as s { INT (int_of_string s) }
39
+
| "0" oct_digit+ as s { INT (int_of_string ("0o" ^ s)) }
23
40
| digit+ as i { INT (int_of_string i) }
24
41
25
42
| var as v { VAR v }
+21
-6
src/lib/arith_parser.mly
+21
-6
src/lib/arith_parser.mly
···
4
4
5
5
%token <int> INT
6
6
%token <string> VAR
7
-
%token PLUS MINUS STAR SLASH
7
+
%token PLUSEQ MINUSEQ DIVEQ MULEQ MODEQ EQ
8
+
%token PLUS MINUS MUL DIV
9
+
%token LT GT EQEQ
10
+
%token QUESTION COLON
8
11
%token LPAREN RPAREN
9
12
%token EOF
10
13
14
+
%right PLUSEQ MINUSEQ DIVEQ MULEQ MODEQ EQ
15
+
%right QUESTION COLON
11
16
%left PLUS MINUS
12
-
%left STAR SLASH
17
+
%left MUL DIV
18
+
%left GT LT
13
19
%right UMINUS UPLUS
14
20
15
21
%start <Arith.expr> main
···
20
26
| expr EOF { $1 }
21
27
22
28
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) }
29
+
| v=VAR PLUSEQ e=expr { Assign (Add, v, e) }
30
+
| v=VAR MINUSEQ e=expr { Assign (Sub, v, e) }
31
+
| v=VAR MULEQ e=expr { Assign (Mul, v, e) }
32
+
| v=VAR DIVEQ e=expr { Assign (Div, v, e) }
33
+
| expr PLUS expr { Binop (Add, $1, $3) }
34
+
| expr MINUS expr { Binop (Sub, $1, $3) }
35
+
| expr MUL expr { Binop (Mul, $1, $3) }
36
+
| expr DIV expr { Binop (Div, $1, $3) }
37
+
| expr LT expr { Binop (Lt, $1, $3) }
38
+
| expr GT expr { Binop (Gt, $1, $3) }
39
+
| expr EQEQ expr { Binop (Eq, $1, $3) }
40
+
| expr QUESTION expr COLON expr { Ternary ($1, $3, $5) }
41
+
27
42
28
43
| PLUS expr %prec UPLUS { $2 }
29
44
| MINUS expr %prec UMINUS { Neg $2 }
+8
-8
src/lib/ast.ml
+8
-8
src/lib/ast.ml
···
228
228
match x with
229
229
| CaseItemNS_Pattern_Rparen_LineBreak (a, _) ->
230
230
let a = pattern a.value in
231
-
Case_pattern a
231
+
Case_pattern (a, None)
232
232
| CaseItemNS_Pattern_Rparen_CompoundList (a, b) ->
233
233
let a = pattern a.value in
234
234
let b = compound_list b.value in
235
-
Case_compound (a, b)
235
+
Case_pattern (a, Some b)
236
236
| CaseItemNS_Lparen_Pattern_Rparen_LineBreak (a, _) ->
237
237
let a = pattern a.value in
238
-
Case_pattern a
238
+
Case_pattern (a, None)
239
239
| CaseItemNS_Lparen_Pattern_Rparen_CompoundList (a, b) ->
240
240
let a = pattern a.value in
241
241
let b = compound_list b.value in
242
-
Case_compound (a, b)
242
+
Case_pattern (a, Some b)
243
243
244
244
and case_item : CST.case_item -> case_item =
245
245
fun x ->
246
246
match x with
247
247
| CaseItem_Pattern_Rparen_LineBreak_Dsemi_LineBreak (a, _, _) ->
248
248
let a = pattern a.value in
249
-
Case_pattern a
249
+
Case_pattern (a, None)
250
250
| CaseItem_Pattern_Rparen_CompoundList_Dsemi_LineBreak (a, b, _) ->
251
251
let a = pattern a.value in
252
252
let b = compound_list b.value in
253
-
Case_compound (a, b)
253
+
Case_pattern (a, Some b)
254
254
| CaseItem_Lparen_Pattern_Rparen_LineBreak_Dsemi_LineBreak (a, _, _) ->
255
255
let a = pattern a.value in
256
-
Case_pattern a
256
+
Case_pattern (a, None)
257
257
| CaseItem_Lparen_Pattern_Rparen_CompoundList_Dsemi_LineBreak (a, b, _) ->
258
258
let a = pattern a.value in
259
259
let b = compound_list b.value in
260
-
Case_compound (a, b)
260
+
Case_pattern (a, Some b)
261
261
262
262
and pattern : CST.pattern -> pattern =
263
263
fun x ->
+28
-21
src/lib/eval.ml
+28
-21
src/lib/eval.ml
···
15
15
executed. *)
16
16
17
17
module J = Job.Make (E)
18
+
module A = Arith.Make (S)
18
19
19
20
class default_map =
20
21
object (_)
···
91
92
Ast.WordName (S.expand ctx.state `Tilde) :: tilde_expansion ctx rest
92
93
| v :: rest -> v :: tilde_expansion ctx rest
93
94
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
95
+
let arithmetic_expansion ctx expr =
96
+
let rec fold (ctx, cst) = function
97
+
| [] -> (ctx, cst)
98
+
| Ast.WordArithmeticExpression word :: rest ->
99
+
let expr = Ast.word_components_to_string word in
100
+
let aexpr =
101
+
Arith_parser.main Arith_lexer.read (Lexing.from_string expr)
102
+
in
103
+
let state, i = A.eval ctx.state aexpr in
104
+
fold
105
+
({ ctx with state }, Ast.WordLiteral (string_of_int i) :: cst)
106
+
rest
107
+
| Ast.WordDoubleQuoted dq :: rest ->
108
+
let ctx, v = fold (ctx, []) dq in
109
+
fold (ctx, Ast.WordDoubleQuoted (List.rev v) :: cst) rest
110
+
| Ast.WordSingleQuoted dq :: rest ->
111
+
let ctx, v = fold (ctx, []) dq in
112
+
fold (ctx, Ast.WordSingleQuoted (List.rev v) :: cst) rest
113
+
| v :: rest -> fold (ctx, v :: cst) rest
114
+
in
115
+
let state, cst = fold (ctx, []) expr in
116
+
(state, List.rev cst)
111
117
112
118
let stdout_for_pipeline ~sw ctx = function
113
119
| [] -> (None, `Global ctx.stdout)
···
649
655
and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst =
650
656
let cst = tilde_expansion ctx cst in
651
657
let ctx, cst = parameter_expansion' ctx cst in
652
-
(ctx, arithmetic_expansion ctx cst)
658
+
arithmetic_expansion ctx cst
653
659
654
660
and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list)
655
661
(c : Ast.cmd_suffix_item list) =
···
757
763
| Some _ as ctx -> ctx
758
764
| None -> (
759
765
match pat with
760
-
| Ast.Case_pattern _ -> assert false
761
-
| Ast.Case_compound (p, sub) ->
766
+
| Ast.Case_pattern (p, sub) ->
762
767
Nlist.fold_left
763
768
(fun inner_acc pattern ->
764
769
match inner_acc with
···
769
774
Ast.word_components_to_string pattern
770
775
in
771
776
if Glob.test ~pattern scrutinee then begin
772
-
Some (exec_subshell ctx sub)
777
+
match sub with
778
+
| Some sub -> Some (exec_subshell ctx sub)
779
+
| None -> Some (Exit.zero ctx)
773
780
end
774
781
else inner_acc)
775
782
None p))
+1
-5
src/lib/sast.ml
+1
-5
src/lib/sast.ml
···
49
49
and wordlist = word Nlist.t
50
50
and case_clause = Cases of word * case_list | Case of word
51
51
and case_list = case_item Nlist.t
52
-
53
-
and case_item =
54
-
| Case_pattern of pattern
55
-
| Case_compound of pattern * compound_list
56
-
52
+
and case_item = Case_pattern of pattern * compound_list option
57
53
and pattern = word Nlist.t
58
54
59
55
and if_clause =
+1
test/built_ins.t
+1
test/built_ins.t
+22
test/modernish.t
+22
test/modernish.t
···
1
+
These these are from parts of the modernish checks.
2
+
3
+
$ cat > arith.sh << EOF
4
+
> i=7
5
+
> j=0
6
+
> case \$(( ( (j+=6*i)==0x2A)>0 ? 014 : 015 )) in
7
+
> ( 12 | 14 ) ;; # OK or BUG_NOOCTAL
8
+
> ( * ) exit ;;
9
+
> esac
10
+
> case \$j in
11
+
> ( 42 ) ;; # BUG_NOOCTAL
12
+
> ( * ) exit ;;
13
+
> esac
14
+
> echo "i:\$i and j:\$j"
15
+
> EOF
16
+
17
+
$ sh arith.sh
18
+
i:7 and j:42
19
+
20
+
$ msh arith.sh
21
+
i:7 and j:42
22
+