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