/[guile]/guile/guile-core/lang/elisp/primitives/numbers.scm
ViewVC logotype

Diff of /guile/guile-core/lang/elisp/primitives/numbers.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by ossau, Fri Oct 26 16:42:43 2001 UTC revision 1.2 by ossau, Tue Jan 22 23:46:01 2002 UTC
# Line 0  Line 1 
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?)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26