Changeset 11453


Ignore:
Timestamp:
12/19/08 19:46:24 (13 years ago)
Author:
ehuelsmann
Message:

Condense LAMBDA and NAMED-LAMBDA branches in p1-function main COND into a single one with conditions.

File:
1 edited

Legend:

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

    r11452 r11453  
    863863  (let ((form (copy-tree form))
    864864        local-function)
    865     (cond ((and (consp (cadr form)) (eq (caadr form) 'LAMBDA))
    866            (when *current-compiland*
    867              (incf (compiland-children *current-compiland*)))
    868            (let* ((*current-compiland* *current-compiland*)
    869                   (lambda-form (cadr form))
     865    (cond ((and (consp (cadr form))
     866                (or (eq (caadr form) 'LAMBDA)
     867                    (eq (caadr form) 'NAMED-LAMBDA)))
     868           (let* ((named-lambda-p (eq (caadr form) 'NAMED-LAMBDA))
     869                  (named-lambda-form (when named-lambda-p
     870                                       (cadr form)))
     871                  (name (when named-lambda-p
     872                          (cadr named-lambda-form)))
     873                  (lambda-form (if named-lambda-p
     874                                   (cons 'LAMBDA (cddr named-lambda-form))
     875                                   (cadr form)))
    870876                  (lambda-list (cadr lambda-form))
    871877                  (body (cddr lambda-form))
    872                   (compiland (make-compiland :name (gensym "ANONYMOUS-LAMBDA-")
     878                  (compiland (make-compiland :name (if named-lambda-p
     879                                                       name (gensym "ANONYMOUS-LAMBDA-"))
    873880                                             :lambda-expression lambda-form
    874881                                             :parent *current-compiland*)))
     882             (when *current-compiland*
     883               (incf (compiland-children *current-compiland*)))
    875884             (multiple-value-bind (body decls)
    876885                 (parse-body body)
    877886               (setf (compiland-lambda-expression compiland)
    878                      `(lambda ,lambda-list ,@decls ,@body))
    879                (let ((*visible-variables* *visible-variables*)
    880                      (*current-compiland* compiland))
    881                  (p1-compiland compiland)))
    882              (list 'FUNCTION compiland)))
    883           ((and (consp (cadr form)) (eq (caadr form) 'NAMED-LAMBDA))
    884            (when *current-compiland*
    885              (incf (compiland-children *current-compiland*)))
    886            (let* ((*current-compiland* *current-compiland*)
    887 ;;                   (lambda-form (cadr form))
    888                   (named-lambda-form (cadr form))
    889                   (name (cadr named-lambda-form))
    890                   (lambda-form (cons 'LAMBDA (cddr named-lambda-form)))
    891                   (lambda-list (cadr lambda-form))
    892                   (body (cddr lambda-form))
    893                   (compiland (make-compiland :name name
    894                                              :lambda-expression lambda-form
    895                                              :parent *current-compiland*)))
    896 ;;              (format t "p1-function named-lambda-form = ~S~%" named-lambda-form)
    897 ;;              (format t "p1-function name = ~S~%" name)
    898 ;;              (format t "p1-function lambda-form = ~S~%" lambda-form)
    899              (multiple-value-bind (body decls)
    900                  (parse-body body)
    901                (setf (compiland-lambda-expression compiland)
    902                      `(lambda ,lambda-list ,@decls (block nil ,@body)))
     887                     (if named-lambda-p
     888                         `(lambda ,lambda-list ,@decls (block nil ,@body))
     889                         `(lambda ,lambda-list ,@decls ,@body)))
    903890               (let ((*visible-variables* *visible-variables*)
    904891                     (*current-compiland* compiland))
     
    38283815(defknown process-args (t) t)
    38293816(defun process-args (args)
     3817  ""
    38303818  (when args
    38313819    (let ((numargs (length args)))
Note: See TracChangeset for help on using the changeset viewer.