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 #.(expt 2 n-random-chunk-bits)) &optional *))
  19   "optimize to single-RANDOM-CHUNK operations"
  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-CHUNK) 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)))