Changeset 4664


Ignore:
Timestamp:
11/07/03 18:12:01 (18 years ago)
Author:
piso
Message:

TRANSFORM1: cleanup.

File:
1 edited

Legend:

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

    r4644 r4664  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: transform.lisp,v 1.4 2003-11-04 19:13:51 piso Exp $
     4;;; $Id: transform.lisp,v 1.5 2003-11-07 18:12:01 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6363  (when (atom form)
    6464    (return-from transform1 form))
    65   (when (symbolp (car form))
    66     (let ((expander (compiler-macro-function (car form))))
    67       (when expander
    68         (return-from transform1 (funcall expander form nil)))))
    69   (let ((fun (car form))
     65  (let ((op (car form))
    7066        (args (cdr form)))
    71     (when (and (symbolp fun)
    72                (not (eq fun 'LAMBDA))
    73                (macro-function fun))
     67    (when (symbolp op)
     68      (let ((expander (compiler-macro-function op)))
     69        (when expander
     70          (return-from transform1 (funcall expander form nil)))))
     71    (when (and (symbolp op)
     72               (not (eq op 'LAMBDA))
     73               (macro-function op))
    7474      (setq form (macroexpand form))
    7575      (return-from transform1 (transform1 form)))
    76     (cond ((eq fun 'COND)
    77            (assert false)
    78            (transform-cond args))
    79           ((eq fun 'AND)
    80            (assert false)
    81            (transform-and args))
    82           ((eq fun 'OR)
    83            (error "transform-or called")
    84            (transform-or args))
    85           ((eq fun 'NOT)
    86            (if (consp args)
    87                (if (eq (first args) 'NOT)
    88                    (transform (second args))
    89                    (list 'NOT (transform (car args))))
    90                (list 'NOT (transform (car args)))))
    91           ((eq fun 'TAGBODY)
     76    (cond ((eq op 'TAGBODY)
    9277           (append (list 'TAGBODY) (mapcar #'transform1 args)))
    93           ((eq fun 'PROGN)
     78          ((eq op 'PROGN)
    9479           (append (list 'PROGN) (mapcar #'transform1 args)))
    95           ((eq fun 'RETURN-FROM)
     80          ((eq op 'RETURN-FROM)
    9681           (append (list 'RETURN-FROM) (list (car args))
    9782                   (list (transform1 (cadr args)))))
    98           ((eq fun 'IF)
     83          ((eq op 'IF)
    9984           (cond ((= (length args) 2)
    10085                  (list 'IF
     
    10893                 (t
    10994                  (error "wrong number of arguments for IF"))))
    110           ((eq fun 'LET)
     95          ((eq op 'LET)
    11196           (append (list 'LET (car args)) (mapcar #'transform1 (cdr args))))
    112           ((eq fun 'LET*)
     97          ((eq op 'LET*)
    11398           (append (list 'LET* (car args)) (mapcar #'transform1 (cdr args))))
    114           ((eq fun 'LAMBDA)
     99          ((eq op 'LAMBDA)
    115100           (transform-lambda args))
    116           ((eq fun 'BLOCK)
     101          ((eq op 'BLOCK)
    117102           (append (list 'BLOCK (car args)) (mapcar #'transform1 (cdr args))))
    118           ((eq fun 'SETQ)
     103          ((eq op 'SETQ)
    119104           (when (= 2 (length args))
    120105               (return-from transform1 (list 'SETQ (first args) (transform1 (second args)))))
     
    130115             (push 'PROGN result)
    131116             result))
    132           ((eq fun 'QUOTE)
     117          ((eq op 'QUOTE)
    133118           form)
    134           ((eq fun 'FUNCTION)
     119          ((eq op 'FUNCTION)
    135120           form)
    136           ((and (symbolp fun) (fboundp fun))
    137            (cons fun (mapcar #'transform1 args)))
     121          ((and (symbolp op) (fboundp op))
     122           (cons op (mapcar #'transform1 args)))
    138123          (t
    139124           form))))
Note: See TracChangeset for help on using the changeset viewer.