@@ -629,103 +629,110 @@ pub(crate) fn int_floor_div(
629
629
idiv ( n1, n2, arena)
630
630
}
631
631
632
- pub ( crate ) fn shr ( n1 : Number , n2 : Number , arena : & mut Arena ) -> Result < Number , MachineStubGen > {
632
+ pub ( crate ) fn shr ( lhs : Number , rhs : Number , arena : & mut Arena ) -> Result < Number , MachineStubGen > {
633
633
let stub_gen = || {
634
634
let shr_atom = atom ! ( ">>" ) ;
635
635
functor_stub ( shr_atom, 2 )
636
636
} ;
637
637
638
- if n2 . is_integer ( ) && n2 . is_negative ( ) {
639
- return shl ( n1 , neg ( n2 , arena) , arena) ;
638
+ if rhs . is_integer ( ) && rhs . is_negative ( ) {
639
+ return shl ( lhs , neg ( rhs , arena) , arena) ;
640
640
}
641
641
642
- match ( n1, n2) {
643
- ( Number :: Fixnum ( n1) , Number :: Fixnum ( n2) ) => {
644
- let n1_i = n1. get_num ( ) ;
645
- let n2_i = n2. get_num ( ) ;
646
-
647
- // FIXME(arithmetic_overflow)
648
- // what should this do for too large n2,
649
- // - logical right shift should probably turn to 0
650
- // - arithmetic right shift should maybe differ for negative numbers
651
- //
652
- // note: negaitve n2 is already handled above
653
- #[ allow( arithmetic_overflow) ]
654
- if let Ok ( n2) = usize:: try_from ( n2_i) {
655
- Ok ( Number :: arena_from ( n1_i >> n2, arena) )
656
- } else {
657
- Ok ( Number :: arena_from ( n1_i >> usize:: MAX , arena) )
658
- }
659
- }
660
- ( Number :: Fixnum ( n1) , Number :: Integer ( n2) ) => {
661
- let n1 = Integer :: from ( n1. get_num ( ) ) ;
662
-
663
- let result: Result < usize , _ > = ( & * n2) . try_into ( ) ;
642
+ match lhs {
643
+ Number :: Fixnum ( lhs) => {
644
+ let rhs = match rhs {
645
+ Number :: Fixnum ( fix) => fix. get_num ( ) . try_into ( ) . unwrap_or ( u32:: MAX ) ,
646
+ Number :: Integer ( int) => ( & * int) . try_into ( ) . unwrap_or ( u32:: MAX ) ,
647
+ other => {
648
+ return Err ( numerical_type_error ( ValidType :: Integer , other, stub_gen) ) ;
649
+ }
650
+ } ;
664
651
665
- match result {
666
- Ok ( n2) => Ok ( Number :: arena_from ( n1 >> n2, arena) ) ,
667
- Err ( _) => Ok ( Number :: arena_from ( n1 >> usize:: MAX , arena) ) ,
668
- }
669
- }
670
- ( Number :: Integer ( n1) , Number :: Fixnum ( n2) ) => match usize:: try_from ( n2. get_num ( ) ) {
671
- Ok ( n2) => Ok ( Number :: arena_from ( Integer :: from ( & * n1 >> n2) , arena) ) ,
672
- _ => Ok ( Number :: arena_from ( Integer :: from ( & * n1 >> usize:: MAX ) , arena) ) ,
673
- } ,
674
- ( Number :: Integer ( n1) , Number :: Integer ( n2) ) => {
675
- let result: Result < usize , _ > = ( & * n2) . try_into ( ) ;
652
+ let res = lhs. get_num ( ) . checked_shr ( rhs) . unwrap_or ( 0 ) ;
653
+ Ok ( Number :: arena_from ( res, arena) )
654
+ }
655
+ Number :: Integer ( lhs) => {
656
+ // Note: bigints require `log(n)` bits of space. If `rhs > usize::MAX`,
657
+ // then this clamping only becomes an issue when `lhs < 2 ^ (usize::MAX)`:
658
+ // - on 32-bit systems, `lhs` would need to be 512MiB big (1/8th of the addressable memory)
659
+ // - on 64-bit systems, `lhs` would need to be 2EiB big (!!!)
660
+ let rhs = match rhs {
661
+ Number :: Fixnum ( fix) => fix. get_num ( ) . try_into ( ) . unwrap_or ( usize:: MAX ) ,
662
+ Number :: Integer ( int) => ( & * int) . try_into ( ) . unwrap_or ( usize:: MAX ) ,
663
+ other => {
664
+ return Err ( numerical_type_error ( ValidType :: Integer , other, stub_gen) ) ;
665
+ }
666
+ } ;
676
667
677
- match result {
678
- Ok ( n2) => Ok ( Number :: arena_from ( Integer :: from ( & * n1 >> n2) , arena) ) ,
679
- Err ( _) => Ok ( Number :: arena_from ( Integer :: from ( & * n1 >> usize:: MAX ) , arena) ) ,
680
- }
668
+ Ok ( Number :: arena_from ( Integer :: from ( & * lhs >> rhs) , arena) )
681
669
}
682
- ( Number :: Integer ( _) , n2) => Err ( numerical_type_error ( ValidType :: Integer , n2, stub_gen) ) ,
683
- ( Number :: Fixnum ( _) , n2) => Err ( numerical_type_error ( ValidType :: Integer , n2, stub_gen) ) ,
684
- ( n1, _) => Err ( numerical_type_error ( ValidType :: Integer , n1, stub_gen) ) ,
670
+ other => Err ( numerical_type_error ( ValidType :: Integer , other, stub_gen) ) ,
685
671
}
686
672
}
687
673
688
- pub ( crate ) fn shl ( n1 : Number , n2 : Number , arena : & mut Arena ) -> Result < Number , MachineStubGen > {
674
+ pub ( crate ) fn shl ( lhs : Number , rhs : Number , arena : & mut Arena ) -> Result < Number , MachineStubGen > {
689
675
let stub_gen = || {
690
676
let shl_atom = atom ! ( "<<" ) ;
691
677
functor_stub ( shl_atom, 2 )
692
678
} ;
693
679
694
- if n2 . is_integer ( ) && n2 . is_negative ( ) {
695
- return shr ( n1 , neg ( n2 , arena) , arena) ;
680
+ if rhs . is_integer ( ) && rhs . is_negative ( ) {
681
+ return shr ( lhs , neg ( rhs , arena) , arena) ;
696
682
}
697
683
698
- match ( n1, n2) {
699
- ( Number :: Fixnum ( n1) , Number :: Fixnum ( n2) ) => {
700
- let n1_i = n1. get_num ( ) ;
701
- let n2_i = n2. get_num ( ) ;
684
+ let rhs = match rhs {
685
+ Number :: Fixnum ( fix) => fix. get_num ( ) . try_into ( ) . unwrap_or ( usize:: MAX ) ,
686
+ Number :: Integer ( int) => ( & * int) . try_into ( ) . unwrap_or ( usize:: MAX ) ,
687
+ other => {
688
+ return Err ( numerical_type_error ( ValidType :: Integer , other, stub_gen) ) ;
689
+ }
690
+ } ;
691
+
692
+ match lhs {
693
+ Number :: Fixnum ( lhs) => {
694
+ let lhs = lhs. get_num ( ) ;
702
695
703
- if let Ok ( n2 ) = usize :: try_from ( n2_i ) {
704
- Ok ( Number :: arena_from ( n1_i << n2 , arena) )
696
+ if let Some ( res ) = checked_signed_shl ( lhs , rhs ) {
697
+ Ok ( Number :: arena_from ( res , arena) )
705
698
} else {
706
- let n1 = Integer :: from ( n1_i) ;
707
- Ok ( Number :: arena_from ( n1 << usize:: MAX , arena) )
699
+ let lhs = Integer :: from ( lhs) ;
700
+ Ok ( Number :: arena_from (
701
+ Integer :: from ( lhs << ( rhs as usize ) ) ,
702
+ arena,
703
+ ) )
708
704
}
709
705
}
710
- ( Number :: Fixnum ( n1) , Number :: Integer ( n2) ) => {
711
- let n1 = Integer :: from ( n1. get_num ( ) ) ;
706
+ Number :: Integer ( lhs) => Ok ( Number :: arena_from (
707
+ Integer :: from ( & * lhs << ( rhs as usize ) ) ,
708
+ arena,
709
+ ) ) ,
710
+ other => Err ( numerical_type_error ( ValidType :: Integer , other, stub_gen) ) ,
711
+ }
712
+ }
712
713
713
- match ( & * n2) . try_into ( ) as Result < usize , _ > {
714
- Ok ( n2) => Ok ( Number :: arena_from ( n1 << n2, arena) ) ,
715
- _ => Ok ( Number :: arena_from ( n1 << usize:: MAX , arena) ) ,
716
- }
714
+ /// Returns `x << shift`, checking for overflow and for values of `shift` that are too big.
715
+ #[ inline]
716
+ fn checked_signed_shl ( x : i64 , shift : usize ) -> Option < i64 > {
717
+ if shift == 0 {
718
+ return Some ( x) ;
719
+ }
720
+
721
+ if x >= 0 {
722
+ // Note: for unsigned integers, the condition would usually be spelled
723
+ // `shift <= x.leading_zeros()`, but since the MSB for signed integers
724
+ // controls the sign, we need to make sure that `shift` is at most
725
+ // `x.leading_zeros() - 1`.
726
+ if shift < x. leading_zeros ( ) as usize {
727
+ Some ( x << shift)
728
+ } else {
729
+ None
717
730
}
718
- ( Number :: Integer ( n1) , Number :: Fixnum ( n2) ) => match usize:: try_from ( n2. get_num ( ) ) {
719
- Ok ( n2) => Ok ( Number :: arena_from ( Integer :: from ( & * n1 << n2) , arena) ) ,
720
- _ => Ok ( Number :: arena_from ( Integer :: from ( & * n1 << usize:: MAX ) , arena) ) ,
721
- } ,
722
- ( Number :: Integer ( n1) , Number :: Integer ( n2) ) => match ( & * n2) . try_into ( ) as Result < usize , _ > {
723
- Ok ( n2) => Ok ( Number :: arena_from ( Integer :: from ( & * n1 << n2) , arena) ) ,
724
- _ => Ok ( Number :: arena_from ( Integer :: from ( & * n1 << usize:: MAX ) , arena) ) ,
725
- } ,
726
- ( Number :: Integer ( _) , n2) => Err ( numerical_type_error ( ValidType :: Integer , n2, stub_gen) ) ,
727
- ( Number :: Fixnum ( _) , n2) => Err ( numerical_type_error ( ValidType :: Integer , n2, stub_gen) ) ,
728
- ( n1, _) => Err ( numerical_type_error ( ValidType :: Integer , n1, stub_gen) ) ,
731
+ } else {
732
+ let y = x. checked_neg ( ) ?;
733
+ // FIXME: incorrectly rejects `-2 ^ 62 << 1`. This is currently a non-issue,
734
+ // since the bitshift is then done as a `Number::Integer`
735
+ checked_signed_shl ( y, shift) . and_then ( |res| res. checked_neg ( ) )
729
736
}
730
737
}
731
738
0 commit comments