From 38b03b707a2a09c928521daf580a885d813d7cc6 Mon Sep 17 00:00:00 2001 From: Bike Date: Fri, 14 May 2021 17:18:31 -0400 Subject: [PATCH] Insert fixed-to-multiple in optimizations to preserve semantics Without this, optimization leads to alien behavior like ((lambda (x) x) (values 1 2 3)) => 1 2 3 (instead of 1) --- BIR-transformations/interpolate-function.lisp | 14 +++++++++++++- BIR-transformations/meta-evaluate.lisp | 9 +++++++-- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/BIR-transformations/interpolate-function.lisp b/BIR-transformations/interpolate-function.lisp index 91dc61b0..c787621e 100644 --- a/BIR-transformations/interpolate-function.lisp +++ b/BIR-transformations/interpolate-function.lisp @@ -100,13 +100,25 @@ ;; The stuff in the AFTER block is now unreachable. (cleavir-bir:delete-iblock after) (let ((call-arguments (rest (cleavir-bir:inputs call))) + (ftmd-arguments + (loop for datum in (rest (cleavir-bir:inputs call)) + collect (make-instance 'cleavir-bir:output + :name (cleavir-bir:name datum) + :derived-type (cleavir-bir:ctype datum)))) (inputs '())) ;; Remove the local call. (cleavir-bir:delete-instruction call) + ;; Insert fixed-to-multiple instructions to ensure only primary values + ;; of the call arguments are used. + (loop for arg in call-arguments for ftm-out in ftmd-arguments + for ftm = (make-instance 'cleavir-bir:fixed-to-multiple + :inputs (list arg) :outputs (list ftm-out)) + do (cleavir-bir:insert-instruction-before ftm jump)) + ;; Compute inputs to the jump. (cleavir-bir:map-lambda-list (lambda (state item index) (declare (ignore index)) - (let ((arg (pop call-arguments))) + (let ((arg (pop ftmd-arguments))) (ecase state (:required (push arg inputs)) diff --git a/BIR-transformations/meta-evaluate.lisp b/BIR-transformations/meta-evaluate.lisp index 8c3a9454..4207a940 100644 --- a/BIR-transformations/meta-evaluate.lisp +++ b/BIR-transformations/meta-evaluate.lisp @@ -371,9 +371,14 @@ (cleavir-bir:function reader)) #+(or) (format t "~&meta-evaluate: substituting single read binding of ~a" variable) - (let ((input (cleavir-bir:input binder))) + (let* ((input (cleavir-bir:input binder)) + (fout (make-instance 'cleavir-bir:output)) + (ftm (make-instance 'cleavir-bir:fixed-to-multiple + :outputs (list fout)))) (setf (cleavir-bir:inputs binder) nil) - (cleavir-bir:replace-uses input reader-out)) + (cleavir-bir:insert-instruction-before ftm reader) + (cleavir-bir:replace-uses fout reader-out) + (setf (cleavir-bir:inputs ftm) (list input))) (cleavir-bir:delete-instruction reader) t)))))