Skip to content

Commit

Permalink
Add custom binary operators
Browse files Browse the repository at this point in the history 
and re-define binary ops in stdlib
  • Loading branch information
@tjammer
tjammer committed Feb 16, 2024
1 parent 7eca72f commit 184dd45
Show file tree
Hide file tree
Showing 19 changed files with 393 additions and 295 deletions.
2 changes: 1 addition & 1 deletion lib/ast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ and expr =
| Var of ident
| Lit of loc * literal
| Bop of loc * bop * expr * expr
| Unop of loc * unop * expr
| Unop of loc * ident * expr
| If of loc * expr * expr * expr option
| Let_e of loc * decl * passed_expr * expr
| Lambda of loc * decl list * func_attr list * type_spec option * block
Expand Down
77 changes: 77 additions & 0 deletions lib/builtin.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,24 @@ type t =
| Lshl
| Lshr
| Ashr
| Addi
| Subi
| Multi
| Divi
| Addf
| Subf
| Mulf
| Divf
| Lessi
| Greateri
| Lesseqi
| Greatereqi
| Equali
| Lessf
| Greaterf
| Lesseqf
| Greatereqf
| Equalf
[@@deriving show]

let tbl =
Expand Down Expand Up @@ -196,6 +214,65 @@ let tbl =
(Lshr, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tint, Simple));
Hashtbl.add tbl "ashr"
(Ashr, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tint, Simple));
Hashtbl.add tbl "__addi"
(Addi, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tint, Simple));
Hashtbl.add tbl "__subi"
(Subi, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tint, Simple));
Hashtbl.add tbl "__multi"
(Multi, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tint, Simple));
Hashtbl.add tbl "__divi"
(Divi, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tint, Simple));
Hashtbl.add tbl "__addf"
( Addf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tfloat, Simple)
);
Hashtbl.add tbl "__subf"
( Subf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tfloat, Simple)
);
Hashtbl.add tbl "__mulf"
( Mulf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tfloat, Simple)
);
Hashtbl.add tbl "__divf"
( Divf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tfloat, Simple)
);
Hashtbl.add tbl "__lessi"
(Lessi, Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tbool, Simple));
Hashtbl.add tbl "__greateri"
( Greateri,
Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tbool, Simple) );
Hashtbl.add tbl "__lesseqi"
( Lesseqi,
Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tbool, Simple) );
Hashtbl.add tbl "__greatereqi"
( Greatereqi,
Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tbool, Simple) );
Hashtbl.add tbl "__equali"
( Equali,
Tfun ([ { p with pt = Tint }; { p with pt = Tint } ], Tbool, Simple) );
Hashtbl.add tbl "__lessf"
( Lessf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tbool, Simple)
);
Hashtbl.add tbl "__greaterf"
( Greaterf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tbool, Simple)
);
Hashtbl.add tbl "__lesseqf"
( Lesseqf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tbool, Simple)
);
Hashtbl.add tbl "__greatereqf"
( Greatereqf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tbool, Simple)
);
Hashtbl.add tbl "__equalf"
( Equalf,
Tfun ([ { p with pt = Tfloat }; { p with pt = Tfloat } ], Tbool, Simple)
);

tbl

let of_string key =
Expand Down
113 changes: 83 additions & 30 deletions lib/codegen/codegen.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -594,6 +594,11 @@ end = struct
func_to_closure param arg
in
let args = List.map handle_arg args in
let binary () =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in

let cast f lltyp typ =
match args with
Expand Down Expand Up @@ -800,53 +805,101 @@ end = struct
{ dummy_fn_value with lltyp = unit_t }
| Copy -> Auto.copy param allocref (List.hd args)
| Land ->
let a, b =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in
let a, b = binary () in
let value = Llvm.build_and a b "land" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Lor ->
let a, b =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in
let a, b = binary () in
let value = Llvm.build_or a b "lor" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Lxor ->
let a, b =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in
let a, b = binary () in
let value = Llvm.build_xor a b "lor" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Lshl ->
let a, b =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in
let a, b = binary () in
let value = Llvm.build_shl a b "lshl" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Lshr ->
let a, b =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in
let a, b = binary () in
let value = Llvm.build_lshr a b "lshr" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Ashr ->
let a, b =
match args with
| [ a; b ] -> (bring_default a, bring_default b)
| _ -> failwith "Internal Error: Arity mismatch in builtin"
in
let a, b = binary () in
let value = Llvm.build_ashr a b "ashr" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Addi ->
let a, b = binary () in
let value = Llvm.build_add a b "add" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Subi ->
let a, b = binary () in
let value = Llvm.build_sub a b "sub" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Multi ->
let a, b = binary () in
let value = Llvm.build_mul a b "mul" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Divi ->
let a, b = binary () in
let value = Llvm.build_sdiv a b "div" builder in
{ value; lltyp = int_t; typ = Tint; kind = Imm }
| Addf ->
let a, b = binary () in
let value = Llvm.build_fadd a b "add" builder in
{ value; lltyp = float_t; typ = Tfloat; kind = Imm }
| Subf ->
let a, b = binary () in
let value = Llvm.build_fsub a b "sub" builder in
{ value; lltyp = float_t; typ = Tfloat; kind = Imm }
| Mulf ->
let a, b = binary () in
let value = Llvm.build_fmul a b "mul" builder in
{ value; lltyp = float_t; typ = Tfloat; kind = Imm }
| Divf ->
let a, b = binary () in
let value = Llvm.build_fdiv a b "div" builder in
{ value; lltyp = float_t; typ = Tfloat; kind = Imm }
| Lessi ->
let a, b = binary () in
let value = Llvm.(build_icmp Icmp.Slt) a b "lt" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Greateri ->
let a, b = binary () in
let value = Llvm.(build_icmp Icmp.Sgt) a b "gt" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Lesseqi ->
let a, b = binary () in
let value = Llvm.(build_icmp Icmp.Sle) a b "le" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Greatereqi ->
let a, b = binary () in
let value = Llvm.(build_icmp Icmp.Sge) a b "ge" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Equali ->
let a, b = binary () in
let value = Llvm.(build_icmp Icmp.Eq) a b "eq" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Lessf ->
let a, b = binary () in
let value = Llvm.(build_fcmp Fcmp.Olt) a b "lt" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Greaterf ->
let a, b = binary () in
let value = Llvm.(build_fcmp Fcmp.Ogt) a b "gt" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Lesseqf ->
let a, b = binary () in
let value = Llvm.(build_fcmp Fcmp.Ole) a b "le" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Greatereqf ->
let a, b = binary () in
let value = Llvm.(build_fcmp Fcmp.Oge) a b "ge" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }
| Equalf ->
let a, b = binary () in
let value = Llvm.(build_fcmp Fcmp.Oeq) a b "eq" builder in
{ value; lltyp = bool_t; typ = Tbool; kind = Imm }

and gen_app_inline param args names tree =
(* Identify args to param names *)
Expand Down
31 changes: 13 additions & 18 deletions lib/lexer.mll
View file
Original file line number Diff line number Diff line change
Expand Up @@ -109,6 +109,15 @@ let sized_id = lowercase_alpha+ hashnum
let hashquest = '#' '?'
let unknown_sized_id = lowercase_alpha+ hashquest
let plus_ops = '+' | '-'
let mult_ops = '*' | '/'
let cmp_ops = '<' | '>'
let binops = '=' | cmp_ops | plus_ops | mult_ops | '.' | '|' | '&' | '?'
let eq_op = '=' binops+
let cmp_op = cmp_ops binops*
let plus_op = plus_ops binops*
let mult_op = mult_ops binops*
rule read =
parse
| white { read lexbuf }
Expand All @@ -127,8 +136,6 @@ rule read =
| ':' { Colon }
| ',' { Comma }
| '.' { Dot }
| "==" { Equal_binop }
| "==." { Bin_equal_f }
| "'" { Quote }
| "if" { If }
| "else" { Else }
Expand Down Expand Up @@ -169,22 +176,6 @@ rule read =
{ U8 (char_for_hexadecimal_code d u) }
| '&' { Ampersand }
| '!' { Exclamation }
| '+' { Plus_i }
| min { Minus_i }
| '*' { Mult_i }
| '/' { Div_i }
| "+." { Plus_f }
| "-." { Minus_f }
| "*." { Mult_f }
| "/." { Div_f }
| '<' { Less_i }
| "<." { Less_f }
| '>' { Greater_i }
| ">." { Greater_f }
| "<=" { Less_eq_i }
| "<=." { Less_eq_f }
| ">=" { Greater_eq_i }
| ">=." { Greater_eq_f }
| '(' { Lpar }
| ')' { Rpar }
| '{' { Lbrac }
Expand All @@ -199,6 +190,10 @@ rule read =
| "->" { Right_arrow }
| "|>" { Pipe_tail }
| "--" { line_comment lexbuf }
| eq_op { Eq_op (Lexing.lexeme lexbuf) }
| cmp_op { Cmp_op (Lexing.lexeme lexbuf) }
| plus_op { Plus_op (Lexing.lexeme lexbuf) }
| mult_op { Mult_op (Lexing.lexeme lexbuf) }
| eof { Eof }
| _ { raise (SyntaxError ("Unexpected char: " ^ Lexing.lexeme lexbuf)) }

Expand Down
Loading

0 comments on commit 184dd45

Please sign in to comment.