Skip to content

Operations on strings #52

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

Merged
AlenaResiko merged 2 commits into from
May 17, 2025
Merged

Operations on strings #52

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
fae1e8f
Kris wants to claim stirng royalty
AlenaResiko May 16, 2025
84981ef
fix formatting
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
175 changes: 111 additions & 64 deletions lib/irgen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,10 @@ and l_unit = L.void_type context
and l_float = L.float_type context

let l_str = L.pointer_type l_char
let l_strcat : L.lltype = L.function_type l_str [| l_str; l_str |]
let strcat_func the_module = L.declare_function "strcat" l_strcat the_module
let l_strcmp : L.lltype = L.function_type l_int [| l_str; l_str |]
let strcmp_func the_module = L.declare_function "strcmp" l_strcmp the_module

let rec ltype_of_typ = function
| RInt -> l_int
Expand Down Expand Up @@ -292,74 +296,117 @@ let rec build_expr expr (vars : variable StringMap.t) var_types the_module build
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 lval =
match typ with
| RInt ->
(match op with
| A.Add -> L.build_add
| A.Sub -> L.build_sub
| A.Mult -> L.build_mul
| A.Div -> L.build_sdiv
| A.Mod -> L.build_srem
| A.Equal -> L.build_icmp L.Icmp.Eq
| A.Neq -> L.build_icmp L.Icmp.Ne
| A.Less -> L.build_icmp L.Icmp.Slt
| A.Leq -> L.build_icmp L.Icmp.Sle
| A.Greater -> L.build_icmp L.Icmp.Sgt
| A.Geq -> L.build_icmp L.Icmp.Sge
| _ ->
failwith
(Printf.sprintf
"Integer binary operator %s not yet implemented"
(Utils.string_of_op op)))
| RFloat ->
(match op with
| A.Add -> L.build_fadd
| A.Sub -> L.build_fsub
| A.Mult -> L.build_fmul
| A.Div -> L.build_fdiv
| A.Mod -> L.build_frem
| A.Equal -> L.build_fcmp L.Fcmp.Oeq
| A.Neq -> L.build_fcmp L.Fcmp.One
| A.Less -> L.build_fcmp L.Fcmp.Olt
| A.Leq -> L.build_fcmp L.Fcmp.Ole
| A.Greater -> L.build_fcmp L.Fcmp.Ogt
| A.Geq -> L.build_fcmp L.Fcmp.Oge
| _ ->
failwith
(Printf.sprintf
"Float binary operator %s not yet implemented"
(Utils.string_of_op op)))
| RBool ->
(match op with
| A.And -> L.build_and
| A.Or -> L.build_or
| A.Equal -> L.build_icmp L.Icmp.Eq
| A.Neq -> L.build_icmp L.Icmp.Ne
| _ ->
failwith
(Printf.sprintf
"Boolean binary operator %s not yet implemented"
(Utils.string_of_op op)))
| REnumType _ ->
(match op with
| A.Equal -> L.build_icmp L.Icmp.Eq
| A.Neq -> L.build_icmp L.Icmp.Ne
(match typ with
| RString ->
(match op with
| A.Add ->
let len1 = L.build_call (strlen_func the_module) [| se1 |] "strlen1" builder in
let len2 = L.build_call (strlen_func the_module) [| se2 |] "strlen2" builder in
let total_len = L.build_add len1 len2 "total_len" builder in
let total_len_plus_one =
L.build_add total_len (L.const_int l_int 1) "total_len_plus_one" builder
in
let new_str =
L.build_array_alloca l_char total_len_plus_one "new_str" builder
in
let new_str_ptr = L.build_pointercast new_str l_str "new_str_ptr" builder in
ignore (L.build_store (L.const_int l_char 0) new_str_ptr builder);
ignore
(L.build_call
(strcat_func the_module)
[| new_str_ptr; se1 |]
"strcat1"
builder);
ignore
(L.build_call
(strcat_func the_module)
[| new_str_ptr; se2 |]
"strcat2"
builder);
new_str_ptr
| A.Equal ->
let cmp =
L.build_call (strcmp_func the_module) [| se1; se2 |] "strcmp" builder
in
L.build_icmp L.Icmp.Eq cmp (L.const_int l_int 0) "eq" builder
| A.Neq ->
let cmp =
L.build_call (strcmp_func the_module) [| se1; se2 |] "strcmp" builder
in
L.build_icmp L.Icmp.Ne cmp (L.const_int l_int 0) "neq" builder
| _ ->
failwith
(Printf.sprintf
"String binary operator %s not yet implemented"
(Utils.string_of_op op)))
| _ ->
let lval =
match typ with
| RInt ->
(match op with
| A.Add -> L.build_add
| A.Sub -> L.build_sub
| A.Mult -> L.build_mul
| A.Div -> L.build_sdiv
| A.Mod -> L.build_srem
| A.Equal -> L.build_icmp L.Icmp.Eq
| A.Neq -> L.build_icmp L.Icmp.Ne
| A.Less -> L.build_icmp L.Icmp.Slt
| A.Leq -> L.build_icmp L.Icmp.Sle
| A.Greater -> L.build_icmp L.Icmp.Sgt
| A.Geq -> L.build_icmp L.Icmp.Sge
| _ ->
failwith
(Printf.sprintf
"Integer binary operator %s not yet implemented"
(Utils.string_of_op op)))
| RFloat ->
(match op with
| A.Add -> L.build_fadd
| A.Sub -> L.build_fsub
| A.Mult -> L.build_fmul
| A.Div -> L.build_fdiv
| A.Mod -> L.build_frem
| A.Equal -> L.build_fcmp L.Fcmp.Oeq
| A.Neq -> L.build_fcmp L.Fcmp.One
| A.Less -> L.build_fcmp L.Fcmp.Olt
| A.Leq -> L.build_fcmp L.Fcmp.Ole
| A.Greater -> L.build_fcmp L.Fcmp.Ogt
| A.Geq -> L.build_fcmp L.Fcmp.Oge
| _ ->
failwith
(Printf.sprintf
"Float binary operator %s not yet implemented"
(Utils.string_of_op op)))
| RBool ->
(match op with
| A.And -> L.build_and
| A.Or -> L.build_or
| A.Equal -> L.build_icmp L.Icmp.Eq
| A.Neq -> L.build_icmp L.Icmp.Ne
| _ ->
failwith
(Printf.sprintf
"Boolean binary operator %s not yet implemented"
(Utils.string_of_op op)))
| REnumType _ ->
(match op with
| A.Equal -> L.build_icmp L.Icmp.Eq
| A.Neq -> L.build_icmp L.Icmp.Ne
| _ ->
failwith
(Printf.sprintf
"Internal Compiler Error: Operator %s on EnumType %s reached IRgen."
(Utils.string_of_op op)
(Utils.string_of_resolved_type typ)))
| _ ->
failwith
(Printf.sprintf
"Internal Compiler Error: Operator %s on EnumType %s reached IRgen."
"Binary operator %s not yet implemented for type %s"
(Utils.string_of_op op)
(Utils.string_of_resolved_type typ)))
| RString -> failwith "GOT A STRING\n"
| _ ->
failwith
(Printf.sprintf
"Binary operator %s not yet implemented for type %s"
(Utils.string_of_op op)
(Utils.string_of_resolved_type typ))
in
lval se1 se2 ("tmp_" ^ Utils.string_of_resolved_type typ) builder
(Utils.string_of_resolved_type typ))
in
lval se1 se2 "tmp" builder)
| SUDTInstance (typename, fields) ->
let struct_type = Hashtbl.find udt_structs typename in
let field_indices = Hashtbl.find udt_field_indices typename in
Expand Down
1 change: 1 addition & 0 deletions lib/semant.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -154,6 +154,7 @@ and get_binop_return_type expr t1 binop t2 =
(match t1, t2 with
| RInt, RInt -> RInt
| RFloat, RFloat -> RFloat
| RString, RString -> RString
| _, _ -> raise (Failure (format_binop_error expr t1 t2)))
| Equal | Neq ->
(match t1, t2 with
Expand Down
80 changes: 80 additions & 0 deletions test/ir/test_string.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,86 @@ let tests =
}\n"
in
assert_equal expected actual ~printer)
; ("concat_string"
>:: fun _ ->
let sast =
get_sast
"fun function() -> () {let a := \"hello\"; let b := \" World\"; a + b; }"
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\
@str = private unnamed_addr constant [6 x i8] c\"hello\\00\", align 1\n\
@str.1 = private unnamed_addr constant [7 x i8] c\" World\\00\", align 1\n\n\
define void @function() {\n\
entry:\n\
\ %a = alloca i8*, align 8\n\
\ store i8* getelementptr inbounds ([6 x i8], [6 x i8]* @str, i32 0, i32 \
0), i8** %a, align 8\n\
\ %b = alloca i8*, align 8\n\
\ store i8* getelementptr inbounds ([7 x i8], [7 x i8]* @str.1, i32 0, i32 \
0), i8** %b, align 8\n\
\ %a1 = load i8*, i8** %a, align 8\n\
\ %b2 = load i8*, i8** %b, align 8\n\
\ %strlen1 = call i32 @strlen(i8* %a1)\n\
\ %strlen2 = call i32 @strlen(i8* %b2)\n\
\ %total_len = add i32 %strlen1, %strlen2\n\
\ %total_len_plus_one = add i32 %total_len, 1\n\
\ %new_str = alloca i8, i32 %total_len_plus_one, align 1\n\
\ store i8 0, i8* %new_str, align 1\n\
\ %strcat1 = call i8* @strcat(i8* %new_str, i8* %a1)\n\
\ %strcat2 = call i8* @strcat(i8* %new_str, i8* %b2)\n\
\ ret void\n\
}\n\n\
declare i32 @strlen(i8*)\n\n\
declare i8* @strcat(i8*, i8*)\n"
in
assert_equal expected actual ~printer)
; ("print_concat_string"
>:: fun _ ->
let sast =
get_sast
"fun function() -> () {let a := \"hello\"; let b := \" World\"; print(a + \
b); }"
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\
@str = private unnamed_addr constant [6 x i8] c\"hello\\00\", align 1\n\
@str.1 = private unnamed_addr constant [7 x i8] c\" World\\00\", align 1\n\
@str_fmt = private unnamed_addr constant [4 x i8] c\"%s\\0A\\00\", align 1\n\n\
define void @function() {\n\
entry:\n\
\ %a = alloca i8*, align 8\n\
\ store i8* getelementptr inbounds ([6 x i8], [6 x i8]* @str, i32 0, i32 \
0), i8** %a, align 8\n\
\ %b = alloca i8*, align 8\n\
\ store i8* getelementptr inbounds ([7 x i8], [7 x i8]* @str.1, i32 0, i32 \
0), i8** %b, align 8\n\
\ %a1 = load i8*, i8** %a, align 8\n\
\ %b2 = load i8*, i8** %b, align 8\n\
\ %strlen1 = call i32 @strlen(i8* %a1)\n\
\ %strlen2 = call i32 @strlen(i8* %b2)\n\
\ %total_len = add i32 %strlen1, %strlen2\n\
\ %total_len_plus_one = add i32 %total_len, 1\n\
\ %new_str = alloca i8, i32 %total_len_plus_one, align 1\n\
\ store i8 0, i8* %new_str, align 1\n\
\ %strcat1 = call i8* @strcat(i8* %new_str, i8* %a1)\n\
\ %strcat2 = call i8* @strcat(i8* %new_str, i8* %b2)\n\
\ %call_printf = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([4 \
x i8], [4 x i8]* @str_fmt, i32 0, i32 0), i8* %new_str)\n\
\ ret void\n\
}\n\n\
declare i32 @strlen(i8*)\n\n\
declare i8* @strcat(i8*, i8*)\n\n\
declare i32 @printf(i8*, ...)\n"
in
_write_to_file actual "actual.out";
assert_equal expected actual ~printer)
]
;;

Expand Down
5 changes: 5 additions & 0 deletions test/sample_programs/test_concat_string.fly
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
fun main() -> () {
let a := "hello";
let b := " World";
print(a + b);
}