#| -*- Mode:LISP; Package:(psl global); Fonts:(cptfontb); Base:10 -*-
|#

(DEFMACRO UNTIL (PRED &REST BODY)
"(UNTIL pred { form1 form2 ... } ) => (DO (pred) (PROGN form1 form2 ...))
  UNTIL loops repeatedly, evaluating the predicate 'pred' -- if the result is NIL,
  the body 'forms' are executed, and then back to the test, and so on.
  Normally the value returned is the last 'form' in the body.

  Because UNTIL is expanded into an equivalent DO form, (RETURN values...) 
  may be used to force an exit and return values from the loop."
  `(DO ($UNTIL$) (,PRED $UNTIL$) 
    (SETQ $UNTIL$
          (PROGN . ,BODY))))

(DEFMACRO WHILE (PRED &REST BODY)
"(WHILE pred { form1 form2 ... } ) => (DO ((NOT pred)) (PROGN form1 form2 ...))
  WHILE loops repeatedly, evaluating the predicate 'pred' -- if the result is non-NIL,
  the body 'forms' are executed, and then back to the predicate, and so on.
  Normally the value returned is the last 'form' in the body.

  Because WHILE is expanded into an equivalent DO form, (RETURN values...) 
  may be used to force an exit and return values from the loop."
  `(DO ($WHILE$) ((NOT ,PRED) $WHILE$) 
    (SETQ $WHILE$
          (PROGN . ,BODY))))

(DEFMACRO DOFROM ((VAR LOWER UPPER RESULTFORM) &BODY BODY)

  "Iterate BODY with VAR bound to successive integers from LOWER's to UPPER's value, inclusive.
(This is a Pascal-style FOR loop, based heavily on the standard macro DOTIMES.)
LOWER and UPPER are evaluated only once.  When it is reached, RESULTFORM is executed and returned.
RETURN and GO can be used inside the BODY."

  (IF (FIXNUMP UPPER)
      `(DO ((,VAR ,LOWER (1+ ,VAR)))
	   ((> ,VAR ,UPPER) ,RESULTFORM)
	 . ,BODY)
    (LET ((ITERATION-VAR (GENSYM)))
      `(DO ((,VAR ,LOWER (1+ ,VAR))
	    (,ITERATION-VAR ,UPPER))
	   ((> ,VAR ,ITERATION-VAR) ,RESULTFORM)
	 . ,BODY))))

(DEFUN PUSH-IP (A L)
"(PUSHIP a l)
Destructively pushes 'a' onto 'l' which really should be a list."
  (LET ((COPY (COPY-LIST (CONS A L))))
    (RPLACA L (CAR COPY))
    (RPLACD L (CDR COPY))))