Changeset 9256


Ignore:
Timestamp:
05/25/05 01:38:01 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

Location:
trunk/j/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/compiler-macro.lisp

    r9204 r9256  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: compiler-macro.lisp,v 1.5 2005-05-19 15:09:34 piso Exp $
     4;;; $Id: compiler-macro.lisp,v 1.6 2005-05-25 01:38:01 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1919
    2020(in-package #:system)
     21
     22(export 'compiler-macroexpand)
    2123
    2224(defvar *compiler-macros* (make-hash-table :test #'equal))
     
    3739           (setf (compiler-macro-function ',name) (function ,expander))
    3840           ',name)))))
     41
     42;;; Adapted from OpenMCL.
     43(defun compiler-macroexpand-1 (form &optional env)
     44  (let ((expander nil)
     45        (new-form nil))
     46    (if (and (consp form)
     47             (symbolp (%car form))
     48             (setq expander (compiler-macro-function (%car form) env)))
     49        (values (setq new-form (funcall expander form env))
     50                (neq new-form form))
     51        (values form
     52                nil))))
     53
     54(defun compiler-macroexpand (form &optional env)
     55  (let ((expanded-p nil))
     56    (loop
     57      (multiple-value-bind (expansion exp-p)
     58          (compiler-macroexpand-1 form env)
     59        (if exp-p
     60            (setf form expansion
     61                  expanded-p t)
     62            (return))))
     63    (values form expanded-p)))
     64
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r9246 r9256  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.466 2005-05-24 19:14:50 piso Exp $
     4;;; $Id: jvm.lisp,v 1.467 2005-05-25 01:37:38 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    783783    (p1-default form)))
    784784
     785(defsubst notinline-p (name)
     786  (declare (optimize speed))
     787  (eq (get name '%inline) 'NOTINLINE))
     788
    785789(defun p1 (form)
    786790  (cond ((symbolp form)
     
    818822               handler)
    819823           (cond ((symbolp op)
     824                  (when (compiler-macro-function op)
     825                    (unless (notinline-p op)
     826                      (multiple-value-bind (expansion expanded-p)
     827                          (sys:compiler-macroexpand form)
     828                        ;; Fall through if no change...
     829                        (when expanded-p
     830                          (return-from p1 (p1 expansion))))))
    820831                  (cond ((setf handler (get op 'p1-handler))
    821832                         (funcall handler form))
     
    28202831(defvar *functions-defined-in-current-file* nil)
    28212832
    2822 (defsubst notinline-p (name)
    2823   (declare (optimize speed))
    2824   (eq (get name '%inline) 'NOTINLINE))
    2825 
    28262833(defun inline-ok (name)
    28272834  (declare (optimize speed))
  • trunk/j/src/org/armedbear/lisp/precompiler.lisp

    r9248 r9256  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: precompiler.lisp,v 1.111 2005-05-24 19:16:34 piso Exp $
     4;;; $Id: precompiler.lisp,v 1.112 2005-05-25 01:36:50 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    153153(defvar *in-jvm-compile* nil)
    154154
    155 ;;; From OpenMCL.
    156 (defun compiler-macroexpand-1 (form &optional env)
    157   (let ((expander nil)
    158         (newdef nil))
    159     (if (and (consp form)
    160              (symbolp (%car form))
    161              (setq expander (compiler-macro-function (%car form) env)))
    162         (values (setq newdef (funcall expander form env))
    163                 (neq newdef form))
    164         (values form
    165                 nil))))
    166 
    167 (defun compiler-macroexpand (form &optional env)
    168   (let ((expanded-p nil))
    169     (loop
    170       (multiple-value-bind (expansion exp-p) (compiler-macroexpand-1 form env)
    171         (if exp-p
    172             (setf form expansion expanded-p t)
    173             (return))))
    174     (values form expanded-p)))
    175 
    176155(defvar *local-variables* ())
    177156
     
    193172               handler)
    194173           (when (symbolp op)
    195              (cond ((compiler-macro-function op)
    196                     (let ((result (compiler-macroexpand form)))
    197                       ;; Fall through if no change...
    198                       (unless (equal result form)
    199                         (return-from precompile1 (precompile1 result)))))
    200                    ((setf handler (get op 'precompile-handler))
     174             (cond ((setf handler (get op 'precompile-handler))
    201175                    (return-from precompile1 (funcall handler form)))
    202176                   ((local-macro-function op)
Note: See TracChangeset for help on using the changeset viewer.