home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / lang / elisp / primitives / numbers.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  1.0 KB  |  44 lines
  1. (define-module (lang elisp primitives numbers)
  2.   #:use-module (lang elisp internals fset)
  3.   #:use-module (lang elisp internals null))
  4.  
  5. (fset 'logior logior)
  6. (fset 'logand logand)
  7. (fset 'integerp (lambda->nil integer?))
  8. (fset '= =)
  9. (fset '< <)
  10. (fset '> >)
  11. (fset '<= <=)
  12. (fset '>= >=)
  13. (fset '* *)
  14. (fset '+ +)
  15. (fset '- -)
  16. (fset '1- 1-)
  17. (fset 'ash ash)
  18.  
  19. (fset 'lsh
  20.       (let ()
  21.     (define (lsh num shift)
  22.       (cond ((= shift 0)
  23.          num)
  24.         ((< shift 0)
  25.          ;; Logical shift to the right.  Do an arithmetic
  26.          ;; shift and then mask out the sign bit.
  27.          (lsh (logand (ash num -1) most-positive-fixnum)
  28.               (+ shift 1)))
  29.         (else
  30.          ;; Logical shift to the left.  Guile's ash will
  31.          ;; always preserve the sign of the result, which is
  32.          ;; not what we want for lsh, so we need to work
  33.          ;; around this.
  34.          (let ((new-sign-bit (ash (logand num
  35.                           (logxor most-positive-fixnum
  36.                               (ash most-positive-fixnum -1)))
  37.                       1)))
  38.            (lsh (logxor new-sign-bit
  39.                 (ash (logand num most-positive-fixnum) 1))
  40.             (- shift 1))))))
  41.     lsh))
  42.  
  43. (fset 'numberp (lambda->nil number?))
  44.