Skip to content

List lengths #44

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
kristoferfannar wants to merge 6 commits into
base: main
Choose a base branch
from
Open

List lengths #44

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
be59d6a
wrap lists in shell structs with len
kristoferfannar May 16, 2025
ef228db
update tests
kristoferfannar May 16, 2025
e55830f
Merge branch 'main' into list-lengths
kristoferfannar May 16, 2025
1c92c6b
index wrapped lists
kristoferfannar May 16, 2025
54ac38c
use list item types
kristoferfannar May 16, 2025
f5b1e1c
Merge branch 'main' into list-lengths
kristoferfannar 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
80 changes: 63 additions & 17 deletions lib/irgen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,15 +26,19 @@ and l_float = L.float_type context

let l_str = L.pointer_type l_char

let rec ltype_of_typ = function
(* A list is a wrapper struct containing length and a pointer to the array *)
let l_list = L.struct_type context [| l_int; l_str |]

let ltype_of_typ = function
| RInt -> l_int
| RBool -> l_bool
| RFloat -> l_float
(* | A.Char -> l_char *)
| RUnit -> l_unit
| RString -> l_str
| REnumType _ -> l_int
| RList typ -> L.pointer_type (ltype_of_typ typ)
| RList _ ->
L.pointer_type l_list (* Not an accident - supposed to be a pointer to list struct *)
| RUserType name ->
(try Hashtbl.find udt_structs name with
| Not_found -> raise (Failure ("Unknown user type: " ^ name)))
Expand Down Expand Up @@ -322,8 +326,20 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build
field_val
| SList list ->
let typ = fst (List.hd list) in
let lval = L.const_int l_int (List.length list) in
let llist = L.build_array_alloca (ltype_of_typ typ) lval "list" builder in
let llen = L.const_int l_int (List.length list) in

let llist_shell = L.build_alloca l_list "list_shell" builder in
let len_ptr = L.build_struct_gep llist_shell 0 "len_ptr" builder in
ignore (L.build_store llen len_ptr builder);

let llist = L.build_array_alloca (ltype_of_typ typ) llen "list" builder in
let llist_cast =
L.build_pointercast llist (L.pointer_type (L.i8_type context)) "llist_cast" builder
in
let data_ptr = L.build_struct_gep llist_shell 1 "data_ptr" builder in

ignore (L.build_store llist_cast data_ptr builder);

List.iteri
(fun idx item ->
let litem = build_expr item vars var_types the_module builder in
Expand All @@ -332,12 +348,37 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build
in
ignore (L.build_store litem lidx builder))
list;
llist
llist_shell
| SStringLit s -> L.build_global_stringptr s "str" builder
| SIndex (list_expr, index_expr) ->
let list_val = build_expr list_expr vars var_types the_module builder in
(* the list_expr should be an SId and nothing else right? *)
let var_name =
match snd list_expr with
| SId i -> i
| _ -> failwith "bad list_expr"
in

let vbl = lookup vars var_name in
let list_val = vbl.v_value in
let typ =
match vbl.v_type with
| RList t -> t
| _ -> failwith "type should be list"
in

let loaded_list_val = L.build_load list_val "loaded_list" builder in

let index_val = build_expr index_expr vars var_types the_module builder in
let elem_ptr = L.build_gep list_val [| index_val |] "elem_ptr" builder in

(* bitcast the array pointer type back to the appropriate value *)
let raw_larr_ptr = L.build_struct_gep loaded_list_val 1 "raw_arr_ptr" builder in
let i8_arr = L.build_load raw_larr_ptr "i8_arr" builder in
let larr_ptr =
L.build_bitcast i8_arr (L.pointer_type (ltype_of_typ typ)) "arr_ptr" builder
in

let elem_ptr = L.build_gep larr_ptr [| index_val |] "elem_ptr" builder in

(match fst expr with
| RInt | RFloat | RString | RBool | REnumType _ ->
L.build_load elem_ptr "elem_val" builder
Expand Down Expand Up @@ -400,17 +441,22 @@ and prelude_print (func : sfunc) vars var_types the_module builder =
and prelude_len (func : sfunc) vars var_types the_module builder =
let func_arg = List.hd (snd func) in
let lexpr = build_expr func_arg vars var_types the_module builder in
let args =
match fst func_arg with
| RString -> [| lexpr |]
| t ->
failwith
(Printf.sprintf
"prelude_len not implemented for type: %s"
(Utils.string_of_resolved_type t))
in

L.build_call (strlen_func the_module) args "call_strlen" builder
match fst func_arg with
| RString ->
let args = [| lexpr |] in

L.build_call (strlen_func the_module) args "call_strlen" builder
| RList _l ->
flush stdout;
let len_ptr = L.build_struct_gep lexpr 0 "len_ptr" builder in
let len_val = L.build_load len_ptr "lislen" builder in
len_val
| t ->
failwith
(Printf.sprintf
"prelude_len not implemented for type: %s"
(Utils.string_of_resolved_type t))

and prelude_input (_func : sfunc) _vars _var_types the_module builder =
(* The max buffer size for reading strings *)
Expand Down
116 changes: 100 additions & 16 deletions test/ir/test_list.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ let _write_to_file text filename =

let tests =
"testing_lists"
>::: [ ("local_list"
>::: [ ("local_int_list"
>:: fun _ ->
let sast = get_sast "fun function() -> () {let a := [10, 20, 30];}" in
let mdl = Irgen.translate sast in
Expand All @@ -37,15 +37,23 @@ let tests =
source_filename = \"Fly\"\n\n\
define void @function() {\n\
entry:\n\
\ %list_shell = alloca { i32, i8* }, align 8\n\
\ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 0\n\
\ store i32 3, i32* %len_ptr, align 4\n\
\ %list = alloca i32, i32 3, align 4\n\
\ %llist_cast = bitcast i32* %list to i8*\n\
\ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 1\n\
\ store i8* %llist_cast, i8** %data_ptr, align 8\n\
\ %index = getelementptr inbounds i32, i32* %list, i32 0\n\
\ store i32 10, i32* %index, align 4\n\
\ %index1 = getelementptr inbounds i32, i32* %list, i32 1\n\
\ store i32 20, i32* %index1, align 4\n\
\ %index2 = getelementptr inbounds i32, i32* %list, i32 2\n\
\ store i32 30, i32* %index2, align 4\n\
\ %a = alloca i32*, align 8\n\
\ store i32* %list, i32** %a, align 8\n\
\ %a = alloca { i32, i8* }*, align 8\n\
\ store { i32, i8* }* %list_shell, { i32, i8* }** %a, align 8\n\
\ ret void\n\
}\n"
in
Expand All @@ -60,17 +68,26 @@ let tests =
source_filename = \"Fly\"\n\n\
define void @function() {\n\
entry:\n\
\ %list_shell = alloca { i32, i8* }, align 8\n\
\ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 0\n\
\ store i32 2, i32* %len_ptr, align 4\n\
\ %list = alloca i1, i32 2, align 1\n\
\ %llist_cast = bitcast i1* %list to i8*\n\
\ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 1\n\
\ store i8* %llist_cast, i8** %data_ptr, align 8\n\
\ %index = getelementptr inbounds i1, i1* %list, i32 0\n\
\ store i1 true, i1* %index, align 1\n\
\ %index1 = getelementptr inbounds i1, i1* %list, i32 1\n\
\ store i1 false, i1* %index1, align 1\n\
\ %a = alloca i1*, align 8\n\
\ store i1* %list, i1** %a, align 8\n\
\ %a = alloca { i32, i8* }*, align 8\n\
\ store { i32, i8* }* %list_shell, { i32, i8* }** %a, align 8\n\
\ ret void\n\
}\n"
in
_write_to_file actual "actual.out";
_write_to_file expected "expected.out";
assert_equal expected actual ~printer)
; ("local_string_list"
>:: fun _ ->
Expand All @@ -84,19 +101,28 @@ let tests =
@str.1 = private unnamed_addr constant [6 x i8] c\"world\\00\", align 1\n\n\
define void @function() {\n\
entry:\n\
\ %list_shell = alloca { i32, i8* }, align 8\n\
\ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 0\n\
\ store i32 2, i32* %len_ptr, align 4\n\
\ %list = alloca i8*, i32 2, align 8\n\
\ %llist_cast = bitcast i8** %list to i8*\n\
\ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 1\n\
\ store i8* %llist_cast, i8** %data_ptr, align 8\n\
\ %index = getelementptr inbounds i8*, i8** %list, i32 0\n\
\ store i8* getelementptr inbounds ([6 x i8], [6 x i8]* @str, i32 0, i32 \
0), i8** %index, align 8\n\
\ %index1 = getelementptr inbounds i8*, i8** %list, i32 1\n\
\ store i8* getelementptr inbounds ([6 x i8], [6 x i8]* @str.1, i32 0, i32 \
0), i8** %index1, align 8\n\
\ %a = alloca i8**, align 8\n\
\ store i8** %list, i8*** %a, align 8\n\
\ %a = alloca { i32, i8* }*, align 8\n\
\ store { i32, i8* }* %list_shell, { i32, i8* }** %a, align 8\n\
\ ret void\n\
}\n"
in
(* _write_to_file actual "actual.out"; *)
_write_to_file actual "actual.out";
_write_to_file expected "expected.out";
assert_equal expected actual ~printer)
; ("local_int_list_index"
>:: fun _ ->
Expand All @@ -108,15 +134,27 @@ let tests =
source_filename = \"Fly\"\n\n\
define i32 @function() {\n\
entry:\n\
\ %list_shell = alloca { i32, i8* }, align 8\n\
\ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 0\n\
\ store i32 2, i32* %len_ptr, align 4\n\
\ %list = alloca i32, i32 2, align 4\n\
\ %llist_cast = bitcast i32* %list to i8*\n\
\ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 1\n\
\ store i8* %llist_cast, i8** %data_ptr, align 8\n\
\ %index = getelementptr inbounds i32, i32* %list, i32 0\n\
\ store i32 1, i32* %index, align 4\n\
\ %index1 = getelementptr inbounds i32, i32* %list, i32 1\n\
\ store i32 2, i32* %index1, align 4\n\
\ %a = alloca i32*, align 8\n\
\ store i32* %list, i32** %a, align 8\n\
\ %a2 = load i32*, i32** %a, align 8\n\
\ %elem_ptr = getelementptr i32, i32* %a2, i32 0\n\
\ %a = alloca { i32, i8* }*, align 8\n\
\ store { i32, i8* }* %list_shell, { i32, i8* }** %a, align 8\n\
\ %loaded_list = load { i32, i8* }*, { i32, i8* }** %a, align 8\n\
\ %raw_arr_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%loaded_list, i32 0, i32 1\n\
\ %i8_arr = load i8*, i8** %raw_arr_ptr, align 8\n\
\ %arr_ptr = bitcast i8* %i8_arr to i32*\n\
\ %elem_ptr = getelementptr i32, i32* %arr_ptr, i32 0\n\
\ %elem_val = load i32, i32* %elem_ptr, align 4\n\
\ ret i32 %elem_val\n\
}\n"
Expand Down Expand Up @@ -151,22 +189,68 @@ let tests =
\ %Point_y3 = getelementptr inbounds { i32, i32 }, { i32, i32 }* \
%Point_inst1, i32 0, i32 1\n\
\ store i32 4, i32* %Point_y3, align 4\n\
\ %list_shell = alloca { i32, i8* }, align 8\n\
\ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 0\n\
\ store i32 2, i32* %len_ptr, align 4\n\
\ %list = alloca { i32, i32 }, i32 2, align 8\n\
\ %llist_cast = bitcast { i32, i32 }* %list to i8*\n\
\ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 1\n\
\ store i8* %llist_cast, i8** %data_ptr, align 8\n\
\ %index = getelementptr inbounds { i32, i32 }, { i32, i32 }* %list, i32 0\n\
\ store { i32, i32 }* %Point_inst, { i32, i32 }* %index, align 8\n\
\ %index4 = getelementptr inbounds { i32, i32 }, { i32, i32 }* %list, i32 1\n\
\ store { i32, i32 }* %Point_inst1, { i32, i32 }* %index4, align 8\n\
\ %arr = alloca { i32, i32 }*, align 8\n\
\ store { i32, i32 }* %list, { i32, i32 }** %arr, align 8\n\
\ %arr5 = load { i32, i32 }*, { i32, i32 }** %arr, align 8\n\
\ %elem_ptr = getelementptr { i32, i32 }, { i32, i32 }* %arr5, i32 1\n\
\ %arr = alloca { i32, i8* }*, align 8\n\
\ store { i32, i8* }* %list_shell, { i32, i8* }** %arr, align 8\n\
\ %loaded_list = load { i32, i8* }*, { i32, i8* }** %arr, align 8\n\
\ %raw_arr_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%loaded_list, i32 0, i32 1\n\
\ %i8_arr = load i8*, i8** %raw_arr_ptr, align 8\n\
\ %arr_ptr = bitcast i8* %i8_arr to { i32, i32 }*\n\
\ %elem_ptr = getelementptr { i32, i32 }, { i32, i32 }* %arr_ptr, i32 1\n\
\ %arr_y = getelementptr inbounds { i32, i32 }, { i32, i32 }* %elem_ptr, \
i32 0, i32 1\n\
\ %arr_y_val = load i32, i32* %arr_y, align 4\n\
\ ret i32 %arr_y_val\n\
}\n"
in
_write_to_file actual "actual.out";
_write_to_file expected "expected.out";
(* _write_to_file actual "actual.out"; *)
assert_equal expected actual ~printer)
(* ; ("global_int_list" *)
(* >:: fun _ -> *)
(* let sast = get_sast "let a := [10, 20, 30];" in *)
(* let mdl = Irgen.translate sast in *)
(* let actual = L.string_of_llmodule mdl in *)
(* let expected = *)
(* "; ModuleID = 'Fly'\n\ *)
(* source_filename = \"Fly\"\n\n\ *)
(* define void @function() {\n\ *)
(* entry:\n\ *)
(* \ %list_shell = alloca { i32, i8* }, align 8\n\ *)
(* \ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \ *)
(* %list_shell, i32 0, i32 0\n\ *)
(* \ store i32 3, i32* %len_ptr, align 4\n\ *)
(* \ %list = alloca i32, i32 3, align 4\n\ *)
(* \ %llist_cast = bitcast i32* %list to i8*\n\ *)
(* \ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \ *)
(* %list_shell, i32 0, i32 1\n\ *)
(* \ store i8* %llist_cast, i8** %data_ptr, align 8\n\ *)
(* \ %index = getelementptr inbounds i32, i32* %list, i32 0\n\ *)
(* \ store i32 10, i32* %index, align 4\n\ *)
(* \ %index1 = getelementptr inbounds i32, i32* %list, i32 1\n\ *)
(* \ store i32 20, i32* %index1, align 4\n\ *)
(* \ %index2 = getelementptr inbounds i32, i32* %list, i32 2\n\ *)
(* \ store i32 30, i32* %index2, align 4\n\ *)
(* \ %a = alloca { i32, i8* }*, align 8\n\ *)
(* \ store { i32, i8* }* %list_shell, { i32, i8* }** %a, align 8\n\ *)
(* \ ret void\n\ *)
(* }\n" *)
(* in *)
(* assert_equal expected actual ~printer) *)
; ("list_of_enums_index"
>:: fun _ ->
let sast =
Expand Down
40 changes: 39 additions & 1 deletion test/ir/test_prelude.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -132,7 +132,7 @@ let tests =
in
(* _write_to_file actual "test.out"; *)
assert_equal expected actual ~printer)
; ("len"
; ("len_of_string"
>:: fun _ ->
let sast =
get_sast "fun main() {let str := \"hello\"; let strlen := len(str); }"
Expand All @@ -158,6 +158,44 @@ let tests =
in
(* _write_to_file actual "actual.out"; *)
assert_equal expected actual ~printer)
; ("len_of_list"
>:: fun _ ->
let sast =
get_sast "fun main() {let lis := [10, 20]; let lislen := len(lis); }"
in
let mdl = Irgen.translate sast in
let actual = L.string_of_llmodule mdl in
let expected =
"; ModuleID = 'Fly'\n\
source_filename = \"Fly\"\n\n\
define void @main() {\n\
entry:\n\
\ %list_shell = alloca { i32, i8* }, align 8\n\
\ %len_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 0\n\
\ store i32 2, i32* %len_ptr, align 4\n\
\ %list = alloca i32, i32 2, align 4\n\
\ %llist_cast = bitcast i32* %list to i8*\n\
\ %data_ptr = getelementptr inbounds { i32, i8* }, { i32, i8* }* \
%list_shell, i32 0, i32 1\n\
\ store i8* %llist_cast, i8** %data_ptr, align 8\n\
\ %index = getelementptr inbounds i32, i32* %list, i32 0\n\
\ store i32 10, i32* %index, align 4\n\
\ %index1 = getelementptr inbounds i32, i32* %list, i32 1\n\
\ store i32 20, i32* %index1, align 4\n\
\ %lis = alloca { i32, i8* }*, align 8\n\
\ store { i32, i8* }* %list_shell, { i32, i8* }** %lis, align 8\n\
\ %lis2 = load { i32, i8* }*, { i32, i8* }** %lis, align 8\n\
\ %len_ptr3 = getelementptr inbounds { i32, i8* }, { i32, i8* }* %lis2, i32 \
0, i32 0\n\
\ %lislen = load i32, i32* %len_ptr3, align 4\n\
\ %lislen4 = alloca i32, align 4\n\
\ store i32 %lislen, i32* %lislen4, align 4\n\
\ ret void\n\
}\n"
in
(* _write_to_file actual "actual.out"; *)
assert_equal expected actual ~printer)
; ("input"
>:: fun _ ->
let sast = get_sast "fun main() {let str := input(); return; }" in
Expand Down