Changeset 8318


Ignore:
Timestamp:
12/31/04 19:13:46 (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

    r8317 r8318  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.332 2004-12-31 16:49:17 piso Exp $
     4;;; $Id: jvm.lisp,v 1.333 2004-12-31 19:13:46 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    246246
    247247(defstruct node
     248  ;; Block name or (TAGBODY) or (LET) or (MULTIPLE-VALUE-BIND).
    248249  name
    249250  form
     
    253254;; BLOCKs per se.
    254255(defstruct (block-node (:conc-name block-) (:include node))
    255   ;; Block name, or (TAGBODY), or (LET).
    256256  (exit (gensym))
    257257  target
     
    293293            (t
    294294             (push (make-variable :name varspec) vars))))
    295     (setf var (nreverse vars))
     295    (setf vars (nreverse vars))
    296296    (dolist (variable vars)
    297297      (push variable *visible-variables*))
     
    354354                   (setf (variable-declared-type variable) (cadr decl))))))))))
    355355    block))
     356
     357(defun p1-multiple-value-bind (form)
     358;;   (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)))
     363    ;; Process the values-form first. ("The scopes of the name binding and
     364    ;; declarations do not include the values-form.")
     365    (setf values-form (if (consp values-form)
     366                          (mapcar #'p1 values-form)
     367                          (p1 values-form)))
     368    (let ((vars ()))
     369      (dolist (symbol varlist)
     370        (let ((var (make-variable :name symbol)))
     371          (push var vars)
     372          (push var *visible-variables*)))
     373      ;; Process declarations.
     374      (dolist (subform body)
     375        (unless (and (consp subform) (eq (car subform) 'DECLARE))
     376          (return))
     377        (let ((decls (cdr subform)))
     378          (dolist (decl decls)
     379            (case (car decl)
     380              (SPECIAL
     381               (dolist (sym (cdr decl))
     382                 (dolist (variable vars)
     383                   (when (eq sym (variable-name variable))
     384                     (setf (variable-special-p variable) t)))))
     385              (TYPE
     386               (dolist (sym (cddr decl))
     387                 (dolist (variable vars)
     388                   (when (eq sym (variable-name variable))
     389                     (setf (variable-declared-type variable) (cadr decl)))))))))))
     390    (setf body (mapcar #'p1 body))
     391    (list* 'MULTIPLE-VALUE-BIND varlist values-form body)))
    356392
    357393(defun p1-block (form)
     
    567603(install-p1-handler 'load-time-value      'identity)
    568604(install-p1-handler 'locally              'p1-default)
    569 (install-p1-handler 'multiple-value-bind  'p1-lambda)
     605(install-p1-handler 'multiple-value-bind  'p1-multiple-value-bind)
    570606(install-p1-handler 'multiple-value-call  'p1-default)
    571607(install-p1-handler 'multiple-value-list  'p1-default)
Note: See TracChangeset for help on using the changeset viewer.