guile18/lang/elisp/primitives/numbers.scm

   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?))