From 0c32e767ae438c650b0d6ed5d0096ee77c5d0f9c Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 12 Nov 1991 16:01:57 +0000 Subject: [PATCH] Added a RANDOM derive-type method. --- compiler/srctran.lisp | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 69dfb6fe3..41ddb0e66 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.30 1991/11/09 02:42:31 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.31 1991/11/12 16:01:57 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -506,6 +506,20 @@ 0 '*)))) +(defoptimizer (random derive-type) ((bound &optional state)) + (let ((type (continuation-type bound))) + (when (numeric-type-p type) + (let ((class (numeric-type-class type)) + (high (numeric-type-high type))) + (make-numeric-type + :class class + :format (numeric-type-format type) + :low (coerce 0 class) + :high (cond ((not high) nil) + ((eq class 'integer) (max (1- high) 0)) + ((or (consp high) (zerop high)) high) + (t `(,high)))))))) + ;;;; Logical derive-type methods: -- GitLab