Commit d218449f authored by  Hayley Patton's avatar Hayley Patton 🐢

Fix some warnings for fun

parent a89e75a4
......@@ -39,8 +39,12 @@
(dotimes (n 32)
(setf (aref hash n) (funcall function)))
(make-instance 'reference :hash hash)))
(:method ((tag (eql 7)) function) :true)
(:method ((tag (eql 8)) function) :false))
(:method ((tag (eql 7)) function)
(declare (ignore function))
:true)
(:method ((tag (eql 8)) function)
(declare (ignore function))
:false))
(defun binary-parse-from-function (function)
(binary-parse-from-type-tag (funcall function) function))
......
......@@ -61,6 +61,8 @@ Providing the class option (:scripts script ...) will attach the initialisation
appending (netfarm-class-scripts class))))))
(defmethod initialize-instance :after ((class netfarm-class) &key)
;; This variable is introduced after the MOP stuff is loaded.
(declare (special *netfarm-classes*))
(force-script-data-evaluation class)
(setf (gethash (netfarm-class-name class) *netfarm-classes*)
class))
......@@ -91,7 +93,9 @@ Providing the class option (:scripts script ...) will attach the initialisation
(find-class 'standard-object))))
(defgeneric netfarm-slots (class)
(:method (class) '())
(:method (class)
(declare (ignore class))
'())
(:method ((class netfarm-class))
(append (loop for slot in (closer-mop:class-direct-slots class)
when (typep slot 'netfarm-slot)
......
......@@ -37,6 +37,7 @@
(initialize-instance object))
(hash-table
(maphash (lambda (key value)
(declare (ignore key))
(push value to-visit))
object)))))))
......
......@@ -78,12 +78,12 @@
reference-hashes))
vague-object)
reference-hashes)
(loop for (key . signature) in (vague-object-signatures vague-object)
(loop for (key . nil) in (vague-object-signatures vague-object)
collect (reference-hash key))))
(:method ((object object))
(append
(list (class->schema (class-of object)))
(loop for (keys . signature) in (object-signatures object)
(loop for (keys . nil) in (object-signatures object)
collect (keys->object keys)))))
(defun vague-object-schema-name (vague-object)
......
......@@ -31,7 +31,6 @@
"INTERPRETER-~A"
symbol))
'#1#)
for variable-name in '#1#
unless (null variable)
collect (list variable accessor)))
,interpreter
......@@ -55,13 +54,15 @@
"Basically WITH-ACCESSORS but you're allowed to use it for any object."
(if (null accessor-bindings)
`(progn ,subject ,@body)
(alexandria:once-only (subject)
`(symbol-macrolet
,(loop for binding in accessor-bindings
collect (destructuring-bind (variable accessor) binding
`(,variable (,accessor ,subject))))
(declare (ignorable . ,(mapcar #'first accessor-bindings)))
,@body))))
(alexandria:with-gensyms (subject-forced)
`(let ((,subject-forced ,subject))
(declare (ignorable ,subject-forced))
(symbol-macrolet
,(loop for binding in accessor-bindings
collect (destructuring-bind (variable accessor) binding
`(,variable (,accessor ,subject-forced))))
(declare (ignorable . ,(mapcar #'first accessor-bindings)))
,@body)))))
(defmacro %define-opcode (number name interpreter inputs bytes declarations function body)
`(setf *discriminator-function* nil
......
......@@ -64,7 +64,7 @@
#'string< :key #'car)))
(unless (null slots)
(write-line "---" stream)
(loop for ((name . slot) . more?) on slots
(loop for (name . slot) in slots
for computed-values = (closer-mop:slot-value-using-class class object slot)
do (render-to-stream name stream)
(write-char #\Space stream)
......
......@@ -75,7 +75,7 @@ This generates the DEFCLASS form, and a method on PRINT-OBJECT."
(defmethod print-object ((object ,class-name) stream)
(print-unreadable-object (object stream :type t :identity t)
(pprint-logical-block (stream nil)
,@(loop for ((name . reader) . continuep) on (reverse slot-alist)
,@(loop for (name . reader) in (reverse slot-alist)
collect `(progn
(write-char #\: stream)
(write-string ,(symbol-name name) stream)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment