wip: add list_append

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 ^ ")"

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 =

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

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

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

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"

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!\""