/[cmucl]/src/compiler/macros.lisp
ViewVC logotype

Diff of /src/compiler/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by ram, Tue Dec 11 13:30:18 1990 UTC revision 1.19 by wlott, Tue Dec 11 13:41:12 1990 UTC
# Line 128  Line 128 
128    (declare (ignore stuff))    (declare (ignore stuff))
129    (error "Can't funcall the SYMBOL-FUNCTION of special forms."))    (error "Can't funcall the SYMBOL-FUNCTION of special forms."))
130    
131  ;;; SPECIAL-FORM-ARG-COUNT-ERROR  ;;; CONVERT-CONDITION-INTO-COMPILER-ERROR  --  Internal
132  ;;;  ;;;
133  (defun special-form-arg-count-error (name kind continue string &rest args)  ;;; Passed to parse-defmacro when we want compiler errors instead of real
134    (declare (ignore continue))  ;;; errors.
135    (compiler-error "While expanding ~A ~S:~%  ~?" kind name string args))  ;;;
136    (proclaim '(inline convert-condition-into-compiler-error))
137    (defun convert-condition-into-compiler-error (datum &rest stuff)
138      (if (stringp datum)
139          (apply #'compiler-error datum stuff)
140          (compiler-error "~A"
141                          (if (symbolp datum)
142                              (apply #'make-condition datum stuff)
143                              datum))))
144    
145  ;;; Def-IR1-Translator  --  Interface  ;;; Def-IR1-Translator  --  Interface
146  ;;;  ;;;
# Line 158  Line 166 
166          (lisp::parse-defmacro lambda-list n-form body name "special form"          (lisp::parse-defmacro lambda-list n-form body name "special form"
167                                :doc-string-allowed t                                :doc-string-allowed t
168                                :environment n-env                                :environment n-env
169                                :error-fun 'special-form-arg-count-error)                                :error-fun 'convert-condition-into-compiler-error)
170        `(progn        `(progn
171           (proclaim '(function ,fn-name (continuation continuation t) void))           (proclaim '(function ,fn-name (continuation continuation t) void))
172           (defun ,fn-name (,start-var ,cont-var ,n-form)           (defun ,fn-name (,start-var ,cont-var ,n-form)
# Line 213  Line 221 
221           (setf (info function source-transform ',name) #',fn-name)))))           (setf (info function source-transform ',name) #',fn-name)))))
222    
223    
 ;;; PRIMITIVE-ARG-COUNT-ERROR  
 ;;;  
 (defun primitive-arg-count-error (name kind continue string &rest args)  
   (declare (ignore continue))  
   (compiler-error "While expanding ~A ~S:~%  ~?" kind name string args))  
   
224  (defmacro def-primitive-translator (name lambda-list &body body)  (defmacro def-primitive-translator (name lambda-list &body body)
225    "Def-Primitive-Translator Name Lambda-List Form*    "Def-Primitive-Translator Name Lambda-List Form*
226    Define a function that converts a use of (%PRIMITIVE Name ...) into Lisp    Define a function that converts a use of (%PRIMITIVE Name ...) into Lisp
# Line 230  Line 232 
232          (body decls)          (body decls)
233          (lisp::parse-defmacro lambda-list n-form body name "%primitive"          (lisp::parse-defmacro lambda-list n-form body name "%primitive"
234                                :environment n-env                                :environment n-env
235                                :error-fun 'primitive-arg-count-error)                                :error-fun 'convert-condition-into-compiler-error)
236        `(progn        `(progn
237           (defun ,fn-name (,n-form)           (defun ,fn-name (,n-form)
238             (let ((,n-env *lexical-environment*))             (let ((,n-env *lexical-environment*))

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

  ViewVC Help
Powered by ViewVC 1.1.5