From 4c844bab3ebe707e768b4fe586d41c4796d1809b Mon Sep 17 00:00:00 2001 From: Mutsuha Asada Date: Wed, 14 Aug 2024 09:49:32 +0900 Subject: [PATCH] wip: add list_append --- compiler/ast.ml | 3 +++ compiler/codegen.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ compiler/inferer.ml | 8 ++++++++ compiler/parser.ml | 3 +++ compiler/tokenizer.ml | 1 + compiler/tokens.ml | 2 ++ test/compiler/e2e.ml | 6 ++++++ 7 files changed, 65 insertions(+) diff --git a/compiler/ast.ml b/compiler/ast.ml index 1b189db..b8f695f 100644 --- a/compiler/ast.ml +++ b/compiler/ast.ml @@ -18,6 +18,7 @@ type ast = | Times of ast * ast | Div of ast * ast | Cons of ast * ast + | Append of ast * ast let rec string_of_ast ast = match ast with @@ -55,3 +56,5 @@ let rec string_of_ast ast = "Times (" ^ string_of_ast e1 ^ ", " ^ string_of_ast e2 ^ ")" | Div (e1, e2) -> "Div (" ^ string_of_ast e1 ^ ", " ^ string_of_ast e2 ^ ")" | Cons (e1, e2) -> "Cons (" ^ string_of_ast e1 ^ ", " ^ string_of_ast e2 ^ ")" + | Append (e1, e2) -> + "Append (" ^ string_of_ast e1 ^ ", " ^ string_of_ast e2 ^ ")" diff --git a/compiler/codegen.ml b/compiler/codegen.ml index 6523f7c..4b5827a 100644 --- a/compiler/codegen.ml +++ b/compiler/codegen.ml @@ -124,6 +124,48 @@ let codegen ast te = in ( Funcs.add func_name { func with body = new_func_body } funcs, next_addr + 4 ) + | Append (lst1, lst2) -> + let func = Funcs.find func_name funcs in + let lst1_funcs, addr = aux func_name funcs env lst1 addr in + let lst1_expr_instr = (Funcs.find func_name lst1_funcs).body in + let lst2_funcs, addr = aux func_name lst1_funcs env lst2 addr in + let lst2_expr_instr = (Funcs.find func_name lst2_funcs).body in + let copy_lst1_instrs, new_addr = + let rec aux acc addr i instrs = + match instrs with + | [] -> (acc, addr) + | instr :: instrs -> + if i = 0 || i = 3 then + aux (I32Const addr :: acc) (addr + 4) (i + 1) instrs + else if i = 4 then + aux (I32Const addr :: acc) addr (i + 1) instrs + else if i = 5 then aux (instr :: acc) addr 0 instrs + else aux (instr :: acc) addr (i + 1) instrs + in + aux [] addr 0 lst1_expr_instr + in + let copy_lst1_instrs = List.tl copy_lst1_instrs in + let copy_lst2_instrs, _ = + let rec aux acc addr i instrs = + match instrs with + | [] -> (acc, addr) + | instr :: instrs -> + if i = 0 || i = 3 then + aux (I32Const addr :: acc) (addr + 4) (i + 1) instrs + else if i = 4 && instr <> I32Const (-1) then + aux (I32Const addr :: acc) addr (i + 1) instrs + else if i = 5 then aux (instr :: acc) addr 0 instrs + else aux (instr :: acc) addr (i + 1) instrs + in + aux [] (new_addr - 4) 0 lst2_expr_instr + in + let copy_lst2_instrs = List.tl copy_lst2_instrs in + let new_func_body = + lst1_expr_instr @ [ Drop ] @ lst2_expr_instr @ [ Drop ] + @ List.rev copy_lst1_instrs @ List.rev copy_lst2_instrs + @ [ I32Const addr ] + in + (Funcs.add func_name { func with body = new_func_body } lst2_funcs, addr) | App (name, args) -> let func = Funcs.find func_name funcs in let funcs, args_instrs, end_addr = diff --git a/compiler/inferer.ml b/compiler/inferer.ml index 0939e63..9a8f1ee 100644 --- a/compiler/inferer.ml +++ b/compiler/inferer.ml @@ -150,6 +150,14 @@ let tinf e = let te3 = subst_tyenv theta3 te2 in let theta4 = compose_subst theta3 (compose_subst theta2 theta1) in (te3, TList t11, theta4, n2) + | Append (l1, l2) -> + let te1, t1, theta1, n1 = aux te l1 n in + let te2, t2, theta2, n2 = aux te1 l2 n1 in + let t11 = subst_ty theta2 t1 in + let theta3 = unify [ (t2, t11) ] in + let te3 = subst_tyenv theta3 te2 in + let theta4 = compose_subst theta3 (compose_subst theta2 theta1) in + (te3, t2, theta4, n2) | Plus (e1, e2) | Minus (e1, e2) | Times (e1, e2) | Div (e1, e2) -> let te1, t1, theta1, n1 = aux te e1 n in let te2, t2, theta2, n2 = aux te1 e2 n1 in diff --git a/compiler/parser.ml b/compiler/parser.ml index a736a40..5330310 100644 --- a/compiler/parser.ml +++ b/compiler/parser.ml @@ -109,6 +109,9 @@ and parse_mul_div_expr tokens = and parse_list_ops_expr tokens = let rec aux acc tokens = match tokens with + | AtSign :: tokens -> + let rhs, tokens = parse_expr tokens in + aux (Append (acc, rhs)) tokens | DoubleColon :: tokens -> let rhs, tokens = parse_expr tokens in aux (Cons (acc, rhs)) tokens diff --git a/compiler/tokenizer.ml b/compiler/tokenizer.ml index 810733b..42faf07 100644 --- a/compiler/tokenizer.ml +++ b/compiler/tokenizer.ml @@ -78,6 +78,7 @@ let tokenize input = else aux (pos + 1) (Hyphen :: tokens) | '*' -> aux (pos + 1) (Asterisk :: tokens) | '/' -> aux (pos + 1) (Slash :: tokens) + | '@' -> aux (pos + 1) (AtSign :: tokens) | '=' -> aux (pos + 1) (Equal :: tokens) | '<' -> if pos + 1 < length && input.[pos + 1] = '>' then diff --git a/compiler/tokens.ml b/compiler/tokens.ml index ce42a31..aa94f87 100644 --- a/compiler/tokens.ml +++ b/compiler/tokens.ml @@ -8,6 +8,7 @@ type token = | Greater (** The '>' operator *) | NotEqual (** The '<>' operator *) | SemiColon (** The ';' operator *) + | AtSign (** The '@' operator *) | Colon (** The ':' operator *) | DoubleColon (** The '::' operator *) | LeftParen (** The '(' operator *) @@ -84,6 +85,7 @@ let string_of_token token = | Less -> "Less" | Greater -> "Greater" | NotEqual -> "NotEqual" + | AtSign -> "AtSign" | SemiColon -> "SemiColon" | Colon -> "Colon" | DoubleColon -> "DoubleColon" diff --git a/test/compiler/e2e.ml b/test/compiler/e2e.ml index 0fcfd0a..1d23a2e 100644 --- a/test/compiler/e2e.ml +++ b/test/compiler/e2e.ml @@ -154,6 +154,12 @@ let () = (list_next lst) in print_int32 (get 3 [1 2 3 4])" 4; ] ); + ( "list_append_1", [ + test_case_str "list_append_1" "print_list ([1 2] @ [3 4])" "[1, 2, 3, 4]\n" + ] ); + ("list_append_2", [ + test_case_str "list_append_2" "let x = [1 2] in print_list (x @ [3 4])" "[1, 2, 3, 4]\n" + ]); ( "string_1", [ test_case_str "string_1" "print_string \"Hello, World!\""