Changeset 11924


Ignore:
Timestamp:
05/22/09 08:37:09 (12 years ago)
Author:
ehuelsmann
Message:

Implement compilation of closures with non-empty
lexical environments (Part 1 [of 2]): Variables.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Environment.java

    r11914 r11924  
    329329      }
    330330    };
     331
     332  // ### environment-all-variables
     333  private static final Primitive ENVIRONMENT_ALL_VARS =
     334    new Primitive("environment-all-variables", PACKAGE_SYS, true, "environment")
     335    {
     336      @Override
     337      public LispObject execute(LispObject arg) throws ConditionThrowable
     338      {
     339            Environment env = checkEnvironment(arg);
     340            LispObject result = NIL;
     341            for (Binding binding = env.vars;
     342                 binding != null; binding = binding.next)
     343              if (binding.specialp)
     344                result = result.push(binding.symbol);
     345              else
     346                result = result.push(new Cons(binding.symbol, binding.value));
     347            return result.nreverse();
     348      }
     349    };
    331350}
  • trunk/abcl/src/org/armedbear/lisp/Primitives.java

    r11889 r11924  
    17991799  };
    18001800
     1801  // ### symbol-macro-p
     1802  private static final Primitive SYMBOL_MACRO_P =
     1803      new Primitive("symbol-macro-p", PACKAGE_SYS, true, "value")
     1804  {
     1805      @Override
     1806      public LispObject execute(LispObject arg) throws ConditionThrowable
     1807      {
     1808          return (arg instanceof SymbolMacro) ? T : NIL;
     1809      }
     1810  };
    18011811
    18021812  // ### %defparameter
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11922 r11924  
    237237(defconstant +lisp-simple-string+ "Lorg/armedbear/lisp/SimpleString;")
    238238(defconstant +lisp-environment+ "Lorg/armedbear/lisp/Environment;")
     239(defconstant +lisp-environment-class+ "org/armedbear/lisp/Environment")
    239240(defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;")
    240241(defconstant +lisp-throw-class+ "org/armedbear/lisp/Throw")
     
    41884189             (emit-swap representation nil)
    41894190             (emit 'putfield +closure-binding-class+ "value" +lisp-object+))
     4191            ((variable-environment variable)
     4192             (assert (not *file-compilation*))
     4193             (emit 'getstatic *this-class*
     4194                   (declare-object (variable-environment variable)
     4195                                   +lisp-environment+
     4196                                   +lisp-environment-class+)
     4197                   +lisp-environment+)
     4198             (emit 'swap)
     4199             (emit-push-variable-name variable)
     4200             (emit 'swap)
     4201             (emit-invokevirtual +lisp-environment-class+ "rebind"
     4202                                 (list +lisp-symbol+ +lisp-object+)
     4203                                 nil))
    41904204            (t
    41914205             (assert nil))))))
     
    42184232           (emit 'aaload)
    42194233           (emit 'getfield +closure-binding-class+ "value" +lisp-object+))
     4234          ((variable-environment variable)
     4235           (assert (not *file-compilation*))
     4236           (emit 'getstatic *this-class*
     4237                 (declare-object (variable-environment variable)
     4238                                 +lisp-environment+
     4239                                 +lisp-environment-class+)
     4240                 +lisp-environment+)
     4241           (emit-push-variable-name variable)
     4242           (emit-invokevirtual +lisp-environment-class+ "lookup"
     4243                               (list +lisp-object+)
     4244                               +lisp-object+))
    42204245          (t
    42214246           (assert nil)))))
     
    72947319                     (variable-register variable)
    72957320                     (variable-closure-index variable)
    7296                      (variable-index variable))
     7321                     (variable-index variable)
     7322                     (variable-environment variable))
    72977323                 (emit-push-variable variable)
    72987324                 (convert-representation (variable-representation variable)
     
    82318257          (incf i)))
    82328258
     8259      ;; Assert that we're not refering to any variables
     8260      ;; we're not allowed to use
     8261      (assert (= 0
     8262                 (length (remove-if (complement #'variable-references)
     8263                                    (remove-if #'variable-references-allowed-p
     8264                                               *visible-variables*)))))
     8265
    82338266      ;; Pass 2.
    82348267      (with-class-file (compiland-class-file compiland)
     
    82458278(defun compile-defun (name form environment filespec)
    82468279  (aver (eq (car form) 'LAMBDA))
    8247   (unless (or (null environment) (empty-environment-p environment))
    8248     (compiler-unsupported "COMPILE-DEFUN: unable to compile LAMBDA form defined in non-null lexical environment."))
    82498280  (catch 'compile-defun-abort
    82508281    (let* ((class-file (make-class-file :pathname filespec
     
    82588289                                          (make-class-file :pathname ,filespec
    82598290                                                           :lambda-name ',name
    8260                                                            :lambda-list (cadr ',form)))))))
     8291                                                           :lambda-list (cadr ',form))))))
     8292           (*compile-file-environment* environment))
    82618293        (compile-1 (make-compiland :name name
    82628294                                   :lambda-expression
     
    83948426    (unless expression
    83958427      (error "Can't find a definition for ~S." definition))
     8428    (when environment
     8429      (dolist (var (reverse (environment-all-variables environment)))
     8430        ;; We need to add all variables, even symbol macros,
     8431        ;; because the latter may shadow other variables by the same name
     8432        ;; The precompiler should have resolved all symbol-macros, so
     8433        ;; later we assert we didn't get any references to the symbol-macro.
     8434        (push (make-variable :name (if (symbolp var) var (car var))
     8435                             :special-p (symbolp var)
     8436                             :environment environment
     8437                             :references-allowed-p
     8438                             (not (sys:symbol-macro-p (cdr var)))
     8439                             :compiland NIL) *visible-variables*)))
     8440    ;; FIXME: we still need to add local functions, ofcourse.
    83968441    (handler-bind
    83978442        ((compiler-unsupported-feature-error
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r11909 r11924  
    261261  index         ; index number for a variable in the argument array
    262262  closure-index ; index number for a variable in the closure context array
     263  environment   ; the environment for the variable, if we're compiling in
     264                ; a non-null lexical environment with variables
    263265    ;; a variable can be either special-p *or* have a register *or*
    264     ;; have an index *or a closure-index
     266    ;; have an index *or* a closure-index *or* an environment
    265267  (reads 0 :type fixnum)
    266268  (writes 0 :type fixnum)
    267269  references
     270  (references-allowed-p t) ; NIL if this is a symbol macro in the enclosing
     271                           ; lexical environment
    268272  used-non-locally-p
    269273  (compiland *current-compiland*))
Note: See TracChangeset for help on using the changeset viewer.