feat: add type declaration support in let and fun expressions

lib/eval.ml

@@ -15,10 +15,10 @@ and function_type = {
 
 let rec eval_expr (scope: scope) (expr: Parser.expr_tree): value_type = 
   match expr with
-  | Parser.LetExpr (Parser.Let (name, value_expr, in_expr)) -> 
+  | Parser.LetExpr (l) -> 
-    eval_let_expr scope name value_expr in_expr
+    eval_let_expr scope l.name l.value_expr l.in_expr
-  | Parser.FunExpr (Parser.Fun (name, body_expr)) -> 
+  | Parser.FunExpr (ftree) -> 
-    eval_fun_expr scope name body_expr
+    eval_fun_expr scope ftree
   | Parser.IfExpr (Parser.If (cond_expr, then_expr, else_expr)) -> 
     eval_if_expr scope cond_expr then_expr else_expr
   | Parser.BinOpExpr (op, left_expr, right_expr) -> 
@@ -54,8 +54,8 @@ and eval_let_expr scope name value_expr in_expr =
   let value = eval_expr scope value_expr in
   let new_scope = { scope with bindings = VariableBindingMap.add name value scope.bindings } in
   eval_expr new_scope in_expr
-and eval_fun_expr scope name body_expr =
+and eval_fun_expr scope (ftree: Parser.fun_expr_tree) =
-  Fun { argname = name; body = body_expr; scope = scope }
+  Fun { argname = ftree.name; body = ftree.body_expr; scope = scope }
 and eval_bin_op_expr scope op left_expr right_expr = 
   let left = eval_expr scope left_expr in
     let right = eval_expr scope right_expr in

lib/lexer.ml

@@ -51,7 +51,7 @@ let%test "test: get_line_and_col 2" =
 let input_first (ctx: lexer_context) = 
   if ctx.pos < String.length ctx.total then 
     ctx.total.[ctx.pos] 
-  else 
+  else
     epsilon
 
 let%test "test first" = 
@@ -142,7 +142,7 @@ let id_to_token_type id =
   match (Token.str2keyword id) with 
   | Some keyword -> keyword
   | None -> Token.Identifier id
-  
+
 
 let lex_token (ctx: lexer_context) = 
   let make_token token_type pos = {Token.token_type = token_type; pos = pos} in
@@ -154,6 +154,7 @@ let lex_token (ctx: lexer_context) =
   | '\000' -> {Token.token_type = Eof; pos = pos}, ctx
   | '(' -> make_token LParen pos, rest
   | ')' -> make_token RParen pos, rest
+  | ':' -> make_token Colon pos, rest
   | '=' -> make_token Equal pos, rest
   | '+' -> make_token Add pos, rest
   | '-' -> 

lib/parser.ml

@@ -1,4 +1,4 @@
-open Lexer
+(* open Lexer *)
 
 type parser_context = {
   seq: (Token.t * Lexer.lexer_context) Seq.t;
@@ -22,6 +22,10 @@ let bind (a: 'a parser) (b:'a -> 'b parser) = fun (ctx: parser_context) ->
   | Some (a', ctx') -> b a' ctx'
   | None -> None
 
+
+let push_error (msg: string): unit parser = fun (ctx: parser_context) ->
+  Some ((), { ctx with errors = msg::ctx.errors })
+
 let (>>=) = bind
 let (let*) = bind
 
@@ -40,6 +44,14 @@ let next_token: Token.t parser = fun (ctx: parser_context) ->
   { ctx with seq = s}
 ))
 
+let rec eat_until: (Token.t -> bool) -> unit parser = fun (filter) -> 
+  let* tt = peek_token in
+  if not (filter tt) then
+    let* _ = next_token in
+    eat_until filter
+  else
+    return ()
+
 let match_token  (tt: Token.token_type) : Token.t parser = 
   let* t = next_token in
   if t.token_type = tt then
@@ -47,10 +59,13 @@ let match_token  (tt: Token.token_type) : Token.t parser =
   else
     stop 
 
-let zero_or_one (p: 'a parser): ('a option) parser = fun (ctx) ->
+let match_identifier: string parser =
-  match p ctx with
+  let* tt = next_token in
-    | Some (a, ctx') -> Some (Some a, ctx')
+  match tt.token_type with
-    | None -> Some (None, ctx)
+  | Token.Identifier id -> return id
+  | _ -> stop
+
+let zero_or_one (p: 'a parser): ('a option) parser = ((fmap (fun x -> Some x) p) <|> return None )
 
 let rec many (p: 'a parser): 'a list parser =
   let* a = zero_or_one p in
@@ -68,8 +83,11 @@ let many1 (p: 'a parser): 'a list parser =
 
 (* 
 BNF:
-  let_expr ::= let identifier = expr in expr
+  type_parameter ::= [a-zA-Z][a-zA-Z0-9]*
-  fun_expr ::= fun identifier -> expr
+  type_generic ::= ''' type_parameter
+  type_declare ::= identifier | identifier -> type_declare | (type_declare) -> type_declare
+  let_expr ::= let identifier (: type_declare)? = expr in expr
+  fun_expr ::= fun (identifier | ('(' identifier (: type_declare)? ')'))? -> expr
   if_expr ::= if expr then expr else expr
   factor ::= (expr) | identifier | number
   call_expr ::= factor | factor factor
@@ -77,6 +95,8 @@ BNF:
   level2 ::= level2 * level1 | level2 / level1 | level2 % level1 | level1  
   level3 ::= level2 ^ level3 | level2
   expr ::= let_expr | fun_expr | if_expr | level3
+  type_alias ::= 'type' type_declare (type_generic)? = type_declare
+  top ::= expr
 *)
 
 type bin_op_type = 
@@ -109,8 +129,22 @@ let op2str (op: bin_op_type): string =
 type mono_op_type = 
   | Neg
 
-type let_expr_tree = Let of string * expr_tree * expr_tree
+type type_tree = 
-and fun_expr_tree = Fun of string * expr_tree
+  | TypeIdentifier of string
+  | TypeArrow of type_tree * type_tree
+
+type let_expr_tree = {
+  (* // TODO: add Pattern Matching *)
+  name: string;
+  type_declare: type_tree option;
+  value_expr: expr_tree;
+  in_expr: expr_tree;
+}
+and fun_expr_tree = {
+  name: string;
+  type_declare: type_tree option;
+  body_expr: expr_tree;
+}
 and if_expr_tree = If of expr_tree * expr_tree * expr_tree
 and call_expr_tree = Call of expr_tree * expr_tree
 and expr_tree = 
@@ -123,42 +157,127 @@ and expr_tree =
   | Identifier of string
   | Number of int
 
+let typeTree2str (t: type_tree): string = 
+  let rec aux t = 
+    match t with
+    | TypeIdentifier id -> id
+    | TypeArrow (t1, t2) -> Printf.sprintf "(%s -> %s)" (aux t1) (aux t2) in
+  aux t
+
 let expr2str (e: expr_tree): string = 
   let tab n = String.make (n * 2) ' ' in
   let rec aux e depth = 
     match e with
-    | LetExpr (Let (id, e1, e2)) -> Printf.sprintf "let %s = %s in\n%s%s" id (aux e1 depth) (tab depth) (aux e2 (depth+1))
+    | LetExpr ({
-    | FunExpr (Fun (id, e)) -> Printf.sprintf "fun %s ->\n%s%s" id (tab depth) (aux e (depth+1))
+      name = id;
-    | IfExpr (If (e1, e2, e3)) -> Printf.sprintf "if %s then\n%s%selse\n%s%s" (aux e1 depth) (tab depth) (aux e2 depth) (tab depth) (aux e3 depth)
+      value_expr = e1;
-    | CallExpr (Call (e1, e2)) -> Printf.sprintf "%s %s" (aux e1 depth) (aux e2 depth)
+      in_expr = e2;
+      type_declare = td;
+    }) -> 
+      let type_declare_str = match td with
+      | Some t -> Printf.sprintf ": %s" (typeTree2str t)
+      | None -> "" in
+        Printf.sprintf "let %s%s = %s in\n%s%s" id
+        type_declare_str (aux e1 depth) (tab depth) (aux e2 (depth+1))
+    | FunExpr ({
+      name = id;
+      body_expr = e;
+      type_declare = td;
+    }) -> 
+      let arg_str = match td with
+      | Some t -> Printf.sprintf "(%s: %s)" id (typeTree2str t)
+      | None -> id in
+      Printf.sprintf "fun %s ->\n%s%s" arg_str (tab depth) (aux e (depth+1))
+    | IfExpr (If (e1, e2, e3)) -> Printf.sprintf "if %s then %s else %s" (aux e1 depth) (aux e2 depth) (aux e3 depth)
+    | CallExpr (Call (e1, e2)) -> Printf.sprintf "%s(%s)" (aux e1 depth) (aux e2 depth)
     | BinOpExpr (op, e1, e2) -> Printf.sprintf "%s %s %s" (aux e1 depth) (op2str op) (aux e2 depth)
     | MonoOpExpr (op, e) -> Printf.sprintf "%s %s" (op2str op) (aux e depth)
     | Identifier id -> id
     | Number n -> string_of_int n in
   aux e 0
 
+let rec parse_type_declare (): type_tree parser = 
+  let parse_simple_type () =
+    let* tt = peek_token in
+      match tt.token_type with
+      | Token.Identifier x -> 
+          let* _ = next_token in
+          return (TypeIdentifier x)
+      | Token.LParen -> 
+          let* _ = match_token Token.LParen in
+          let* t = parse_type_declare() in
+          let* _ = match_token Token.RParen in
+          return t
+      | _ -> stop
+    in
+    let* base = parse_simple_type() in
+    let* lookahead = peek_token in
+    match lookahead.token_type with
+      | Token.Arrow -> 
+        let* _ = next_token in
+        (* // TODO: add error handling for invalid type declaration *)
+        let* t = parse_type_declare() in
+        return (TypeArrow (base, t))
+      | _ -> return base
+
+let parse_type_declare_with_colon (): type_tree option parser = 
+  let* tt = zero_or_one (match_token Token.Colon) in
+  begin match tt with
+    | Some _ -> 
+      let* t = zero_or_one (parse_type_declare()) in
+      begin match t with 
+      | Some(t) -> return (Some t)
+      | _ -> let* _ = (push_error "invalid type declare") in return None  
+      end
+    | None -> return None
+  end
+
 let rec parse_let_expr (): let_expr_tree parser = 
   let* _ = match_token ( Token.Let) in
   let* tt = next_token in
   match tt.token_type with
   Token.Identifier(x) ->
       let id = x in
+      let* type_declare = parse_type_declare_with_colon() in
+      let* _ = eat_until (fun x -> x.token_type = Token.Equal) in
       let* _ = match_token Token.Equal in
       let* e1 = expr() in
       let* _ = match_token (Token.In) in
       let* e2 = expr() in
-      return (Let (id, e1, e2))
+      return ({
+        name = id;
+        value_expr = e1;
+        in_expr = e2;
+        type_declare = type_declare
+      })
   | _ -> stop
 and parse_fun_expr (): fun_expr_tree parser =
   let* _ = match_token (Token.Fun) in
   let* tt = next_token in
-  match tt.token_type with
+  begin match tt.token_type with
   Token.Identifier(x) ->
       let id = x in
       let* _ = match_token Token.Arrow in
       let* e = expr() in
-      return (Fun (id, e))
+      return ({
+        name = id;
+        body_expr = e;
+        type_declare = None
+      })
+  | Token.LParen -> 
+    let* id = match_identifier in
+    let* type_declare = parse_type_declare_with_colon() in
+    let* _ = eat_until (fun x -> x.token_type = Token.RParen) in
+    let* _ = match_token Token.RParen in
+    let* _ = match_token Token.Arrow in
+    let* e = expr() in
+    return ({
+      name = id;
+      body_expr = e;
+      type_declare = type_declare
+    })
   | _ -> stop
+  end
 and parse_if_expr (): if_expr_tree parser =
   let* _ = match_token (Token.If) in
   let* e1 = expr() in
@@ -255,5 +374,47 @@ let get_expr_tree_from_tokens (tokens: (Token.t * Lexer.lexer_context) Seq.t): e
 let%test "test get_expr_tree_from_tokens 1" =
   let tokens = Lexer.lex_tokens_seq "let x = 1 in\n  x" in
   match get_expr_tree_from_tokens tokens with
-  | Some e -> expr2str e = "let x = 1 in\n  x"
+  | Some e -> expr2str e = "let x = 1 in\nx"
   | None -> false
+
+let%test "test get_expr_tree_from_tokens 2" =
+  let tokens = Lexer.lex_tokens_seq "fun x -> x" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "fun x ->\nx"
+  | None -> false
+
+let%test "test get_expr_tree_from_tokens 3" =
+  let tokens = Lexer.lex_tokens_seq "if 1 then 2 else 3" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "if 1 then 2 else 3"
+  | None -> false
+
+let%test "test get_expr_tree_from_tokens 4" =
+  let tokens = Lexer.lex_tokens_seq "1 + 2 * 3" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "1 + 2 * 3"
+  | None -> false
+
+let%test "test get_expr_tree_from_tokens 5" =
+  let tokens = Lexer.lex_tokens_seq "x 1 2" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "x(1)(2)"
+  | None -> false
+ 
+let%test "test get_expr_tree_from_tokens 6 with type" =
+  let tokens = Lexer.lex_tokens_seq "let x: int = 1 in\n  x" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "let x: int = 1 in\nx"
+  | None -> false
+
+let%test "test get_expr_tree_from_tokens 7 with type" =
+  let tokens = Lexer.lex_tokens_seq "fun (x: int) -> x" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "fun (x: int) ->\nx"
+  | None -> false
+
+let%test "test get_expr_tree_from_tokens 8" =
+  let tokens = Lexer.lex_tokens_seq "fun (x) -> x" in
+  match get_expr_tree_from_tokens tokens with
+  | Some e -> expr2str e = "fun x ->\nx"
+  | None -> false