Merge pull request #29 from s-expressionists/fdefn-fixes

Fdefn fixes

BIR/disassemble.lisp

@@ -45,6 +45,10 @@
 
 (defgeneric disassemble-datum (datum))
 (defmethod disassemble-datum ((value constant)) `',(constant-value value))
+(defmethod disassemble-datum ((value function-cell))
+  `(function-cell ,(function-name value)))
+(defmethod disassemble-datum ((value variable-cell))
+  `(variable-cell ,(variable-name value)))
 (defmethod disassemble-datum ((value datum))
   (or (gethash value *ids*)
       (setf (gethash value *ids*)
@@ -157,7 +161,7 @@
 (defmethod cleavir-bir-disassembler:disassemble ((module module))
   (check-type module module)
   (cleavir-bir-disassembler:with-disassembly ()
-    (list* (set:mapset 'list #'constant-value (constants module))
+    (list* (set:mapset 'list #'disassemble-datum (constants module))
            (set:mapset 'list #'cleavir-bir-disassembler:disassemble
                        (functions module)))))
 

BIR/verify.lisp

@@ -290,14 +290,6 @@ If there are problems, a VERIFICATION-FAILED is signaled. If the verification pr
         "has mismatch between inputs ~a and outputs ~a"
         inst inputs outputs))
 
-(defun collect-duplicates (list)
-  ;; quadratic, but next lists are really short anyway
-  (loop with duplicates = nil
-        for (e . rest) on list
-        when (member e rest)
-          do (pushnew e duplicates)
-        finally (return duplicates)))
-
 (defmethod verify progn ((instruction terminator))
   ;; No successor (verify type decl)
   (test (null (successor instruction))
@@ -313,12 +305,7 @@ If there are problems, a VERIFICATION-FAILED is signaled. If the verification pr
     (test (not (set:presentp (next instruction) *seen-next*))
           "shares its next-list ~a"
           instruction (next instruction))
-    (set:nadjoinf *seen-next* (next instruction)))
-  ;; NEXT doesn't have any repeats other than maybe the normal
-  (let ((dupes (collect-duplicates (rest (next instruction)))))
-    (test (null dupes)
-          "has repeated elements in next-list ~a"
-          instruction dupes)))
+    (set:nadjoinf *seen-next* (next instruction))))
 
 (defmethod verify progn ((instruction terminator0))
   ;; No NEXT (verify type decl)