;-*- Mode:LISP; Package:ITERATIVESTATEMENTPACKAGE; Base:10; Readtable:INTERLISP -*-

(SPECIAL LocalDeclare Name Variables Initialization I.V.Set Tests LoopBody 
	 ExitTests Generate Go$$LP Exit Return$$VAL
	 IterativeVariable StatementStack ValueConstructionVariable
	 LastInEffects LastToEffects LastByEffects LastFromEffects
	 DummyVariables DummyVariableNumber PrincipalIterativeVariable
	 PrincipalIterativeSymbolUsed? SpecialSubstitutions OldIterativeVariables)

(DEFCONST DefaultIterativeVariable 'InterlispUsers:X)

(DEFCONST IterativeArgumentSymbol 'BODY)

(DEFCONST IterativeDummyVariables
	  (LIST (GENSYM) (GENSYM) (GENSYM) (GENSYM) (GENSYM) (GENSYM) (GENSYM)))

(DEFCONST IterativeStatementInstantiators '((Variables . LIST)
					    (Initialization . SimplifyForms)
					    (I.V.Set . SimplifyForms)
					    (Tests . SimplifyForms)
					    (LoopBody . SimplifyForms)
					    (ExitTests . SimplifyForms)
					    (Generate . SimplifyForms)
					    (Exit . SimplifyForms)
					    (LocalDeclare . ExpandLocalDeclare)
					    (Go$$LP . ExpandGo$$LP)
					    (Return$$VAL . ExpandReturn$$VAL)))

(DEFCONST IterativeStatementQueues '(LocalDeclare Name Variables Initialization
						  I.V.Set Tests LoopBody ExitTests
						  Generate Go$$LP Exit Return$$VAL))

(DEFCONST IterativeStatementTemplate '(LocalDeclare (PROG Name Variables Initialization
						       $$LP I.V.Set Tests LoopBody
						       $$ITERATE ExitTests Generate Go$$LP
						       $$OUT Exit Return$$VAL)))

(DEFCONST IterativeVariableSymbol 'I.V.)

(DEFCONST PrincipalIterativeSymbol 'P.I.V.)

(DEFMACRO CurrentIterativeVariable NIL
  '(OR IterativeVariable (SETQ PrincipalIterativeSymbolUsed? PrincipalIterativeSymbol)))

(DEFMACRO PrincipalIterativeVariable NIL
  '(OR PrincipalIterativeVariable
       (SETQ PrincipalIterativeSymbolUsed? PrincipalIterativeSymbol)))

(MACRO as (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO bind (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO by (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO *declare (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO eachtime (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO finally (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO first (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO for (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO from (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO in (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO loopname (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO on (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO repeateachtime (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO repeatuntil (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO repeatwhile (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO to (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO unless (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO until (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO when (Form) (DISPLACE Form (TranslateIterativeStatement Form)))
(MACRO while (Form) (DISPLACE Form (TranslateIterativeStatement Form)))

(DEFUN GETDUMMYVAR (&OPTIONAL BindIt?)
  (LET ((Variable (OR (POP DummyVariables) (GENSYM))))
    (AND BindIt? (BindIterativeVariable Variable))
    Variable))

(DEFUN AllClausesSwitch? (Clauses UnconditionalEntryLabels)
  (LET ((LastClause (CAR (LAST Clauses))))
    (AND (MEMQ (CAR LastClause) UnconditionalEntryLabels)
	 (CDR LastClause)
	 (ControlSwitchStatement? (CAR (LAST LastClause)))
	 (GLOBAL:DO ((ClauseTail Clauses (CDR ClauseTail)))
		    ((NULL (CDR ClauseTail))
		     T)
	   (OR (AND (CDAR ClauseTail) (ControlSwitchStatement? (CAR (LAST (CAR ClauseTail)))))
	       (RETURN))))))

(DEFUN Assignment? (Form)
  (AND (LISTP Form)
       (COND
	 ((SELECTQ (CAR Form) (SETQ T) (SETF T))
	  (RPLACA Form (CADR Form))
	  (RPLACA (CDR Form) '_)
	  Form)
	 ((EQ (CADR Form) '_)
	  Form))))

(DEFUN BindIterativeVariable (Variable &OPTIONAL InitializedValue AllowReinitialization?)
  (OR (SYMBOLP Variable)
      (FERROR NIL "Attempt to bind ~S as a variable in iterative statement:~%~S"
	      Variable (OriginalIterativeStatement)))
  (COND ((MEMQ Variable OldIterativeVariables)
	 (OR AllowReinitialization?
	     (GLOBAL:DO ((InitializationTail Initialization (CDR InitializationTail))
			 (TargetVariables (COND ((EQ Variable PrincipalIterativeVariable)
						 (LIST PrincipalIterativeSymbol Variable))
						(T (LIST Variable)))))
			((NULL InitializationTail))
	       (COND ((AND (MEMQ (CAR InitializationTail) '(SETQ SETF))
			   (MEMQ (CADR InitializationTail) TargetVariables))
		      (AND InitializedValue
			   (COND (AllowReinitialization?
				  (RPLACA (CDDAR InitializationTail) InitializedValue))
				 (T (OR (EQUAL InitializedValue (CADDAR InitializationTail))
					(FERROR NIL
				   "Attempt to initialize ~S twice in iterative statement.~%~
                                    Value 1:  ~S~%~
                                    Value 2:  ~S~%~
                                    Iterative Statement:  ~S~%"
						Variable
						(CADDAR InitializationTail)
						InitializedValue
						(OriginalIterativeStatement))))))))))
	 (GLOBAL:PUSH `(SETQ ,Variable ,InitializedValue) Initialization))
	(T (GLOBAL:DO ((VariableTail Variables (CDR VariableTail))
		       (TargetVariables (COND ((EQ Variable PrincipalIterativeVariable)
					       (LIST PrincipalIterativeSymbol Variable))
					      (T (LIST Variable)))))
		      ((NULL VariableTail)
		       (GLOBAL:PUSH (COND (InitializedValue (LIST Variable InitializedValue))
				   (T Variable))
			     Variables))
	     (COND
	       ((MEMQ (CAR VariableTail) TargetVariables)
		(AND InitializedValue (RPLACA VariableTail (LIST Variable InitializedValue)))
		(RETURN))
	       ((AND (LISTP (CAR VariableTail))
		     (MEMQ (CAAR VariableTail) TargetVariables))
		(AND InitializedValue
		     (COND (AllowReinitialization?
			    (RPLACA (CDAR VariableTail) InitializedValue))
			   (T (OR (EQUAL InitializedValue (CADAR VariableTail))
				  (FERROR NIL
				  "Attempt to initialize ~S twice in iterative statement.~%~
                                   Value 1:  ~S~%~
                                   Value 2:  ~S~%~
                                   Iterative Statement:  ~S~%"
					  Variable
					  (CADAR VariableTail)
					  InitializedValue
					  (OriginalIterativeStatement))))))
		(RETURN)))))))

(DEFUN ControlSwitchStatement? (Form)
  (AND (LISTP Form)
       (SELECTQ (CAR Form)
	 ((GO RETURN RETURN-FROM MULTIPLE-VALUE-RETURN *THROW) T)
	 (PROGN (ControlSwitchStatement? (CAR (LAST Form))))
	 (COND (AllClausesSwitch? (CDR Form) '(T)))
	 (IF (AND (CDDDR Form)
		  (ControlSwitchStatement? (CADDR Form))
		  (ControlSwitchStatement? (CADDDR Form))))
	 ((SELECT SELECTQ) (AllClausesSwitch? (CDDR Form) '(T OTHERWISE)))
	 (OTHERWISE NIL))))

(DEFUN ExpandGo$$LP (Queue) Queue (NCONS (LIST 'GO '$$LP)))

(SPECIAL ARGUMENTS)

(DEFUN ExpandIterativeMacro (Tail)
  (LET ((Definition (GET (CAR Tail) 'IterativeMacro)) Evaluate? Form Others Substitutions
	ARGUMENTS)
    (SETQ Evaluate? (CAR Definition))
    (SETQ Form (CADR Definition))
    (SETQ Others (CDDR Definition))
    (SETQ Substitutions
	  (LIST (CONS IterativeArgumentSymbol
		      (COND
			(Form (GLOBAL:DO ((ArgumentTail (CDR Tail) (CDR ArgumentTail))
					  Result)
					 ((IterativeOperatorTail? ArgumentTail)
					  (SETQ Tail ArgumentTail)
					  Result)
				(AND Result (GLOBAL:PUSH Result LoopBody))
				(SETQ Result (CAR ArgumentTail))))
			(T (GLOBAL:DO ((ArgumentTail (CDR Tail) (CDR ArgumentTail)))
				      ((IterativeOperatorTail? ArgumentTail)
				       (SETQ Tail ArgumentTail)
				       (COND ((CDR ARGUMENTS)
					      (CONS 'PROGN (SETQ ARGUMENTS
								 (NREVERSE ARGUMENTS))))
					     (T (CAR ARGUMENTS))))
			     (GLOBAL:PUSH (CAR ArgumentTail) ARGUMENTS)))))
		(CONS '$$VAL (PROG1 (OR ValueConstructionVariable '$$VAL)
				    (SETQ ValueConstructionVariable NIL)))))
    (COND (Evaluate? (AND Form (SETQ Form (EVAL Form)))
		     (AND Others (SETQ Others (EVAL Others)))))
    (COND ((OR (SymbolInListStructure? IterativeVariableSymbol Form)
	       (SymbolInListStructure? IterativeVariableSymbol Others))
	   (GLOBAL:PUSH (CONS IterativeVariableSymbol (COND (Form (PrincipalIterativeVariable))
						     (T (CurrentIterativeVariable))))
		 Substitutions)))
    (AND Form (GLOBAL:PUSH (SUBLIS Substitutions Form) LoopBody))
    (AND Others (SETQ Tail (APPEND (SUBLIS Substitutions Others) Tail)))
    Tail))

(DEFUN ExpandLocalDeclare (LocalDeclarations)
  (AND LocalDeclarations (LIST 'LOCAL-DECLARE LocalDeclarations)))

(DEFUN ExpandReturn$$VAL (Queue) Queue (NCONS (LIST 'RETURN '$$VAL)))

(DEFMACRO I.S.OPR (Name Form &OPTIONAL Others Evaluate? (AllowedAsFirstOperator? T))
  `(EVAL-WHEN (LOAD COMPILE EVAL)
	      (DefineI.S.OPR ,Name ,Form ,Others ,Evaluate? ,AllowedAsFirstOperator?)))

(EVAL-WHEN (LOAD COMPILE EVAL)
(DEFUN DefineI.S.OPR (&QUOTE Name Form &OPTIONAL Others Evaluate? (AllowedAsFirstOperator? T)
		      &AUX (Definition (LIST Form Others Evaluate? AllowedAsFirstOperator?)))
  (AND (GET Name 'IterativeOperator)
       (NOT (EQUAL Definition (GET Name 'IterativeMacroDefinition)))
       (FORMAT TERMINAL-IO "~%~S redefined as an I.S.OPR" Name))
  (PUTPROP Name Definition 'IterativeMacroDefinition)
  (COND ((AND Form (NLISTP Form) (NEQ Form IterativeArgumentSymbol))
	 (COND ((GET Form 'IterativeMacro)
		(PUTPROP Name 'ExpandIterativeMacro 'IterativeOperator)
		(PUTPROP Name (GET Form 'IterativeMacro) 'IterativeMacro))
	       ((GET Form 'IterativeOperator)
		(PUTPROP Name (GET Form 'IterativeOperator) 'IterativeOperator))
	       (T (FERROR NIL 
			  "Attempt to define ~S as an iterative synonym for nonexistant ~S!!"
			  Name Form)))
	 (PUTPROP Name Form 'IterativeSynonymOf))
	(T (PUTPROP Name 'ExpandIterativeMacro 'IterativeOperator)
	   (PUTPROP Name (LIST* Evaluate? Form Others) 'IterativeMacro)))
  (AND AllowedAsFirstOperator?
       (EVAL (SUBST Name 'Name
		    '(MACRO Name (Form) (DISPLACE Form (TranslateIterativeStatement Form))))))
  Name))

(DEFUN InitializeIterativeTranslation (Statement)
  (BindIterativeVariable '$$VAL)
  Statement)

(SPECIAL Queues Instantiators)
(DEFUN InstantiateTemplate (Template Queues Instantiators)
  (CAR (InstantiateTemplate1 Template)))

(SPECIAL Queues Instantiators)
(DEFUN InstantiateTemplate1 (Template)
  (COND ((LISTP Template)
	 (NCONS (GLOBAL:DO ((Tail Template (CDR Tail))
			    Result)
			   ((NULL Tail)
			    Result)
		  (SETQ Result (NCONC Result (InstantiateTemplate1 (CAR Tail)))))))
	((MEMQ Template Queues)
	 (LET ((Entry (ASSQ Template Instantiators)))
	   (COND (Entry (FUNCALL (CDR Entry) (SYMEVAL Template)))
		 (T (SYMEVAL Template)))))
	(T (NCONS Template))))

(DEFUN (:PROPERTY as IterativeOperator) (Tail)
  (POP Tail)
  (COND ((EQ (CAR Tail) 'old)
	 (POP Tail)
	 (COND
	   ((LISTP (CAR Tail))
	    (OR (Assignment? (CAR Tail))
		(FERROR NIL "Funny argument to as:  ~S~%Statement:  ~S"
			(CAR Tail) (OriginalIterativeStatement)))
	    (NewIterativeVariable (CAAR Tail) T (LIST 'SETQ (CAAR Tail) (CADDR (POP Tail)))))
	   (T (NewIterativeVariable (POP Tail) T))))
	((LISTP (CAR Tail))
	 (COND ((Assignment? (CAR Tail))
		(NewIterativeVariable (CAAR Tail) NIL (CADDR (POP Tail))))
	       (T (NewIterativeVariable (CAAR Tail))
		  (GLOBAL:DO ((VariableTail (CDR (POP Tail)) (CDR VariableTail)))
			     ((NULL VariableTail))
		    (BindIterativeVariable (CAR VariableTail))))))
	(T (NewIterativeVariable (POP Tail))))
  Tail)

(DEFUN (:PROPERTY bind IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((ArgumentTail Tail (CDR ArgumentTail)))
       ((IterativeOperatorTail? ArgumentTail) (SETQ Tail ArgumentTail))
       (COND
	 ((LISTP (CAR ArgumentTail))
	  (COND
	    ((Assignment? (CAR ArgumentTail))
	     (BindIterativeVariable (CAAR ArgumentTail) (CADDAR ArgumentTail)))
	    (T (GLOBAL:DO ((VariableTail (CAR ArgumentTail) (CDR VariableTail)))
		    ((NULL VariableTail))
		    (COND
		      ((LISTP (CAR VariableTail))
		       (OR (Assignment? (CAR VariableTail))
			   (FERROR NIL "Funny argument to bind:  ~S~%Iterative Statement:  ~S"
				   (CAR ArgumentTail) (OriginalIterativeStatement)))
		       (BindIterativeVariable (CAAR VariableTail) (CADDAR VariableTail)))
		      (T (BindIterativeVariable (CAR VariableTail))))))))
	 (T (BindIterativeVariable (CAR ArgumentTail))))))

(DEFUN (:PROPERTY by IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((Statements StatementStack (CDR Statements)))
	     ((NULL Statements)
	      (LET
		((Argument (POP Tail)) (I.V. (CurrentIterativeVariable))
		 ArgumentVariable GenerationForm PreGenerationForm)
		(COND
		  ((NOT (NUMBERP Argument))
		   (COND
		     ((SYMBOLP Argument)
		      (SETQ ArgumentVariable Argument))
		     (T (SETQ ArgumentVariable (GETDUMMYVAR T))
			(SETQ PreGenerationForm (LIST 'SETQ ArgumentVariable Argument))))))
		(SETQ GenerationForm (LIST 'SETQ I.V. (LIST 'PLUS I.V.
							    (OR ArgumentVariable Argument))))
		(COND
		  ((AND LastToEffects (SameIterativeVariables? (CAR LastToEffects) I.V.))
		   (COND
		     (ArgumentVariable
		      (RPLACA (CADR LastToEffects) 'OR)
		      (RPLACD (CADR LastToEffects)
			      (LIST (LIST 'ZEROP ArgumentVariable)
				    (SUBLIS (PAIRLIS '(I.V. Increment LastValue)
						     (LIST I.V. ArgumentVariable
							   (CADDR (CADR LastToEffects))))
					    '(COND ((MINUSP Increment) (LESSP I.V. LastValue))
						   (T (GREATERP I.V. LastValue)))))))
		     ((MINUSP Argument) (RPLACA (CADR LastToEffects) 'LESSP)))
		   (LET ((TailToChange (COND ((AND LastFromEffects
						   (EQ (CAR LastFromEffects) I.V.))
					      (CADR LastFromEffects))
					     (T (CADDR LastToEffects)))))
		     (RPLACA TailToChange GenerationForm)
		     (AND PreGenerationForm
			  (RPLACD TailToChange (CONS PreGenerationForm (CDR TailToChange))))))
		  (T (COND
		       ((AND LastFromEffects (EQ (CAR LastFromEffects) I.V.))
			(RPLACA (CADR LastFromEffects) GenerationForm)
			(AND PreGenerationForm
			     (RPLACD (CADR LastFromEffects) (CONS PreGenerationForm
								  (CDADR LastFromEffects)))))
		       (PreGenerationForm (GLOBAL:PUSH PreGenerationForm Generate)))
		     (SETQ LastByEffects
			   (LIST I.V.
				 (COND (PreGenerationForm (LIST ArgumentVariable Generate))
				       (ArgumentVariable)
				       (T Argument))))))))
    (SELECTQ
      (CAAR Statements)
      ((for as)
       (COND
	 ((Assignment? (CADAR Statements))
	  (GLOBAL:PUSH (LIST 'SETQ (CurrentIterativeVariable) (POP Tail))
		Generate)
	  (RETURN))
	 (T (SETQ Statements NIL))))
      ((in on)
       (COND
	 ((AND LastInEffects
	       (SameIterativeVariables? (CAR LastInEffects) (CurrentIterativeVariable)))
	  (SubstituteCurrentIterativeVariable (CADR LastInEffects) Tail)
	  (RPLACA (CADDR LastInEffects)
		  (LIST 'SETQ
			(CADR LastInEffects)
			(SUBLIS (PAIRLIS (LIST (CurrentIterativeVariable) (CADAR Statements))
					 (LIST (CADR LastInEffects) (CADR LastInEffects)))
				(POP Tail))))
	  (RETURN))
	 (T (SETQ Statements NIL))))
      (OTHERWISE NIL)))
  Tail)

(DEFUN (:PROPERTY *declare IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((ArgumentTail Tail (CDR ArgumentTail)))
	     ((IterativeOperatorTail? ArgumentTail)
	      ArgumentTail)
    (GLOBAL:PUSH (CAR ArgumentTail) LocalDeclare)))

(DEFUN (:PROPERTY eachtime IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((ArgumentTail Tail (CDR ArgumentTail)))
	     ((IterativeOperatorTail? ArgumentTail)
	      ArgumentTail)
    (GLOBAL:PUSH (CAR ArgumentTail) Tests)))

(DEFUN (:PROPERTY finally IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((ArgumentTail Tail (CDR ArgumentTail)))
	     ((IterativeOperatorTail? ArgumentTail)
	      ArgumentTail)
    (GLOBAL:PUSH (CAR ArgumentTail) Exit)))

(DEFUN (:PROPERTY first IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((ArgumentTail Tail (CDR ArgumentTail)))
	     ((IterativeOperatorTail? ArgumentTail)
	      ArgumentTail)
    (GLOBAL:PUSH (CAR ArgumentTail) Initialization)))

(DEFUN (:PROPERTY for IterativeOperator) (Tail)
  (POP Tail)
  (COND ((EQ (CAR Tail) 'old)
	 (POP Tail)
	 (COND ((LISTP (CAR Tail))
		(OR (Assignment? (CAR Tail))
		    (FERROR NIL "Funny argument to for:  ~S~%Statement:  ~S"
			    (CAR Tail) (OriginalIterativeStatement)))
		(NewIterativeVariable (CAAR Tail) T (CADDR (POP Tail)) T))
	       (T (NewIterativeVariable (POP Tail) T NIL T))))
	((LISTP (CAR Tail))
	 (COND ((Assignment? (CAR Tail))
		(NewIterativeVariable (CAAR Tail) NIL (CADDR (POP Tail)) T))
	       (T (NewIterativeVariable (CAAR Tail) NIL NIL T)
		  (GLOBAL:DO ((VariableTail (CDR (POP Tail)) (CDR VariableTail)))
			     ((NULL VariableTail))
		    (BindIterativeVariable (CAR VariableTail))))))
	(T (NewIterativeVariable (POP Tail) NIL NIL T)))
  Tail)

(DEFUN (:PROPERTY from IterativeOperator) (Tail)
  (POP Tail)
  (LET ((I.V. (CurrentIterativeVariable)))
    (BindIterativeVariable I.V. (POP Tail) T)
    (OR (AND LastToEffects (SameIterativeVariables? (CAR LastToEffects) I.V.))
	(PROGN (GLOBAL:PUSH
		 (LIST 'SETQ I.V. (COND
				    ((AND LastByEffects
					  (SameIterativeVariables? (CAR LastByEffects) I.V.))
				     (LIST 'PLUS I.V. (COND ((LISTP (CADR LastByEffects))
							     (CAADR LastByEffects))
							    (T (CADR LastByEffects)))))
				    (T (LIST 'ADD1 I.V.))))
		 Generate)
	       (SETQ LastFromEffects (LIST I.V. Generate)))))
  Tail)

(DEFUN (:PROPERTY in IterativeOperator) (Tail)
  (LET (TailVariable Argument)
    (POP Tail)
    (COND ((EQ (CAR Tail) 'old)
	   (POP Tail)
	   (SETQ TailVariable (POP Tail))
	   (COND ((LISTP TailVariable)
		  (OR (Assignment? TailVariable)
		      (FERROR NIL "Funny argument to in old:  ~S~%Statement:  ~S"
			      TailVariable (OriginalIterativeStatement)))
		  (GLOBAL:PUSH (LIST 'SETQ (CAR TailVariable) (CADDR TailVariable))
			Initialization)
		  (SETQ Argument (SETQ TailVariable (CAR TailVariable))))
		 (T (SETQ Argument TailVariable))))
	  (T (SETQ TailVariable (GETDUMMYVAR))
	     (BindIterativeVariable TailVariable (SETQ Argument (POP Tail)))))
    (GLOBAL:PUSH (SUBLIS (PAIRLIS '(I.V. TailVariable)
			   (LIST (CurrentIterativeVariable) TailVariable))
		  '(SETQ I.V. (COND (TailVariable (CAR TailVariable))
				    (T (GO $$OUT)))))
	  I.V.Set)
    (COND
      ((AND LastByEffects
	    (SameIterativeVariables? (CAR LastByEffects) (CurrentIterativeVariable)))
       (OR (LISTP (CADR LastByEffects))
	   (FERROR NIL
		   "by argument in conjunction with in seems strange~%IterativeStatement:  ~S"
		   (OriginalIterativeStatement)))
       (RPLACA (CADADR LastByEffects)
	       (LIST 'SETQ TailVariable
		     (SUBLIS (PAIRLIS (LIST (CurrentIterativeVariable) Argument)
				      (LIST TailVariable TailVariable))
			     (CAR (CADADR LastByEffects)))))
       (SubstituteCurrentIterativeVariable TailVariable (CADADR LastByEffects)))
      (T (GLOBAL:PUSH (SUBST TailVariable 'TailVariable '(SETQ TailVariable (CDR TailVariable)))
	       Generate)
	 (SETQ LastInEffects (LIST (CurrentIterativeVariable) TailVariable Generate))))
    Tail))

(DEFUN (:PROPERTY into IterativeOperator) (Tail)
  (POP Tail)
  (COND ((EQ 'old (CAR Tail))
	 (POP Tail)
	 (GLOBAL:PUSH `(SETQ ,(CAR Tail) NIL) Initialization))
	(T (BindIterativeVariable (CAR Tail))))
  (SETQ ValueConstructionVariable (POP tail))
  Tail)

(DEFUN (:PROPERTY loopname IterativeOperator) (Tail)
  (POP Tail)
  (AND Name
       (FERROR NIL "Iterative statement given two names: ~S and ~S !!~%Statement:  ~S"
	       Name (CAR Tail) (OriginalIterativeStatement)))
  (SETQ Name (NCONS (POP Tail)))
  Tail)

(DEFUN (:PROPERTY on IterativeOperator) (Tail)
  (LET (TailVariable)
    (POP Tail)
    (COND ((EQ (CAR Tail) 'old)
	   (POP Tail)
	   (SETQ TailVariable (POP Tail))
	   (COND ((LISTP TailVariable)
		  (OR (Assignment? TailVariable)
		      (FERROR NIL "Funny argument to on old:  ~S~%Statement:  ~S"
			      TailVariable (OriginalIterativeStatement)))
		  (GLOBAL:PUSH (LIST 'SETQ (CAR TailVariable) (CADDR TailVariable))
			Initialization)
		  (SETQ TailVariable (CAR TailVariable))))
	   (GLOBAL:PUSH (SUBLIS (PAIRLIS '(I.V. TailVariable) (LIST (CurrentIterativeVariable)
							     TailVariable))
			 '(SETQ I.V. (OR TailVariable (GO $$OUT))))
		 I.V.Set))
	  (T (SETQ TailVariable (CurrentIterativeVariable))
	     (BindIterativeVariable TailVariable (POP Tail))
	     (GLOBAL:PUSH (LIST 'OR TailVariable '(GO $$OUT))
		   I.V.Set)))
    (COND
      ((AND LastByEffects
	    (SameIterativeVariables? (CurrentIterativeVariable) (CAR LastByEffects)))
       (OR (LISTP (CADR LastByEffects))
	   (FERROR NIL "by argument in conjunction with on seems strange!~%Statement:  ~S"
		   (OriginalIterativeStatement)))
       (GLOBAL:PUSH (LIST 'SETQ (CurrentIterativeVariable) (CAADR LastByEffects))
	     Generate))
      (T (GLOBAL:PUSH (SUBST TailVariable 'TailVariable
		      '(SETQ TailVariable (CDR TailVariable)))
	       Generate)
	 (SETQ LastInEffects (LIST (CurrentIterativeVariable) TailVariable Generate))))
    Tail))

(DEFUN IterativeOperatorTail? (Tail)
  (OR (NULL Tail) (AND (SYMBOLP (CAR Tail))
		       (GET (CAR Tail) 'IterativeOperator))))

(DEFUN (:PROPERTY repeateachtime IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:DO ((ArgumentTail Tail (CDR ArgumentTail)))
	     ((IterativeOperatorTail? ArgumentTail)
	      ArgumentTail)
    (GLOBAL:PUSH (CAR ArgumentTail) ExitTests)))

(DEFUN (:PROPERTY repeatuntil IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:PUSH (LIST 'AND (COND ((NUMBERP (CAR Tail))
			  (LIST 'GREATERP (CurrentIterativeVariable) (POP Tail)))
			 (T (POP Tail)))
	      '(GO $$OUT))
	ExitTests)
  Tail)

(DEFUN (:PROPERTY repeatwhile IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:PUSH (LIST 'OR (POP Tail) '(GO $$OUT))
	ExitTests)
  Tail)

(DEFUN (:PROPERTY to IterativeOperator) (Tail)
  (POP Tail)
  (LET (Test Increment (LastValue (GETDUMMYVAR)) (I.V. (CurrentIterativeVariable)))
    (BindIterativeVariable LastValue (POP Tail))
    (OR LastFromEffects (BindIterativeVariable I.V. 1))
    (COND ((AND LastByEffects (SameIterativeVariables? (CAR LastByEffects) I.V.))
	   (SETQ Test
		 (COND ((NUMBERP (CADR LastByEffects))
			(SETQ Increment (CADR LastByEffects))
			(COND ((PLUSP (CADR LastByEffects))
			       (LIST 'GREATERP I.V. LastValue))
			      (T (LIST 'LESSP I.V. LastValue))))
		       (T (SUBLIS (PAIRLIS '(I.V. Increment LastValue)
					   (LIST I.V.
						 (SETQ Increment
						       (COND ((NLISTP (CADR LastByEffects))
							      (CADR LastByEffects))
							     (T (CAADR LastByEffects))))
						 LastValue))
				  '(OR (ZEROP Increment)
				       (COND ((MINUSP Increment) (LESSP I.V. LastValue))
					     (T (GREATERP I.V. LastValue))))))))
	   (OR (AND LastFromEffects (SameIterativeVariables? I.V. (CAR LastFromEffects)))
	       (GLOBAL:PUSH (LIST 'SETQ I.V. (LIST 'PLUS I.V. Increment))
		     Generate))
	   (SETQ LastToEffects (LIST I.V.)))
	  (T (OR (AND LastFromEffects (SameIterativeVariables? (CAR LastFromEffects) I.V.))
		 (GLOBAL:PUSH (LIST 'SETQ I.V. (LIST 'ADD1 I.V.))
		       Generate))
	     (SETQ Test (LIST 'GREATERP I.V. LastValue))
	     (SETQ LastToEffects (LIST I.V. Test Generate))))
    (GLOBAL:PUSH (LIST 'AND Test '(GO $$OUT))
	  Tests))
  Tail)

(DEFUN (:PROPERTY unless IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:PUSH (LIST 'AND (POP Tail) '(GO $$ITERATE))
	Tests)
  Tail)

(DEFUN (:PROPERTY until IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:PUSH (LIST 'AND (COND ((NUMBERP (CAR Tail))
			  (LIST 'GREATERP (CurrentIterativeVariable) (POP Tail)))
			 (T (POP Tail)))
	      '(GO $$OUT))
	Tests)
  Tail)

(DEFUN (:PROPERTY when IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:PUSH (LIST 'OR (POP Tail) '(GO $$ITERATE))
	Tests)
  Tail)

(DEFUN (:PROPERTY while IterativeOperator) (Tail)
  (POP Tail)
  (GLOBAL:PUSH (LIST 'OR (POP Tail) '(GO $$OUT))
	Tests)
  Tail)

(DEFUN ListNonNil (Anything) (AND Anything (LIST Anything)))

(DEFUN NewIterativeVariable (Variable &OPTIONAL Old? InitializedValue Principal?)
  (AND Principal? (SETQ PrincipalIterativeVariable Variable))
  (SETQ IterativeVariable Variable)
  (COND (Old? (GLOBAL:PUSH Variable OldIterativeVariables)
	      (AND InitializedValue (GLOBAL:PUSH (LIST 'SETQ Variable InitializedValue)
					  Initialization)))
	(T (BindIterativeVariable Variable InitializedValue)))
  Variable)

(DEFUN OriginalIterativeStatement NIL (CAR (LAST StatementStack)))

(DEFUN SameIterativeVariables? (Variable1 Variable2)
  (COND ((EQ Variable1 Variable2))
	((EQ Variable1 PrincipalIterativeSymbol)
	 (EQ Variable2 PrincipalIterativeVariable))
	((EQ Variable2 PrincipalIterativeSymbol)
	 (EQ Variable1 PrincipalIterativeVariable))))

(DEFUN SimplifyForms (Forms)
  (GLOBAL:DO ((FormTail Forms (CDR FormTail)) Result LastResult ThisResult)
	     ((NULL FormTail) Result)
    (SETQ ThisResult (COND ((AND (LISTP (CAR FormTail)) (EQ (CAAR FormTail) 'PROGN))
			    (SimplifyForms (CDAR FormTail)))
			   (T (NCONS (CAR FormTail)))))
    (AND ThisResult (COND (LastResult (RPLACD (SETQ LastResult (LAST LastResult))
					      ThisResult))
			  (T (SETQ LastResult (SETQ Result ThisResult)))))))

(SPECIAL Forms ReferencedLabels)
(DEFUN SimplifyPROG (ProgForm &AUX Bindings Forms ReferencedLabels)
  (COND ((AND (CADR ProgForm) (SYMBOLP (CADR ProgForm)))
	 (SETQ Bindings (LOCF (CADDR ProgForm)) Forms (CDDDR ProgForm)))
	(T (SETQ Bindings (LOCF (CADR ProgForm)) Forms (CDDR ProgForm))))
  (SETQ ReferencedLabels (ArgumentsOf 'GO Forms))
  (SETQ Forms
	(DEL-IF #'(LAMBDA (Form) (AND (SYMBOLP Form) (NOT (MEMQ Form ReferencedLabels))))
		Forms))
  (GLOBAL:DO ((Tail Forms (CDR Tail)))
	     ((NULL (CDR Tail)))
    (AND (ControlSwitchStatement? (CAR Tail))
	 (GLOBAL:DO ((InnerTail Tail (CDR InnerTail)))
		    ((OR (NULL (CDR InnerTail)) (SYMBOLP (CADR InnerTail))))
	   (RPLACD InnerTail (CDDR InnerTail)))))
  (RPLACA Bindings
	  (DEL-IF #'(LAMBDA (Binding)
		      (AND (SYMBOLP Binding)
			   (OR (EQ Binding '$$VAL) (MEMQ Binding IterativeDummyVariables))
			   (NOT (SymbolInListStructure? Binding Forms))))
		  (CAR Bindings)))
  (RemoveUselessVariables Bindings Forms)
  ProgForm)

(DEFUN ArgumentsOf (Function Forms &OPTIONAL (Which 1))
  (GLOBAL:DO (Result (Tail Forms (CDR Tail)))
	     ((NULL Tail) Result)
    (COND ((LISTP (CAR Tail))
	   (AND (EQ Function (CAAR Tail))
		(GLOBAL:PUSH (NTH Which (CAR Tail)) Result))
	   (SETQ Result (NCONC (ArgumentsOf Function (CDAR Tail) Which)
			       Result))))))

(DEFUN RemoveUselessVariables (Bindings Forms)
  (VALUES Bindings Forms))

(DEFUN SubstituteCurrentIterativeVariable (Value Tail)
  (AND (EQ (CurrentIterativeVariable) PrincipalIterativeSymbol)
       (GLOBAL:PUSH (LIST (CONS PrincipalIterativeSymbol Value) (CAR Tail))
	     SpecialSubstitutions)))

(DEFUN SymbolInListStructure? (Symbol Structure)
  (COND ((NLISTP Structure) (EQ Symbol Structure))
	(T (GLOBAL:DO ((Tail Structure (CDR Tail)))
		      ((NLISTP Tail) (EQ Tail Symbol))
	     (AND (SymbolInListStructure? Symbol (CAR Tail))
		  (RETURN T))))))

(SPECIAL PrincipalIterativeVariable IterativeVariable DummyVariables DummyVariableNumber
	      LastFromEffects LastToEffects LastByEffects LastInEffects 
	      PrincipalIterativeSymbolUsed? SpecialSubstitutions)

(DEFUN TranslateIterativeStatement (Statement)
    (LET
      (PrincipalIterativeVariable IterativeVariable (DummyVariables IterativeDummyVariables)
       (DummyVariableNumber (ADD1 (LENGTH IterativeDummyVariables)))
       LastFromEffects LastToEffects LastByEffects LastInEffects ValueConstructionVariable
       PrincipalIterativeSymbolUsed? Form SpecialSubstitutions OldIterativeVariables)
      (SETQ Form (TranslateStatement Statement 'IterativeOperator IterativeStatementTemplate 
				     IterativeStatementQueues IterativeStatementInstantiators
				     (FUNCTION InitializeIterativeTranslation)))
      (AND (LISTP (CAR Form)) (SETQ Form (CAR Form)))
      (GLOBAL:DO ((Substitutions (NREVERSE SpecialSubstitutions) (CDR Substitutions)))
		 ((NULL Substitutions))
	(RPLACA (OR (MEMQ (CADAR Substitutions) Form)
		    (FERROR NIL "Bug in iterative statement package!~%~
                                 Doing post substiutions: ~S~%~S"
			    Substitutions Form))
		(SUBLIS (COND ((EQ (CAAAR Substitutions) PrincipalIterativeSymbol)
			       (LIST (CONS PrincipalIterativeVariable (CDAAR Substitutions))))
			      (T (LIST (CAAR Substitutions))))
			(CADAR Substitutions))))
      (COND (PrincipalIterativeSymbolUsed?
	     (COND ((NOT PrincipalIterativeVariable)
		    (SETQ PrincipalIterativeVariable DefaultIterativeVariable)
		    (LET ((Variables (COND ((SYMBOLP (CADR Form))
					    (CADDR Form))
					   (T (CADR Form)))))
		      (GLOBAL:DO ((Tail Variables (CDR Tail)))
				 ((NULL Tail)
				  (RPLACD Variables (CONS PrincipalIterativeVariable
							  (CDR Variables))))
			(AND (OR (EQ PrincipalIterativeSymbol (CAR Tail))
				 (AND (LISTP (CAR Tail))
				      (EQ PrincipalIterativeSymbol (CAAR Tail))))
			     (RETURN))))))
	     (SETQ Form (SUBST PrincipalIterativeVariable PrincipalIterativeSymbol Form))))
      (SimplifyPROG (COND ((EQ (CAR Form) 'LOCAL-DECLARE) (CADDR Form))
			  (T Form)))
      Form))

(SPECIAL Statement)
(SPECIAL StatementStack)
(DEFUN TranslateStatement
       (Statement Type Template Queues Instantiators InitializationFunction)
  (PROGV Queues (MAKE-LIST (length Queues))
    (LET (StatementStack)
      (GLOBAL:DO ((Tail (COND (InitializationFunction
			       (FUNCALL InitializationFunction Statement))
			      (T Statement))))
		 ((NULL Tail)
		  (GLOBAL:DO ((QueueTail Queues (CDR QueueTail)))
			     ((NULL QueueTail))
		    (SET (CAR QueueTail)	(NREVERSE (SYMEVAL (CAR QueueTail)))))
		  (InstantiateTemplate Template Queues Instantiators))
	(GLOBAL:PUSH Tail StatementStack)
	(SETQ Tail (FUNCALL (COND ((AND (SYMBOLP (CAR Tail))
					(GET (CAR Tail) Type)))
				  (T (FERROR NIL
					     "~S was encountered when expecting an interative operator!~%~
                             This occurred in the iterative statement:  ~S"
					     (CAR Tail) (OriginalIterativeStatement))))
			    Tail))))))

(I.S.OPR always
	 (COND ((NOT BODY) (SETQ $$VAL NIL) (GO $$OUT)))
	 (first (SETQ $$VAL T))
	 NIL)

(I.S.OPR collect
	 (SUBLIS (PAIRLIS (QUOTE (IterativeValue LastCONS))
			  (LIST (GETDUMMYVAR T) (GETDUMMYVAR T)))
		 '(PROGN (SETQ IterativeValue BODY)
			 (COND (LastCONS (RPLACD LastCONS
						 (SETQ LastCONS (NCONS IterativeValue))))
			       (T (SETQ $$VAL (SETQ LastCONS (LIST IterativeValue)))))))
	 NIL T)

(I.S.OPR count
	 (AND BODY (SETQ $$VAL (ADD1 $$VAL)))
	 (first (SETQ $$VAL 0))
	 NIL)

(I.S.OPR do BODY NIL NIL)

(I.S.OPR else NIL (finally (OR $$VAL (RETURN BODY))) NIL)

(I.S.OPR inside NIL
	 (SUBST (GETDUMMYVAR) 'Tail
		'(bind (Tail _ BODY)
		       eachtime (COND ((NULL Tail) (GO $$OUT))
				      ((NLISTP Tail) (SETQ I.V. Tail) (SETQ Tail NIL))
				      (T (SETQ I.V. (CAR Tail)) (SETQ Tail (CDR Tail))))))
	 T)

(I.S.OPR join
	 (SUBLIS (PAIRLIS '(IterativeValue LastCONS)
			  (LIST (GETDUMMYVAR T) (GETDUMMYVAR T)))
		 '(COND ((SETQ IterativeValue BODY)
			 (COND (LastCONS (RPLACD (SETQ LastCONS (LAST LastCONS))
						 IterativeValue))
			       (T (SETQ LastCONS (SETQ $$VAL IterativeValue)))))))
	 NIL T)

(I.S.OPR never
	 (COND (BODY (SETQ $$VAL NIL) (GO $$OUT)))
	 (first (SETQ $$VAL T))
	 NIL)

(I.S.OPR sum
	 (SETQ $$VAL (PLUS $$VAL BODY))
	 (first (SETQ $$VAL 0))
	 NIL)

(I.S.OPR product
	 (SETQ $$VAL (TIMES $$VAL BODY))
	 (first (SETQ $$VAL 1))
	 NIL)

(I.S.OPR then NIL (finally (AND $$VAL (RETURN BODY))) NIL)

(I.S.OPR thereis (COND (BODY (SETQ $$VAL (OR I.V. T)) (GO $$OUT))) NIL NIL)

(I.S.OPR thereisval (AND (SETQ $$VAL BODY) (GO $$OUT)) NIL NIL)

(I.S.OPR min
	 (PROGN (SETQ !ThisValue BODY)
		 (COND ((OR (NULL !CurrentMinimum) (LESSP !ThisValue !CurrentMinimum))
			(SETQ $$VAL (LIST I.V.))
			(SETQ !CurrentMinimum !ThisValue))
		       ((= !ThisValue !CurrentMinimum)
			(SETQ $$VAL (CONS I.V. $$VAL)))))
	 (bind !CurrentMinimum !ThisValue)
	 NIL NIL)

(I.S.OPR max
	 (PROGN (SETQ !ThisValue BODY)
		(COND ((OR (NULL !CurrentMaximum) (GREATERP !ThisValue !CurrentMaximum))
		       (SETQ $$VAL (LIST I.V.))
		       (SETQ !CurrentMaximum !ThisValue))
		      ((= !ThisValue !CurrentMaximum)
		       (SETQ $$VAL (CONS I.V. $$VAL)))))
	 (bind !CurrentMaximum !ThisValue)
	 NIL NIL)

(I.S.OPR exceptfirst
	 NIL
	 (LET ((!FirstTime (GETDUMMYVAR)))
	   `(bind (,!FirstTime _ T) eachtime (COND (,!FirstTime (SETQ ,!FirstTime NIL))
						   (T BODY))))
	 T)

;;; Generate the tails of a (short) list backwards.
(I.S.OPR backwardson
	 NIL
	 (LET ((!List (GETDUMMYVAR)) (!I (GETDUMMYVAR))	(!Length (GETDUMMYVAR)))
	   `(bind (,!List _ BODY) ,!Length ,!I
		  first (SETQ ,!Length (LENGTH ,!List)) (SETQ ,!I 1)
		  while (COND (( ,!I ,!Length)
			       (SETQ I.V. (NTHCDR (- ,!Length ,!I) ,!List))
			       (SETQ ,!I (ADD1 ,!I))))))
	 T)

;;; Generate the elements of a (short) list backwards.
(I.S.OPR backwardsin
	 NIL
	 (LET ((!List (GETDUMMYVAR)) (!I (GETDUMMYVAR))	(!Length (GETDUMMYVAR)))
	   `(bind (,!List _ BODY) ,!Length ,!I
		  first (SETQ ,!Length (LENGTH ,!List)) (SETQ ,!I 1)
		  while (COND (( ,!I ,!Length)
			       (SETQ I.V. (NTH (- ,!Length ,!I) ,!List))
			       (SETQ ,!I (ADD1 ,!I))))))
	 T)

;;; Construct the maximum value of the argument measure.
(I.S.OPR maxval
	 (PROGN (SETQ !!Temp BODY) (AND (OR (NOT $$VAL) (> !!Temp $$VAL))
					(SETQ $$VAL !!Temp)))
	 (bind !!Temp))


;;; Construct the minimum value of the argument measure.
(I.S.OPR minval
	 (PROGN (SETQ !!Temp BODY) (AND (OR (NOT $$VAL) (< !!Temp $$VAL))
					(SETQ $$VAL !!Temp)))
	 (bind !!Temp))

;;; Generate the elements of the sublists of the argument list.
(I.S.OPR ineachof
	 NIL
	 (LET ((!Lists (GETDUMMYVAR)) (!ListsTail (GETDUMMYVAR)) (!Tail (GETDUMMYVAR)))
	    `(bind ,!Tail ,!ListsTail (,!Lists _ BODY)
		   first (SETQ ,!Tail (CBOX NIL (CAR (SETQ ,!ListsTail ,!Lists))))
		   while (PROG1 (OR (SETQ ,!Tail (CDR ,!Tail))
				    (while (SETQ ,!ListsTail (CDR ,!ListsTail)) thereis
					   (SETQ ,!Tail (CAR ,!ListsTail))))
				(SETQ I.V. (CAR ,!Tail)))))
	 T)

;;; Generate the tails of the sublists of the argument list.
(I.S.OPR oneachof
	 NIL
	 (LET ((!Lists (GETDUMMYVAR)) (!ListsTail (GETDUMMYVAR)))
	   `(bind (,!Lists _ BODY) ,!ListsTail
		  first (SETQ I.V. (CBOX NIL (CAR (SETQ ,!ListsTail ,!Lists))))
		  while (OR (SETQ I.V. (CDR I.V.))
			    (while (SETQ ,!ListsTail (CDR ,!ListsTail)) thereis
				   (SETQ I.V. (CAR ,!ListsTail))))))
	 T)

;;; Like on, but include the final NIL tail.
(I.S.OPR onwithnil NIL
	 (LET ((!List (GETDUMMYVAR)))
	   `(bind (!List _ BODY) first (SETQ I.V. T)
		  eachtime (COND (I.V. (SETQ I.V. !List !List (CDR !List)))
				 (T (GO $$OUT)))))
	 T)

;;; Construct the list of values of the argument body, reusing the same storage on every
;;; execution.
(I.S.OPR scratchcollect
	 (RPLACA (SETQ $$ScratchTail (OR (CDR $$ScratchTail)
					 (CDR (RPLACD $$ScratchTail (NCONS NIL)))))
		 BODY)
	 (bind $$ScratchTail ($$ScratchList _ (CONSTANT (NCONS (NCONS NIL))))
	       first (SETQ $$ScratchTail $$ScratchList)
	       (AND (CDAR $$ScratchList)
		    (RPLACD (CDAR $$ScratchList) (CAAR $$ScratchList)))
	       finally (RPLACA (CAR $$ScratchList) (CDR $$ScratchTail))
	       (RPLACD (CAR $$ScratchList) $$ScratchTail)
	       (RPLACD $$ScratchTail NIL)
	       (SETQ $$VAL (CDR $$ScratchList))))

;;; Generate the successive lines (WITHOUT CR's) of an arbitrary string argument.
(I.S.OPR inlinesof NIL
	 (LET ((String (GETDUMMYVAR)) (StartIndex (GETDUMMYVAR)) (EndIndex (GETDUMMYVAR)))
	   `(bind (,String _ BODY) (,StartIndex _ 0) ,EndIndex
	      while ( ,StartIndex (STRING-LENGTH ,String))
	      eachtime (COND ((SETQ ,EndIndex (STRING-SEARCH-CHAR #\CR ,String ,StartIndex))
			      (SETQ I.V. (NSUBSTRING ,String ,StartIndex ,EndIndex)
				    ,StartIndex (1+ ,EndIndex)))
			     (T (SETQ I.V. (NSUBSTRING ,String ,StartIndex)
				      ,StartIndex (STRING-LENGTH ,String))))))
	 T)

;;; somewhat bizarre $$VAL hacking.
(I.S.OPR dunion
	 (SETQ $$VAL (bind ($$VAL _ $$VAL) for !!element in BODY unless (MEMQ !!element $$VAL)
			   do (push !!element $$VAL))))

(I.S.OPR dintersect
	 (COND ((EQ $$VAL T) (SETQ $$VAL BODY))
	       (T (SETQ !!List BODY)
		  (SETQ $$VAL (Delete* $$VAL (NOT (MEMQ (CADR tail) !!List))))))
	 (bind !!List first (SETQ $$VAL T)))

(I.S.OPR bindeachtime nil
	 `(bind ,.(for arg in ARGUMENTS collect (COND ((SYMBOLP arg) arg)
						      (T arg
1)))
	    eachtime ,.(for arg in ARGUMENTS when (LISTP arg) collect arg))
	 T)

;;; Rod's version with losing syntax
(i.s.opr with nil
	 `(bind ,.(for arg in (car ARGUMENTS) collect (car arg))
	    eachtime ,.(for arg in (car ARGUMENTS)
			 collect `(setf ,(car arg) ,(cadr arg))))
	 t)

;;; Cannot use GETDUMMYVAR becasue of loop nesting!!
(I.S.OPR cross NIL
	 (LET ((Element (GENSYM)) (Result (GENSYM)) (ThisResult (GENSYM)) (Partial (GENSYM)))
	   `(bind ,ThisResult (,Result _ (LIST NIL)) first (SETQ $$VAL ,Result)
	      do (SETQ ,ThisResult BODY)
		 (SETQ ,Result (for ,Element in ,ThisResult join
				    (for ,Partial in ,Result collect
					 (APPEND ,Partial (LIST ,Element)))))
		 (SETQ $$VAL ,Result)))
	 T)