Changeset 4765


Ignore:
Timestamp:
11/15/03 15:26:12 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4764 r4765  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: precompiler.lisp,v 1.6 2003-11-15 14:30:30 piso Exp $
     4;;; $Id: precompiler.lisp,v 1.7 2003-11-15 15:26:12 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2626                  (equal (fourth args) '(function eq))))
    2727         `(assq ,(first args) ,(second args)))
     28        (t form)))
     29
     30(define-compiler-macro member (&whole form &rest args)
     31  (cond ((and (= (length args) 4)
     32              (eq (third args) :test)
     33              (or (equal (fourth args) '(quote eq))
     34                  (equal (fourth args) '(function eq))))
     35         `(memq ,(first args) ,(second args)))
     36        ((and (= (length args) 4)
     37              (eq (third args) :test)
     38              (or (equal (fourth args) '(quote eql))
     39                  (equal (fourth args) '(function eql))))
     40         `(memql ,(first args) ,(second args)))
     41        ((= (length args) 2)
     42         `(memql ,(first args) ,(second args)))
    2843        (t form)))
    2944
     
    295310                nil))))
    296311
    297 ;;; From OpenMCL.
    298312(defun compiler-macroexpand (form &optional env)
    299   (multiple-value-bind (new win) (compiler-macroexpand-1 form env)
    300     (do* ((won-at-least-once win))
    301          ((null win) (values new won-at-least-once))
    302       (multiple-value-setq (new win) (compiler-macroexpand-1 new env)))))
     313  (let ((expanded-p nil))
     314    (loop
     315      (multiple-value-bind (expansion exp-p) (compiler-macroexpand-1 form env)
     316        (if exp-p
     317            (setf form expansion expanded-p t)
     318            (return))))
     319    (values form expanded-p)))
    303320
    304321(defun precompile1 (form)
Note: See TracChangeset for help on using the changeset viewer.