Changeset 4040


Ignore:
Timestamp:
09/24/03 14:22:45 (19 years ago)
Author:
piso
Message:

ANSI-LOOP, LOOP

File:
1 edited

Legend:

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

    r3540 r4040  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: macros.lisp,v 1.21 2003-08-28 00:23:05 piso Exp $
     4;;; $Id: macros.lisp,v 1.22 2003-09-24 14:22:45 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    8787  (let* ((inits ())
    8888   (steps ())
    89    (l1 (gensym))
    90    (l2 (gensym)))
     89   (L1 (gensym))
     90   (L2 (gensym)))
    9191    ;; Check for illegal old-style do.
    9292    (when (or (not (listp varlist)) (atom endlist))
     
    106106      (t (error "~S is an illegal form for a ~S varlist." v name))))
    107107    ;; And finally construct the new form.
    108     `(block ,BLOCK
     108    `(block ,block
    109109            (,bind ,(nreverse inits)
    110110                   (tagbody
     
    115115                    ,L2
    116116                    (unless ,(car endlist) (go ,L1))
    117                     (return-from ,BLOCK (progn ,@(cdr endlist))))))))
     117                    (return-from ,block (progn ,@(cdr endlist))))))))
    118118
    119119
     
    125125  (do-do-body varlist endlist body 'let* 'setq 'do* nil))
    126126
     127(defun ansi-loop (exps)
     128  (require 'loop)
     129  (fmakunbound 'ansi-loop)
     130  `(loop ,@exps))
     131
    127132(defmacro loop (&rest exps)
    128   (if (and exps (symbolp (car exps)))
    129       (error "LOOP keywords are not supported")
    130       (let ((tag (gensym)))
    131   `(block nil (tagbody ,tag ,@exps (go ,tag))))))
     133  (dolist (exp exps)
     134    (when (atom exp)
     135      (return-from loop (ansi-loop exps))))
     136  (let ((tag (gensym)))
     137    `(block nil (tagbody ,tag ,@exps (go ,tag)))))
Note: See TracChangeset for help on using the changeset viewer.