123 |
;; Unary ops |
;; Unary ops |
124 |
(40 |
(40 |
125 |
(let ((op (random-from-seq '(- abs signum 1+ 1- identity progn floor |
(let ((op (random-from-seq '(- abs signum 1+ 1- identity progn floor |
126 |
ceiling truncate round |
ceiling truncate round realpart imagpart |
127 |
integer-length logcount values)))) |
integer-length logcount values)))) |
128 |
`(,op ,(make-random-integer-form (1- size) vars)))) |
`(,op ,(make-random-integer-form (1- size) vars)))) |
129 |
(2 `(isqrt (abs ,(make-random-integer-form (- size 2) vars)))) |
(2 `(isqrt (abs ,(make-random-integer-form (- size 2) vars)))) |
136 |
|
|
137 |
;; binary floor, ceiling, truncate, round |
;; binary floor, ceiling, truncate, round |
138 |
(4 |
(4 |
139 |
(let ((op (random-from-seq #(floor ceiling truncate round))) |
(let ((op (random-from-seq #(floor ceiling truncate round mod rem))) |
140 |
(op2 (random-from-seq #(max min)))) |
(op2 (random-from-seq #(max min)))) |
141 |
(destructuring-bind (s1 s2) |
(destructuring-bind (s1 s2) |
142 |
(random-partition (- size 2) 2) |
(random-partition (- size 2) 2) |
511 |
(case op |
(case op |
512 |
|
|
513 |
((signum integer-length logcount |
((signum integer-length logcount |
514 |
gcd lcm logandc1 logandc2 lognand lognor logorc1 logorc2) |
gcd lcm logandc1 logandc2 lognand lognor logorc1 logorc2 |
515 |
|
realpart imagpart) |
516 |
(mapc #'try args) |
(mapc #'try args) |
517 |
(try 0) |
(try 0) |
518 |
(try 1) |
(try 1) |
596 |
(assert (consp arg)) |
(assert (consp arg)) |
597 |
(assert (eq (first arg) 'abs)) |
(assert (eq (first arg) 'abs)) |
598 |
(let ((arg2 (second arg))) |
(let ((arg2 (second arg))) |
599 |
|
(try arg2) |
600 |
;; Try to fold |
;; Try to fold |
601 |
(when (integerp arg2) |
(when (integerp arg2) |
602 |
(try (isqrt (abs arg2)))) |
(try (isqrt (abs arg2)))) |
625 |
`(ash ,form1 (,(first form2) ,(second form2) |
`(ash ,form1 (,(first form2) ,(second form2) |
626 |
,form))))))))) |
,form))))))))) |
627 |
|
|
628 |
((floor ceiling truncate round) |
((floor ceiling truncate round mod rem) |
629 |
(let ((form1 (second form)) |
(let ((form1 (second form)) |
630 |
(form2 (third form))) |
(form2 (third form))) |
631 |
(try form1) |
(try form1) |
674 |
|
|
675 |
(defun prune-case (form try-fn) |
(defun prune-case (form try-fn) |
676 |
(declare (type function try-fn)) |
(declare (type function try-fn)) |
677 |
(let* ((op (first form)) |
(flet ((try (e) (funcall try-fn e))) |
678 |
(expr (second form)) |
(let* ((op (first form)) |
679 |
(cases (cddr form))) |
(expr (second form)) |
680 |
|
(cases (cddr form))) |
681 |
;; Try just the top expression |
|
682 |
(funcall try-fn expr) |
;; Try just the top expression |
683 |
|
(try expr) |
684 |
;; Try simplifying the expr |
|
685 |
(prune expr |
;; Try simplifying the expr |
686 |
#'(lambda (form) |
(prune expr |
687 |
(funcall try-fn `(,op ,form ,@cases)))) |
#'(lambda (form) |
688 |
|
(try `(,op ,form ,@cases)))) |
689 |
;; Try deleting individual cases |
|
690 |
(loop for i from 0 below (1- (length cases)) |
;; Try individual cases |
691 |
do (funcall try-fn `(,op ,expr |
(loop for case in cases |
692 |
,@(subseq cases 0 i) |
do (try (first (last (rest case))))) |
693 |
,@(subseq cases (1+ i))))) |
|
694 |
|
;; Try deleting individual cases |
695 |
;; Try simplifying the cases |
(loop for i from 0 below (1- (length cases)) |
696 |
;; Assume each case has a single form |
do (try `(,op ,expr |
697 |
(prune-list cases |
,@(subseq cases 0 i) |
698 |
#'(lambda (case try-fn) |
,@(subseq cases (1+ i))))) |
699 |
(declare (function try-fn)) |
|
700 |
(when (eql (length case) 2) |
;; Try simplifying the cases |
701 |
(prune (cadr case) |
;; Assume each case has a single form |
702 |
#'(lambda (form) |
(prune-list cases |
703 |
(funcall try-fn |
#'(lambda (case try-fn) |
704 |
(list (car case) form)))))) |
(declare (function try-fn)) |
705 |
#'(lambda (cases) |
(when (eql (length case) 2) |
706 |
(funcall try-fn `(,op ,expr ,@cases)))))) |
(prune (cadr case) |
707 |
|
#'(lambda (form) |
708 |
|
(funcall try-fn |
709 |
|
(list (car case) form)))))) |
710 |
|
#'(lambda (cases) |
711 |
|
(try `(,op ,expr ,@cases))))))) |
712 |
|
|
713 |
(defun prune-fn (form try-fn) |
(defun prune-fn (form try-fn) |
714 |
"Attempt to simplify a function call form. It is considered |
"Attempt to simplify a function call form. It is considered |