diff --git a/dune-project b/dune-project index d7f9cb5..fed6a9c 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,5 @@ (lang dune 3.20) +(using menhir 3.0) (name merry) diff --git a/src/lib/arith.ml b/src/lib/arith.ml new file mode 100644 index 0000000..33a9a3a --- /dev/null +++ b/src/lib/arith.ml @@ -0,0 +1,25 @@ +(* We handle _very_ simple arithmetic expressions. + Really nothing crazy yet, hopefully enough to handle + most [while x < 10 do x = x + 1 done] loops! *) + +type expr = + | Int of int + | Var of string + | Add of expr * expr + | Sub of expr * expr + | Mul of expr * expr + | Div of expr * expr + | Neg of expr +[@@deriving to_yojson] + +let eval lookup expr = + let rec calc = function + | Int i -> i + | Var v -> lookup v + | Add (e1, e2) -> calc e1 + calc e2 + | Sub (e1, e2) -> calc e1 - calc e2 + | Div (e1, e2) -> calc e1 / calc e2 + | Mul (e1, e2) -> calc e1 * calc e2 + | Neg n -> Int.neg (calc n) + in + calc expr diff --git a/src/lib/arith_lexer.mll b/src/lib/arith_lexer.mll new file mode 100644 index 0000000..564c888 --- /dev/null +++ b/src/lib/arith_lexer.mll @@ -0,0 +1,31 @@ +{ + open Arith_parser +} + +let digit = ['0'-'9'] +let alpha = ['a'-'z' 'A'-'Z' '_'] +let ident = alpha (alpha | digit)* +let var = + ident +| '$' ident + +rule read = parse + | [' ' '\t' '\n'] { read lexbuf } + + | '+' { PLUS } + | '-' { MINUS } + | '*' { STAR } + | '/' { SLASH } + + | '(' { LPAREN } + | ')' { RPAREN } + + | digit+ as i { INT (int_of_string i) } + + | var as v { VAR v } + + | eof { EOF } + + | _ as c + { failwith ("Unexpected character: " ^ Char.escaped c) } + diff --git a/src/lib/arith_parser.mly b/src/lib/arith_parser.mly new file mode 100644 index 0000000..731f8e8 --- /dev/null +++ b/src/lib/arith_parser.mly @@ -0,0 +1,34 @@ +%{ + open Arith +%} + +%token INT +%token VAR +%token PLUS MINUS STAR SLASH +%token LPAREN RPAREN +%token EOF + +%left PLUS MINUS +%left STAR SLASH +%right UMINUS UPLUS + +%start main + +%% + +main: + | expr EOF { $1 } + +expr: + | expr PLUS expr { Add ($1, $3) } + | expr MINUS expr { Sub ($1, $3) } + | expr STAR expr { Mul ($1, $3) } + | expr SLASH expr { Div ($1, $3) } + + | PLUS expr %prec UPLUS { $2 } + | MINUS expr %prec UMINUS { Neg $2 } + + | INT { Int $1 } + | VAR { Var $1 } + | LPAREN expr RPAREN { $2 } + diff --git a/src/lib/ast.ml b/src/lib/ast.ml index 366b555..d79f3fe 100644 --- a/src/lib/ast.ml +++ b/src/lib/ast.ml @@ -539,6 +539,7 @@ and word_component : CST.word_component -> word_component = WordVariable a | WordGlobAll -> WordGlobAll | WordGlobAny -> WordGlobAny + | WordArithmeticExpression s -> WordArithmeticExpression (word s) | WordReBracketExpression a -> let a = bracket_expression a in WordReBracketExpression a diff --git a/src/lib/dune b/src/lib/dune index 7bc7f0d..7f4722b 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -1,3 +1,9 @@ +(ocamllex arith_lexer) + +(menhir + (flags --inspection --table) + (modules arith_parser)) + (library (name merry) (public_name merry) diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 54d15f6..467a1c8 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -91,6 +91,24 @@ module Make (S : Types.State) (E : Types.Exec) = struct Ast.WordName (S.expand ctx.state `Tilde) :: tilde_expansion ctx rest | v :: rest -> v :: tilde_expansion ctx rest + let rec arithmetic_expansion ctx = function + | [] -> [] + | Ast.WordArithmeticExpression word :: rest -> + let expr = Ast.word_components_to_string word in + let aexpr = + Arith_parser.main Arith_lexer.read (Lexing.from_string expr) + in + let lookup s = + match S.lookup ctx.state ~param:s with + | Some [ Ast.WordLiteral n ] when Option.is_some (int_of_string_opt n) + -> + int_of_string n + | _ -> 0 + in + let i = Arith.eval lookup aexpr in + Ast.WordLiteral (string_of_int i) :: arithmetic_expansion ctx rest + | v :: rest -> v :: arithmetic_expansion ctx rest + let stdout_for_pipeline ~sw ctx = function | [] -> (None, `Global ctx.stdout) | _ -> @@ -615,7 +633,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst = let cst = tilde_expansion ctx cst in - parameter_expansion' ctx cst + let ctx, cst = parameter_expansion' ctx cst in + (ctx, arithmetic_expansion ctx cst) and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list) (c : Ast.cmd_suffix_item list) = @@ -749,6 +768,16 @@ module Make (S : Types.State) (E : Types.Exec) = struct let v = e >|= fun _ -> saved_ctx in v + and handle_while_clause ctx + (While ((term, sep), (term', sep')) : Ast.while_clause) = + let rec loop exit_so_far = + let running_ctx = Exit.value exit_so_far in + match exec running_ctx (term, Some sep) with + | Exit.Nonzero _ -> exit_so_far (* TODO: Context? *) + | Exit.Zero ctx -> loop (exec ctx (term', Some sep')) + in + loop (Exit.zero ctx) + and handle_compound_command ctx v : ctx Exit.t = match v with | Ast.ForClause fc -> handle_for_clause ctx fc @@ -756,6 +785,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Ast.BraceGroup (term, sep) -> exec ctx (term, Some sep) | Ast.Subshell s -> exec_subshell ctx s | Ast.CaseClause cases -> handle_case_clause ctx cases + | Ast.WhileClause while_ -> handle_while_clause ctx while_ | _ as c -> Fmt.epr "Compound command not supported: %a\n%!" yojson_pp (Ast.compound_command_to_yojson c); diff --git a/src/lib/sast.ml b/src/lib/sast.ml index d53f0b2..8906a7d 100644 --- a/src/lib/sast.ml +++ b/src/lib/sast.ml @@ -125,6 +125,7 @@ and word_component = | WordVariable of variable | WordGlobAll (* asterisk *) | WordGlobAny (* question mark *) + | WordArithmeticExpression of word | WordReBracketExpression of bracket_expression (* Empty CST. Useful to represent the absence of relevant CSTs. *) | WordEmpty diff --git a/test/while.t b/test/while.t new file mode 100644 index 0000000..6271dbd --- /dev/null +++ b/test/while.t @@ -0,0 +1,25 @@ +While clauses. + + $ cat > test.sh << EOF + > i=1 + > + > while [ "\$i" -le 5 ] + > do + > echo "Iteration \$i..." + > i=\$((i + 1)) + > done + > + > EOF + + $ sh test.sh + Iteration 1... + Iteration 2... + Iteration 3... + Iteration 4... + Iteration 5... + $ msh test.sh + Iteration 1... + Iteration 2... + Iteration 3... + Iteration 4... + Iteration 5... diff --git a/vendor/morbig.0.11.0/src/CST.mli b/vendor/morbig.0.11.0/src/CST.mli index 0fc7727..9ecc993 100644 --- a/vendor/morbig.0.11.0/src/CST.mli +++ b/vendor/morbig.0.11.0/src/CST.mli @@ -328,6 +328,7 @@ and word_component = | WordVariable of variable | WordGlobAll (* asterisk *) | WordGlobAny (* question mark *) + | WordArithmeticExpression of word | WordReBracketExpression of bracket_expression (* Empty CST. Useful to represent the absence of relevant CSTs. *) | WordEmpty diff --git a/vendor/morbig.0.11.0/src/prelexer.mll b/vendor/morbig.0.11.0/src/prelexer.mll index db8949e..4e00453 100644 --- a/vendor/morbig.0.11.0/src/prelexer.mll +++ b/vendor/morbig.0.11.0/src/prelexer.mll @@ -431,7 +431,8 @@ rule token current = parse } | "$((" { - let current = push_string current "$((" in + debug ~rule:"arithmetic-exp" lexbuf current; + let current = push_arith current in let current = next_double_rparen 1 current lexbuf in token current lexbuf } @@ -718,6 +719,12 @@ and next_double_rparen dplevel current = parse let current = push_string current "((" in next_double_rparen (dplevel+1) current lexbuf } +| "$((" { + debug ~rule:"arithmetic-exp" lexbuf current; + let current = push_arith current in + let current = next_double_rparen (dplevel+1) current lexbuf in + current + } | '`' as op | "$" ( '(' as op) { let escaping_level = 0 in (* FIXME: Probably wrong. *) let current = push_string current (Lexing.lexeme lexbuf) in @@ -727,7 +734,7 @@ and next_double_rparen dplevel current = parse next_double_rparen dplevel current lexbuf } | "))" { - let current = push_string current "))" in + let current = pop_arith current in if dplevel = 1 then current else if dplevel > 1 then next_double_rparen (dplevel-1) current lexbuf diff --git a/vendor/morbig.0.11.0/src/prelexerState.ml b/vendor/morbig.0.11.0/src/prelexerState.ml index c5ebcf9..ac608eb 100644 --- a/vendor/morbig.0.11.0/src/prelexerState.ml +++ b/vendor/morbig.0.11.0/src/prelexerState.ml @@ -22,6 +22,7 @@ type atom = | WordComponent of (string * word_component) | QuotingMark of quote_kind | AssignmentMark + | ArithmeticMark and quote_kind = SingleQuote | DoubleQuote | OpeningBrace @@ -218,6 +219,33 @@ let string_of_atom = function | WordComponent (s, _) -> s | AssignmentMark -> "|=|" | QuotingMark _ -> "|Q|" + | ArithmeticMark -> "|+|" + +let push_arith b = + let cst = ArithmeticMark in + let buffer = AtomBuffer.make (cst :: buffer b) in + { b with buffer } + +let pop_arith b = + let rec aux str_expression expression = function + | [] -> + (str_expression, expression, []) + | ArithmeticMark :: buffer -> (str_expression, expression, buffer) + | (AssignmentMark | QuotingMark _ ) :: buffer -> + aux str_expression expression buffer (* FIXME: Check twice. *) + | WordComponent (w, WordEmpty) :: buffer -> + aux (w ^ str_expression) expression buffer + | WordComponent (w, c) :: buffer -> + aux (w ^ str_expression) (c :: expression) buffer + in + let str_expression, expression, buffer = aux "" [] (buffer b) in + let word = Word (str_expression, expression) in + let expression = WordArithmeticExpression word in + let str_expression = "$((" ^ str_expression ^ "))" + in + let expression = WordComponent (str_expression, expression) in + let buffer = AtomBuffer.make (expression :: buffer) in + { b with buffer } let contents_of_atom_list atoms = String.concat "" (List.rev_map string_of_atom atoms)