Changeset 4664 for trunk/j/src/org/armedbear/lisp/transform.lisp
 Timestamp:
 11/07/03 18:12:01 (19 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/j/src/org/armedbear/lisp/transform.lisp
r4644 r4664 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: transform.lisp,v 1. 4 20031104 19:13:51 piso Exp $4 ;;; $Id: transform.lisp,v 1.5 20031107 18:12:01 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 63 63 (when (atom form) 64 64 (returnfrom transform1 form)) 65 (when (symbolp (car form)) 66 (let ((expander (compilermacrofunction (car form)))) 67 (when expander 68 (returnfrom transform1 (funcall expander form nil))))) 69 (let ((fun (car form)) 65 (let ((op (car form)) 70 66 (args (cdr form))) 71 (when (and (symbolp fun) 72 (not (eq fun 'LAMBDA)) 73 (macrofunction fun)) 67 (when (symbolp op) 68 (let ((expander (compilermacrofunction op))) 69 (when expander 70 (returnfrom transform1 (funcall expander form nil))))) 71 (when (and (symbolp op) 72 (not (eq op 'LAMBDA)) 73 (macrofunction op)) 74 74 (setq form (macroexpand form)) 75 75 (returnfrom transform1 (transform1 form))) 76 (cond ((eq fun 'COND) 77 (assert false) 78 (transformcond args)) 79 ((eq fun 'AND) 80 (assert false) 81 (transformand args)) 82 ((eq fun 'OR) 83 (error "transformor called") 84 (transformor 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) 92 77 (append (list 'TAGBODY) (mapcar #'transform1 args))) 93 ((eq fun'PROGN)78 ((eq op 'PROGN) 94 79 (append (list 'PROGN) (mapcar #'transform1 args))) 95 ((eq fun'RETURNFROM)80 ((eq op 'RETURNFROM) 96 81 (append (list 'RETURNFROM) (list (car args)) 97 82 (list (transform1 (cadr args))))) 98 ((eq fun'IF)83 ((eq op 'IF) 99 84 (cond ((= (length args) 2) 100 85 (list 'IF … … 108 93 (t 109 94 (error "wrong number of arguments for IF")))) 110 ((eq fun'LET)95 ((eq op 'LET) 111 96 (append (list 'LET (car args)) (mapcar #'transform1 (cdr args)))) 112 ((eq fun'LET*)97 ((eq op 'LET*) 113 98 (append (list 'LET* (car args)) (mapcar #'transform1 (cdr args)))) 114 ((eq fun'LAMBDA)99 ((eq op 'LAMBDA) 115 100 (transformlambda args)) 116 ((eq fun'BLOCK)101 ((eq op 'BLOCK) 117 102 (append (list 'BLOCK (car args)) (mapcar #'transform1 (cdr args)))) 118 ((eq fun'SETQ)103 ((eq op 'SETQ) 119 104 (when (= 2 (length args)) 120 105 (returnfrom transform1 (list 'SETQ (first args) (transform1 (second args))))) … … 130 115 (push 'PROGN result) 131 116 result)) 132 ((eq fun'QUOTE)117 ((eq op 'QUOTE) 133 118 form) 134 ((eq fun'FUNCTION)119 ((eq op 'FUNCTION) 135 120 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))) 138 123 (t 139 124 form))))
Note: See TracChangeset
for help on using the changeset viewer.