From d8186715ad75cfc24d5e20045d6968d534679ece Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 15:15:32 -0400 Subject: [PATCH 1/9] add unbinding --- lib/unbind.ml | 34 ++++++++++++++++++ test/type_checker/test_bind.ml | 63 ++++++++++++++++++++++++++++++++++ 2 files changed, 97 insertions(+) create mode 100644 lib/unbind.ml create mode 100644 test/type_checker/test_bind.ml diff --git a/lib/unbind.ml b/lib/unbind.ml new file mode 100644 index 0000000..4d26e51 --- /dev/null +++ b/lib/unbind.ml @@ -0,0 +1,34 @@ +open Sast +module StringSet = Set.Make (String) + +let rec unbind_expr se = + let t', sexpr' = se in + match sexpr' with + | SLiteral | SBoolLit | SFloatLit | SCharLit | SStringLit | SUnit | SEnumAccess -> t', sexpr' + | SBinop (se1, binop, se2) -> + | SUnop (se, unop) -> + | SUnopSideEffect | SMatch | SWildcard -> failwith("Dropping") + | SFunctionCall (func_name, func_args) -> + | SId id -> + | STuple -> + | SFunctionCall + | SUDTInstance + | SUDTAccess + | SUDTStaticAccess + | SIndex + | SList + | STypeCast + +and unbind_block sblk = + match sblk with + | + +and unbind_block_list sblk_list variables = + match sblk_list with + | [] -> [] + | sblk :: rest -> + let unbound_sblk, updated_variables = unbind_block sblk in + unbound_sblk :: unbind_block_list rest updated_variables + + +;; diff --git a/test/type_checker/test_bind.ml b/test/type_checker/test_bind.ml new file mode 100644 index 0000000..17e6a74 --- /dev/null +++ b/test/type_checker/test_bind.ml @@ -0,0 +1,63 @@ +open OUnit2 +open Fly_lib + +let check_program source_code = + let lexbuf = Lexing.from_string source_code in + let ast = Parser.program_rule Scanner.tokenize lexbuf in + try + let _ = Semant.check ast.body in + "" + with + | Failure msg -> msg +;; + +let tests = + "testing_return" + >::: [ ("static_bind" + >:: fun _ -> + let actual = check_program "type Person {name: string, age: int} bind new(name: string, age: int) -> Person { return Person {name: name, age: age}; }" in + let expected = "" in + assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) + ; ("non_static_bind" + >:: fun _ -> + let actual = + check_program + "type Person {name: string, age: int} bind get_age(self) -> int { return self.age; }" + in + let expected = "" in + assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) + + ; ("primitive_bind" + >:: fun _ -> + let actual = + check_program + "bind add(self, other: int) -> int { return self + other; }" + in + let expected = "" in + assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) + + ; ("non_primitive_bind" + >:: fun _ -> + let actual = + check_program + "bind search>(self, target: value) -> bool \n\ + \ { \n\ + for v := self { \n\ + \ if (v == target) { + \ return true; + \ } + \ } + \ return false; + }\n\ + + let x := [1,2,3,4,5]; + let res := x.search(3); + " + in + let expected = "" in + assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) + + ] +;; + +let _ = run_test_tt_main tests \ No newline at end of file From 37dffa5c20692e9fc16a57e53fa21128827a8da2 Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 15:25:49 -0400 Subject: [PATCH 2/9] set up skeleton --- lib/unbind.ml | 53 +++++++++++++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 19 deletions(-) diff --git a/lib/unbind.ml b/lib/unbind.ml index 4d26e51..bb25e08 100644 --- a/lib/unbind.ml +++ b/lib/unbind.ml @@ -1,27 +1,44 @@ open Sast module StringSet = Set.Make (String) -let rec unbind_expr se = - let t', sexpr' = se in - match sexpr' with - | SLiteral | SBoolLit | SFloatLit | SCharLit | SStringLit | SUnit | SEnumAccess -> t', sexpr' - | SBinop (se1, binop, se2) -> - | SUnop (se, unop) -> +let rec unbind_sexpr se = + let t', se' = se in + match se' with + | SLiteral | SBoolLit | SFloatLit | SCharLit | SStringLit | SUnit | SEnumAccess -> t', se' + | SBinop (se1, binop, se2) -> failwith("Unimplemented") + | SUnop (se, unop) -> failwith("Unimplemented") | SUnopSideEffect | SMatch | SWildcard -> failwith("Dropping") - | SFunctionCall (func_name, func_args) -> - | SId id -> - | STuple -> - | SFunctionCall - | SUDTInstance - | SUDTAccess - | SUDTStaticAccess - | SIndex - | SList - | STypeCast + | SFunctionCall (func_name, func_args) -> failwith("Unimplemented") + | SId id -> failwith("Unimplemented") + | STuple -> failwith("Unimplemented") + | SFunctionCall -> failwith("Unimplemented") + | SUDTInstance -> failwith("Unimplemented") + | SUDTAccess -> failwith("Unimplemented") + | SUDTStaticAccess -> failwith("Unimplemented") + | SIndex -> failwith("Unimplemented") + | SList -> failwith("Unimplemented") + | STypeCast -> failwith("Unimplemented") and unbind_block sblk = match sblk with - | + | SMutDeclTyped _ | SAssign _ -> failwith("Dropping") + | SDeclTyped (var_name, rt, se) -> SDeclTyped(var_name, rt, unbind_sexpr se) + | SFunctionDefinition sfunc_def -> SFunctionDefinition sfunc_def + | SBoundFunctionDefinition -> failwith("Unimplemented") + | SEnumDeclaration -> failwith("Unimplemented") + | SUDTDef -> failwith("Unimplemented") + | SIfEnd -> failwith("Unimplemented") + | SIfNonEnd -> failwith("Unimplemented") + | SElifNonEnd -> failwith("Unimplemented") + | SElifEnd -> failwith("Unimplemented") + | SElseEnd -> failwith("Unimplemented") + | SWhile -> failwith("Unimplemented") + | SFor -> failwith("Unimplemented") + | SBreak -> failwith("Unimplemented") + | SContinue -> failwith("Unimplemented") + | SReturnUnit -> failwith("Unimplemented") + | SReturnVal -> failwith("Unimplemented") + | SExpr se -> unbind_sexpr se and unbind_block_list sblk_list variables = match sblk_list with @@ -29,6 +46,4 @@ and unbind_block_list sblk_list variables = | sblk :: rest -> let unbound_sblk, updated_variables = unbind_block sblk in unbound_sblk :: unbind_block_list rest updated_variables - - ;; From abd4517214c640dfe2440bf738be892018e93abc Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 15:40:02 -0400 Subject: [PATCH 3/9] more skeleton --- lib/unbind.ml | 77 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 47 insertions(+), 30 deletions(-) diff --git a/lib/unbind.ml b/lib/unbind.ml index bb25e08..107e260 100644 --- a/lib/unbind.ml +++ b/lib/unbind.ml @@ -4,46 +4,63 @@ module StringSet = Set.Make (String) let rec unbind_sexpr se = let t', se' = se in match se' with - | SLiteral | SBoolLit | SFloatLit | SCharLit | SStringLit | SUnit | SEnumAccess -> t', se' + | SLiteral _ | SBoolLit _ | SFloatLit _ | SCharLit _ | SStringLit _ | SUnit | SEnumAccess _ -> t', se' + | SUnopSideEffect _ | SMatch _ | SWildcard -> failwith("Dropping") | SBinop (se1, binop, se2) -> failwith("Unimplemented") | SUnop (se, unop) -> failwith("Unimplemented") - | SUnopSideEffect | SMatch | SWildcard -> failwith("Dropping") | SFunctionCall (func_name, func_args) -> failwith("Unimplemented") | SId id -> failwith("Unimplemented") - | STuple -> failwith("Unimplemented") - | SFunctionCall -> failwith("Unimplemented") - | SUDTInstance -> failwith("Unimplemented") - | SUDTAccess -> failwith("Unimplemented") - | SUDTStaticAccess -> failwith("Unimplemented") - | SIndex -> failwith("Unimplemented") - | SList -> failwith("Unimplemented") - | STypeCast -> failwith("Unimplemented") + | STuple (se_list) -> failwith("Unimplemented") + | SUDTInstance (udt_name, udt_members) -> failwith("Unimplemented") + | SUDTAccess (udt_se, udt_member) -> failwith("Unimplemented") + | SUDTStaticAccess (udt_name, udt_static_func) -> failwith("Unimplemented") + | SIndex (indexed_se, index_val) -> failwith("Unimplemented") + | SList (se_list) -> failwith("Unimplemented") + | STypeCast (new_rt, target_se) -> failwith("Unimplemented") -and unbind_block sblk = +and unbind_block sblk variables = match sblk with - | SMutDeclTyped _ | SAssign _ -> failwith("Dropping") - | SDeclTyped (var_name, rt, se) -> SDeclTyped(var_name, rt, unbind_sexpr se) - | SFunctionDefinition sfunc_def -> SFunctionDefinition sfunc_def - | SBoundFunctionDefinition -> failwith("Unimplemented") - | SEnumDeclaration -> failwith("Unimplemented") - | SUDTDef -> failwith("Unimplemented") - | SIfEnd -> failwith("Unimplemented") - | SIfNonEnd -> failwith("Unimplemented") - | SElifNonEnd -> failwith("Unimplemented") - | SElifEnd -> failwith("Unimplemented") - | SElseEnd -> failwith("Unimplemented") - | SWhile -> failwith("Unimplemented") - | SFor -> failwith("Unimplemented") - | SBreak -> failwith("Unimplemented") - | SContinue -> failwith("Unimplemented") - | SReturnUnit -> failwith("Unimplemented") - | SReturnVal -> failwith("Unimplemented") - | SExpr se -> unbind_sexpr se + | SMutDeclTyped _ | SAssign _ -> + failwith("Dropping") + | SDeclTyped (var_name, rt, se) -> + variables, SDeclTyped(var_name, rt, unbind_sexpr se) + | SFunctionDefinition (rt, func_name, func_args, body) -> + variables, SFunctionDefinition (rt, func_name, func_args, body) + | SBoundFunctionDefinition (rt, func_name, func_args, body, bound_type) -> + variables, failwith("Unimplemented") + | SEnumDeclaration (enum_name, enum_variants) -> + variables, failwith("Unimplemented") + | SUDTDef (udt_name, udt_members) -> + variables, failwith("Unimplemented") + | SIfEnd (cond, if_body) -> + variables, failwith("Unimplemented") + | SIfNonEnd (cond, if_body, other) -> + variables, failwith("Unimplemented") + | SElifNonEnd (cond, elif_body, other) -> + variables, failwith("Unimplemented") + | SElifEnd (cond, elif_body) -> + variables, failwith("Unimplemented") + | SElseEnd (else_body) -> + variables, failwith("Unimplemented") + | SWhile (se, while_body) -> + variables, failwith("Unimplemented") + | SFor (iterator, iterable_se, for_body) -> + variables, failwith("Unimplemented") + | SBreak -> + variables, SBreak + | SContinue -> + variables, SContinue + | SReturnUnit -> + variables, SReturnUnit + | SReturnVal se -> + variables, SReturnVal (unbind_sexpr se) + | SExpr se -> + variables, SExpr (unbind_sexpr se) and unbind_block_list sblk_list variables = match sblk_list with | [] -> [] | sblk :: rest -> - let unbound_sblk, updated_variables = unbind_block sblk in + let updated_variables, unbound_sblk = unbind_block sblk variables in unbound_sblk :: unbind_block_list rest updated_variables ;; From f2d755301b8eeccdd87be783a78ae544825833fa Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 16:22:45 -0400 Subject: [PATCH 4/9] i see the light --- lib/unbind.ml | 106 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 77 insertions(+), 29 deletions(-) diff --git a/lib/unbind.ml b/lib/unbind.ml index 107e260..e92faa1 100644 --- a/lib/unbind.ml +++ b/lib/unbind.ml @@ -1,51 +1,99 @@ open Sast module StringSet = Set.Make (String) -let rec unbind_sexpr se = +let rec unbind_sexpr se replace_self new_var_name = let t', se' = se in match se' with | SLiteral _ | SBoolLit _ | SFloatLit _ | SCharLit _ | SStringLit _ | SUnit | SEnumAccess _ -> t', se' | SUnopSideEffect _ | SMatch _ | SWildcard -> failwith("Dropping") - | SBinop (se1, binop, se2) -> failwith("Unimplemented") - | SUnop (se, unop) -> failwith("Unimplemented") - | SFunctionCall (func_name, func_args) -> failwith("Unimplemented") - | SId id -> failwith("Unimplemented") - | STuple (se_list) -> failwith("Unimplemented") - | SUDTInstance (udt_name, udt_members) -> failwith("Unimplemented") - | SUDTAccess (udt_se, udt_member) -> failwith("Unimplemented") - | SUDTStaticAccess (udt_name, udt_static_func) -> failwith("Unimplemented") - | SIndex (indexed_se, index_val) -> failwith("Unimplemented") - | SList (se_list) -> failwith("Unimplemented") - | STypeCast (new_rt, target_se) -> failwith("Unimplemented") + | SBinop (se1, binop, se2) -> + let unbound_se1 = unbind_sexpr se1 replace_self new_var_name in + let unbound_se2 = unbind_sexpr se2 replace_self new_var_name in + t', SBinop (unbound_se1, binop, unbound_se2) + | SUnop (se, unop) -> + let unbound_se = unbind_sexpr se replace_self new_var_name in + t', SUnop (unbound_se, unop) + | SFunctionCall (func_name, func_args) -> + let unbound_args = List.map (fun arg -> unbind_sexpr arg replace_self new_var_name) func_args in + t', SFunctionCall (func_name, unbound_args) + | SId id -> + if replace_self && id = "self" + then t', SId new_var_name + else t', SId id + | STuple (se_list) -> + let unbound_se_list = List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list in + t', STuple (unbound_se_list) + | SUDTInstance (udt_name, udt_members) -> + let unbound_udt_members = List.map (fun member -> fst member, unbind_sexpr (snd member) replace_self new_var_name) udt_members in + t', SUDTInstance (udt_name, unbound_udt_members) + | SUDTAccess (udt_se, udt_member) -> + let unbound_udt_se = unbind_sexpr udt_se replace_self new_var_name in + t', SUDTAccess (unbound_udt_se, udt_member) + | SUDTStaticAccess (udt_name, udt_static_func) -> + t', SUDTStaticAccess (udt_name, udt_static_func) + | SIndex (indexed_se, index_val) -> + let unbound_indexed_se = unbind_sexpr indexed_se replace_self new_var_name in + let unbound_index_val = unbind_sexpr index_val replace_self new_var_name in + t', SIndex (unbound_indexed_se, unbound_index_val) + | SList (se_list) -> + let unbound_se_list = List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list in + t', SList (unbound_se_list) + | STypeCast (new_rt, target_se) -> + let unbound_target_se = unbind_sexpr target_se replace_self new_var_name in + t', STypeCast (new_rt, unbound_target_se) -and unbind_block sblk variables = +and unbind_block sblk variables replace_self new_var_name = match sblk with | SMutDeclTyped _ | SAssign _ -> failwith("Dropping") | SDeclTyped (var_name, rt, se) -> - variables, SDeclTyped(var_name, rt, unbind_sexpr se) + let updated_variables = StringSet.add var_name variables in + updated_variables, SDeclTyped(var_name, rt, unbind_sexpr se replace_self new_var_name) | SFunctionDefinition (rt, func_name, func_args, body) -> - variables, SFunctionDefinition (rt, func_name, func_args, body) + let rec add_func_args args vars = + (match args with + | [] -> vars + | curr :: rest -> + let new_vars = StringSet.add (fst curr) vars in + add_func_args rest new_vars) + in + let updated_variables = add_func_args func_args variables in + let unbound_body = unbind_block_list body updated_variables in + updated_variables, SFunctionDefinition (rt, func_name, func_args, unbound_body) | SBoundFunctionDefinition (rt, func_name, func_args, body, bound_type) -> - variables, failwith("Unimplemented") + + variables, SBoundFunctionDefinition (rt, func_name, func_args, body, bound_type) | SEnumDeclaration (enum_name, enum_variants) -> - variables, failwith("Unimplemented") + variables, SEnumDeclaration (enum_name, enum_variants) | SUDTDef (udt_name, udt_members) -> - variables, failwith("Unimplemented") + variables, SUDTDef (udt_name, udt_members) | SIfEnd (cond, if_body) -> - variables, failwith("Unimplemented") + let unbound_cond = unbind_sexpr cond replace_self new_var_name in + variables, SIfEnd (unbound_cond, if_body) | SIfNonEnd (cond, if_body, other) -> - variables, failwith("Unimplemented") - | SElifNonEnd (cond, elif_body, other) -> - variables, failwith("Unimplemented") + let unbound_cond = unbind_sexpr cond replace_self new_var_name in + let unbound_if_body = unbind_block_list if_body variables in + let updated_variables, unbound_other = unbind_block other variables replace_self new_var_name in + updated_variables, SIfNonEnd (unbound_cond, unbound_if_body, unbound_other) + | SElifNonEnd (cond, elif_body, other) -> + let unbound_cond = unbind_sexpr cond replace_self new_var_name in + let unbound_elif_body = unbind_block_list elif_body variables in + let updated_variables, unbound_other = unbind_block other variables replace_self new_var_name in + updated_variables, SElifNonEnd (unbound_cond, unbound_elif_body, unbound_other) | SElifEnd (cond, elif_body) -> - variables, failwith("Unimplemented") + let unbound_cond = unbind_sexpr cond replace_self new_var_name in + let unbound_elif_body = unbind_block_list elif_body variables in + variables, SElifEnd (unbound_cond, unbound_elif_body) | SElseEnd (else_body) -> - variables, failwith("Unimplemented") + let unbound_else_body = unbind_block_list else_body variables in + variables, SElseEnd (unbound_else_body) | SWhile (se, while_body) -> - variables, failwith("Unimplemented") + let unbound_se = unbind_sexpr se replace_self new_var_name in + variables, SWhile (unbound_se, while_body) | SFor (iterator, iterable_se, for_body) -> - variables, failwith("Unimplemented") + let unbound_iterable_se = unbind_sexpr iterable_se replace_self new_var_name in + let unbound_for_body = unbind_block_list for_body variables in + variables, SFor (iterator, unbound_iterable_se, unbound_for_body) | SBreak -> variables, SBreak | SContinue -> @@ -53,14 +101,14 @@ and unbind_block sblk variables = | SReturnUnit -> variables, SReturnUnit | SReturnVal se -> - variables, SReturnVal (unbind_sexpr se) + variables, SReturnVal (unbind_sexpr se replace_self new_var_name) | SExpr se -> - variables, SExpr (unbind_sexpr se) + variables, SExpr (unbind_sexpr se replace_self new_var_name) and unbind_block_list sblk_list variables = match sblk_list with | [] -> [] | sblk :: rest -> - let updated_variables, unbound_sblk = unbind_block sblk variables in + let updated_variables, unbound_sblk = unbind_block sblk variables false "" in unbound_sblk :: unbind_block_list rest updated_variables ;; From c1d69721237a9b72003279bd21e52cd461fe55fd Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 17:34:54 -0400 Subject: [PATCH 5/9] pass ir tests --- bin/fly.ml | 3 +- lib/unbind.ml | 80 ++++++++++++++++++++++++++--------------- test/ir/test_cond.ml | 3 +- test/ir/test_enums.ml | 3 +- test/ir/test_ir.ml | 4 +-- test/ir/test_list.ml | 4 +-- test/ir/test_prelude.ml | 4 +-- test/ir/test_string.ml | 4 +-- test/ir/test_udt.ml | 4 +-- test/ir/test_vars.ml | 4 +-- 10 files changed, 69 insertions(+), 44 deletions(-) diff --git a/bin/fly.ml b/bin/fly.ml index f49989c..eb82e04 100644 --- a/bin/fly.ml +++ b/bin/fly.ml @@ -61,7 +61,8 @@ let read_and_compile channel = let lexbuf = Lexing.from_channel channel in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Semant.check ast.body in - let md = Irgen.translate sast in + let unbound_sast = Unbind.unbind sast in + let md = Irgen.translate unbound_sast in (* Inititalize triples that llvm needs to create a target *) Llvm_all_backends.initialize (); diff --git a/lib/unbind.ml b/lib/unbind.ml index e92faa1..0079f1d 100644 --- a/lib/unbind.ml +++ b/lib/unbind.ml @@ -1,7 +1,20 @@ open Sast module StringSet = Set.Make (String) -let rec unbind_sexpr se replace_self new_var_name = +let rec add_func_args args vars = + (match args with + | [] -> vars + | curr :: rest -> + let new_vars = StringSet.add (fst curr) vars in + add_func_args rest new_vars) + +and fresh_var_name base_name vars counter = + let candidate = base_name ^ string_of_int counter in + if StringSet.mem candidate vars then + fresh_var_name base_name vars (counter + 1) + else + candidate +and unbind_sexpr se replace_self new_var_name = let t', se' = se in match se' with | SLiteral _ | SBoolLit _ | SFloatLit _ | SCharLit _ | SStringLit _ | SUnit | SEnumAccess _ -> t', se' @@ -28,7 +41,12 @@ let rec unbind_sexpr se replace_self new_var_name = t', SUDTInstance (udt_name, unbound_udt_members) | SUDTAccess (udt_se, udt_member) -> let unbound_udt_se = unbind_sexpr udt_se replace_self new_var_name in - t', SUDTAccess (unbound_udt_se, udt_member) + (match udt_member with + | SUDTVariable x -> t', SUDTAccess(unbound_udt_se, SUDTVariable x) + | SUDTFunction (udt_func_name, udt_func_params) -> + let unbound_udt_func_params = List.map (fun param -> unbind_sexpr param replace_self new_var_name) udt_func_params in + t', SFunctionCall(udt_func_name, unbound_udt_func_params)) + | SUDTStaticAccess (udt_name, udt_static_func) -> t', SUDTStaticAccess (udt_name, udt_static_func) | SIndex (indexed_se, index_val) -> @@ -50,19 +68,17 @@ and unbind_block sblk variables replace_self new_var_name = let updated_variables = StringSet.add var_name variables in updated_variables, SDeclTyped(var_name, rt, unbind_sexpr se replace_self new_var_name) | SFunctionDefinition (rt, func_name, func_args, body) -> - let rec add_func_args args vars = - (match args with - | [] -> vars - | curr :: rest -> - let new_vars = StringSet.add (fst curr) vars in - add_func_args rest new_vars) - in - let updated_variables = add_func_args func_args variables in - let unbound_body = unbind_block_list body updated_variables in - updated_variables, SFunctionDefinition (rt, func_name, func_args, unbound_body) - | SBoundFunctionDefinition (rt, func_name, func_args, body, bound_type) -> - - variables, SBoundFunctionDefinition (rt, func_name, func_args, body, bound_type) + let updated_variables1 = add_func_args func_args variables in + let updated_variables2, unbound_body = unbind_block_list body updated_variables1 in + updated_variables2, SFunctionDefinition (rt, func_name, func_args, unbound_body) + | SBoundFunctionDefinition (rt, func_name, func_args, body, _) -> + let updated_variables1 = add_func_args func_args variables in + let updated_variables2, _ = unbind_block_list body updated_variables1 in + let var_name = fresh_var_name "tmp" updated_variables2 0 in + let updated_func_args = List.map (fun (arg_name, arg_type) -> if arg_name = "self" then (var_name, arg_type) else (arg_name, arg_type)) func_args in + let updated_variables3 = add_func_args updated_func_args variables in + let _, unbound_body = unbind_block_list body updated_variables3 in + variables, SFunctionDefinition (rt, func_name, updated_func_args, unbound_body) | SEnumDeclaration (enum_name, enum_variants) -> variables, SEnumDeclaration (enum_name, enum_variants) | SUDTDef (udt_name, udt_members) -> @@ -72,28 +88,28 @@ and unbind_block sblk variables replace_self new_var_name = variables, SIfEnd (unbound_cond, if_body) | SIfNonEnd (cond, if_body, other) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let unbound_if_body = unbind_block_list if_body variables in - let updated_variables, unbound_other = unbind_block other variables replace_self new_var_name in - updated_variables, SIfNonEnd (unbound_cond, unbound_if_body, unbound_other) + let updated_variables1, unbound_if_body = unbind_block_list if_body variables in + let updated_variables2, unbound_other = unbind_block other updated_variables1 replace_self new_var_name in + updated_variables2, SIfNonEnd (unbound_cond, unbound_if_body, unbound_other) | SElifNonEnd (cond, elif_body, other) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let unbound_elif_body = unbind_block_list elif_body variables in - let updated_variables, unbound_other = unbind_block other variables replace_self new_var_name in - updated_variables, SElifNonEnd (unbound_cond, unbound_elif_body, unbound_other) + let updated_variables1, unbound_elif_body = unbind_block_list elif_body variables in + let updated_variables2, unbound_other = unbind_block other updated_variables1 replace_self new_var_name in + updated_variables2, SElifNonEnd (unbound_cond, unbound_elif_body, unbound_other) | SElifEnd (cond, elif_body) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let unbound_elif_body = unbind_block_list elif_body variables in - variables, SElifEnd (unbound_cond, unbound_elif_body) + let updated_variables, unbound_elif_body = unbind_block_list elif_body variables in + updated_variables, SElifEnd (unbound_cond, unbound_elif_body) | SElseEnd (else_body) -> - let unbound_else_body = unbind_block_list else_body variables in - variables, SElseEnd (unbound_else_body) + let updated_variables, unbound_else_body = unbind_block_list else_body variables in + updated_variables, SElseEnd (unbound_else_body) | SWhile (se, while_body) -> let unbound_se = unbind_sexpr se replace_self new_var_name in variables, SWhile (unbound_se, while_body) | SFor (iterator, iterable_se, for_body) -> let unbound_iterable_se = unbind_sexpr iterable_se replace_self new_var_name in - let unbound_for_body = unbind_block_list for_body variables in - variables, SFor (iterator, unbound_iterable_se, unbound_for_body) + let updated_variables, unbound_for_body = unbind_block_list for_body variables in + updated_variables, SFor (iterator, unbound_iterable_se, unbound_for_body) | SBreak -> variables, SBreak | SContinue -> @@ -107,8 +123,14 @@ and unbind_block sblk variables replace_self new_var_name = and unbind_block_list sblk_list variables = match sblk_list with - | [] -> [] + | [] -> (variables, []) | sblk :: rest -> let updated_variables, unbound_sblk = unbind_block sblk variables false "" in - unbound_sblk :: unbind_block_list rest updated_variables + updated_variables, unbound_sblk :: snd (unbind_block_list rest updated_variables) ;; + +let unbind sblk_list = + let variables = StringSet.empty in + let _, unbound_sblk_list = unbind_block_list sblk_list variables in + unbound_sblk_list +;; \ No newline at end of file diff --git a/test/ir/test_cond.ml b/test/ir/test_cond.ml index 4cc9a29..28e19fe 100644 --- a/test/ir/test_cond.ml +++ b/test/ir/test_cond.ml @@ -7,7 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise diff --git a/test/ir/test_enums.ml b/test/ir/test_enums.ml index 3698ea4..c38ed9c 100644 --- a/test/ir/test_enums.ml +++ b/test/ir/test_enums.ml @@ -7,7 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise diff --git a/test/ir/test_ir.ml b/test/ir/test_ir.ml index f0c0a05..e5547ea 100644 --- a/test/ir/test_ir.ml +++ b/test/ir/test_ir.ml @@ -7,8 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast - with + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise (Failure diff --git a/test/ir/test_list.ml b/test/ir/test_list.ml index 1c8b4fe..4fd3d08 100644 --- a/test/ir/test_list.ml +++ b/test/ir/test_list.ml @@ -7,8 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast - with + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise (Failure diff --git a/test/ir/test_prelude.ml b/test/ir/test_prelude.ml index be64c57..317fe94 100644 --- a/test/ir/test_prelude.ml +++ b/test/ir/test_prelude.ml @@ -9,8 +9,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast - with + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise (Failure diff --git a/test/ir/test_string.ml b/test/ir/test_string.ml index eb2643c..db184a6 100644 --- a/test/ir/test_string.ml +++ b/test/ir/test_string.ml @@ -7,8 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast - with + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise (Failure diff --git a/test/ir/test_udt.ml b/test/ir/test_udt.ml index bcb71d1..e0d4202 100644 --- a/test/ir/test_udt.ml +++ b/test/ir/test_udt.ml @@ -7,8 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast - with + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise (Failure diff --git a/test/ir/test_vars.ml b/test/ir/test_vars.ml index 7754ad6..90c5c04 100644 --- a/test/ir/test_vars.ml +++ b/test/ir/test_vars.ml @@ -7,8 +7,8 @@ let get_sast input = let lexbuf = Lexing.from_string input in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in - sast - with + let unbound_sast = Fly_lib.Unbind.unbind sast in + unbound_sast with | err -> raise (Failure From ba122d3525f69c28bce6fd55858c11b51b6ba0fd Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 18:28:29 -0400 Subject: [PATCH 6/9] bind should be working --- bin/fly.ml | 3 +- lib/unbind.ml | 184 +++++++++++++++++++-------------- test/ir/test_ir.ml | 3 +- test/ir/test_list.ml | 3 +- test/ir/test_prelude.ml | 3 +- test/ir/test_string.ml | 3 +- test/ir/test_udt.ml | 3 +- test/ir/test_vars.ml | 3 +- test/type_checker/test_bind.ml | 39 +++---- 9 files changed, 141 insertions(+), 103 deletions(-) diff --git a/bin/fly.ml b/bin/fly.ml index eb82e04..80516e3 100644 --- a/bin/fly.ml +++ b/bin/fly.ml @@ -53,7 +53,8 @@ let read_and_print_ir channel = let lexbuf = Lexing.from_channel channel in let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Semant.check ast.body in - let md = Irgen.translate sast in + let unbound_sast = Unbind.unbind sast in + let md = Irgen.translate unbound_sast in print_endline (L.string_of_llmodule md) ;; diff --git a/lib/unbind.ml b/lib/unbind.ml index 0079f1d..85037aa 100644 --- a/lib/unbind.ml +++ b/lib/unbind.ml @@ -1,136 +1,166 @@ open Sast module StringSet = Set.Make (String) -let rec add_func_args args vars = - (match args with +let rec add_func_args args vars = + match args with | [] -> vars - | curr :: rest -> + | curr :: rest -> let new_vars = StringSet.add (fst curr) vars in - add_func_args rest new_vars) + add_func_args rest new_vars and fresh_var_name base_name vars counter = let candidate = base_name ^ string_of_int counter in - if StringSet.mem candidate vars then - fresh_var_name base_name vars (counter + 1) - else - candidate + if StringSet.mem candidate vars + then fresh_var_name base_name vars (counter + 1) + else candidate + and unbind_sexpr se replace_self new_var_name = let t', se' = se in match se' with - | SLiteral _ | SBoolLit _ | SFloatLit _ | SCharLit _ | SStringLit _ | SUnit | SEnumAccess _ -> t', se' - | SUnopSideEffect _ | SMatch _ | SWildcard -> failwith("Dropping") - | SBinop (se1, binop, se2) -> + | SLiteral _ + | SBoolLit _ + | SFloatLit _ + | SCharLit _ + | SStringLit _ + | SUnit + | SEnumAccess _ -> t', se' + | SUnopSideEffect _ | SMatch _ | SWildcard -> failwith "Dropping" + | SBinop (se1, binop, se2) -> let unbound_se1 = unbind_sexpr se1 replace_self new_var_name in let unbound_se2 = unbind_sexpr se2 replace_self new_var_name in t', SBinop (unbound_se1, binop, unbound_se2) - | SUnop (se, unop) -> + | SUnop (se, unop) -> let unbound_se = unbind_sexpr se replace_self new_var_name in t', SUnop (unbound_se, unop) - | SFunctionCall (func_name, func_args) -> - let unbound_args = List.map (fun arg -> unbind_sexpr arg replace_self new_var_name) func_args in + | SFunctionCall (func_name, func_args) -> + let unbound_args = + List.map (fun arg -> unbind_sexpr arg replace_self new_var_name) func_args + in t', SFunctionCall (func_name, unbound_args) | SId id -> if replace_self && id = "self" - then t', SId new_var_name - else t', SId id - | STuple (se_list) -> - let unbound_se_list = List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list in - t', STuple (unbound_se_list) - | SUDTInstance (udt_name, udt_members) -> - let unbound_udt_members = List.map (fun member -> fst member, unbind_sexpr (snd member) replace_self new_var_name) udt_members in + then ( + print_endline ("Replaced 'self' with '" ^ new_var_name ^ "' in SId"); + t', SId new_var_name + ) else t', SId id + | STuple se_list -> + let unbound_se_list = + List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list + in + t', STuple unbound_se_list + | SUDTInstance (udt_name, udt_members) -> + let unbound_udt_members = + List.map + (fun member -> fst member, unbind_sexpr (snd member) replace_self new_var_name) + udt_members + in t', SUDTInstance (udt_name, unbound_udt_members) - | SUDTAccess (udt_se, udt_member) -> + | SUDTAccess (udt_se, udt_member) -> let unbound_udt_se = unbind_sexpr udt_se replace_self new_var_name in (match udt_member with - | SUDTVariable x -> t', SUDTAccess(unbound_udt_se, SUDTVariable x) - | SUDTFunction (udt_func_name, udt_func_params) -> - let unbound_udt_func_params = List.map (fun param -> unbind_sexpr param replace_self new_var_name) udt_func_params in - t', SFunctionCall(udt_func_name, unbound_udt_func_params)) - - | SUDTStaticAccess (udt_name, udt_static_func) -> + | SUDTVariable x -> t', SUDTAccess (unbound_udt_se, SUDTVariable x) + | SUDTFunction (udt_func_name, udt_func_params) -> + let unbound_params = + List.map + (fun param -> unbind_sexpr param replace_self new_var_name) + udt_func_params + in + (* let unbound_params2 = unbound_params1 @ [ (fst unbound_udt_se, SId new_var_name ) ] in *) + t', SFunctionCall (udt_func_name, unbound_params)) + + | SUDTStaticAccess (udt_name, udt_static_func) -> t', SUDTStaticAccess (udt_name, udt_static_func) - | SIndex (indexed_se, index_val) -> + | SIndex (indexed_se, index_val) -> let unbound_indexed_se = unbind_sexpr indexed_se replace_self new_var_name in let unbound_index_val = unbind_sexpr index_val replace_self new_var_name in t', SIndex (unbound_indexed_se, unbound_index_val) - | SList (se_list) -> - let unbound_se_list = List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list in - t', SList (unbound_se_list) - | STypeCast (new_rt, target_se) -> + | SList se_list -> + let unbound_se_list = + List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list + in + t', SList unbound_se_list + | STypeCast (new_rt, target_se) -> let unbound_target_se = unbind_sexpr target_se replace_self new_var_name in t', STypeCast (new_rt, unbound_target_se) and unbind_block sblk variables replace_self new_var_name = match sblk with - | SMutDeclTyped _ | SAssign _ -> - failwith("Dropping") - | SDeclTyped (var_name, rt, se) -> + | SMutDeclTyped _ | SAssign _ -> failwith "Dropping" + | SDeclTyped (var_name, rt, se) -> let updated_variables = StringSet.add var_name variables in - updated_variables, SDeclTyped(var_name, rt, unbind_sexpr se replace_self new_var_name) - | SFunctionDefinition (rt, func_name, func_args, body) -> + updated_variables, SDeclTyped (var_name, rt, unbind_sexpr se replace_self new_var_name) + | SFunctionDefinition (rt, func_name, func_args, body) -> let updated_variables1 = add_func_args func_args variables in - let updated_variables2, unbound_body = unbind_block_list body updated_variables1 in + let updated_variables2, unbound_body = unbind_block_list body updated_variables1 replace_self new_var_name in updated_variables2, SFunctionDefinition (rt, func_name, func_args, unbound_body) - | SBoundFunctionDefinition (rt, func_name, func_args, body, _) -> + | SBoundFunctionDefinition (rt, func_name, func_args, body, _) -> let updated_variables1 = add_func_args func_args variables in - let updated_variables2, _ = unbind_block_list body updated_variables1 in + let updated_variables2, _ = unbind_block_list body updated_variables1 replace_self new_var_name in let var_name = fresh_var_name "tmp" updated_variables2 0 in - let updated_func_args = List.map (fun (arg_name, arg_type) -> if arg_name = "self" then (var_name, arg_type) else (arg_name, arg_type)) func_args in + let updated_func_args = + List.map + (fun (arg_name, arg_type) -> + if arg_name = "self" then ( + print_endline ("Replaced 'self' with '" ^ var_name ^ "' in tuple"); + (var_name, arg_type) + ) + + else arg_name, arg_type) + func_args + in let updated_variables3 = add_func_args updated_func_args variables in - let _, unbound_body = unbind_block_list body updated_variables3 in + let _, unbound_body = unbind_block_list body updated_variables3 true var_name in variables, SFunctionDefinition (rt, func_name, updated_func_args, unbound_body) - | SEnumDeclaration (enum_name, enum_variants) -> + | SEnumDeclaration (enum_name, enum_variants) -> variables, SEnumDeclaration (enum_name, enum_variants) - | SUDTDef (udt_name, udt_members) -> - variables, SUDTDef (udt_name, udt_members) - | SIfEnd (cond, if_body) -> + | SUDTDef (udt_name, udt_members) -> variables, SUDTDef (udt_name, udt_members) + | SIfEnd (cond, if_body) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in variables, SIfEnd (unbound_cond, if_body) - | SIfNonEnd (cond, if_body, other) -> + | SIfNonEnd (cond, if_body, other) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let updated_variables1, unbound_if_body = unbind_block_list if_body variables in - let updated_variables2, unbound_other = unbind_block other updated_variables1 replace_self new_var_name in + let updated_variables1, unbound_if_body = unbind_block_list if_body variables replace_self new_var_name in + let updated_variables2, unbound_other = + unbind_block other updated_variables1 replace_self new_var_name + in updated_variables2, SIfNonEnd (unbound_cond, unbound_if_body, unbound_other) | SElifNonEnd (cond, elif_body, other) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let updated_variables1, unbound_elif_body = unbind_block_list elif_body variables in - let updated_variables2, unbound_other = unbind_block other updated_variables1 replace_self new_var_name in + let updated_variables1, unbound_elif_body = unbind_block_list elif_body variables replace_self new_var_name in + let updated_variables2, unbound_other = + unbind_block other updated_variables1 replace_self new_var_name + in updated_variables2, SElifNonEnd (unbound_cond, unbound_elif_body, unbound_other) - | SElifEnd (cond, elif_body) -> + | SElifEnd (cond, elif_body) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let updated_variables, unbound_elif_body = unbind_block_list elif_body variables in + let updated_variables, unbound_elif_body = unbind_block_list elif_body variables replace_self new_var_name in updated_variables, SElifEnd (unbound_cond, unbound_elif_body) - | SElseEnd (else_body) -> - let updated_variables, unbound_else_body = unbind_block_list else_body variables in - updated_variables, SElseEnd (unbound_else_body) - | SWhile (se, while_body) -> + | SElseEnd else_body -> + let updated_variables, unbound_else_body = unbind_block_list else_body variables replace_self new_var_name in + updated_variables, SElseEnd unbound_else_body + | SWhile (se, while_body) -> let unbound_se = unbind_sexpr se replace_self new_var_name in variables, SWhile (unbound_se, while_body) - | SFor (iterator, iterable_se, for_body) -> + | SFor (iterator, iterable_se, for_body) -> let unbound_iterable_se = unbind_sexpr iterable_se replace_self new_var_name in - let updated_variables, unbound_for_body = unbind_block_list for_body variables in + let updated_variables, unbound_for_body = unbind_block_list for_body variables replace_self new_var_name in updated_variables, SFor (iterator, unbound_iterable_se, unbound_for_body) - | SBreak -> - variables, SBreak - | SContinue -> - variables, SContinue - | SReturnUnit -> - variables, SReturnUnit - | SReturnVal se -> - variables, SReturnVal (unbind_sexpr se replace_self new_var_name) - | SExpr se -> - variables, SExpr (unbind_sexpr se replace_self new_var_name) + | SBreak -> variables, SBreak + | SContinue -> variables, SContinue + | SReturnUnit -> variables, SReturnUnit + | SReturnVal se -> variables, SReturnVal (unbind_sexpr se replace_self new_var_name) + | SExpr se -> variables, SExpr (unbind_sexpr se replace_self new_var_name) -and unbind_block_list sblk_list variables = +and unbind_block_list sblk_list variables replace_self var_name = match sblk_list with - | [] -> (variables, []) - | sblk :: rest -> - let updated_variables, unbound_sblk = unbind_block sblk variables false "" in - updated_variables, unbound_sblk :: snd (unbind_block_list rest updated_variables) + | [] -> variables, [] + | sblk :: rest -> + let updated_variables, unbound_sblk = unbind_block sblk variables replace_self var_name in + updated_variables, unbound_sblk :: snd (unbind_block_list rest updated_variables replace_self var_name) ;; -let unbind sblk_list = +let unbind sblk_list = let variables = StringSet.empty in - let _, unbound_sblk_list = unbind_block_list sblk_list variables in + let _, unbound_sblk_list = unbind_block_list sblk_list variables false "" in unbound_sblk_list ;; \ No newline at end of file diff --git a/test/ir/test_ir.ml b/test/ir/test_ir.ml index e5547ea..2c9ac4a 100644 --- a/test/ir/test_ir.ml +++ b/test/ir/test_ir.ml @@ -8,7 +8,8 @@ let get_sast input = let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in let unbound_sast = Fly_lib.Unbind.unbind sast in - unbound_sast with + unbound_sast + with | err -> raise (Failure diff --git a/test/ir/test_list.ml b/test/ir/test_list.ml index 4fd3d08..2d5aa3c 100644 --- a/test/ir/test_list.ml +++ b/test/ir/test_list.ml @@ -8,7 +8,8 @@ let get_sast input = let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in let unbound_sast = Fly_lib.Unbind.unbind sast in - unbound_sast with + unbound_sast + with | err -> raise (Failure diff --git a/test/ir/test_prelude.ml b/test/ir/test_prelude.ml index 317fe94..b1664d0 100644 --- a/test/ir/test_prelude.ml +++ b/test/ir/test_prelude.ml @@ -10,7 +10,8 @@ let get_sast input = let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in let unbound_sast = Fly_lib.Unbind.unbind sast in - unbound_sast with + unbound_sast + with | err -> raise (Failure diff --git a/test/ir/test_string.ml b/test/ir/test_string.ml index db184a6..956478c 100644 --- a/test/ir/test_string.ml +++ b/test/ir/test_string.ml @@ -8,7 +8,8 @@ let get_sast input = let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in let unbound_sast = Fly_lib.Unbind.unbind sast in - unbound_sast with + unbound_sast + with | err -> raise (Failure diff --git a/test/ir/test_udt.ml b/test/ir/test_udt.ml index e0d4202..34955a9 100644 --- a/test/ir/test_udt.ml +++ b/test/ir/test_udt.ml @@ -8,7 +8,8 @@ let get_sast input = let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in let unbound_sast = Fly_lib.Unbind.unbind sast in - unbound_sast with + unbound_sast + with | err -> raise (Failure diff --git a/test/ir/test_vars.ml b/test/ir/test_vars.ml index 90c5c04..093278e 100644 --- a/test/ir/test_vars.ml +++ b/test/ir/test_vars.ml @@ -8,7 +8,8 @@ let get_sast input = let ast = Fly_lib.Parser.program_rule Fly_lib.Scanner.tokenize lexbuf in let sast = Fly_lib.Semant.check ast.body in let unbound_sast = Fly_lib.Unbind.unbind sast in - unbound_sast with + unbound_sast + with | err -> raise (Failure diff --git a/test/type_checker/test_bind.ml b/test/type_checker/test_bind.ml index 17e6a74..f7ed71d 100644 --- a/test/type_checker/test_bind.ml +++ b/test/type_checker/test_bind.ml @@ -15,19 +15,23 @@ let tests = "testing_return" >::: [ ("static_bind" >:: fun _ -> - let actual = check_program "type Person {name: string, age: int} bind new(name: string, age: int) -> Person { return Person {name: name, age: age}; }" in + let actual = + check_program + "type Person {name: string, age: int} bind new(name: string, age: \ + int) -> Person { return Person {name: name, age: age}; }" + in let expected = "" in assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) ; ("non_static_bind" >:: fun _ -> let actual = check_program - "type Person {name: string, age: int} bind get_age(self) -> int { return self.age; }" + "type Person {name: string, age: int} bind get_age(self) -> int { \ + return self.age; }" in let expected = "" in assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) - - ; ("primitive_bind" + ; ("primitive_bind" >:: fun _ -> let actual = check_program @@ -35,29 +39,26 @@ let tests = in let expected = "" in assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) - - ; ("non_primitive_bind" + ; ("non_primitive_bind" >:: fun _ -> let actual = check_program "bind search>(self, target: value) -> bool \n\ \ { \n\ - for v := self { \n\ - \ if (v == target) { - \ return true; - \ } - \ } - \ return false; - }\n\ - - let x := [1,2,3,4,5]; - let res := x.search(3); - " + for v := self { \n\ + \ if (v == target) {\n\ + \ return true;\n\ + \ }\n\ + \ }\n\ + \ return false;\n\ + \ }\n\n\ + \ let x := [1,2,3,4,5];\n\ + \ let res := x.search(3);\n\ + \ " in let expected = "" in assert_equal expected actual ~printer:(fun s -> "\"" ^ s ^ "\"")) - ] ;; -let _ = run_test_tt_main tests \ No newline at end of file +let _ = run_test_tt_main tests From 05ad6a51f3bb5d02dbdb117b9931b91e74f56520 Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 19:16:58 -0400 Subject: [PATCH 7/9] prep for merge --- lib/irgen.ml | 97 +++++++++++++++++++++++++++++++++------------------ lib/semant.ml | 2 +- lib/unbind.ml | 49 ++++++++++++++++---------- 3 files changed, 94 insertions(+), 54 deletions(-) diff --git a/lib/irgen.ml b/lib/irgen.ml index ad47617..b20b464 100644 --- a/lib/irgen.ml +++ b/lib/irgen.ml @@ -131,13 +131,6 @@ let define_udt_type name members = L.struct_set_body struct_ll_type field_ll_types_array false ;; -(* let define_udt_type name members = *) -(* let field_types = List.map (fun (_, t) -> ltype_of_typ t) members in *) -(* let struct_type = L.struct_type context (Array.of_list field_types) in *) -(* Hashtbl.add udt_structs name struct_type; *) -(* Hashtbl.add udt_field_indices name (List.mapi (fun i (name, _) -> name, i) members) *) -(* ;; *) - let build_udt_access typ var_name field_name vars builder = let struct_ptr = lookup_value vars var_name in let var_typ = @@ -217,6 +210,7 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build | A.Postincr | A.Postdecr -> ll_original_val | A.Preincr | A.Predecr -> ll_new_val | _ -> failwith "Could apply incr/decr to variable") + (* In build_expr, replacing the SFunctionCall case *) | SFunctionCall (func_name, actual_s_exprs_list) -> if func_name = print_func_name then prelude_print (func_name, actual_s_exprs_list) vars var_types the_module builder @@ -229,46 +223,81 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build match L.lookup_function func_name the_module with | Some f -> f | None -> - failwith - (Printf.sprintf - "IRgen build_expr: Function '%s' not found in LLVM module. (Was it \ - declared in Pass 1?)" - func_name) + raise (Failure (Printf.sprintf "IRgen: Function '%s' not declared" func_name)) in - let exp_formals, exp_ret_typ = + let sast_expected_formals, sast_expected_return_typ = try StringMap.find func_name !function_signatures with | Not_found -> - failwith - (Printf.sprintf - "IRgen build_expr: SAST signature for function '%s' not found." - func_name) + raise + (Failure (Printf.sprintf "IRgen: SAST signature for '%s' not found" func_name)) in - if List.length exp_formals <> List.length actual_s_exprs_list + if List.length sast_expected_formals <> List.length actual_s_exprs_list then failwith (Printf.sprintf - "IRgen build_expr: Arity mismatch for function '%s'. Expected %d args, got \ - %d." + "IRgen: Arity mismatch for %s. Expected %d, Got %d" func_name - (List.length exp_formals) + (List.length sast_expected_formals) (List.length actual_s_exprs_list)); - let evaluated_ll_args_list : L.llvalue list = - List.map2 - (fun (sexpr_arg : sexpr) (_formal_name, resolved_type) -> - let act_type = fst sexpr_arg in - assert_types act_type resolved_type; - build_expr sexpr_arg vars var_types the_module builder) + let callee_llvm_func_type = L.element_type (L.type_of callee_lfunc) in + let callee_llvm_param_types_array = L.param_types callee_llvm_func_type in + + let final_ll_args_for_call : L.llvalue list = + List.mapi + (fun i (actual_arg_sexpr : sexpr) -> + let _sast_formal_name, sast_formal_typ = List.nth sast_expected_formals i in + let sast_actual_arg_typ, _ = actual_arg_sexpr in + + assert_types sast_actual_arg_typ sast_formal_typ; + + let ll_val_from_arg_expr = + build_expr actual_arg_sexpr vars var_types the_module builder + in + let expected_llvm_param_type_in_callee = callee_llvm_param_types_array.(i) in + let type_of_ll_val_from_arg_expr = L.type_of ll_val_from_arg_expr in + + match sast_actual_arg_typ with + | RUserType _ -> + if + L.classify_type type_of_ll_val_from_arg_expr = L.TypeKind.Pointer + && L.classify_type expected_llvm_param_type_in_callee = L.TypeKind.Struct + then + L.build_load + ll_val_from_arg_expr + ("load_arg_" ^ _sast_formal_name) + builder + else if type_of_ll_val_from_arg_expr <> expected_llvm_param_type_in_callee + then + failwith + (Printf.sprintf + "IRgen SFunctionCall: UDT Arg LLVM type mismatch for %s. Got %s, \ + Callee expects %s" + _sast_formal_name + (L.string_of_lltype type_of_ll_val_from_arg_expr) + (L.string_of_lltype expected_llvm_param_type_in_callee)) + else ll_val_from_arg_expr + | _ -> + if type_of_ll_val_from_arg_expr <> expected_llvm_param_type_in_callee + then + failwith + (Printf.sprintf + "IRgen SFunctionCall: Non-UDT Arg LLVM type mismatch for %s. Got \ + %s, Callee expects %s" + _sast_formal_name + (L.string_of_lltype type_of_ll_val_from_arg_expr) + (L.string_of_lltype expected_llvm_param_type_in_callee)); + ll_val_from_arg_expr) actual_s_exprs_list - exp_formals in - let evaluated_ll_args_array : L.llvalue array = - Array.of_list evaluated_ll_args_list + let final_ll_args_array = Array.of_list final_ll_args_for_call in + let sast_expr_node_return_typ = fst expr in + assert_types sast_expr_node_return_typ sast_expected_return_typ; + + let call_result_name = + if sast_expected_return_typ = RUnit then "" else func_name ^ "_result" in - let ret_typ = fst expr in - assert_types ret_typ exp_ret_typ; - let call_result_name = if exp_ret_typ = RUnit then "" else func_name ^ "_result" in - L.build_call callee_lfunc evaluated_ll_args_array call_result_name builder) + L.build_call callee_lfunc final_ll_args_array call_result_name builder) | SEnumAccess (enum_name, variant_name) -> let key = extract_id_from_sexpr enum_name ^ "::" ^ variant_name in let vbl = diff --git a/lib/semant.ml b/lib/semant.ml index a210636..c18a4dd 100644 --- a/lib/semant.ml +++ b/lib/semant.ml @@ -71,7 +71,7 @@ and var_dec_helper var_name t envs = ] in if List.exists (fun x -> x) env_checks - then raise (Failure (var_name ^ "already exists")) + then raise (Failure (var_name ^ " already exists")) else StringMap.add var_name t envs.var_env and func_def_helper func_name args rtyp envs = diff --git a/lib/unbind.ml b/lib/unbind.ml index 14c8e93..8c1ea14 100644 --- a/lib/unbind.ml +++ b/lib/unbind.ml @@ -37,11 +37,7 @@ and unbind_sexpr se replace_self new_var_name = List.map (fun arg -> unbind_sexpr arg replace_self new_var_name) func_args in t', SFunctionCall (func_name, unbound_args) - | SId id -> - if replace_self && id = "self" - then - t', SId new_var_name - else t', SId id + | SId id -> if replace_self && id = "self" then t', SId new_var_name else t', SId id | STuple se_list -> let unbound_se_list = List.map (fun elem -> unbind_sexpr elem replace_self new_var_name) se_list @@ -66,7 +62,6 @@ and unbind_sexpr se replace_self new_var_name = in let unbound_params2 = unbound_params1 @ [ unbound_udt_se ] in t', SFunctionCall (udt_func_name, unbound_params2)) - | SUDTStaticAccess (udt_name, udt_static_func) -> t', SUDTStaticAccess (udt_name, udt_static_func) | SIndex (indexed_se, index_val) -> @@ -90,18 +85,20 @@ and unbind_block sblk variables replace_self new_var_name = updated_variables, SDeclTyped (var_name, rt, unbind_sexpr se replace_self new_var_name) | SFunctionDefinition (rt, func_name, func_args, body) -> let updated_variables1 = add_func_args func_args variables in - let updated_variables2, unbound_body = unbind_block_list body updated_variables1 replace_self new_var_name in + let updated_variables2, unbound_body = + unbind_block_list body updated_variables1 replace_self new_var_name + in updated_variables2, SFunctionDefinition (rt, func_name, func_args, unbound_body) | SBoundFunctionDefinition (rt, func_name, func_args, body, _) -> let updated_variables1 = add_func_args func_args variables in - let updated_variables2, _ = unbind_block_list body updated_variables1 replace_self new_var_name in + let updated_variables2, _ = + unbind_block_list body updated_variables1 replace_self new_var_name + in let var_name = fresh_var_name "tmp" updated_variables2 0 in let updated_func_args = List.map (fun (arg_name, arg_type) -> - if arg_name = "self" then - (var_name, arg_type) - else arg_name, arg_type) + if arg_name = "self" then var_name, arg_type else arg_name, arg_type) func_args in let updated_variables3 = add_func_args updated_func_args variables in @@ -115,31 +112,41 @@ and unbind_block sblk variables replace_self new_var_name = variables, SIfEnd (unbound_cond, if_body) | SIfNonEnd (cond, if_body, other) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let updated_variables1, unbound_if_body = unbind_block_list if_body variables replace_self new_var_name in + let updated_variables1, unbound_if_body = + unbind_block_list if_body variables replace_self new_var_name + in let updated_variables2, unbound_other = unbind_block other updated_variables1 replace_self new_var_name in updated_variables2, SIfNonEnd (unbound_cond, unbound_if_body, unbound_other) | SElifNonEnd (cond, elif_body, other) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let updated_variables1, unbound_elif_body = unbind_block_list elif_body variables replace_self new_var_name in + let updated_variables1, unbound_elif_body = + unbind_block_list elif_body variables replace_self new_var_name + in let updated_variables2, unbound_other = unbind_block other updated_variables1 replace_self new_var_name in updated_variables2, SElifNonEnd (unbound_cond, unbound_elif_body, unbound_other) | SElifEnd (cond, elif_body) -> let unbound_cond = unbind_sexpr cond replace_self new_var_name in - let updated_variables, unbound_elif_body = unbind_block_list elif_body variables replace_self new_var_name in + let updated_variables, unbound_elif_body = + unbind_block_list elif_body variables replace_self new_var_name + in updated_variables, SElifEnd (unbound_cond, unbound_elif_body) | SElseEnd else_body -> - let updated_variables, unbound_else_body = unbind_block_list else_body variables replace_self new_var_name in + let updated_variables, unbound_else_body = + unbind_block_list else_body variables replace_self new_var_name + in updated_variables, SElseEnd unbound_else_body | SWhile (se, while_body) -> let unbound_se = unbind_sexpr se replace_self new_var_name in variables, SWhile (unbound_se, while_body) | SFor (iterator, iterable_se, for_body) -> let unbound_iterable_se = unbind_sexpr iterable_se replace_self new_var_name in - let updated_variables, unbound_for_body = unbind_block_list for_body variables replace_self new_var_name in + let updated_variables, unbound_for_body = + unbind_block_list for_body variables replace_self new_var_name + in updated_variables, SFor (iterator, unbound_iterable_se, unbound_for_body) | SBreak -> variables, SBreak | SContinue -> variables, SContinue @@ -151,12 +158,16 @@ and unbind_block_list sblk_list variables replace_self var_name = match sblk_list with | [] -> variables, [] | sblk :: rest -> - let updated_variables, unbound_sblk = unbind_block sblk variables replace_self var_name in - updated_variables, unbound_sblk :: snd (unbind_block_list rest updated_variables replace_self var_name) + let updated_variables, unbound_sblk = + unbind_block sblk variables replace_self var_name + in + ( updated_variables + , unbound_sblk :: snd (unbind_block_list rest updated_variables replace_self var_name) + ) ;; let unbind sblk_list = let variables = StringSet.empty in let _, unbound_sblk_list = unbind_block_list sblk_list variables false "" in unbound_sblk_list -;; \ No newline at end of file +;; From 4d3f426d6f250cc2865d91b5632f9a6fa3248970 Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 20:10:18 -0400 Subject: [PATCH 8/9] multiple bindings --- lib/semant.ml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lib/semant.ml b/lib/semant.ml index c18a4dd..47625b3 100644 --- a/lib/semant.ml +++ b/lib/semant.ml @@ -367,7 +367,7 @@ and check_expr expr envs special_blocks = | None -> raise (Failure - (fst udt_func ^ "is not a method bound to " + (fst udt_func ^ " is not a method bound to " ^ string_of_resolved_type udt_typ)))) | UDTStaticAccess (udt_name, (func_name, args)) -> let udt_typ = find_udt udt_name envs.udt_env in @@ -540,7 +540,7 @@ and check_block block envs special_blocks func_ret_type = let updated_checked_func_body = update_func_body checked_func_body func_name is_unit rtyp envs in - ( updated_envs2 + ( updated_envs1 , updated_special_blocks , rtyp , SFunctionDefinition (rt, func_name, args, updated_checked_func_body) ) @@ -553,26 +553,26 @@ and check_block block envs special_blocks func_ret_type = let new_func_env = func_def_helper func_name args rt envs in (* add function name to environment *) let updated_envs1 = { envs with func_env = new_func_env } in + let new_udt_env = + add_bound_func_def func_name (string_of_resolved_type bound_type) envs + in + let updated_envs2 = { updated_envs1 with udt_env = new_udt_env } in let new_var_env = add_func_args args updated_envs1 in (* add function arguments to environment *) - let updated_envs2 = { updated_envs1 with var_env = new_var_env } in + let updated_envs3 = { updated_envs2 with var_env = new_var_env } in let updated_special_blocks = if rtyp = Unit then StringSet.add "ReturnUnit" special_blocks else StringSet.add "ReturnVal" special_blocks in let checked_func_body = - check_block_list func_body updated_envs2 updated_special_blocks rtyp + check_block_list func_body updated_envs3 updated_special_blocks rtyp in let is_unit = rtyp = Unit in let updated_checked_func_body = update_func_body checked_func_body func_name is_unit rtyp envs in - let new_udt_env = - add_bound_func_def func_name (string_of_resolved_type bound_type) envs - in - let updated_envs3 = { updated_envs2 with udt_env = new_udt_env } in - ( updated_envs3 + ( updated_envs2 , updated_special_blocks , rtyp , SBoundFunctionDefinition (rt, func_name, args, updated_checked_func_body, bound_type) From 4f3de3c51766b4b72a263c808a89b75189f1f605 Mon Sep 17 00:00:00 2001 From: Xiang Yu Tuang Date: Fri, 16 May 2025 20:26:37 -0400 Subject: [PATCH 9/9] more formatting zzz --- lib/semant.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/semant.ml b/lib/semant.ml index 47625b3..d92c04a 100644 --- a/lib/semant.ml +++ b/lib/semant.ml @@ -554,7 +554,7 @@ and check_block block envs special_blocks func_ret_type = (* add function name to environment *) let updated_envs1 = { envs with func_env = new_func_env } in let new_udt_env = - add_bound_func_def func_name (string_of_resolved_type bound_type) envs + add_bound_func_def func_name (string_of_resolved_type bound_type) envs in let updated_envs2 = { updated_envs1 with udt_env = new_udt_env } in let new_var_env = add_func_args args updated_envs1 in