1.0.19.9: elide runtime calls to %COERCE-CALLABLE-TO-FUN in more cases
[sbcl.git] / src / compiler / integer-tran.lisp
1 ;;;; integer-specific (quite possibly FIXNUM-specific or
2 ;;;; machine-word-specific) transforms
3
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
12
13 (in-package "SB!C")
14 \f
15 ;;;; RANDOM in various integer cases
16
17 (deftransform random ((limit &optional state)
18                       ((integer 1 #.(ash 1 sb!vm:n-word-bits)) &optional *))
19   "transform to a sample no wider than CPU word"
20   (let ((type (lvar-type limit)))
21     (if (numeric-type-p type)
22         (let ((limit-high (numeric-type-high (lvar-type limit))))
23           (aver limit-high)
24           (if (<= limit-high (1+ most-positive-fixnum))
25               '(%inclusive-random-fixnum (1- limit)
26                                          (or state *random-state*))
27               '(%inclusive-random-integer (1- limit)
28                                           (or state *random-state*))))
29         (give-up-ir1-transform "too-wide inferred type for LIMIT argument"))))
30
31 ;;; Boxing the argument to RANDOM (and often the return value as well)
32 ;;; could be quite expensive in speed, while inlining every RANDOM
33 ;;; call could be very expensive in code space, so use policy to
34 ;;; decide.
35 (deftransform %inclusive-random-integer
36     ((inclusive-limit state) (* *) * :policy (> speed space))
37   ;; By the way, some natural special cases (notably when the user is
38   ;; asking for a full %RANDOM-WORD) could be expanded to much simpler
39   ;; code (with no test and loop) if someone finds it important.
40   '(let ((n-bits (integer-length inclusive-limit)))
41     (%inclusive-random-integer-accept-reject (%random-bits n-bits state)
42      inclusive-limit)))