moved mutable part of state inside mutable field

since only `tokens` is actually mutable we can make that field mutable,
and hence not have to deal with `state ref`s, and only have a single
mutating function, i.e. `advance`.
This commit is contained in:
Moritz Gmeiner 2024-08-27 18:01:34 +02:00
commit 6206ee4a00

View file

@ -6,29 +6,29 @@ open Lexer
open Stmt open Stmt
type parse_result = (stmt_node list, parser_error list) result type parse_result = (stmt_node list, parser_error list) result
type state = { mutable tokens : token list; is_in_loop : bool }
type stmt_result = (stmt_node, parser_error) result type stmt_result = (stmt_node, parser_error) result
type expr_result = (expr_node, parser_error) result type expr_result = (expr_node, parser_error) result
type state = { tokens : token list; is_in_loop : bool }
let with_is_in_loop (f : state ref -> stmt_result) (state : state ref) : stmt_result = let with_is_in_loop (f : state -> 'a) (state : state) : 'a =
let was_in_loop = !state.is_in_loop in let state = { state with is_in_loop = true } in
state := { !state with is_in_loop = true }; f state
let result = f state in
state := { !state with is_in_loop = was_in_loop };
result
let make_state tokens = ref { tokens; is_in_loop = false } let make_state tokens = { tokens; is_in_loop = false }
let is_at_end state = (List.hd !state.tokens).token_type = Eof
let advance state = state := { !state with tokens = List.tl !state.tokens } let is_at_end state =
assert (not (List.is_empty state.tokens));
(List.hd state.tokens).token_type = Eof
let advance state = state.tokens <- List.tl state.tokens
let next state = let next state =
assert (not ((List.hd !state.tokens).token_type = Eof)); let token = List.hd state.tokens in
let token = List.hd !state.tokens in
advance state; advance state;
token token
let peek state = List.hd !state.tokens let peek state = List.hd state.tokens
let peek_tt (state : state ref) : token_type = (peek state).token_type let peek_tt (state : state) : token_type = (peek state).token_type
let cur_pos state = (peek state).pos let cur_pos state = (peek state).pos
let advance_if state tt = let advance_if state tt =
@ -38,7 +38,7 @@ let advance_if state tt =
else false else false
let consume state tt = let consume state tt =
if advance_if state tt then Ok () if advance_if state tt then Ok state
else else
let pos = cur_pos state in let pos = cur_pos state in
let tt' = peek_tt state in let tt' = peek_tt state in
@ -59,8 +59,8 @@ let matches state tts =
let f = ( = ) (peek_tt state) in let f = ( = ) (peek_tt state) in
Array.fold_left (fun acc tt -> acc || f tt) false tts Array.fold_left (fun acc tt -> acc || f tt) false tts
let collect_chain (state : state ref) (tts : token_type array) let collect_chain (state : state) (tts : token_type array) (higher_prec : state -> expr_result) :
(higher_prec : state ref -> expr_result) : ((expr_node * token) list, parser_error) result = ((expr_node * token) list, parser_error) result =
let rec collect_chain_rec (acc : (expr_node * token) list) = let rec collect_chain_rec (acc : (expr_node * token) list) =
if (not (is_at_end state)) && matches state tts then if (not (is_at_end state)) && matches state tts then
let token = next state in let token = next state in
@ -69,9 +69,9 @@ let collect_chain (state : state ref) (tts : token_type array)
collect_chain_rec acc collect_chain_rec acc
else Ok acc else Ok acc
in in
collect_chain_rec [] |> Result.map (fun l -> List.rev l) collect_chain_rec [] |> Result.map List.rev
let primary (state : state ref) : expr_result = let primary (state : state) : expr_result =
let pos = cur_pos state in let pos = cur_pos state in
match peek_tt state with match peek_tt state with
| Number x -> | Number x ->
@ -97,7 +97,7 @@ let primary (state : state ref) : expr_result =
let msg = Printf.sprintf "Expected valid expression, got %s instead" (show_token_type tt) in let msg = Printf.sprintf "Expected valid expression, got %s instead" (show_token_type tt) in
Error { msg; pos } Error { msg; pos }
let rec grouping (state : state ref) : expr_result = let rec grouping (state : state) : expr_result =
if matches state [| LeftParen |] then ( if matches state [| LeftParen |] then (
advance state; advance state;
let* expr = expression state in let* expr = expression state in
@ -109,7 +109,7 @@ let rec grouping (state : state ref) : expr_result =
Error { pos; msg }) Error { pos; msg })
else primary state else primary state
and neg_not (state : state ref) : expr_result = and neg_not (state : state) : expr_result =
if matches state [| Bang; Minus |] then if matches state [| Bang; Minus |] then
let token = next state in let token = next state in
let pos = token.pos in let pos = token.pos in
@ -124,7 +124,7 @@ and neg_not (state : state ref) : expr_result =
Ok expr Ok expr
else grouping state else grouping state
and mul_or_div (state : state ref) : expr_result = and mul_or_div (state : state) : expr_result =
let* expr = neg_not state in let* expr = neg_not state in
let* exprs_tokens = collect_chain state [| Star; Slash |] neg_not in let* exprs_tokens = collect_chain state [| Star; Slash |] neg_not in
let f acc (expr, (token : token)) = let f acc (expr, (token : token)) =
@ -140,7 +140,7 @@ and mul_or_div (state : state ref) : expr_result =
let expr = List.fold_left f expr exprs_tokens in let expr = List.fold_left f expr exprs_tokens in
Ok expr Ok expr
and sum_or_diff (state : state ref) : expr_result = and sum_or_diff (state : state) : expr_result =
let* expr = mul_or_div state in let* expr = mul_or_div state in
let* exprs_tokens = collect_chain state [| Plus; Minus |] mul_or_div in let* exprs_tokens = collect_chain state [| Plus; Minus |] mul_or_div in
let f acc (expr, (token : token)) = let f acc (expr, (token : token)) =
@ -156,7 +156,7 @@ and sum_or_diff (state : state ref) : expr_result =
let expr = List.fold_left f expr exprs_tokens in let expr = List.fold_left f expr exprs_tokens in
Ok expr Ok expr
and inequality (state : state ref) : expr_result = and inequality (state : state) : expr_result =
(* TODO: maybe rework to only have Less and Greater as ops; performance? *) (* TODO: maybe rework to only have Less and Greater as ops; performance? *)
let* expr = sum_or_diff state in let* expr = sum_or_diff state in
let* exprs_tokens = let* exprs_tokens =
@ -177,7 +177,7 @@ and inequality (state : state ref) : expr_result =
let expr = List.fold_left f expr exprs_tokens in let expr = List.fold_left f expr exprs_tokens in
Ok expr Ok expr
and equality (state : state ref) : expr_result = and equality (state : state) : expr_result =
let* expr = inequality state in let* expr = inequality state in
let* exprs_tokens = collect_chain state [| EqualEqual; BangEqual |] inequality in let* exprs_tokens = collect_chain state [| EqualEqual; BangEqual |] inequality in
let f acc (expr, (token : token)) = let f acc (expr, (token : token)) =
@ -192,7 +192,7 @@ and equality (state : state ref) : expr_result =
let expr = List.fold_left f expr exprs_tokens in let expr = List.fold_left f expr exprs_tokens in
Ok expr Ok expr
and logical_and (state : state ref) : expr_result = and logical_and (state : state) : expr_result =
let* expr = equality state in let* expr = equality state in
let* exprs_tokens = collect_chain state [| And |] equality in let* exprs_tokens = collect_chain state [| And |] equality in
let f acc (expr, (token : token)) = let f acc (expr, (token : token)) =
@ -203,7 +203,7 @@ and logical_and (state : state ref) : expr_result =
let expr = List.fold_left f expr exprs_tokens in let expr = List.fold_left f expr exprs_tokens in
Ok expr Ok expr
and logical_or (state : state ref) : expr_result = and logical_or (state : state) : expr_result =
let* expr = logical_and state in let* expr = logical_and state in
let* exprs_tokens = collect_chain state [| Or |] logical_and in let* exprs_tokens = collect_chain state [| Or |] logical_and in
let f acc (expr, (token : token)) = let f acc (expr, (token : token)) =
@ -214,7 +214,7 @@ and logical_or (state : state ref) : expr_result =
let expr = List.fold_left f expr exprs_tokens in let expr = List.fold_left f expr exprs_tokens in
Ok expr Ok expr
and assignment (state : state ref) : expr_result = and assignment (state : state) : expr_result =
let* expr = logical_or state in let* expr = logical_or state in
if Equal = peek_tt state then if Equal = peek_tt state then
let pos = (next state).pos in let pos = (next state).pos in
@ -226,9 +226,9 @@ and assignment (state : state ref) : expr_result =
ParserError.make pos msg |> Result.error ParserError.make pos msg |> Result.error
else Ok expr else Ok expr
and expression (state : state ref) : expr_result = assignment state and expression (state : state) : expr_result = assignment state
let rec block (state : state ref) : stmt_result = let rec block (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
let* _ = consume state LeftBrace in let* _ = consume state LeftBrace in
let rec collect_stmts state = let rec collect_stmts state =
@ -247,7 +247,7 @@ let rec block (state : state ref) : stmt_result =
let* _ = consume state RightBrace in let* _ = consume state RightBrace in
make_block pos stmts |> Result.ok make_block pos stmts |> Result.ok
and if_then_else (state : state ref) : stmt_result = and if_then_else (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
let* _ = consume state If in let* _ = consume state If in
let* _ = consume state LeftParen in let* _ = consume state LeftParen in
@ -259,7 +259,7 @@ and if_then_else (state : state ref) : stmt_result =
in in
make_if pos cond then_ else_ |> Result.ok make_if pos cond then_ else_ |> Result.ok
and while_loop (state : state ref) : stmt_result = and while_loop (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
let* _ = consume state While in let* _ = consume state While in
let* _ = consume state LeftParen in let* _ = consume state LeftParen in
@ -268,7 +268,7 @@ and while_loop (state : state ref) : stmt_result =
let* body = with_is_in_loop statement state in let* body = with_is_in_loop statement state in
make_while pos cond body |> Result.ok make_while pos cond body |> Result.ok
and for_loop (state : state ref) : stmt_result = and for_loop (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
let* _ = consume state For in let* _ = consume state For in
let* _ = consume state LeftParen in let* _ = consume state LeftParen in
@ -296,18 +296,18 @@ and for_loop (state : state ref) : stmt_result =
let* body = with_is_in_loop statement state in let* body = with_is_in_loop statement state in
make_for pos init cond update body |> Result.ok make_for pos init cond update body |> Result.ok
and expr_stmt (state : state ref) : stmt_result = and expr_stmt (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
let* expr = expression state in let* expr = expression state in
let* _ = consume state Semicolon in let* _ = consume state Semicolon in
let stmt = make_expr_stmt pos expr in let stmt = make_expr_stmt pos expr in
Ok stmt Ok stmt
and statement (state : state ref) : stmt_result = and statement (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
match peek_tt state with match peek_tt state with
| Break -> | Break ->
if !state.is_in_loop then ( if state.is_in_loop then (
advance state; advance state;
let* _ = consume state Semicolon in let* _ = consume state Semicolon in
make_break pos |> Result.ok) make_break pos |> Result.ok)
@ -315,7 +315,7 @@ and statement (state : state ref) : stmt_result =
let msg = "Can use break only in loops" in let msg = "Can use break only in loops" in
ParserError.make pos msg |> Result.error ParserError.make pos msg |> Result.error
| Continue -> | Continue ->
if !state.is_in_loop then ( if state.is_in_loop then (
advance state; advance state;
let* _ = consume state Semicolon in let* _ = consume state Semicolon in
make_continue pos |> Result.ok) make_continue pos |> Result.ok)
@ -334,7 +334,7 @@ and statement (state : state ref) : stmt_result =
| For -> for_loop state | For -> for_loop state
| _ -> expr_stmt state | _ -> expr_stmt state
and var_declaration (state : state ref) : stmt_result = and var_declaration (state : state) : stmt_result =
let pos = cur_pos state in let pos = cur_pos state in
(* consume var token *) (* consume var token *)
assert ((next state).token_type = Var); assert ((next state).token_type = Var);
@ -351,10 +351,10 @@ and var_declaration (state : state ref) : stmt_result =
let* _ = consume state Semicolon in let* _ = consume state Semicolon in
make_var_decl pos name init |> Result.ok make_var_decl pos name init |> Result.ok
and declaration (state : state ref) : stmt_result = and declaration (state : state) : stmt_result =
match peek_tt state with Var -> var_declaration state | _ -> statement state match peek_tt state with Var -> var_declaration state | _ -> statement state
let rec synchronise (state : state ref) = let rec synchronise (state : state) =
match peek_tt state with match peek_tt state with
| Semicolon -> advance state | Semicolon -> advance state
| Class | Fun | Var | For | If | While | Print | Return | Eof -> () | Class | Fun | Var | For | If | While | Print | Return | Eof -> ()
@ -362,7 +362,7 @@ let rec synchronise (state : state ref) =
advance state; advance state;
synchronise state synchronise state
let rec parse_impl (state : state ref) : parse_result = let rec parse_impl (state : state) : parse_result =
if peek_tt state = Eof then Ok [] if peek_tt state = Eof then Ok []
else else
let result = declaration state in let result = declaration state in