From 122808922d67822eb9e9a71b1a04cdd9813b478c Mon Sep 17 00:00:00 2001 From: monoid Date: Wed, 29 Jan 2025 17:56:00 +0900 Subject: [PATCH] remove ;; --- .gitignore | 1 + lib/eval.ml | 8 ++++---- lib/lexer.ml | 52 +++++++++++++++++++++++++-------------------------- lib/parser.ml | 44 +++++++++++++++++++++---------------------- 4 files changed, 53 insertions(+), 52 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c6a151b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +_build/ \ No newline at end of file diff --git a/lib/eval.ml b/lib/eval.ml index bd10b31..92a1c6d 100644 --- a/lib/eval.ml +++ b/lib/eval.ml @@ -1,6 +1,6 @@ -module VariableBindingMap = Map.Make(String);; +module VariableBindingMap = Map.Make(String) type value_type = @@ -14,7 +14,7 @@ and function_type = { name: string; body: Parser.expr_tree; scope: scope; -};; +} let rec eval_expr (scope: scope) (expr: Parser.expr_tree): value_type = match expr with @@ -83,7 +83,7 @@ and eval_bin_op_expr scope op left_expr right_expr = | (Int l, Int r) -> Int (int_of_float (float_of_int l ** float_of_int r)) | _ -> failwith "Type error" )) -;; + let eval_str (str: string): value_type = let tokens = Lexer.lex_tokens_seq str in @@ -92,7 +92,7 @@ let eval_str (str: string): value_type = match expr with | Some e -> eval_expr { parent = None; bindings = VariableBindingMap.empty } e | None -> failwith "Parse error" -;; + let%test "test eval_str 1" = let result = eval_str "let x = 1 in x" in diff --git a/lib/lexer.ml b/lib/lexer.ml index d316437..df0f498 100644 --- a/lib/lexer.ml +++ b/lib/lexer.ml @@ -37,16 +37,16 @@ type token_type = | Keyword of keyword_type | Comment of string | Fail of string -;; + type token = { (* token type *) token_type: token_type; (* start position *) pos: int; -};; +} -let epsilon = '\000';; +let epsilon = '\000' (* Lexer is just state machine *) @@ -61,7 +61,7 @@ type lexer_context = { pos: int; (* \n position array *) line_pos: int array; -};; +} let binary_search_range arr x = if Array.length arr = 0 then 0 @@ -70,7 +70,7 @@ let binary_search_range arr x = match compare low high with | 0 -> if arr.(low) >= x then low else low + 1 (* unreachable *) - | c when c > 0 -> raise (Invalid_argument "binary_search_range") + | c when c > 0 -> invalid_arg "binary_search_range" | _ -> let mid = (low + high) / 2 in if arr.(mid) >= x && ( mid = 0 || arr.(mid - 1) < x) then mid @@ -83,67 +83,67 @@ let get_line_and_col (line_pos: int array) (pos: int) = (* let _ = Printf.printf "line_index: %d\n" line_index in *) let line_start_pos = if line_index > 0 then (line_pos.(line_index - 1) + 1) else 0 in - (line_index + 1, pos - (line_start_pos) + 1);; + (line_index + 1, pos - (line_start_pos) + 1) let%test "test: get_line_and_col 1" = let actual = get_line_and_col [|1; 2; 3; 4; 6|] 3 in let expected = (3, 1) in (* let _ = Printf.printf "(%d,%d)\n" (fst actual) (snd actual) in *) - actual = expected;; + actual = expected let%test "test: get_line_and_col 2" = let actual = get_line_and_col [|1; 2; 3; 4; 6|] 10 in let expected = (6, 4) in (* let _ = Printf.printf "(%d,%d)\n" (fst actual) (snd actual) in *) - actual = expected;; + actual = expected let input_first (ctx: lexer_context) = if ctx.pos < String.length ctx.total then ctx.total.[ctx.pos] else - epsilon;; + epsilon let%test "test first" = let ctx = {total = "abc"; pos = 0; line_pos = [||]} in - input_first ctx = 'a';; + input_first ctx = 'a' let input_rest (ctx: lexer_context) = let ch = input_first ctx in if ch = '\n' then {ctx with pos = ctx.pos + 1; line_pos = Array.append ctx.line_pos [|ctx.pos|]} else - {ctx with pos = ctx.pos + 1};; + {ctx with pos = ctx.pos + 1} let%test "test rest" = let ctx = {total = "abc"; pos = 0; line_pos = [||]} in let ctx' = input_rest ctx in - ctx'.pos = 1 && ctx'.line_pos = [||];; + ctx'.pos = 1 && ctx'.line_pos = [||] let%test "test rest with new line" = let ctx = {total = "a\nbc"; pos = 1; line_pos = [||]} in let ctx' = input_rest ctx in - ctx'.pos = 2 && ctx'.line_pos = [|1|];; + ctx'.pos = 2 && ctx'.line_pos = [|1|] let%test "test rest with new line 2" = let ctx = {total = "a\nb\nc"; pos = 3; line_pos = [|1|]} in let ctx' = input_rest ctx in (* let _ = Printf.printf "pos: %d, line_pos: %s" ctx'.pos (String.concat "," (List.map string_of_int (Array.to_list ctx'.line_pos))) in *) - ctx'.pos = 4 && ctx'.line_pos = [|1; 3|];; + ctx'.pos = 4 && ctx'.line_pos = [|1; 3|] let rec skip_spaces (ctx: lexer_context) = let ch = input_first ctx in if ch = ' ' || ch = '\t' || ch = '\n' then skip_spaces (input_rest ctx) else - ctx;; + ctx let%test "test skip_spaces" = let ctx = {total = " \nabc"; pos = 0; line_pos = [||]} in let ctx' = skip_spaces ctx in (* let _ = Printf.printf "pos: %d, line_pos: %s" ctx'.pos (String.concat "," (List.map string_of_int (Array.to_list ctx'.line_pos))) in *) - ctx'.pos = 3 && ctx'.line_pos = [|2|];; + ctx'.pos = 3 && ctx'.line_pos = [|2|] (* 1. identifier: [a-zA-Z][a-zA-Z0-9]* @@ -164,12 +164,12 @@ let get_identifier (ctx: lexer_context) = let ctx' = aux ctx in let len = ctx'.pos - ctx.pos in let id = String.sub ctx'.total ctx.pos len in - id, ctx';; + id, ctx' let%test "test get_identifier" = let ctx = {total = "abc"; pos = 0; line_pos = [||]} in let id, ctx' = get_identifier ctx in - id = "abc" && ctx'.pos = 3;; + id = "abc" && ctx'.pos = 3 let get_digits (ctx: lexer_context) = let rec aux ctx = @@ -181,12 +181,12 @@ let get_digits (ctx: lexer_context) = let ctx' = aux ctx in let len = ctx'.pos - ctx.pos in let id = String.sub ctx'.total ctx.pos len in - id, ctx';; + id, ctx' let%test "test get_digit" = let ctx = {total = "123"; pos = 0; line_pos = [||]} in let id, ctx' = get_digits ctx in - id = "123" && ctx'.pos = 3;; + id = "123" && ctx'.pos = 3 let id_to_token_type id = match id with @@ -196,7 +196,7 @@ let id_to_token_type id = | "then" -> Keyword Then | "else" -> Keyword Else | "fun" -> Keyword Fun - | _ -> Identifier id;; + | _ -> Identifier id let lex_token (ctx: lexer_context) = let make_token token_type pos = {token_type = token_type; pos = pos} in @@ -240,19 +240,19 @@ let lex_token (ctx: lexer_context) = | c when is_digit c -> let id, ctx = get_digits ctx in make_token (Digit id) pos, ctx - | _ -> make_token (Fail "invalid token") pos, input_rest ctx;; + | _ -> make_token (Fail "invalid token") pos, input_rest ctx let%test "test lex_token 1" = let ctx = {total = "let"; pos = 0; line_pos = [||]} in let token, ctx' = lex_token ctx in - token.token_type = Keyword Let && token.pos = 0 && ctx'.pos = 3;; + token.token_type = Keyword Let && token.pos = 0 && ctx'.pos = 3 let%test "test lex_token 2" = let ctx = {total = "let in"; pos = 0; line_pos = [||]} in let token, ctx' = lex_token ctx in let token', ctx'' = lex_token ctx' in token.token_type = Keyword Let && token.pos = 0 && ctx'.pos = 3 && - token'.token_type = Keyword In && token'.pos = 4 && ctx''.pos = 6;; + token'.token_type = Keyword In && token'.pos = 4 && ctx''.pos = 6 let lex_tokens_seq (total: string): (token * lexer_context) Seq.t = let rec aux ctx = @@ -261,7 +261,7 @@ let lex_tokens_seq (total: string): (token * lexer_context) Seq.t = Seq.Cons ((token, next_ctx), fun () -> Seq.Nil) else Seq.Cons ((token, next_ctx), fun () -> aux next_ctx) in - fun () -> aux {total = total; pos = 0; line_pos = [||]};; + fun () -> aux {total = total; pos = 0; line_pos = [||]} let%test "test lex_tokens_seq" = let total = "let in" in @@ -273,4 +273,4 @@ let%test "test lex_tokens_seq" = {token_type = Keyword In; pos = 4}; {token_type = Eof; pos = 6} ] in - tokens = expected;; + tokens = expected diff --git a/lib/parser.ml b/lib/parser.ml index 6f12499..7219fac 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -1,56 +1,56 @@ -open Lexer;; +open Lexer type parser_context = { seq: Lexer.token Seq.t; errors: string list; -};; +} (* The parser is a function that takes a parser_context and returns an option of a tuple of a value and a parser_context.*) -type 'a parser = parser_context -> ('a * parser_context) option;; +type 'a parser = parser_context -> ('a * parser_context) option -let return (a: 'a) = fun (ctx: parser_context) -> Some (a, ctx);; -let stop = fun (_: parser_context) -> None;; +let return (a: 'a) = fun (ctx: parser_context) -> Some (a, ctx) +let stop = fun (_: parser_context) -> None let fmap (f: 'a -> 'b) (p: 'a parser): 'b parser = fun (ctx: parser_context) -> match p ctx with | Some (a, ctx') -> Some (f a, ctx') - | None -> None;; + | None -> None let bind (a: 'a parser) (b:'a -> 'b parser) = fun (ctx: parser_context) -> let p = a ctx in match p with | Some (a', ctx') -> b a' ctx' - | None -> None;; + | None -> None -let (>>=) = bind;; -let (let*) = bind;; +let (>>=) = bind +let (let*) = bind let or_parser (a: 'a parser) (b: 'a parser): 'a parser = fun (ctx: parser_context) -> match a ctx with | Some _ as res -> res - | None -> b ctx;; + | None -> b ctx -let (<|>) = or_parser;; +let (<|>) = or_parser let peek_token: token parser = fun (ctx: parser_context) -> - Seq.uncons ctx.seq |> Option.map (fun (t,_) -> (t,ctx));; + Seq.uncons ctx.seq |> Option.map (fun (t,_) -> (t,ctx)) let next_token: token parser = fun (ctx: parser_context) -> Seq.uncons ctx.seq |> Option.map (fun (t, s) -> (t, { ctx with seq = s} -));; +)) let match_token (tt: token_type) : token parser = let* t = next_token in if t.token_type = tt then return t else - stop;; + stop let zero_or_one (p: 'a parser): ('a option) parser = fun (ctx) -> match p ctx with | Some (a, ctx') -> Some (Some a, ctx') - | None -> Some (None, ctx);; + | None -> Some (None, ctx) let rec many (p: 'a parser): 'a list parser = let* a = zero_or_one p in @@ -59,12 +59,12 @@ let rec many (p: 'a parser): 'a list parser = let* as' = many p in return (a'::as') ) - | None -> return [];; + | None -> return [] let many1 (p: 'a parser): 'a list parser = let* a = p in let* as' = many p in - return (a::as');; + return (a::as') (* BNF: @@ -88,7 +88,7 @@ and expr_tree = | BinOpExpr of Lexer.op_type * expr_tree * expr_tree | MonoOpExpr of Lexer.op_type * expr_tree | Identifier of string - | Number of int;; + | Number of int let expr2str (e: expr_tree): string = let rec aux e = @@ -100,7 +100,7 @@ let expr2str (e: expr_tree): string = | MonoOpExpr (op, e) -> Printf.sprintf "%s %s" (Lexer.op2str op) (aux e) | Identifier id -> id | Number n -> string_of_int n in - aux e;; + aux e let rec parse_let_expr (): let_expr_tree parser = let* _ = match_token (Lexer.Keyword Lexer.Let) in @@ -184,7 +184,7 @@ and expr (): expr_tree parser = let* e = (parse_let_expr() |> fmap (fun x -> LetExpr x)) <|> (parse_fun_expr() |> fmap (fun x -> FunExpr x)) <|> (parse_if_expr() |> fmap (fun x -> IfExpr x)) <|> parse_level3() in - return e;; + return e let get_expr_tree_from_tokens (tokens: Lexer.token Seq.t): expr_tree option = let ntokens = Seq.filter (fun x -> @@ -195,11 +195,11 @@ let get_expr_tree_from_tokens (tokens: Lexer.token Seq.t): expr_tree option = let ctx = { seq = ntokens; errors = [] } in match expr() ctx with | Some (e, _) -> Some e - | None -> None;; + | None -> None let%test "test get_expr_tree_from_tokens 1" = let tokens = Lexer.lex_tokens_seq "let x = 1 in x" in let tokens = tokens |> Seq.map (fun (x,_) -> x) in match get_expr_tree_from_tokens tokens with | Some e -> expr2str e = "let x = 1 in\n x" - | None -> false;; + | None -> false