Changeset 8319


Ignore:
Timestamp:
01/01/05 06:07:58 (17 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

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

    r8318 r8319  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.333 2004-12-31 19:13:46 piso Exp $
     4;;; $Id: jvm.lisp,v 1.334 2005-01-01 06:07:58 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    357357(defun p1-multiple-value-bind (form)
    358358;;   (dformat t "p1-multiple-value-bind~%")
    359   (let ((*visible-variables* *visible-variables*)
    360         (varlist (cadr form))
    361         (values-form (caddr form))
    362         (body (cdddr form)))
     359  (let* ((*visible-variables* *visible-variables*)
     360         (block (make-block-node :name '(MULTIPLE-VALUE-BIND)))
     361         (*blocks* (cons block *blocks*))
     362         (varlist (cadr form))
     363         (values-form (caddr form))
     364         (body (cdddr form)))
    363365    ;; Process the values-form first. ("The scopes of the name binding and
    364366    ;; declarations do not include the values-form.")
    365     (setf values-form (if (consp values-form)
    366                           (mapcar #'p1 values-form)
    367                           (p1 values-form)))
     367;;     (setf values-form (if (consp values-form)
     368;;                           (mapcar #'p1 values-form)
     369;;                           (p1 values-form)))
     370    (setf values-form (p1 values-form))
    368371    (let ((vars ()))
    369372      (dolist (symbol varlist)
     
    389392                     (setf (variable-declared-type variable) (cadr decl)))))))))))
    390393    (setf body (mapcar #'p1 body))
    391     (list* 'MULTIPLE-VALUE-BIND varlist values-form body)))
     394    (setf (block-form block) (list* 'MULTIPLE-VALUE-BIND varlist values-form body))
     395    block))
    392396
    393397(defun p1-block (form)
     
    31583162         (aver nil))))
    31593163
    3160 (defun compile-multiple-value-bind (form &key (target *val*) representation)
    3161   (let* ((block (make-block-node :name '(MULTIPLE-VALUE-BIND)))
     3164;; (defun compile-multiple-value-bind (form &key (target *val*) representation)
     3165(defun compile-multiple-value-bind-node (block target)
     3166  (let* (;;(block (make-block-node :name '(MULTIPLE-VALUE-BIND)))
    31623167         (*blocks* (cons block *blocks*))
    31633168         (*register* *register*)
     3169         (form (block-form block))
    31643170         (*visible-variables* *visible-variables*)
    31653171         (specials ())
     
    49714977               ((equal (block-name form) '(LET))
    49724978                (compile-let/let*-node form target))
     4979               ((equal (block-name form) '(MULTIPLE-VALUE-BIND))
     4980                (compile-multiple-value-bind-node form target))
    49734981               (t
    49744982                (compile-block-node form target))))
     
    53015309    (error "COMPILE-DEFUN: unable to compile LAMBDA form defined in non-null lexical environment."))
    53025310  (handler-bind ((warning #'handle-warning))
    5303     (let ((precompiled-form (precompile-form form t)))
     5311;;     (let ((precompiled-form (precompile-form form t)))
     5312    (let ((precompiled-form (if *current-compiland*
     5313                               form
     5314                               (precompile-form form t))))
    53045315      (compile-1 (make-compiland :name name
    53055316                                 :lambda-expression precompiled-form
     
    54495460                             length
    54505461                             locally
    5451                              multiple-value-bind
     5462;;                              multiple-value-bind
    54525463                             multiple-value-call
    54535464                             multiple-value-list
Note: See TracChangeset for help on using the changeset viewer.