Bytevector support (#169)

* bytevector support and vm cleanup

* add bytevector module

* cleaning up super instructions

* remove recycler from structs for now

* add bytevector tests

* update docs

cogs/collections/mhash.scm

@@ -1,22 +1,113 @@
-(require-builtin #%private/steel/mhash as private.)
+(provide (contract/out mhash-set! (->/c mhash? any/c any/c any/c))
+         (contract/out mhash-ref (->/c mhash? any/c any/c))
+         mhash
+         (contract/out mhash->hash (->/c mhash? hash?))
+         (contract/out mhash-length (->/c mhash? int?))
+         (contract/out mhash-contains? (->/c mhash? bool?))
+         (contract/out mhash-keys->list (->/c mhash? list?))
+         (contract/out mhash-values->list (->/c mhash? list?))
+         (contract/out mhash->list (->/c mhash? list?))
+         (contract/out mhash? (->/c any/c bool?))
+         no-contract-mhash-ref)
 
-(struct mutable-hash (inner) #:mutable)
+(define (for-each func lst)
+  (if (null? lst)
+      void
+      (begin
+        (func (car lst))
+        (when (null? lst)
+          (return! void))
+        (for-each func (cdr lst)))))
 
+;; Manually box the hash map
+(struct mutable-hash (inner)
+  #:printer
+  (lambda (obj printer)
+    (simple-display "'#mhash(")
+    (let ([hash-as-list-of-pairs (transduce (#%unbox (mutable-hash-inner obj)) (into-list))])
+      (cond
+        [(empty? hash-as-list-of-pairs) (simple-display ")")]
+        [else
+
+         (simple-display "(")
+         (printer (caar hash-as-list-of-pairs))
+         (simple-display " . ")
+         (printer (cadar hash-as-list-of-pairs))
+         (simple-display ")")
+
+         (for-each (λ (obj)
+                     (simple-display " (")
+                     (printer (car obj))
+                     (simple-display " . ")
+                     (printer (list-ref obj 1))
+                     (simple-display ")"))
+                   (cdr hash-as-list-of-pairs))
+
+         (simple-display ")")]))))
+
+(define mhash? mutable-hash?)
+
+;;@doc
+;; Mutably update the hashmap in place, setting the key and value accordingly.
 (define (mhash-set! mhash key value)
-  (private.mhash-set! (mutable-hash-inner mhash) key value))
+  (swap-with-expr (mutable-hash-inner mhash) (lambda (h) (hash-insert h key value))))
 
+;;@doc
+;; Fetch the value for the given key
 (define (mhash-ref mhash key)
-  (private.mhash-ref (mutable-hash-inner mhash) key))
+  (hash-ref (#%unbox (mutable-hash-inner mhash)) key))
+
+(define no-contract-mhash-ref mhash-ref)
+
+;;@doc
+;; Construct a mutable hash map from the given key value pairs
+(define (mhash . args)
+  (mutable-hash (#%box (apply hash args))))
+
+;;@doc
+;; If you want to call any methods that
+;; exist for an immutable hash, just delegate here.
+;;
+;; This conversion is very inexpensive, and does not copy
+;; the entire vector.
+(define (mhash->hash mh)
+  (#%unbox (mutable-hash-inner mh)))
+
+;;@doc
+;; Get the length of the mutable hash table. The length is defined
+;; as the number of key value pairs.
+(define (mhash-length mh)
+  (hash-length (mhash->hash mh)))
 
-(define (mhash)
-  (mutable-hash (private.mhash)))
+;;@doc
+;; Check if this mutable hash contains a key
+(define (mhash-contains? mh key)
+  (hash-contains? (mhash->hash mh) key))
 
-(define (loop)
-  (define my-hash (mhash))
+;;@doc
+;; Get the keys of this mutable hash map as a list
+(define (mhash-keys->list mh)
+  (hash-keys->list (mhash->hash mh)))
 
-  (mhash-set! my-hash 'foo 'bar)
-  (mhash-set! my-hash 'bar 'foo)
+;;@doc
+;; Get the values of this mutable hash map as a list
+(define (mhash-values->list mh)
+  (hash-values->list (mhash->hash mh)))
 
-  (mhash-set! my-hash 'baz my-hash)
+;;@doc
+;; Convert this mutable hash into an association list, which
+;; in this case is a list of pairs.
+(define (mhash->list mh)
+  (transduce (mhash->hash mh) (into-list)))
 
-  (loop))
+;; Swap the contents of the boxed value
+;; in place, so that we can perform in place
+;; updates where relevant.
+;;
+;; Note: This might actually just be slower, but
+;; for the sake of experimenting we'll go with it.
+(define (swap-with-expr boxed-value thunk)
+  ;; Replace the inner box with void
+  (let ([previous (#%set-box! boxed-value void)])
+    (with-handler (lambda (err) (#%set-box! boxed-value previous))
+                  (#%set-box! boxed-value (thunk previous)))))

crates/steel-core/build.rs

@@ -8,9 +8,13 @@ fn main() {
         use std::path::Path;
 
         let out_dir = env::var_os("OUT_DIR").unwrap();
-        let dest_path = Path::new(&out_dir).join("generated.rs");
+        // let dest_path = Path::new(&out_dir).join("generated.rs");
 
-        fs::write(dest_path, steel_gen::permutations::code_gen()).unwrap();
+        // fs::write(dest_path, steel_gen::permutations::code_gen()).unwrap();
+
+        let dest_path = Path::new(&out_dir).join("dynamic.rs");
+
+        fs::write(dest_path, steel_gen::generate_opcode_map()).unwrap();
 
         println!("cargo:rerun-if-changed=build.rs");
     }

crates/steel-core/src/compiler/program.rs

@@ -30,7 +30,7 @@ use log::{debug, log_enabled};
 
 use super::{compiler::DebruijnIndicesInterner, map::SymbolMap};
 
-const _TILE_SUPER_INSTRUCTIONS: bool = false;
+const _TILE_SUPER_INSTRUCTIONS: bool = true;
 
 pub fn number_literal_to_steel(n: &NumberLiteral) -> Result<SteelVal> {
     // real_to_steel does some cloning of bignums. It may be possible to optimize this away.
@@ -505,7 +505,8 @@ pub const fn sequence_to_opcode(pattern: &[(OpCode, usize)]) -> &'static [steel_
     }
 }
 
-pub fn tile_super_instructions(_instructions: &mut [Instruction]) {
+#[allow(unused)]
+pub fn tile_super_instructions(instructions: &mut [Instruction]) {
     #[cfg(feature = "dynamic")]
     {
         pub fn tile<const N: usize>(instructions: &mut [Instruction]) {
@@ -535,7 +536,10 @@ pub fn tile_super_instructions(_instructions: &mut [Instruction]) {
                     steel_gen::Pattern::from_opcodes_with_buffer(&buffer, &mut pattern_buffer);
 
                     if crate::steel_vm::vm::pattern_exists(&pattern_buffer) {
-                        log::debug!(target: "super-instructions", "Applying tiling for: {:?}", op_code);
+                        // log::debug!(target: "super-instructions", "Applying tiling for: {:?}", op_code);
+
+                        // println!("Applying tiling for: {:?}", op_code);
+                        // println!("{:?}", pattern_buffer);
 
                         instructions[i].op_code = op_code;
 
@@ -552,6 +556,8 @@ pub fn tile_super_instructions(_instructions: &mut [Instruction]) {
         // Super instruction tiling here!
 
         if _TILE_SUPER_INSTRUCTIONS {
+            tile::<11>(instructions);
+            tile::<10>(instructions);
             tile::<9>(instructions);
             tile::<8>(instructions);
             tile::<7>(instructions);

crates/steel-core/src/parser/ast.rs

@@ -266,22 +266,16 @@ impl TryFrom<&SteelVal> for ExprKind {
 
                 Pair(_) => Err("Can't convert from pair to expression!"),
 
-                // StructClosureV(_) => Err("Can't convert from struct-function to expression!"),
                 PortV(_) => Err("Can't convert from port to expression!"),
                 Closure(_) => Err("Can't convert from bytecode closure to expression"),
                 HashMapV(_) => Err("Can't convert from hashmap to expression!"),
                 HashSetV(_) => Err("Can't convert from hashset to expression!"),
                 IterV(_) => Err("Can't convert from iterator to expression!"),
                 FutureFunc(_) => Err("Can't convert from future function to expression!"),
                 FutureV(_) => Err("Can't convert future to expression!"),
-                // Promise(_) => Err("Can't convert from promise to expression!"),
                 StreamV(_) => Err("Can't convert from stream to expression!"),
-                // Contract(_) => Err("Can't convert from contract to expression!"),
-                // ContractedFunction(_) => Err("Can't convert from contracted function to expression!"),
                 BoxedFunction(_) => Err("Can't convert from boxed function to expression!"),
                 ContinuationFunction(_) => Err("Can't convert from continuation to expression!"),
-                // #[cfg(feature = "jit")]
-                // CompiledFunction(_) => Err("Can't convert from function to expression!"),
                 MutFunc(_) => Err("Can't convert from function to expression!"),
                 BuiltIn(_) => Err("Can't convert from function to expression!"),
                 ReducerV(_) => Err("Can't convert from reducer to expression!"),
@@ -291,6 +285,7 @@ impl TryFrom<&SteelVal> for ExprKind {
                 Boxed(_) => Err("Can't convert from boxed steel val to expression!"),
                 Reference(_) => Err("Can't convert from opaque reference type to expression!"),
                 HeapAllocated(_) => Err("Can't convert from heap allocated value to expression!"),
+                ByteVector(_) => Err("Can't convert from bytevector to expression!"),
             }
         }
 

crates/steel-core/src/primitives.rs

@@ -1,3 +1,4 @@
+pub mod bytevectors;
 pub mod contracts;
 mod control;
 mod fs;
@@ -20,7 +21,7 @@ mod utils;
 pub mod vectors;
 
 use crate::gc::Gc;
-use crate::rvals::{FromSteelVal, IntoSteelVal};
+use crate::rvals::{FromSteelVal, IntoSteelVal, SteelByteVector};
 use crate::rvals::{
     FunctionSignature, PrimitiveAsRef, PrimitiveAsRefMut, SteelHashMap, SteelHashSet, SteelVal,
     SteelVector,
@@ -134,6 +135,45 @@ impl From<i64> for SteelVal {
     }
 }
 
+impl FromSteelVal for u8 {
+    fn from_steelval(val: &SteelVal) -> crate::rvals::Result<Self> {
+        match val {
+            SteelVal::IntV(v) => (*v).try_into().map_err(|_err| {
+                SteelErr::new(
+                    ErrorKind::ConversionError,
+                    format!("Unable to convert isize to u8: {}", v),
+                )
+            }),
+            SteelVal::BigNum(n) => n.as_ref().try_into().map_err(|_err| {
+                SteelErr::new(
+                    ErrorKind::ConversionError,
+                    format!("Unable to convert bignum to u8: {:?}", n),
+                )
+            }),
+            _ => Err(SteelErr::new(
+                ErrorKind::ConversionError,
+                format!("Unable to convert steelval to u8: {}", val),
+            )),
+        }
+    }
+}
+
+impl From<usize> for SteelVal {
+    fn from(value: usize) -> Self {
+        if value > isize::MAX as usize {
+            SteelVal::BigNum(Gc::new(value.into()))
+        } else {
+            SteelVal::IntV(value as isize)
+        }
+    }
+}
+
+impl IntoSteelVal for usize {
+    fn into_steelval(self) -> crate::rvals::Result<SteelVal> {
+        Ok(SteelVal::from(self))
+    }
+}
+
 impl IntoSteelVal for i64 {
     fn into_steelval(self) -> crate::rvals::Result<SteelVal> {
         Ok(self.into())
@@ -279,9 +319,9 @@ impl IntoSteelVal for BigRational {
 }
 
 from_f64!(f64, f32);
-from_for_isize!(i32, i16, i8, u8, u16, u32, u64, usize, isize);
+from_for_isize!(i32, i16, i8, u8, u16, u32, u64, isize);
 try_from_impl!(NumV => f64, f32);
-try_from_impl!(IntV => i32, i16, i8, u8, u16, u32, u64, usize, isize);
+try_from_impl!(IntV => i32, i16, i8, u16, u32, u64, usize, isize);
 
 impl TryFrom<SteelVal> for String {
     type Error = SteelErr;
@@ -382,6 +422,22 @@ impl<'a, L: PrimitiveAsRef<'a>, R: PrimitiveAsRef<'a>> PrimitiveAsRef<'a> for Ei
     }
 }
 
+impl<'a> PrimitiveAsRef<'a> for &'a SteelByteVector {
+    fn primitive_as_ref(val: &'a SteelVal) -> crate::rvals::Result<Self> {
+        Self::maybe_primitive_as_ref(val).ok_or_else(
+            crate::throw!(ConversionError => format!("Cannot convert value to bytevector: {}", val)),
+        )
+    }
+
+    fn maybe_primitive_as_ref(val: &'a SteelVal) -> Option<Self> {
+        if let SteelVal::ByteVector(s) = val {
+            Some(s)
+        } else {
+            None
+        }
+    }
+}
+
 impl<'a> PrimitiveAsRef<'a> for &'a UserDefinedStruct {
     fn primitive_as_ref(val: &'a SteelVal) -> crate::rvals::Result<Self> {
         Self::maybe_primitive_as_ref(val).ok_or_else(
@@ -721,6 +777,26 @@ impl<'a> PrimitiveAsRefMut<'a> for &'a mut Gc<im_rc::HashMap<SteelVal, SteelVal>
     }
 }
 
+impl<'a> PrimitiveAsRefMut<'a> for &'a mut SteelByteVector {
+    #[inline(always)]
+    fn primitive_as_ref(val: &'a mut SteelVal) -> crate::rvals::Result<Self> {
+        if let SteelVal::ByteVector(hm) = val {
+            Ok(hm)
+        } else {
+            crate::stop!(ConversionError => format!("Cannot convert steel value: {} to bytevector", val))
+        }
+    }
+
+    #[inline(always)]
+    fn maybe_primitive_as_ref(val: &'a mut SteelVal) -> Option<Self> {
+        if let SteelVal::ByteVector(hm) = val {
+            Some(hm)
+        } else {
+            None
+        }
+    }
+}
+
 impl<'a> PrimitiveAsRef<'a> for &'a SteelHashMap {
     #[inline(always)]
     fn primitive_as_ref(val: &'a SteelVal) -> crate::rvals::Result<Self> {