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