more methods: ports, chars (#227)

* more methods: ports, chars

* support aliases for native definitions

* support arbitrary tokens in native definition docs

* aliases, more docs, minor fixes

* rename raw functions

* minor changes and additions

* minor changes

* update docs

* fix infinite loop

cogs/r5rs.scm

@@ -437,6 +437,21 @@
 (check-equal? "case-insensitive string >=, true" #t (string-ci>=? "aa" "A"))
 (check-equal? "case-insensitive string >=, same string" #t (string-ci>=? "a" "A"))
 
+(check-equal? "char=?, true" #t (char=? #\a #\a #\a))
+(check-equal? "char=?, false" #f (char=? #\a #\A))
+(check-equal? "char<?, true" #t (char<? #\a #\b #\c))
+(check-equal? "char<?, false, strict" #f (char<? #\a #\a))
+(check-equal? "char<?, false" #f (char<? #\b #\a))
+(check-equal? "char>?, false" #f (char>? #\a #\b))
+(check-equal? "char>?, false, strict" #f (char>? #\a #\a))
+(check-equal? "char>?, true" #t (char>? #\c #\b #\a))
+(check-equal? "char<=?, true" #t (char<=? #\a #\b #\b))
+(check-equal? "char<=?, true, non-strict" #t (char<=? #\a #\a))
+(check-equal? "char<=?, false" #f (char<=? #\b #\a))
+(check-equal? "char>=?, false" #f (char>=? #\a #\b))
+(check-equal? "char>=?, true, non-strict" #t (char>=? #\a #\a))
+(check-equal? "char>=?, true" #t (char>=? #\b #\b #\a))
+
 (check-equal? "make-string creates single character string 'a' correctly"
               #t
               (string=? "a" (make-string 1 #\a)))

cogs/r7rs.scm

@@ -70,6 +70,30 @@
               (parameterize ([location "on a bus"])
                 (would-you-could-you?)))
 
+;; Bytevectors
+
+;; TODO: use bytevector literals
+(check-equal? "utf8->string" "ABC" (utf8->string (bytes #x41 #x42 #x43)))
+(check-equal? "utf8->string, multi-byte char" "λ" (utf8->string (bytes #xCE #xBB)))
+(check-equal? "utf8->string with start" "ABC" (utf8->string (bytes 0 #x41 #x42 #x43) 1))
+(check-equal? "utf8->string with start and end" "ABC" (utf8->string (bytes 0 #x41  #x42 #x43 0) 1 4))
+(check-equal? "utf8->string with start and end, multi-byte char" "λ" (utf8->string (bytes 0 #xCE #xBB 0) 1 3))
+(check-equal? "string->utf8" (bytes #x41 #x42 #x43) (string->utf8 "ABC"))
+(check-equal? "string->utf8 with start" (bytes #x42 #x43) (string->utf8 "ABC" 1))
+(check-equal? "string->utf8 with start and end" (bytes #x42) (string->utf8 "ABC" 1 2))
+(check-equal? "string->utf8 with start and end, multi-byte" (bytes #xCE #xBB) (string->utf8 "σλC" 1 2))
+(check-equal? "string->utf8, multi-byte char" (bytes #xCE #xBB) (string->utf8 "λ"))
+
+(check-equal? "char->integer, special escape, null" 0 (char->integer (read (open-input-string "#\\null"))))
+(check-equal? "char->integer, special escape, alarm" 7 (char->integer (read (open-input-string "#\\alarm"))))
+(check-equal? "char->integer, special escape, backspace" 8 (char->integer (read (open-input-string "#\\backspace"))))
+(check-equal? "char->integer, special escape, tab" 9 (char->integer (read (open-input-string "#\\tab"))))
+(check-equal? "char->integer, special escape, newline" 10 (char->integer (read (open-input-string "#\\newline"))))
+(check-equal? "char->integer, special escape, return" 13 (char->integer (read (open-input-string "#\\return"))))
+(check-equal? "char->integer, special escape, delete" #x7F (char->integer (read (open-input-string "#\\delete"))))
+(check-equal? "char->integer, special escape, escape" #x1B (char->integer (read (open-input-string "#\\escape"))))
+(check-equal? "char->integer, multi-byte" #x03BB (char->integer (read (open-input-string "#\\λ"))))
+
 (define r7rs-test-stats (get-test-stats))
 
 (displayln "Passed: " (hash-ref r7rs-test-stats 'success-count))

crates/steel-core/src/primitives/bytevectors.rs

@@ -3,7 +3,7 @@ use steel_derive::function;
 use crate::{
     rerrs::ErrorKind,
     rvals::FromSteelVal,
-    rvals::{RestArgsIter, Result, SteelByteVector, SteelString},
+    rvals::{RestArgsIter, Result, SteelByteVector},
     steel_vm::builtin::BuiltInModule,
     stop, throw, SteelErr, SteelVal,
 };
@@ -20,12 +20,12 @@ pub fn bytevector_module() -> BuiltInModule {
         .register_native_fn_definition(MAKE_BYTES_DEFINITION)
         .register_native_fn_definition(IS_BYTE_DEFINITION)
         .register_native_fn_definition(BYTES_LENGTH_DEFINITION)
-        .register_native_fn_definition(STRING_TO_BYTES_DEFINITION)
         .register_native_fn_definition(BYTES_REF_DEFINITION)
         .register_native_fn_definition(BYTES_SET_DEFINITION)
         .register_native_fn_definition(BYTES_TO_LIST_DEFINITION)
         .register_native_fn_definition(LIST_TO_BYTES_DEFINITION)
-        .register_native_fn_definition(BYTES_APPEND_DEFINITION);
+        .register_native_fn_definition(BYTES_APPEND_DEFINITION)
+        .register_native_fn_definition(BYTES_TO_STRING_DEFINITION);
 
     module
 }
@@ -206,19 +206,6 @@ pub fn bytes_length(value: &SteelByteVector) -> usize {
     value.vec.borrow().len()
 }
 
-/// Converts the given string to a bytevector
-///
-/// # Examples
-/// ```scheme
-/// (string->bytes "Apple") ;; => (bytes 65 112 112 108 101)
-/// ```
-#[function(name = "string->bytes")]
-pub fn string_to_bytes(value: &SteelString) -> Result<SteelVal> {
-    Ok(SteelVal::ByteVector(SteelByteVector::new(
-        value.as_str().as_bytes().to_vec(),
-    )))
-}
-
 /// Fetches the byte at the given index within the bytevector.
 /// If the index is out of bounds, this will error.
 ///
@@ -320,3 +307,51 @@ pub fn bytes_append(value: &SteelByteVector, other: &SteelByteVector) -> Result<
             .collect(),
     )))
 }
+
+/// Decodes a string from a bytevector containing valid UTF-8.
+///
+/// (bytes->string/utf8 buf [start] [end]) -> string?
+///
+/// * buf : bytes?
+/// * start: int? = 0
+/// * end: int? = (bytes-length buf)
+///
+/// # Examples
+/// ```scheme
+/// (bytes->string/utf8 (bytes #xe5 #x8d #x83 #xe8 #x91 #x89)) ;; => "千葉"
+/// ```
+#[function(name = "bytes->string/utf8", alias = "utf8->string")]
+pub fn bytes_to_string(
+    value: &SteelByteVector,
+    mut rest: RestArgsIter<'_, isize>,
+) -> Result<SteelVal> {
+    let borrowed = (&*value.vec).borrow();
+
+    let start = rest.next().transpose()?.unwrap_or(0);
+    let end = rest.next().transpose()?.unwrap_or(borrowed.len() as isize);
+
+    if rest.next().is_some() {
+        stop!(ArityMismatch => "expected at most 3 arguments");
+    }
+
+    if start < 0 {
+        stop!(ContractViolation => "start should be a positive number, got {}", start);
+    }
+
+    if end < 0 {
+        stop!(ContractViolation => "end should be a positive number, got {}", end);
+    }
+
+    if end < start {
+        stop!(ContractViolation => "start should be smaller than end, got {} and {}", start, end);
+    }
+
+    let start = start as usize;
+    let end = end as usize;
+
+    let Ok(s) = std::str::from_utf8(&(&*borrowed)[start..end]) else {
+        stop!(ConversionError => "bytevector contains malformed UTF-8")
+    };
+
+    Ok(s.to_string().into())
+}

crates/steel-core/src/primitives/lists.rs

@@ -83,6 +83,7 @@ pub fn list_module() -> BuiltInModule {
         .register_native_fn_definition(PAIR_DEFINITION)
         .register_native_fn_definition(NativeFunctionDefinition {
             name: "apply",
+            aliases: &[],
             func: BuiltInFunctionType::Context(apply),
             arity: Arity::Exact(2),
             doc: Some(APPLY_DOC),