BUG: MIN-VRTYPE not defined on DOUBLE-FLOAT FIXNUM while compiling ironclad

[kpoeck]

Describe the bug While chasing the bug that compiling ironcald seems to loop in bir-transformationsfound another one

Actual behavior

(ql:quickload :ironclad) errors with
; caught ERROR:
;   BUG: MIN-VRTYPE not defined on DOUBLE-FLOAT FIXNUM
;     at /Users/karstenpoeck/quicklisp/local-projects/fork-ironclad/src/digests/sha3.lisp 387:0

The backtrace with asdf is useless,for (cmp:compile-file-serial "/Users/karstenpoeck/quicklisp/local-projects/fork-ironclad/src/digests/sha3.lisp" :print t) it is:

COMMON-LISP-USER>> :b

   6: ((METHOD CC-BIR-TO-BMIR::MIN-VRTYPE (T T)) :DOUBLE-FLOAT :FIXNUM)
  11: (CC-BIR-TO-BMIR::MIN-VRTYPE :DOUBLE-FLOAT :FIXNUM)
  15: (MAPCAR #<STANDARD-GENERIC-FUNCTION CC-BIR-TO-BMIR::MIN-VRTYPE> (:DOUBLE-FLOAT) (:FIXNUM))
  17: (CC-BIR-TO-BMIR::MIN-RTYPE (:DOUBLE-FLOAT) (:FIXNUM))
  18: ((METHOD CC-BIR-TO-BMIR::USE-RTYPE (CLEAVIR-BIR:VARIABLE)) #<VARIABLE IRONCLAD::RATE-BYTES @0x1639173f1>)
  23: (CC-BIR-TO-BMIR::USE-RTYPE #<VARIABLE IRONCLAD::RATE-BYTES @0x1639173f1>)
  25: (CC-BIR-TO-BMIR::VARIABLE-RTYPE #<VARIABLE IRONCLAD::RATE-BYTES @0x1639173f1>)
  27: ((METHOD CC-BIR-TO-BMIR::MAYBE-ASSIGN-RTYPE (CLEAVIR-BIR:VARIABLE)) #<VARIABLE IRONCLAD::RATE-BYTES @0x1639173f1>)
  32: (CC-BIR-TO-BMIR::MAYBE-ASSIGN-RTYPE #<VARIABLE IRONCLAD::RATE-BYTES @0x1639173f1>)
  36: (MAPC #<STANDARD-GENERIC-FUNCTION CC-BIR-TO-BMIR::MAYBE-ASSIGN-RTYPE> (#<VARIABLE IRONCLAD::RATE-BYTES @0x1639173f1>))
  38: (CC-BIR-TO-BMIR::ASSIGN-INSTRUCTION-RTYPES #<CLEAVIR-BIR:LETI>)
  39: (CLEAVIR-BIR:MAP-IBLOCK-INSTRUCTIONS #<FUNCTION CC-BIR-TO-BMIR::ASSIGN-INSTRUCTION-RTYPES> #<IBLOCK #:IF-THEN>)
  41: (CLEAVIR-BIR:MAP-LOCAL-INSTRUCTIONS #<FUNCTION CC-BIR-TO-BMIR::ASSIGN-INSTRUCTION-RTYPES> #<FUNCTION IRONCLAD::SHA3-UPDATE>)
  43: (CC-BIR-TO-BMIR::ASSIGN-FUNCTION-RTYPES #<FUNCTION IRONCLAD::SHA3-UPDATE>)
  44: (CLEAVIR-BIR:MAP-FUNCTIONS #<FUNCTION CC-BIR-TO-BMIR::ASSIGN-FUNCTION-RTYPES> #<CLEAVIR-BIR:MODULE>)
  46: (CC-BIR-TO-BMIR:ASSIGN-MODULE-RTYPES #<CLEAVIR-BIR:MODULE>)
  47: (CLASP-CLEAVIR::BIR-TRANSFORMATIONS #<CLEAVIR-BIR:MODULE> #<CLASP-CLEAVIR::CLASP-64BIT>)
  49: (CLASP-CLEAVIR::TRANSLATE-AST #<FUNCTION-AST NIL #<CONS-CST raw: (PROGN (EVAL-WHEN (:COMPILE-TOPLEVEL) (COMPILER:REGISTER-GLOBAL-FUNCTION-DEF 'DEFUN 'IRONCLAD::SHA3-UPDATE)) (FUNCALL #'(SETF FDEFINITION) #'(LAMBDA (IRONCLAD::STATE VECTOR IRONCLAD::START IRONCLAD::END) (DECLARE (CORE:LAMBDA-NAME IRONCLAD::SHA3-UPDATE) (OPTIMIZE (DEBUG 0)) (OPTIMIZE (SPACE 0)) (OPTIMIZE (SAFETY 0)) (OPTIMIZE (SPEED 3)) (TYPE FIXNUM IRONCLAD::END) (TYPE FIXNUM IRONCLAD::START) (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) VECTOR) (TYPE IRONCLAD:SHA3 IRONCLAD::STATE)) (BLOCK IRONCLAD::SHA3-UPDATE (LET* ((IRONCLAD::KECCAK-STATE (IRONCLAD::SHA3-STATE IRONCLAD::STATE)) (IRONCLAD::BUFFER (IRONCLAD::SHA3-BUFFER IRONCLAD::STATE)) (IRONCLAD::BUFFER-INDEX (IRONCLAD::SHA3-BUFFER-INDEX IRONCLAD::STATE)) (IRONCLAD::BIT-RATE (IRONCLAD::SHA3-BIT-RATE IRONCLAD::STATE)) (IRONCLAD::RATE-BYTES (TRUNCATE IRONCLAD::BIT-RATE 8))) (DECLARE (TYPE IRONCLAD::KECCAK-STATE IRONCLAD::KECCAK-STATE) (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (200)) IRONCLAD::BUFFER) (TYPE (INTEGER 0 199) IRONCLAD::BUFFER-INDEX) (TYPE (INTEGER 0 1600) IRONCLAD::BIT-RATE) (TYPE (INTEGER 0 200) IRONCLAD::RATE-BYTES)) (UNLESS (ZEROP IRONCLAD::BUFFER-INDEX) (LET ((IRONCLAD::REMAINDER (- IRONCLAD::RATE-BYTES IRONCLAD::BUFFER-INDEX)) (LENGTH (- IRONCLAD::END IRONCLAD::START))) (DECLARE (TYPE FIXNUM IRONCLAD::REMAINDER LENGTH)) (REPLACE IRONCLAD::BUFFER VECTOR :START1 IRONCLAD::BUFFER-INDEX :END1 IRONCLAD::RATE-BYTES :START2 IRONCLAD::START :END2 IRONCLAD::END) (WHEN (< LENGTH IRONCLAD::REMAINDER) (INCF (IRONCLAD::SHA3-BUFFER-INDEX IRONCLAD::STATE) LENGTH) (RETURN-FROM IRONCLAD::SHA3-UPDATE)) (IRONCLAD::KECCAK-STATE-MERGE-INPUT IRONCLAD::KECCAK-STATE IRONCLAD::BIT-RATE IRONCLAD::BUFFER 0) (IRONCLAD::KECCAK-ROUNDS IRONCLAD::KECCAK-STATE) (SETF (IRONCLAD::SHA3-BUFFER-INDEX IRONCLAD::STATE) 0) (SETF IRONCLAD::START (+ IRONCLAD::START IRONCLAD::REMAINDER)))) (LOOP IRONCLAD::FOR IRONCLAD::BLOCK-OFFSET IRONCLAD::OF-TYPE FIXNUM IRONCLAD::FROM IRONCLAD::START IRONCLAD::BELOW IRONCLAD::END IRONCLAD::BY IRONCLAD::RATE-BYTES DO (COND ((<= (+ IRONCLAD::BLOCK-OFFSET IRONCLAD::RATE-BYTES) IRONCLAD::END) (IRONCLAD::KECCAK-STATE-MERGE-INPUT IRONCLAD::KECCAK-STATE IRONCLAD::BIT-RATE VECTOR IRONCLAD::BLOCK-OFFSET) (IRONCLAD::KECCAK-ROUNDS IRONCLAD::KECCAK-STATE)) (T (REPLACE IRONCLAD::BUFFER VECTOR :START1 0 :END1 IRONCLAD::RATE-BYTES :START2 IRONCLAD::BLOCK-OFFSET :END2 IRONCLAD::END) (SETF (IRONCLAD::SHA3-BUFFER-INDEX IRONCLAD::STATE) (- IRONCLAD::END IRONCLAD::BLOCK-OFFSET)))))) (VALUES))) 'IRONCLAD::SHA3-UPDATE) NIL 'IRONCLAD::SHA3-UPDATE) @0x16536ee31> @0x163fbb2d1> :LINKAGE LLVM-SYS:INTERNAL-LINKAGE)

Code at issue self-sufficent example

(defun sha3-update (state vector start end buffer)
  (declare (ignore state)
           (type (simple-array (unsigned-byte 8) (*)) vector)
           (type fixnum start end)
           (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (let* ((rate-bytes (truncate (random 64) 8))
         (buffer-index (random 10)))
    (declare
     (type (simple-array (unsigned-byte 8) (200)) buffer)
     (type (integer 0 199) buffer-index)
     (type (integer 0 200) rate-bytes))

    ;; Handle potential remaining bytes
    (unless (zerop buffer-index)
      (let ((remainder (- rate-bytes buffer-index))
            (length (- end start)))
        (declare (type fixnum remainder length))
        (replace buffer vector :start1 buffer-index :end1 rate-bytes :start2 start :end2 end)

        ;; Return if still unfilled buffer
        (when (< length remainder)
          (return-from sha3-update))

        (setf start (+ start remainder))))

    ;; Now handle full blocks, stuff any remainder into buf-offset of-type fixnum from start below end by rate-bytes
          do (cond
               ((<= (+ block-offset rate-bytes) end))
               (t
                (replace buffer vector :start1 0 :end1 rate-bytes :start2 block-offset :end2 end)
                ))))
  (values))
; caught ERROR:
;   BUG: MIN-VRTYPE not defined on DOUBLE-FLOAT FIXNUM
;     at unknown location
; 

Condition of type: SIMPLE-ERROR
BUG: MIN-VRTYPE not defined on DOUBLE-FLOAT FIXNUM
Available restarts:
(use :r1 to invoke restart 1, etc.)

1. (RESTART-TOPLEVEL) Go back to Top-Level REPL.


((METHOD CC-BIR-TO-BMIR::MIN-VRTYPE (T T)) :DOUBLE-FLOAT :FIXNUM)

If the code is more than a few dozen lines, please attach a source file instead.

Context

(CORE:CLASP-GIT-FULL-COMMIT)

"835703fa3f0b18b61739ad19be5aee634f995182"
(clasp-cltl2:declaration-information 'optimize)

((COMPILATION-SPEED 1) (DEBUG 1) (SPACE 1) (SPEED 1) (SAFETY 1))

[kpoeck]

For min-vrtype only see the following definitions, so the error is sort of logical:

(defgeneric min-vrtype (vrt1 vrt2))
(defmethod min-vrtype (vrt1 vrt2)
  (if (eql vrt1 vrt2)
      vrt1
      (error "BUG: ~a not defined on ~a ~a" 'min-vrtype vrt1 vrt2)))
(defmethod min-vrtype ((vrt1 (eql :object)) vrt2) vrt2)
(defmethod min-vrtype (vrt1 (vrt2 (eql :object))) vrt1)

[kpoeck]

If I defined rate-bytes as (rate-bytes (multiple-value-bind (a b) (truncate (random 64) 8) (declare (ignore b)) a)) all works, so perhaps the same as #1258

[Bike]

There's no min-vrtype for fixnum vs double because representation selection would have to decide, like, that one write to a variable should be a fixnum and another should be an unboxed double, which is incoherent. it's not supposed to do that. so between this and the other bug, i guess there's some messed up type inference that's thinking truncation type operations return doubles.

[kpoeck]

I pasted the reproducer wrong, here it is:

(defun sha3-update (state vector start end buffer)
  (declare
   (ignore state)
   (type sha3 state)
   (type (simple-array (unsigned-byte 8) (*)) vector)
   (type fixnum start end)
   (optimize (speed 3) (safety 0) (space 0) (debug 0)))
  (let* ((buffer-index (random 10))
         (rate-bytes (truncate (random 64) 8)))
    (declare 
     (type (simple-array (unsigned-byte 8) (200)) buffer)
     (type (integer 0 199) buffer-index)
     (type (integer 0 200) rate-bytes))

    ;; Handle potential remaining bytes
    (unless (zerop buffer-index)
      (let ((remainder (- rate-bytes buffer-index))
            (length (- end start)))
        (declare (type fixnum remainder length))
        (replace buffer vector :start1 buffer-index :end1 rate-bytes :start2 start :end2 end)

        ;; Return if still unfilled buffer
        (when (< length remainder)
          (return-from sha3-update))
        (setf start (+ start remainder))))

    ;; Now handle full blocks, stuff any remainder into buffer
    (loop for block-offset of-type fixnum from start below end by rate-bytes
          do (cond
               ((<= (+ block-offset rate-bytes) end)
                17)
               (t
                (replace buffer vector :start1 0 :end1 rate-bytes :start2 block-offset :end2 end)
                ))))
  (values))

but does not seem to fail anymore