use std::collections::BTreeSet;
use crate::compiler::{
crust::{ItemSource, Symbol, Type, TypeScheme, TypeVar},
nucleus,
};
pub const STD_OPS: &str = "std::ops";
pub const ADDITION: &str = "+";
pub const SUBTRACTION: &str = "-";
pub const MULTIPLICATION: &str = "*";
pub const DIVISION: &str = "/";
pub fn register_binary_operator_functions(builder: &mut ItemSource) {
let type_var = TypeVar(0);
let binary_op_type_scheme = TypeScheme {
unbound_rows: Default::default(),
unbound_tys: BTreeSet::from_iter([type_var]),
evidence: Default::default(),
typ: Type::abstraction(
Type::Var(type_var),
Type::abstraction(Type::Var(type_var), Type::Var(type_var)),
),
};
builder.register(
Symbol {
module: STD_OPS.to_string(),
field: ADDITION.to_string(),
},
binary_op_type_scheme.clone(),
);
builder.register(
Symbol {
module: STD_OPS.to_string(),
field: SUBTRACTION.to_string(),
},
binary_op_type_scheme.clone(),
);
builder.register(
Symbol {
module: STD_OPS.to_string(),
field: MULTIPLICATION.to_string(),
},
binary_op_type_scheme.clone(),
);
builder.register(
Symbol {
module: STD_OPS.to_string(),
field: DIVISION.to_string(),
},
binary_op_type_scheme.clone(),
);
}
pub fn register_binary_operator_imports(modules: &mut Vec<(String, String, nucleus::Module)>) {
let module = wat::parse_str(STD_OPS_WAT).expect("blr-std::ops should be a valid wat module");
modules.push((
STD_OPS.to_string(),
"".to_string(),
nucleus::Module {
module,
imports: BTreeSet::from_iter(["blr_runtime".to_string()]),
externals: Default::default(),
exports: Default::default(),
},
));
}
const STD_OPS_WAT: &str = r#"
(module
(type $alloc (func (param i32 i32) (result i32)))
;; add
(type $add-int-inner (func (param i32 i64) (result i64)))
(type $add-int (func (param i32 i64) (result i32)))
(type $add-float-inner (func (param i32 f64) (result f64)))
(type $add-float (func (param i32 f64) (result i32)))
;; sub
(type $sub-int-inner (func (param i32 i64) (result i64)))
(type $sub-int (func (param i32 i64) (result i32)))
(type $sub-float-inner (func (param i32 f64) (result f64)))
(type $sub-float (func (param i32 f64) (result i32)))
;; mul
(type $mul-int-inner (func (param i32 i64) (result i64)))
(type $mul-int (func (param i32 i64) (result i32)))
(type $mul-float-inner (func (param i32 f64) (result f64)))
(type $mul-float (func (param i32 f64) (result i32)))
;; div
(type $div-int-inner (func (param i32 i64) (result i64)))
(type $div-int (func (param i32 i64) (result i32)))
(type $div-float-inner (func (param i32 f64) (result f64)))
(type $div-float (func (param i32 f64) (result i32)))
(import "blr_runtime" "func_tbl" (table $ft 1000 funcref))
(import "blr_runtime" "alloc" (func $alloc (type 0)))
(import "blr_runtime" "mem" (memory 1))
;; add
(export "add-int-inner" (func $add-int-inner))
(export "+[(int)]" (func $add-int))
(export "add-float-inner" (func $add-float-inner))
(export "+[(float)]" (func $add-float))
;; sub
(export "sub-int-inner" (func $sub-int-inner))
(export "-[(int)]" (func $sub-int))
(export "sub-float-inner" (func $sub-float-inner))
(export "-[(float)]" (func $sub-float))
;; mul
(export "mul-int-inner" (func $mul-int-inner))
(export "*[(int)]" (func $mul-int))
(export "mul-float-inner" (func $mul-float-inner))
(export "*[(float)]" (func $mul-float))
;; div
(export "div-int-inner" (func $div-int-inner))
(export "/[(int)]" (func $div-int))
(export "div-float-inner" (func $div-float-inner))
(export "/[(float)]" (func $div-float))
;; add
(func $add-int-inner (type $add-int-inner) (param $clos i32) (param $b i64) (result i64)
local.get $clos
i64.load offset=4
local.get $b
i64.add)
(func $add-int (type $add-int) (param $clos i32) (param $a i64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 10)
(ref.func $add-int-inner))
(i32.const 10))
(i64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
(func $add-float-inner (type $add-float-inner) (param $clos i32) (param $b f64) (result f64)
local.get $clos
f64.load offset=4
local.get $b
f64.add)
(func $add-float (type $add-float) (param $clos i32) (param $a f64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 11)
(ref.func $add-float-inner))
(i32.const 11))
(f64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
;; sub
(func $sub-int-inner (type $sub-int-inner) (param $clos i32) (param $b i64) (result i64)
local.get $clos
i64.load offset=4
local.get $b
i64.sub)
(func $sub-int (type $sub-int) (param $clos i32) (param $a i64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 12)
(ref.func $sub-int-inner))
(i32.const 12))
(i64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
(func $sub-float-inner (type $sub-float-inner) (param $clos i32) (param $b f64) (result f64)
local.get $clos
f64.load offset=4
local.get $b
f64.sub)
(func $sub-float (type $sub-float) (param $clos i32) (param $a f64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 13)
(ref.func $sub-float-inner))
(i32.const 13))
(f64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
;; mul
(func $mul-int-inner (type $mul-int-inner) (param $clos i32) (param $b i64) (result i64)
local.get $clos
i64.load offset=4
local.get $b
i64.mul)
(func $mul-int (type $mul-int) (param $clos i32) (param $a i64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 14)
(ref.func $mul-int-inner))
(i32.const 14))
(i64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
(func $mul-float-inner (type $mul-float-inner) (param $clos i32) (param $b f64) (result f64)
local.get $clos
f64.load offset=4
local.get $b
f64.mul)
(func $mul-float (type $mul-float) (param $clos i32) (param $a f64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 15)
(ref.func $mul-float-inner))
(i32.const 15))
(f64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
;; div
(func $div-int-inner (type $div-int-inner) (param $clos i32) (param $b i64) (result i64)
local.get $clos
i64.load offset=4
local.get $b
i64.div_s)
(func $div-int (type $div-int) (param $clos i32) (param $a i64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 16)
(ref.func $div-int-inner))
(i32.const 16))
(i64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
(func $div-float-inner (type $div-float-inner) (param $clos i32) (param $b f64) (result f64)
local.get $clos
f64.load offset=4
local.get $b
f64.div)
(func $div-float (type $div-float) (param $clos i32) (param $a f64) (result i32)
(local $new-clos i32)
(local.set $new-clos
(call $alloc
(i32.const 8)
(i32.const 12)))
(i32.store
(local.get $new-clos)
(table.set $ft
(i32.const 17)
(ref.func $div-float-inner))
(i32.const 17))
(f64.store offset=4
(local.get $new-clos)
(local.get $a))
(return local.get $new-clos))
)
"#;