blr-lang 0.1.0

A language implementation that provides type safe dataframes
Documentation
use std::collections::BTreeSet;

use crate::compiler::{
    crust::{ItemSource, Symbol, Type, TypeScheme, TypeVar},
    nucleus,
};

/// TODO Make real symbols
pub const STD_OPS: &str = "std::ops";

// NB: Use names that are not valid identifier so they cannot be shadowed
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(),
        //TODO
        "".to_string(),
        nucleus::Module {
            module,
            imports: BTreeSet::from_iter(["blr_runtime".to_string()]),
            externals: Default::default(),
            // TODO fill this out
            exports: Default::default(),
        },
    ));
}
// TODO build a mini compilation process that can generate the curried items for this hand written
// wat.

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))

)
"#;