Changeset 5136


Ignore:
Timestamp:
12/15/03 01:39:28 (18 years ago)
Author:
asimon
Message:

PRECOMPILE sets arglist of macros

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/precompiler.lisp

    r5119 r5136  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: precompiler.lisp,v 1.21 2003-12-13 20:36:07 piso Exp $
     4;;; $Id: precompiler.lisp,v 1.22 2003-12-15 01:39:28 asimon Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    153153
    154154(defun precompile-progn (form)
    155    (let ((body (cdr form)))
    156      (if (= (length body) 1)
    157          (let ((res (precompile1 (car body))))
    158            ;; If the result turns out to be a bare symbol, leave it wrapped
    159            ;; with PROGN so it won't be mistaken for a tag in an enclosing
    160            ;; TAGBODY.
    161            (if (symbolp res)
    162                (list 'progn res)
    163                res))
    164          (cons 'PROGN (mapcar #'precompile1 body)))))
     155  (let ((body (cdr form)))
     156    (if (= (length body) 1)
     157        (let ((res (precompile1 (car body))))
     158          ;; If the result turns out to be a bare symbol, leave it wrapped
     159          ;; with PROGN so it won't be mistaken for a tag in an enclosing
     160          ;; TAGBODY.
     161          (if (symbolp res)
     162              (list 'progn res)
     163              res))
     164        (cons 'PROGN (mapcar #'precompile1 body)))))
    165165
    166166(defun precompile-progv (form)
    167    (list* 'PROGV (cadr form) (caddr form) (mapcar #'precompile1 (cdddr form))))
     167  (list* 'PROGV (cadr form) (caddr form) (mapcar #'precompile1 (cdddr form))))
    168168
    169169(defun precompile-setq (form)
    170170  (let* ((args (cdr form))
    171         (len (length args)))
     171         (len (length args)))
    172172    (when (oddp len)
    173173      (error "odd number of arguments to SETQ"))
     
    348348
    349349(defun precompile-multiple-value-list (form)
    350    (list 'MULTIPLE-VALUE-LIST (precompile1 (cadr form))))
     350  (list 'MULTIPLE-VALUE-LIST (precompile1 (cadr form))))
    351351
    352352(defun precompile-return (form)
    353    (list 'RETURN (precompile1 (cadr form))))
     353  (list 'RETURN (precompile1 (cadr form))))
    354354
    355355(defun precompile-return-from (form)
     
    368368
    369369(defun precompile-unwind-protect (form)
    370    (list* 'UNWIND-PROTECT
    371           (precompile1 (cadr form))
    372           (mapcar #'precompile1 (cddr form))))
     370  (list* 'UNWIND-PROTECT
     371         (precompile1 (cadr form))
     372         (mapcar #'precompile1 (cddr form))))
    373373
    374374;; EXPAND-MACRO is like MACROEXPAND, but EXPAND-MACRO quits if *in-jvm-compile*
     
    529529      (%set-lambda-name result name)
    530530      (%set-call-count result (%call-count definition))
    531       (%set-arglist result (arglist definition))
    532531      (if (and (symbolp name) (macro-function name))
    533           (setf (fdefinition name) (make-macro result))
    534           (setf (fdefinition name) result)))
     532          (let ((mac (make-macro result)))
     533            (%set-arglist mac (arglist (symbol-function name)))
     534            (setf (fdefinition name) mac))
     535          (progn
     536            (setf (fdefinition name) result)
     537            (%set-arglist result (arglist definition)))))
    535538    (values (or name result) nil nil)))
    536539
     
    562565    `(progn
    563566       (let ((mac (make-macro (or (precompile nil ,expander) ,expander))))
    564   (if (special-operator-p ',name)
    565            (%put ',name 'macroexpand-macro mac)
    566            (fset ',name mac))
    567   (%set-arglist mac ',lambda-list)
    568   ',name))))
     567        (if (special-operator-p ',name)
     568             (%put ',name 'macroexpand-macro mac)
     569             (fset ',name mac))
     570        (%set-arglist mac ',lambda-list)
     571        ',name))))
    569572
    570573;; Make an exception just this one time...
Note: See TracChangeset for help on using the changeset viewer.