numbers.scm 1.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344
  1. (define-module (lang elisp primitives numbers)
  2. #:use-module (lang elisp internals fset)
  3. #:use-module (lang elisp internals null))
  4. (fset 'logior logior)
  5. (fset 'logand logand)
  6. (fset 'integerp (lambda->nil integer?))
  7. (fset '= =)
  8. (fset '< <)
  9. (fset '> >)
  10. (fset '<= <=)
  11. (fset '>= >=)
  12. (fset '* *)
  13. (fset '+ +)
  14. (fset '- -)
  15. (fset '1- 1-)
  16. (fset 'ash ash)
  17. (fset 'lsh
  18. (let ()
  19. (define (lsh num shift)
  20. (cond ((= shift 0)
  21. num)
  22. ((< shift 0)
  23. ;; Logical shift to the right. Do an arithmetic
  24. ;; shift and then mask out the sign bit.
  25. (lsh (logand (ash num -1) most-positive-fixnum)
  26. (+ shift 1)))
  27. (else
  28. ;; Logical shift to the left. Guile's ash will
  29. ;; always preserve the sign of the result, which is
  30. ;; not what we want for lsh, so we need to work
  31. ;; around this.
  32. (let ((new-sign-bit (ash (logand num
  33. (logxor most-positive-fixnum
  34. (ash most-positive-fixnum -1)))
  35. 1)))
  36. (lsh (logxor new-sign-bit
  37. (ash (logand num most-positive-fixnum) 1))
  38. (- shift 1))))))
  39. lsh))
  40. (fset 'numberp (lambda->nil number?))