Skip to content

func scope #40

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
AlenaResiko wants to merge 3 commits into
base: main
Choose a base branch
from
Open

func scope #40

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
ad07e2d
func calls
AlenaResiko May 16, 2025
1d07b90
small fixes
AlenaResiko May 16, 2025
b0c80ef
Merge remote-tracking branch 'origin' into ir-func-scope
AlenaResiko May 16, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
215 changes: 126 additions & 89 deletions lib/irgen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -130,7 +130,7 @@ let get_or_add_string_const s builder =
v)
;;

let rec build_expr expr (vars : variable StringMap.t) var_types the_module builder =
let rec build_expr expr (vars : variable StringMap.t) var_types the_module builder func_blocks =
let sx = snd expr in
match sx with
| SLiteral l -> L.const_int l_int l
Expand All @@ -148,7 +148,7 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build
then vbl.v_value
else L.build_load vbl.v_value var builder
| SUnop (e, op) ->
let llval = build_expr e vars var_types the_module builder in
let llval = build_expr e vars var_types the_module builder func_blocks in
let typ = fst e in
(match op with
| A.Not ->
Expand Down Expand Up @@ -187,16 +187,18 @@ 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")
| SFunctionCall func ->
let func_name = fst func in

| SFunctionCall (func_name, params) ->
if func_name = print_func_name
then prelude_print func vars var_types the_module builder
then prelude_print (func_name, params) vars var_types the_module builder func_blocks
else if func_name = len_func_name
then prelude_len func vars var_types the_module builder
then prelude_len (func_name, params) vars var_types the_module builder func_blocks
else if func_name = input_func_name
then prelude_input func vars var_types the_module builder
else raise (Failure "function calls not implemented")
then prelude_input (func_name, params) vars var_types the_module builder func_blocks
else
let (fdef, _, _) = List.find (fun (f, _, _) -> L.value_name f = func_name) func_blocks in
let llargs = List.map (fun param -> build_expr param vars var_types the_module builder func_blocks) params in
let result = if L.type_of fdef = l_unit then "" else func_name ^ "_result" in
L.build_call fdef (Array.of_list llargs) result builder
| SEnumAccess (enum_name, variant_name) ->
let key = enum_name ^ "::" ^ variant_name in
if not (StringMap.mem key vars)
Expand All @@ -207,8 +209,8 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build
else lookup_value vars key
| SBinop (e1, op, e2) ->
let typ = fst e1 in
let se1 = build_expr e1 vars var_types the_module builder in
let se2 = build_expr e2 vars var_types the_module builder in
let se1 = build_expr e1 vars var_types the_module builder func_blocks in
let se2 = build_expr e2 vars var_types the_module builder func_blocks in
let lval =
match typ with
| A.Int ->
Expand Down Expand Up @@ -277,7 +279,7 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build
let field_ptr =
L.build_struct_gep instance idx (typename ^ "_" ^ field_name) builder
in
let field_val = build_expr sexpr vars var_types the_module builder in
let field_val = build_expr sexpr vars var_types the_module builder func_blocks in
ignore (L.build_store field_val field_ptr builder))
fields;
instance
Expand All @@ -304,17 +306,17 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build

Preferrably this function should exist somewhere else, but it needs to be defined with build_expr
*)
and prelude_print (func : sfunc) vars var_types the_module builder =
and prelude_print (func : sfunc) vars var_types the_module builder func_blocks =
if List.length (snd func) != 1
then failwith "Incorrect number of args to print: expected 1"
else (
let func_arg = List.hd (snd func) in
let lexpr = build_expr func_arg vars var_types the_module builder in
let lexpr = build_expr func_arg vars var_types the_module builder func_blocks in
let args =
match fst func_arg with
| A.Int -> [| int_format_str builder; lexpr |]
| A.Bool ->
let lexpr = build_expr func_arg vars var_types the_module builder in
let lexpr = build_expr func_arg vars var_types the_module builder func_blocks in

(* For bool prints, we actually print a string: "true" for true, and "false" for false
This is pretty tricky, requiring us to create branches and use a phi conditional (some IR stuff)
Expand Down Expand Up @@ -347,18 +349,18 @@ and prelude_print (func : sfunc) vars var_types the_module builder =
in
[| str_format_str builder; bool_str |]
| A.Float ->
let lexpr = build_expr func_arg vars var_types the_module builder in
let lexpr = build_expr func_arg vars var_types the_module builder func_blocks in
[| float_format_str builder; lexpr |]
| A.String ->
let lexpr = build_expr func_arg vars var_types the_module builder in
let lexpr = build_expr func_arg vars var_types the_module builder func_blocks in
[| str_format_str builder; lexpr |]
| _ -> failwith "print not implemented for type"
in
L.build_call (print_func the_module) args "call_printf" builder)

and prelude_len (func : sfunc) vars var_types the_module builder =
and prelude_len (func : sfunc) vars var_types the_module builder func_blocks =
let func_arg = List.hd (snd func) in
let lexpr = build_expr func_arg vars var_types the_module builder in
let lexpr = build_expr func_arg vars var_types the_module builder func_blocks in
let args =
match fst func_arg with
| A.String -> [| lexpr |]
Expand All @@ -371,7 +373,7 @@ and prelude_len (func : sfunc) vars var_types the_module builder =

L.build_call (strlen_func the_module) args "call_strlen" builder

and prelude_input (_func : sfunc) _vars _var_types the_module builder =
and prelude_input (_func : sfunc) _vars _var_types the_module builder _func_blocks =
(* The max buffer size for reading strings *)
let max_strlen = 100 in
let buffer_type = L.array_type l_char max_strlen in
Expand All @@ -398,11 +400,11 @@ let assert_types typ1 typ2 =
(Utils.string_of_type typ2))
;;

let add_local_val typ var vars var_types (expr : A.typ * Sast.sx) the_module builder =
let add_local_val typ var vars var_types (expr : A.typ * Sast.sx) the_module builder func_blocks =
let expr_type = fst expr in
assert_types expr_type typ;
let ll_initializer_value : L.llvalue =
build_expr expr vars var_types the_module builder
build_expr expr vars var_types the_module builder func_blocks
in
match typ with
| A.UserType _ ->
Expand Down Expand Up @@ -474,83 +476,103 @@ let translate blocks =
(lfunc, formals, body) :: func_blocks
in

(* Receives all func blocks after all functions have been declared and fills each func blocks' body *)
(* before build_call, collect all function declarations *)
let rec collect_func_decls blocks func_blocks =
match blocks with
| [] -> func_blocks
| SFunctionDefinition (typ, id, formals, body) :: rest ->
let func_blocks' = declare_function typ id formals body func_blocks in
(* nested case *)
let func_blocks'' = collect_func_decls body func_blocks' in
collect_func_decls rest func_blocks''

| SEnumDeclaration (_, _) :: rest ->
print_endline "THIS IS AN ENUM";
collect_func_decls rest func_blocks

| SIfEnd (_, blks) :: rest ->
let func_blocks' = collect_func_decls blks func_blocks in
collect_func_decls rest func_blocks'
| SIfNonEnd (_, blks, else_blk) :: rest ->
let func_blocks' = collect_func_decls blks func_blocks in
let func_blocks'' = collect_func_decls [else_blk] func_blocks' in
collect_func_decls rest func_blocks''
| _ :: rest -> collect_func_decls rest func_blocks
in

let rec process_func_blocks func_blocks vars var_types =
match func_blocks with
| [] -> ()
| _blk :: rst ->
process_func_block _blk vars var_types;
process_func_blocks rst vars var_types
and process_func_block
(func_block : L.llvalue * A.formal list * sblock list)
vars
var_types
=
let lfunc, _, blocks = func_block in
let curr_func = Some lfunc in
let builder = L.builder_at_end context (L.entry_block lfunc) in
process_blocks blocks vars var_types curr_func [] (Some builder)
and process_blocks
blocks
vars
var_types
(curr_func : L.llvalue option)
func_blocks
(builder : L.llbuilder option)
=
| (lfunc, formals, blocks) :: rest ->
let builder = L.builder_at_end context (L.entry_block lfunc) in
let vars_with_formals =
List.fold_left2
(fun acc (name, typ) param ->
let alloca = L.build_alloca (ltype_of_typ typ) name builder in
ignore (L.build_store param alloca builder);
StringMap.add name
{ v_value = alloca; v_type = typ; v_scope = Local }
acc)
vars
formals
(Array.to_list (L.params lfunc))
in

Printf.printf "\n\nprocessing body of: %s\n\n" (L.value_name lfunc);
(* function body *)
ignore (process_blocks blocks vars_with_formals var_types (Some lfunc) func_blocks (Some builder));

(* add return if it isn't there *)
(match L.block_terminator (L.insertion_block builder) with
| Some _ -> ()
| None ->
if L.return_type (L.type_of lfunc) = l_unit
then ignore (L.build_ret_void builder));

(* Process remaining functions *)
process_func_blocks rest vars var_types

and process_blocks blocks vars var_types (curr_func : L.llvalue option) func_blocks builder =
match blocks with
(* We've declared all objects, lets fill in all function bodies *)
| [] -> process_func_blocks func_blocks vars var_types
| [] -> ()
| block :: rest ->
let updated_vars, updated_var_types, updated_curr_func, u_func_blocks, u_builder =
process_block block vars var_types curr_func func_blocks builder
process_block block vars var_types curr_func builder func_blocks
in
process_blocks
rest
updated_vars
updated_var_types
updated_curr_func
u_func_blocks
u_builder
and process_block
block
vars
var_types
(curr_func : L.llvalue option)
func_blocks
(builder : L.llbuilder option)
=
process_blocks rest updated_vars updated_var_types updated_curr_func u_func_blocks u_builder

and process_block block vars var_types (curr_func : L.llvalue option) builder func_blocks =
Printf.printf "\n\nPROCESS BLOCK: %s\n" (Utils.string_of_sblock block);
match block with
| SUDTDef (name, members) ->
define_udt_type name members;
vars, var_types, curr_func, func_blocks, builder
| SDeclTyped (id, typ, expr) ->
if Option.is_some curr_func
then (
let new_vars =
add_local_val typ id vars var_types expr the_module (Option.get builder)
in
let new_vars = add_local_val typ id vars var_types expr the_module (Option.get builder) func_blocks in
let new_var_types = StringMap.add id typ var_types in
new_vars, new_var_types, curr_func, func_blocks, builder)
new_vars, new_var_types, curr_func, func_blocks, builder )
else (
let new_vars = add_global_val typ id vars var_types expr the_module in
let new_var_types = StringMap.add id typ var_types in
new_vars, new_var_types, curr_func, func_blocks, builder)
| SFunctionDefinition (typ, id, formals, body) ->
let u_func_blocks = declare_function typ id formals body func_blocks in
vars, var_types, curr_func, u_func_blocks, builder
| SFunctionDefinition (_, id, _, _) ->
Printf.printf "FUNCTION: %s" id;
(* handled by collect_func_decls already *)
vars, var_types, curr_func, func_blocks, builder
| SReturnUnit ->
ignore (L.build_ret_void (Option.get builder));
vars, var_types, curr_func, func_blocks, builder
| SReturnVal expr ->
let ret = build_expr expr vars var_types the_module (Option.get builder) in
let ret = build_expr expr vars var_types the_module (Option.get builder) func_blocks in
ignore (L.build_ret ret (Option.get builder));
vars, var_types, curr_func, func_blocks, builder
| SExpr expr ->
ignore (build_expr expr vars var_types the_module (Option.get builder));
ignore (build_expr expr vars var_types the_module (Option.get builder) func_blocks);
vars, var_types, curr_func, func_blocks, builder
| SIfEnd (expr, blks) ->
let bool_val = build_expr expr vars var_types the_module (Option.get builder) in
let bool_val = build_expr expr vars var_types the_module (Option.get builder) func_blocks in

(* We require curr_func to be Some - no if-else in global scope *)
let then_bb = L.append_block context "then" (Option.get curr_func) in
Expand All @@ -564,12 +586,16 @@ let translate blocks =
vars, var_types, curr_func, func_blocks, u_builder
| SIfNonEnd (expr, blks, else_blk) ->
assert_types (fst expr) A.Bool;
let bool_val = build_expr expr vars var_types the_module (Option.get builder) in

let bool_val = build_expr expr vars var_types the_module (Option.get builder) func_blocks in

let then_bb = L.append_block context "then" (Option.get curr_func) in
let then_builder = Some (L.builder_at_end context then_bb) in
ignore (process_blocks blks vars var_types curr_func func_blocks then_builder);
let end_bb = L.append_block context "if_end" (Option.get curr_func) in

(* skip this "if_end", ElseEnd or ElifEnd will process it *)
(* We require curr_func to be Some - no if-else in global scope *)
let else_bb = L.append_block context "else" (Option.get curr_func) in
let else_builder = Some (L.builder_at_end context else_bb) in
ignore (L.build_cond_br bool_val then_bb else_bb (Option.get builder));
Expand All @@ -581,6 +607,7 @@ let translate blocks =
add_terminal (L.builder_at_end context else_bb) build_br_end;
vars, var_types, curr_func, func_blocks, u_builder
| SEnumDeclaration (id, variants) ->
Printf.printf "\n\nENUM: %s\n\n" id;
let enum_type = L.named_struct_type context id in
let fields = Array.of_list (List.map (fun _ -> L.i32_type context) variants) in
ignore (L.struct_set_body enum_type fields true);
Expand Down Expand Up @@ -609,23 +636,16 @@ let translate blocks =
raise
(Failure
(Printf.sprintf "expression not implemented: %s" (Utils.string_of_sblock b)))
and process_elseifs
vars
block
end_bb
curr_func
func_blocks
var_types
(builder : L.llbuilder option)
=
and process_elseifs vars block end_bb curr_func func_blocks var_types (builder : L.llbuilder option) =
match block with
| SElseEnd blks ->
ignore (process_blocks blks vars var_types curr_func func_blocks builder);
let u_builder = Some (L.builder_at_end context end_bb) in
u_builder
| SElifEnd (expr, blks) ->
assert_types (fst expr) A.Bool;
let bool_val = build_expr expr vars var_types the_module (Option.get builder) in

let bool_val = build_expr expr vars var_types the_module (Option.get builder) func_blocks in

let then_bb = L.append_block context "then" (Option.get curr_func) in
let then_builder = Some (L.builder_at_end context then_bb) in
Expand All @@ -637,7 +657,8 @@ let translate blocks =
u_builder
| SElifNonEnd (expr, blks, else_blk) ->
assert_types (fst expr) A.Bool;
let bool_val = build_expr expr vars var_types the_module (Option.get builder) in

let bool_val = build_expr expr vars var_types the_module (Option.get builder) func_blocks in

let then_bb = L.append_block context "then" (Option.get curr_func) in
let then_builder = Some (L.builder_at_end context then_bb) in
Expand All @@ -654,12 +675,28 @@ let translate blocks =
| _ -> raise (Failure "Only SElseEnd, SElifEnd and SElifNonEnd can follow SIfNonEnd")
in

(* we start off in no function.. *)
let curr_func = None in
(* ..and have come across no functions.. *)
let func_blocks = [] in
(* process global variables first *)
let process_globals blocks vars var_types =
let rec aux blocks vars =
match blocks with
| [] -> vars
| SDeclTyped (id, typ, expr) :: rest ->
let updated_vars = add_global_val typ id vars var_types expr the_module in
aux rest updated_vars
| _ :: rest -> aux rest vars
in
aux blocks vars
in

let func_blocks = collect_func_decls blocks [] in

(*(* Debug print: print all function names in func_blocks *)
List.iter (fun (f, _, _) -> print_endline (L.value_name f)) func_blocks;
(* ..and start off with no builder.. *)
let builder = None in
process_blocks blocks local_vars var_types curr_func func_blocks builder;
process_func_blocks func_blocks local_vars;*)
let vars_with_globals = process_globals blocks local_vars var_types in

process_func_blocks func_blocks vars_with_globals var_types;
the_module
;;
;;
Loading
Loading