Skip to content

Commit

Permalink
update steel/ord (#252)
Browse files Browse the repository at this point in the history 
* update steel/ord

* fix build

* attempt to fix trie sort test

* reuse SteelVal's PartialEq, update with numbers' promotions for comparison

* fix ord arity

* fix arity check
  • Loading branch information
@fominok
fominok authored Aug 15, 2024
1 parent 2c0a755 commit c057a36
Show file tree
Hide file tree
Showing 10 changed files with 445 additions and 50 deletions.
14 changes: 14 additions & 0 deletions Cargo.lock
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 5 additions & 5 deletions cogs/sorting/trie-sort.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,8 @@
;; children are empty, return list of empty children
[(empty? lst) (list (trie char empty #t next-prefix))]
;; less than, put it to the left
[(< char (trie-char (first lst))) (cons (trie char empty #t next-prefix) lst)]
[(equal? char (trie-char (first lst))) ;; equal, step down a level
[(char<? char (trie-char (first lst))) (cons (trie char empty #t next-prefix) lst)]
[(char=? char (trie-char (first lst))) ;; equal, step down a level
(cons (trie char (trie-children (first lst)) #t next-prefix) (rest lst))]
;; move to the right
[else (cons (first lst) (create-children char-list (rest lst) prefix-chars))]))
Expand All @@ -43,9 +43,9 @@
(cond
[(empty? lst) ;; no children, pop off front and step down
(list (trie char (create-children (rest char-list) empty next-prefix) #f next-prefix))]
[(< char (trie-char (first lst))) ;; place where it is, pop off front and go
[(char<? char (trie-char (first lst))) ;; place where it is, pop off front and go
(cons (trie char (create-children (rest char-list) empty next-prefix) #f next-prefix) lst)]
[(equal? char (trie-char (first lst))) ;; equal, step down
[(char=? char (trie-char (first lst))) ;; equal, step down
(cons (trie char
(create-children (rest char-list) (trie-children (first lst)) next-prefix)
(trie-end-word? (first lst))
Expand All @@ -64,7 +64,7 @@

;; contract: trie? trie? -> boolean?
(define (trie<? trie-node1 trie-node2)
(< (trie-char trie-node1) (trie-char trie-node2)))
(char<? (trie-char trie-node1) (trie-char trie-node2)))

;; contract: trie? (listof string?) -> trie?
(define (build-trie-from-list-of-words trie list-of-words)
Expand Down
2 changes: 2 additions & 0 deletions crates/steel-core/Cargo.toml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,8 @@ anyhow = { version = "1", optional = true }

stacker = { version = "0.1.15", optional = true }

bigdecimal = "0.4.5"

[target.'cfg(target_arch = "wasm32")'.dependencies]
getrandom = { version = "*", features = ["js"] }

Expand Down
178 changes: 152 additions & 26 deletions crates/steel-core/src/rvals.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ macro_rules! list {
}};
}

use bigdecimal::BigDecimal;
use SteelVal::*;

use im_rc::{HashMap, Vector};
Expand All @@ -70,7 +71,9 @@ use futures_util::future::Shared;
use futures_util::FutureExt;

use crate::values::lists::List;
use num::{BigInt, BigRational, Rational32, Signed, ToPrimitive, Zero};
use num::{
bigint::ToBigInt, BigInt, BigRational, FromPrimitive, Rational32, Signed, ToPrimitive, Zero,
};
use steel_parser::tokens::{IntLiteral, RealLiteral};

use self::cycles::{CycleDetector, IterativeDropHandler};
Expand Down Expand Up @@ -2079,33 +2082,156 @@ impl PartialOrd for SteelVal {
// TODO: Attempt to avoid converting to f64 for cases below as it may lead to precision loss
// at tiny and large values.
match (self, other) {
(IntV(l), IntV(r)) => l.partial_cmp(r),
(IntV(l), NumV(r)) => partial_cmp_f64(l, r),
(IntV(l), Rational(r)) => partial_cmp_f64(l, r),
(IntV(l), BigRational(r)) => partial_cmp_f64(l, r.as_ref()),
(IntV(l), BigNum(r)) => BigInt::from(*l).partial_cmp(r),
(NumV(l), IntV(r)) => partial_cmp_f64(l, r),
(NumV(l), NumV(r)) => l.partial_cmp(r),
(NumV(l), Rational(r)) => partial_cmp_f64(l, r),
(NumV(l), BigRational(r)) => partial_cmp_f64(l, r.as_ref()),
(NumV(l), BigNum(r)) => partial_cmp_f64(l, r.as_ref()),
(Rational(l), Rational(r)) => l.partial_cmp(&r),
(Rational(l), IntV(r)) => partial_cmp_f64(l, r),
(Rational(l), NumV(r)) => l.to_f64()?.partial_cmp(&r),
(Rational(l), BigRational(r)) => partial_cmp_f64(l, r.as_ref()),
(Rational(l), BigNum(r)) => l.to_f64()?.partial_cmp(&r.to_f64()?),
(BigNum(l), IntV(r)) => l.as_ref().partial_cmp(&BigInt::from(*r)),
(BigNum(l), NumV(r)) => l.to_f64()?.partial_cmp(r),
(BigNum(l), BigNum(r)) => l.as_ref().partial_cmp(r.as_ref()),
(BigNum(l), Rational(r)) => partial_cmp_f64(l.as_ref(), r),
(BigNum(l), BigRational(r)) => partial_cmp_f64(l.as_ref(), r.as_ref()),
(BigRational(l), BigRational(r)) => l.as_ref().partial_cmp(r.as_ref()),
(BigRational(l), IntV(r)) => partial_cmp_f64(l.as_ref(), r),
(BigRational(l), NumV(r)) => partial_cmp_f64(l.as_ref(), r),
(BigRational(l), Rational(r)) => partial_cmp_f64(l.as_ref(), r),
(BigRational(l), BigNum(r)) => partial_cmp_f64(l.as_ref(), r.as_ref()),
// Comparison of matching `SteelVal` variants:
(IntV(x), IntV(y)) => x.partial_cmp(y),
(BigNum(x), BigNum(y)) => x.partial_cmp(y),
(Rational(x), Rational(y)) => x.partial_cmp(y),
(BigRational(x), BigRational(y)) => x.partial_cmp(y),
(NumV(x), NumV(y)) => x.partial_cmp(y),
(StringV(s), StringV(o)) => s.partial_cmp(o),
(CharV(l), CharV(r)) => l.partial_cmp(r),

// Comparison of `IntV`, means promoting to the rhs type
(IntV(x), BigNum(y)) => x
.to_bigint()
.expect("integers are representable by bigint")
.partial_cmp(y),
(IntV(x), Rational(y)) => {
// Since we have platform-dependent type for rational conditional compilation is required to find
// the common ground
#[cfg(target_pointer_width = "32")]
{
let x_rational = num::Rational32::new_raw(*x as i32, 1);
x_rational.partial_cmp(y)
}
#[cfg(target_pointer_width = "64")]
{
let x_rational = num::Rational64::new_raw(*x as i64, 1);
x_rational.partial_cmp(&num::Rational64::new_raw(
*y.numer() as i64,
*y.denom() as i64,
))
}
}
(IntV(x), BigRational(y)) => {
let x_rational = BigRational::from_integer(
x.to_bigint().expect("integers are representable by bigint"),
);
x_rational.partial_cmp(y)
}
(IntV(x), NumV(y)) => (*x as f64).partial_cmp(y),

// BigNum comparisons means promoting to BigInt for integers, BigRational for ratios,
// or Decimal otherwise
(BigNum(x), IntV(y)) => x
.as_ref()
.partial_cmp(&y.to_bigint().expect("integers are representable by bigint")),
(BigNum(x), Rational(y)) => {
let x_big_rational = BigRational::from_integer(x.unwrap());
let y_big_rational = BigRational::new_raw(
y.numer()
.to_bigint()
.expect("integers are representable by bigint"),
y.denom()
.to_bigint()
.expect("integers are representable by bigint"),
);
x_big_rational.partial_cmp(&y_big_rational)
}
(BigNum(x), BigRational(y)) => {
let x_big_rational = BigRational::from_integer(x.unwrap());
x_big_rational.partial_cmp(&y)
}
(BigNum(x), NumV(y)) => {
let x_decimal = BigDecimal::new(x.unwrap(), 0);
let y_decimal_opt = BigDecimal::from_f64(*y);
y_decimal_opt.and_then(|y_decimal| x_decimal.partial_cmp(&y_decimal))
}

// Rationals require rationals, regular or bigger versions; for float it will be divided to float as well
(Rational(x), IntV(y)) => {
// Same as before, but opposite direction
#[cfg(target_pointer_width = "32")]
{
let y_rational = num::Rational32::new_raw(*y as i32, 1);
x.partial_cmp(&y_rational)
}
#[cfg(target_pointer_width = "64")]
{
let y_rational = num::Rational64::new_raw(*y as i64, 1);
num::Rational64::new_raw(*x.numer() as i64, *x.denom() as i64)
.partial_cmp(&y_rational)
}
}
(Rational(x), BigNum(y)) => {
let x_big_rational = BigRational::new_raw(
x.numer()
.to_bigint()
.expect("integers are representable by bigint"),
x.denom()
.to_bigint()
.expect("integers are representable by bigint"),
);
let y_big_rational = BigRational::from_integer(y.unwrap());
x_big_rational.partial_cmp(&y_big_rational)
}
(Rational(x), BigRational(y)) => {
let x_big_rational = BigRational::new_raw(
x.numer()
.to_bigint()
.expect("integers are representable by bigint"),
x.denom()
.to_bigint()
.expect("integers are representable by bigint"),
);
x_big_rational.partial_cmp(&y)
}
(Rational(x), NumV(y)) => (*x.numer() as f64 / *x.denom() as f64).partial_cmp(y),

// The most capacious set, but need to cover float case with BigDecimal anyways
(BigRational(x), IntV(y)) => {
let y_rational = BigRational::from_integer(
y.to_bigint().expect("integers are representable by bigint"),
);
x.as_ref().partial_cmp(&y_rational)
}
(BigRational(x), BigNum(y)) => {
let y_big_rational = BigRational::from_integer(y.unwrap());
x.as_ref().partial_cmp(&y_big_rational)
}
(BigRational(x), Rational(y)) => {
let y_big_rational = BigRational::new_raw(
y.numer()
.to_bigint()
.expect("integers are representable by bigint"),
y.denom()
.to_bigint()
.expect("integers are representable by bigint"),
);
x.as_ref().partial_cmp(&y_big_rational)
}
(BigRational(x), NumV(y)) => {
let x_decimal =
BigDecimal::new(x.numer().clone(), 0) / BigDecimal::new(x.denom().clone(), 0);
let y_decimal_opt = BigDecimal::from_f64(*y);
y_decimal_opt.and_then(|y_decimal| x_decimal.partial_cmp(&y_decimal))
}

// The opposite of all float cases above
(NumV(x), IntV(y)) => x.partial_cmp(&(*y as f64)),
(NumV(x), BigNum(y)) => {
let x_decimal_opt = BigDecimal::from_f64(*x);
let y_decimal = BigDecimal::new(y.unwrap(), 0);
x_decimal_opt.and_then(|x_decimal| x_decimal.partial_cmp(&y_decimal))
}
(NumV(x), Rational(y)) => x.partial_cmp(&(*y.numer() as f64 / *y.denom() as f64)),
(NumV(x), BigRational(y)) => {
let x_decimal_opt = BigDecimal::from_f64(*x);
let y_decimal =
BigDecimal::new(y.numer().clone(), 0) / BigDecimal::new(y.denom().clone(), 0);
x_decimal_opt.and_then(|x_decimal| x_decimal.partial_cmp(&y_decimal))
}

(l, r) => {
// All real numbers (not complex) should have order defined.
debug_assert!(
Expand Down
10 changes: 5 additions & 5 deletions crates/steel-core/src/scheme/trie.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,9 +25,9 @@
(define next-prefix (push-back prefix-chars char))
(cond [(empty? lst) ;; children are empty, return list of empty children
(list (trie char empty #t next-prefix))]
[(< char (trie-char (first lst))) ;; less than, put it to the left
[(char<? char (trie-char (first lst))) ;; less than, put it to the left
(cons (trie char empty #t next-prefix) lst)]
[(= char (trie-char (first lst))) ;; equal, step down a level
[(char=? char (trie-char (first lst))) ;; equal, step down a level
(cons (trie char (trie-children (first lst)) #t next-prefix) (rest lst))]
[else ;; move to the right
(cons (first lst)
Expand All @@ -41,10 +41,10 @@
(cond [(empty? lst) ;; no children, pop off front and step down
(list (trie char (create-children
(rest char-list) empty next-prefix) #f next-prefix))]
[(< char (trie-char (first lst))) ;; place where it is, pop off front and go
[(char<? char (trie-char (first lst))) ;; place where it is, pop off front and go
(cons (trie char (create-children
(rest char-list) empty next-prefix) #f next-prefix) lst)]
[(= char (trie-char (first lst))) ;; equal, step down
[(char=? char (trie-char (first lst))) ;; equal, step down
(cons (trie char (create-children (rest char-list) (trie-children (first lst)) next-prefix)
(trie-end-word? (first lst))
(trie-word-up-to (first lst)))
Expand All @@ -64,7 +64,7 @@

; contract: trie? trie? -> boolean?
(define (trie<? trie-node1 trie-node2)
(< (trie-char trie-node1) (trie-char trie-node2)))
(char<? (trie-char trie-node1) (trie-char trie-node2)))


;; contract: trie? (listof string?) -> trie?
Expand Down
Loading

0 comments on commit c057a36

Please sign in to comment.