Add IGNORE declarations and remove some unused variables.

parent 169d2997
......@@ -55,9 +55,10 @@
(setq form `(progn (setf (symbol-function ',name) #',form) ',name))))
(values (eval form) nil nil))
(defun bc-compile-file-pathname (name &key (output-file name) (type :fasl type-supplied-p)
verbose print c-file h-file data-file shared-data-file
system-p load)
(defun bc-compile-file-pathname (name &key (output-file name) (type :fasl)
verbose print c-file h-file data-file
shared-data-file system-p load)
(declare (ignore load c-file h-file data-file shared-data-file system-p verbose print))
(let ((extension "fasc"))
(case type
((:fasl :fas) (setf extension "fasc"))
......
......@@ -219,12 +219,15 @@
(values (slot-unbound class self (slot-definition-name slotd))))))
(defmethod slot-boundp-using-class ((class class) self slotd)
(declare (ignore class))
(si::sl-boundp (standard-instance-get self slotd)))
(defmethod (setf slot-value-using-class) (val (class class) self slotd)
(declare (ignore class))
(standard-instance-set val self slotd))
(defmethod slot-makunbound-using-class ((class class) instance slotd)
(declare (ignore class))
(ensure-up-to-date-instance instance)
(let* ((location (slot-definition-location slotd)))
(cond ((ext:fixnump location)
......@@ -244,10 +247,11 @@
(defmethod slot-missing ((class t) object slot-name operation
&optional new-value)
(declare (ignore operation new-value))
(declare (ignore operation new-value class))
(error "~A is not a slot of ~A" slot-name object))
(defmethod slot-unbound ((class t) object slot-name)
(declare (ignore class))
(error 'unbound-slot :instance object :name slot-name))
;;;
......
......@@ -106,8 +106,10 @@
finally (si::*make-constant '+builtin-classes+ array))
(defmethod ensure-class-using-class ((class null) name &rest rest)
(declare (ignore class))
(multiple-value-bind (metaclass direct-superclasses options)
(apply #'help-ensure-class rest)
(declare (ignore direct-superclasses))
(apply #'make-instance metaclass :name name options)))
(defmethod change-class ((instance t) (new-class symbol) &rest initargs)
......@@ -121,18 +123,23 @@
(apply #'make-instance (find-class class-name) initargs))
(defmethod slot-makunbound-using-class ((class built-in-class) self slotd)
(declare (ignore class self slotd))
(error "SLOT-MAKUNBOUND-USING-CLASS cannot be applied on built-in objects"))
(defmethod slot-boundp-using-class ((class built-in-class) self slotd)
(declare (ignore class self slotd))
(error "SLOT-BOUNDP-USING-CLASS cannot be applied on built-in objects"))
(defmethod slot-value-using-class ((class built-in-class) self slotd)
(declare (ignore class self slotd))
(error "SLOT-VALUE-USING-CLASS cannot be applied on built-in objects"))
(defmethod (setf slot-value-using-class) (val (class built-in-class) self slotd)
(declare (ignore class self slotd val))
(error "SLOT-VALUE-USING-CLASS cannot be applied on built-in objects"))
(defmethod slot-exists-p-using-class ((class built-in-class) self slotd)
(declare (ignore class self slotd))
nil)
;;; ======================================================================
......@@ -169,7 +176,7 @@
(:metaclass structure-class))
(defmethod make-load-form ((object structure-object) &optional environment)
(make-load-form-saving-slots object))
(make-load-form-saving-slots object :key environment))
(defmethod print-object ((obj structure-object) stream)
(let* ((class (si:instance-class obj))
......
......@@ -62,8 +62,7 @@
;; unbound."
;; "The values of slots specified as shared in the class Cfrom and
;; as local in the class Cto are retained."
(let* ((old-local-slotds (class-slots (class-of old-instance)))
(new-local-slotds (class-slots (class-of instance))))
(let* ((new-local-slotds (class-slots (class-of instance))))
(dolist (new-slot new-local-slotds)
;; CHANGE-CLASS can only operate on the value of local slots.
(when (eq (slot-definition-allocation new-slot) :INSTANCE)
......@@ -77,6 +76,7 @@
instance))
(defmethod change-class ((instance class) new-class &rest initargs)
(declare (ignore new-class initargs))
(if (forward-referenced-class-p instance)
(call-next-method)
(error "The metaclass of a class metaobject cannot be changed.")))
......@@ -114,7 +114,6 @@
(defmethod update-instance-for-redefined-class
((instance standard-object) added-slots discarded-slots property-list
&rest initargs)
(declare (ignore discarded-slots property-list))
(check-initargs (class-of instance) initargs
(valid-keywords-from-methods
(compute-applicable-methods
......
......@@ -203,6 +203,7 @@
,name (&optional (order :MOST-SPECIFIC-FIRST))
((around (:AROUND))
(principal (,name) :REQUIRED t))
,documentation
(let ((main-effective-method
`(,',operator ,@(mapcar #'(lambda (x) `(CALL-METHOD ,x NIL))
(if (eql order :MOST-SPECIFIC-LAST)
......@@ -237,7 +238,6 @@
(when (and (consp x) (eql (first x) :GENERIC-FUNCTION))
(setf body (rest body))
(unless (symbolp (setf generic-function (second x)))
(print 1)
(syntax-error))))
(dolist (group method-groups)
(destructuring-bind (group-name predicate &key description
......@@ -257,7 +257,7 @@
(if (eql q '*)
`(every #'equal ',p .METHOD-QUALIFIERS.)
`(equal ',p .METHOD-QUALIFIERS.))))))
(t (print 2) (syntax-error)))))
(t (syntax-error)))))
(push `(,condition (push .METHOD. ,group-name)) group-checks))
(when required
(push `(unless ,group-name
......@@ -307,7 +307,6 @@
;;;
(defun compute-effective-method (gf method-combination applicable-methods)
(declare (ignore method-combination-type method-combination-args))
(let* ((method-combination-name (car method-combination))
(method-combination-args (cdr method-combination)))
(if (eq method-combination-name 'STANDARD)
......
......@@ -775,7 +775,6 @@ that caused the error. CONTINUE-FORMAT-STRING and ERROR-FORMAT-STRING are the
format strings of the error message. ARGS are the arguments to the format
strings."
(declare (inline apply) ;; So as not to get bogus frames in debugger
(ignore error-name)
#-ecl-min
(c::policy-debug-ihs-frame))
(let ((condition (coerce-to-condition datum args 'simple-error 'error)))
......
......@@ -68,11 +68,13 @@
(defmethod reader-method-class ((class std-class)
(direct-slot direct-slot-definition)
&rest initargs)
(declare (ignore class direct-slot initargs))
(find-class 'standard-reader-method))
(defmethod writer-method-class ((class std-class)
(direct-slot direct-slot-definition)
&rest initargs)
(declare (ignore class direct-slot initargs))
(find-class 'standard-writer-method))
;;; ----------------------------------------------------------------------
......@@ -96,7 +98,7 @@
(cond ((null old-class)
(find-class 'standard-method))
((symbolp old-class)
(find-class old-class))
(find-class (the symbol old-class)))
(t
old-class))))
(si::instance-sig-set gfun)
......@@ -133,6 +135,7 @@
(defun congruent-lambda-p (l1 l2)
(multiple-value-bind (r1 opts1 rest1 key-flag1 keywords1 a-o-k1)
(si::process-lambda-list l1 'FUNCTION)
(declare (ignore a-o-k1))
(multiple-value-bind (r2 opts2 rest2 key-flag2 keywords2 a-o-k2)
(si::process-lambda-list l2 'FUNCTION)
(and (= (length r2) (length r1))
......@@ -145,7 +148,7 @@
(null key-flag2)
a-o-k2
(null (set-difference (all-keywords keywords1)
(all-keywords keywords2))))
(all-keywords keywords2))))
t))))
(defun add-method (gf method)
......@@ -232,7 +235,7 @@ their lambda lists ~A and ~A are not congruent."
(mapcar #'type-of args)))
(defmethod no-next-method (gf method &rest args)
(declare (ignore gf args))
(declare (ignore gf))
(error "In method ~A~%No next method given arguments ~A" method args))
(defun no-primary-method (gf &rest args)
......@@ -242,7 +245,8 @@ their lambda lists ~A and ~A are not congruent."
;;; Now we protect classes from redefinition:
(eval-when (compile load)
(defun setf-find-class (new-value name &optional errorp env)
(let ((old-class (find-class name nil)))
(declare (ignore errorp))
(let ((old-class (find-class name nil env)))
(cond
((typep old-class 'built-in-class)
(error "The class associated to the CL specifier ~S cannot be changed."
......@@ -269,7 +273,7 @@ their lambda lists ~A and ~A are not congruent."
(function-to-method 'add-dependent '((c standard-generic-function) function))
(defmethod add-dependent ((c class) dep)
(pushnew c (class-dependents c)))
(pushnew dep (class-dependents c)))
(defmethod remove-dependent ((c standard-generic-function) dep)
(setf (generic-function-dependents c)
......@@ -290,6 +294,7 @@ their lambda lists ~A and ~A are not congruent."
(defmethod update-dependents ((object generic-function) (dep initargs-updater)
&rest initargs)
(declare (ignore dep initargs))
(recursively-update-classes +the-class+))
(setf *clos-booted* t)
......
......@@ -123,6 +123,7 @@
method-combination
(method-class (find-class 'method))
)
(declare (ignore initargs slot-names))
;;
;; Check the validity of several fields.
;;
......@@ -173,6 +174,7 @@
(defmethod shared-initialize ((gfun standard-generic-function) slot-names
&rest initargs)
(declare (ignore initargs slot-names))
(call-next-method)
(compute-g-f-spec-list gfun)
gfun)
......@@ -216,6 +218,7 @@
(method-class 'STANDARD-METHOD method-class-p)
(generic-function-class 'STANDARD-GENERIC-FUNCTION)
(delete-methods nil))
(declare (ignore delete-methods gfun))
;; else create a new generic function object
(setf args (copy-list args))
(remf args :generic-function-class)
......@@ -242,7 +245,7 @@
((macro-function name)
(simple-program-error "The symbol ~A is bound to a macro and is not a valid name for a generic function" name))
((not *clos-booted*)
(setf (fdefinition (or traced name))
(setf (fdefinition name)
(apply #'ensure-generic-function-using-class nil name args))
(fdefinition name))
(t
......
......@@ -162,6 +162,7 @@
(warn "Ignoring class definition for ~S" class)))
(defun setf-find-class (new-value name &optional errorp env)
(declare (ignore errorp env))
(let ((old-class (find-class name nil)))
(cond
((and old-class
......
......@@ -139,7 +139,8 @@
(> (count-if #'function-boundary (car env)) 1)))
(defun walk-method-lambda (method-lambda required-parameters env)
(declare (si::c-local))
(declare (si::c-local)
(ignore required-parameters))
(let ((call-next-method-p nil)
(next-method-p-p nil)
(in-closure-p nil))
......@@ -270,6 +271,7 @@ have disappeared."
(defun add-method-keywords (method)
(multiple-value-bind (reqs opts rest key-flag keywords allow-other-keys)
(si::process-lambda-list (method-lambda-list method) t)
(declare (ignore reqs opts rest key-flag))
(setf (method-keywords method)
(if allow-other-keys
't
......@@ -322,8 +324,6 @@ have disappeared."
(defun find-method (gf qualifiers specializers &optional (errorp t))
(declare (notinline method-qualifiers))
(let* ((method-list (generic-function-methods gf))
(required-args (subseq (generic-function-lambda-list gf) 0
(length specializers)))
found)
(dolist (method method-list)
(when (and (equal qualifiers (method-qualifiers method))
......
......@@ -36,9 +36,10 @@
`(slot-makunbound ,object ',slot-name))
initialization)))))
(defun need-to-make-load-form-p (object)
(defun need-to-make-load-form-p (object env)
"Return T if the object cannot be externalized using the lisp
printer and we should rather use MAKE-LOAD-FORM."
(declare (ignore env))
(let ((*load-form-cache* nil))
(declare (special *load-form-cache*))
(labels ((recursive-test (object)
......@@ -80,12 +81,12 @@ printer and we should rather use MAKE-LOAD-FORM."
(recursive-test object)
nil))))
(defmethod make-load-form ((object t) &optional environment)
(defmethod make-load-form ((object t) &optional env)
(flet ((maybe-quote (object)
(if (or (consp object) (symbolp object))
(list 'quote object)
object)))
(unless (need-to-make-load-form-p object)
(unless (need-to-make-load-form-p object env)
(return-from make-load-form (maybe-quote object)))
(typecase object
(compiled-function
......@@ -93,10 +94,10 @@ printer and we should rather use MAKE-LOAD-FORM."
(si::bc-split object)
(unless code
(error "Cannot externalize object ~a" object))
(values `(si::bc-join ,(make-load-form lex)
(values `(si::bc-join ,(make-load-form lex env)
',code ; An specialized array, no load form
,(make-load-form data)
,(make-load-form name)))))
,(make-load-form data env)
,(make-load-form name env)))))
(array
(let ((init-forms '()))
(values `(make-array ',(array-dimensions object)
......@@ -105,7 +106,7 @@ printer and we should rather use MAKE-LOAD-FORM."
:initial-contents
',(loop for i from 0 below (array-total-size object)
collect (let ((x (row-major-aref object i)))
(if (need-to-make-load-form-p x)
(if (need-to-make-load-form-p x env)
(progn (push `(setf (row-major-aref ,object ,i) ',x)
init-forms)
0)
......@@ -113,7 +114,8 @@ printer and we should rather use MAKE-LOAD-FORM."
(and init-forms `(progn ,@init-forms)))))
(cons
(values `(cons ,(maybe-quote (car object)) nil)
(and (rest object) `(rplacd ,(maybe-quote object) ,(maybe-quote (cdr object))))))
(and (rest object) `(rplacd ,(maybe-quote object)
,(maybe-quote (cdr object))))))
(hash-table
(let* ((content (ext:hash-table-content object))
(make-form `(make-hash-table
......@@ -121,7 +123,7 @@ printer and we should rather use MAKE-LOAD-FORM."
:rehash-size ,(hash-table-rehash-size object)
:rehash-threshold ,(hash-table-rehash-threshold object)
:test ',(hash-table-test object))))
(if (need-to-make-load-form-p content)
(if (need-to-make-load-form-p content env)
(values
make-form
`(dolist (i ',(loop for key being each hash-key in object
......@@ -135,15 +137,17 @@ printer and we should rather use MAKE-LOAD-FORM."
(error "Cannot externalize object ~a" object)))))
(defmethod make-load-form ((object standard-object) &optional environment)
(make-load-form-saving-slots object))
(make-load-form-saving-slots object :environment environment))
(defmethod make-load-form ((class class) &optional environment)
(declare (ignore environment))
(let ((name (class-name class)))
(if (and name (eq (find-class name) class))
`(find-class ',name)
(error "Cannot externalize anonymous class ~A" class))))
(defmethod make-load-form ((package package) &optional environment)
(declare (ignore environment))
`(find-package ,(package-name package)))
;;; ----------------------------------------------------------------------
......
......@@ -138,9 +138,11 @@
initargs)))
(defmethod direct-slot-definition-class ((class T) &rest canonicalized-slot)
(declare (ignore class canonicalized-slot))
(find-class 'standard-direct-slot-definition nil))
(defmethod effective-slot-definition-class ((class T) &rest canonicalized-slot)
(declare (ignore class canonicalized-slot))
(find-class 'standard-effective-slot-definition nil))
(defun has-forward-referenced-parents (class)
......@@ -155,6 +157,7 @@
(defmethod initialize-instance ((class class) &rest initargs
&key sealedp direct-superclasses direct-slots)
(declare (ignore sealedp))
;; convert the slots from lists to direct slots
(setf direct-slots (loop for s in direct-slots
collect (canonical-slot-to-direct-slot class s)))
......@@ -194,6 +197,7 @@
(defmethod shared-initialize ((class std-class) slot-names &rest initargs &key
(optimize-slot-access (list *optimize-slot-access*))
sealedp)
(declare (ignore initargs slot-names))
(setf (slot-value class 'optimize-slot-access) (first optimize-slot-access)
(slot-value class 'sealedp) (and sealedp t))
(setf class (call-next-method))
......@@ -436,8 +440,10 @@ because it contains a reference to the undefined class~% ~A"
;;;
(defmethod ensure-class-using-class ((class class) name &rest rest
&key direct-slots direct-default-initargs)
(declare (ignore direct-default-initargs direct-slots))
(multiple-value-bind (metaclass direct-superclasses options)
(apply #'help-ensure-class rest)
(declare (ignore direct-superclasses))
(cond ((forward-referenced-class-p class)
(change-class class metaclass))
((not (eq (class-of class) metaclass))
......@@ -758,21 +764,22 @@ because it contains a reference to the undefined class~% ~A"
(defmethod describe-object ((obj std-class) (stream t))
(let ((slotds (class-slots (si:instance-class obj))))
(format t "~%~A is an instance of class ~A"
(format stream "~%~A is an instance of class ~A"
obj (class-name (si:instance-class obj)))
(do ((scan slotds (cdr scan))
(i 0 (1+ i)))
((null scan))
(declare (fixnum i))
(print (slot-definition-name (car scan))) (princ ": ")
(print (slot-definition-name (car scan)) stream)
(princ ": " stream)
(case (slot-definition-name (car scan))
((SUPERIORS INFERIORS PRECEDENCE-LIST)
(princ "(")
(princ "(" stream)
(do* ((scan (si:instance-ref obj i) (cdr scan))
(e (car scan) (car scan)))
((null scan))
(prin1 (class-name e))
(when (cdr scan) (princ " ")))
(prin1 (class-name e) stream)
(when (cdr scan) (princ " " stream)))
(princ ")"))
(otherwise (prin1 (si:instance-ref obj i))))))
(otherwise (prin1 (si:instance-ref obj i) stream)))))
obj)
......@@ -41,6 +41,7 @@
(defun function-keywords (method)
(multiple-value-bind (reqs opts rest-var key-flag keywords)
(si::process-lambda-list (slot-value method 'lambda-list) 'function)
(declare (ignore reqs opts rest-var))
(when key-flag
(do* ((output '())
(l (cdr keywords) (cddddr l)))
......@@ -58,4 +59,5 @@
(defclass standard-writer-method (standard-accessor-method) ())
(defmethod shared-initialize ((method standard-method) slot-names &rest initargs)
(declare (ignore initargs method slot-names))
(add-method-keywords (call-next-method)))
......@@ -284,6 +284,7 @@
;; CLEAR-INPUT
(defmethod stream-clear-input ((stream fundamental-character-input-stream))
(declare (ignore stream))
nil)
(defmethod stream-clear-input ((stream ansi-stream))
......@@ -296,6 +297,7 @@
;; CLEAR-OUTPUT
(defmethod stream-clear-output ((stream fundamental-output-stream))
(declare (ignore stream))
nil)
(defmethod stream-clear-output ((stream ansi-stream))
......@@ -316,12 +318,14 @@
(cl:close stream :abort abort))
(defmethod close ((stream t) &key abort)
(declare (ignore abort))
(bug-or-error stream 'close))
;; STREAM-ELEMENT-TYPE
(defmethod stream-element-type ((stream fundamental-character-stream))
(declare (ignore stream))
'character)
(defmethod stream-element-type ((stream ansi-stream))
......@@ -333,6 +337,7 @@
;; FINISH-OUTPUT
(defmethod stream-finish-output ((stream fundamental-output-stream))
(declare (ignore stream))
nil)
(defmethod stream-finish-output ((stream ansi-stream))
......@@ -345,6 +350,7 @@
;; FORCE-OUTPUT
(defmethod stream-force-output ((stream fundamental-output-stream))
(declare (ignore stream))
nil)
(defmethod stream-force-output ((stream ansi-stream))
......@@ -368,9 +374,11 @@
;; INPUT-STREAM-P
(defmethod input-stream-p ((stream fundamental-stream))
(declare (ignore stream))
nil)
(defmethod input-stream-p ((stream fundamental-input-stream))
(declare (ignore stream))
t)
(defmethod input-stream-p ((stream ansi-stream))
......@@ -392,7 +400,8 @@
;; LINE-COLUMN
(defmethod stream-line-column ((stream fundamental-character-output-stream))
nil)
(declare (ignore stream))
nil)
;; LISTEN
......@@ -422,9 +431,11 @@
;; OUTPUT-STREAM-P
(defmethod output-stream-p ((stream fundamental-stream))
(declare (ignore stream))
nil)
(defmethod output-stream-p ((stream fundamental-output-stream))
(declare (ignore stream))
t)
(defmethod output-stream-p ((stream ansi-stream))
......@@ -473,6 +484,7 @@
(cl:unread-char character stream))
(defmethod stream-unread-char ((stream ansi-stream) character)
(declare (ignore character))
(bug-or-error stream 'stream-unread-char))
......@@ -531,6 +543,7 @@
(si:do-read-sequence stream sequence start end))
(defmethod stream-read-sequence ((stream t) sequence &optional start end)
(declare (ignore sequence start end))
(bug-or-error stream 'stream-read-sequence))
......@@ -551,9 +564,11 @@
;; STREAM-P
(defmethod streamp ((stream stream))
(declare (ignore stream))
t)
(defmethod streamp ((stream t))
(declare (ignore stream))
nil)
......@@ -563,6 +578,7 @@
(cl:write-byte integer stream))
(defmethod stream-write-byte ((stream t) integer)
(declare (ignore integer))
(bug-or-error stream 'stream-write-byte))
......@@ -572,6 +588,7 @@
(cl:write-char character stream))
(defmethod stream-write-char ((stream t) character)
(declare (ignore character))
(bug-or-error stream 'stream-write-char))
......@@ -589,6 +606,7 @@
(si::do-write-sequence sequence stream start end))
(defmethod stream-write-sequence ((stream t) sequence &optional start end)
(declare (ignore sequence start end))
(bug-or-error stream 'stream-write-sequence))
......@@ -612,6 +630,7 @@
(cl:write-string string stream :start start :end end))
(defmethod stream-write-string ((stream t) string &optional start end)
(declare (ignore string start end))
(bug-or-error stream 'stream-write-string))
......@@ -663,6 +682,7 @@
(defmethod stream-file-descriptor ((stream file-stream) &optional (direction
:input))
(declare (ignore direction))
(si:file-stream-fd stream))
......
......@@ -22,8 +22,7 @@
(EQ 'SI::HASH-EQ)
(EQL 'SI::HASH-EQL)
(EQUAL 'SI::HASH-EQUAL)
(t (setf test 'EQUALP) 'SI::HASH-EQUALP)))
(hash (gensym "HASH")))
(t (setf test 'EQUALP) 'SI::HASH-EQUALP))))
`(progn
(defparameter ,cache-name (make-array 1024 :element-type t :adjustable nil))
(defun ,reset-name ()
......
......@@ -29,7 +29,6 @@
(*current-form* form)
(*first-error* t)
(*setjmps* 0))
;(let ((*print-level* 3)) (print form))
(catch *cmperr-tag*
(when (consp form)
(let ((fun (car form)) (args (cdr form)) fd)
......@@ -110,7 +109,6 @@
&aux def top-output-string
(*volatile* " volatile "))
;(let ((*print-level* 3)) (pprint *top-level-forms*))
(setq *top-level-forms* (nreverse *top-level-forms*))
(wt-nl1 "#include \"" (brief-namestring h-pathname) "\"")
......@@ -376,7 +374,6 @@ return f2;
(equal (ref-ref-clb x) (ref-ref-clb y))
(equal (ref-ref x) (ref-ref y))))
(similar-var (x y)
(print (list (var-loc x) (var-loc y)))
(and! (similar-ref x y)
(equal (var-name x) (var-name y))
(equal (var-kind x) (var-kind y))
......@@ -390,7 +387,6 @@ return f2;
(eql (c1form-sp-change x) (c1form-sp-change y))
(eql (c1form-volatile x) (c1form-volatile y))))
(similar-fun (x y)
(print (list '? (fun-name x) (fun-name y)))
(and! (similar-ref x y)
(eql (fun-global x) (fun-global y))
(eql (fun-exported x) (fun-exported y))
......
......@@ -113,7 +113,7 @@
(add-object 0 :duplicate t :permanent t))
(defun add-load-form (object location)
(when (clos::need-to-make-load-form-p object)
(when (clos::need-to-make-load-form-p object *cmp-env*)
(if (not (eq *compiler-phase* 't1))
(cmperr "Unable to internalize complex object ~A in ~a phase" object *compiler-phase*)
(multiple-value-bind (make-form init-form) (make-load-form object)
......
......@@ -2071,7 +2071,7 @@ extern ECL_API cl_object cl_slot_value(cl_object object, cl_object slot);
extern ECL_API cl_object cl_slot_exists_p(cl_object object, cl_object slot);
/* print.lsp */
extern ECL_API cl_object clos_need_to_make_load_form_p(cl_object o);
extern ECL_API cl_object clos_need_to_make_load_form_p(cl_object o, cl_object env);
/* defclass.lsp */
extern ECL_API cl_object clos_load_defclass(cl_object name, cl_object superclasses, cl_object slots, cl_object options);
......
......@@ -38,6 +38,7 @@ Gives a global declaration. See DECLARE for possible DECL-SPECs."
)
(defmacro with-compilation-unit (options &rest body)
(declare (ignore options))
`(progn ,@body))
;;; Editor.
......@@ -72,6 +73,7 @@ Displays information about storage allocation in the following format.
* number of pages ECL can use.
The number of times the garbage collector has been called is not shown, if the
number is zero. The optional X is simply ignored."
(declare (ignorable x))
#+boehm-gc
(progn
(format t "
......
......@@ -184,6 +184,7 @@ An excerpt of the rules used by ECL:
"
(multiple-value-bind (commands loadrc unprocessed-options)
(produce-init-code args rules)
(declare (ignore unprocessed-options))
(restart-case
(handler-bind ((error
#'(lambda (c)
......
......@@ -250,14 +250,17 @@
ppn
doc)))))
#+ecl-min
(si::fset 'defmacro
#'(ext::lambda-block defmacro (def env)
(declare (ignore env))
(let* ((name (second def))
(vl (third def))
(body (cdddr def))
(function))
(multiple-value-bind (function pprint doc)
(sys::expand-defmacro name vl body)
(declare (ignore doc))
(setq function `(function ,function))
(when *dump-defmacro-definitions*
(print function)
......@@ -298,6 +301,7 @@
(find-declarations body)
(multiple-value-bind (ppn whole dl arg-check)
(destructure vl nil)
(declare (ignore ppn))
`(let* ((,whole ,list) ,@dl)
,@decls
,@arg-check
......@@ -317,11 +321,13 @@ or SYMBOL-MACRO forms, and also to evaluate other forms."
(declare (si::c-local))
(flet ((local-var-error-function (name)
#'(lambda (whole env)
(declare (ignore whole env))
(error
"In a MACROLET function you tried to access a local variable, ~A,
from the function in which it appears." name)))
(local-fun-error-function (name)
#'(lambda (whole env)
(declare (ignore whole env))
(error
"In a MACROLET function you tried to access a local function, ~A,
from the function in which it appears." name))))
......
......@@ -468,8 +468,6 @@ inspect commands, or type '?' to the inspector."
(values)))
(defun inspect (object)
(print 'hola)
(print ext:*inspector-hook*)
(if ext:*inspector-hook*
(funcall *inspector-hook* object)
(default-inspector object))
......
......@@ -111,6 +111,7 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)."
(defmacro define-compiler-macro (&whole whole name vl &rest body)
(multiple-value-bind (function pprint doc-string)
(sys::expand-defmacro name vl body)
(declare (ignore pprint))
(setq function `(function ,function))
(when *dump-defun-definitions*
(print function)
......
......@@ -55,6 +55,7 @@
;; defmacro.lsp.
;;
(let ((f #'(ext::lambda-block dolist (whole env)
(declare (ignore env))
(let (body pop finished control var expr exit)
(setq body (rest whole))
(when (endp body)
......@@ -81,6 +82,7 @@
(si::fset 'dolist f t))
(let ((f #'(ext::lambda-block dotimes (whole env)
(declare (ignore env))
(let (body pop finished control var expr exit)
(setq body (rest whole))
(when (endp body)
......@@ -108,6 +110,7 @@
(si::fset 'dotimes f t))
(let ((f #'(ext::lambda-block do/do*-expand (whole env)
(declare (ignore env))
(let (do/do* control test result vl step let psetq body)
(setq do/do* (first whole) body (rest whole))
(if (eq do/do* 'do)
......
......@@ -96,6 +96,7 @@
align (apply #'max (mapcar #'(lambda (field)
(multiple-value-bind (field-size field-align)
(size-of-foreign-type (second field))
(declare (ignore field-size))
field-align))
(rest type))))
(%align-data size align))
......
......@@ -239,6 +239,7 @@ strings."
;; (EXT:OPTIONAL-ANNOTATION arguments for EXT:ANNOTATE)
(si::fset 'ext:optional-annotation
#'(ext:lambda-block ext:optional-annotation (whole env)
(declare (ignore env #-ecl-min whole))
#+ecl-min
`(ext:annotate ,@(rest whole)))
t)
......
......@@ -296,6 +296,7 @@ hash table; otherwise it signals that we have reached the end of the hash table.
,@body)))