(FILECREATED " 6-NOV-79 17:25:50" <LISPUSERS>SIMPLIFY.;3
    4066

     changes to:  APPLYFORM

     previous date: " 6-NOV-79 16:53:20" <LISPUSERS>SIMPLIFY.;2)


(PRETTYCOMPRINT SIMPLIFYCOMS)

(RPAQQ SIMPLIFYCOMS
 ((* Tools for symbolic simplification of LISP forms)
		     (FNS SIMPLIFY)
		     (FNS APPLYFORM ONCE ONCE1 OPAQUE SIMPLEP SUBSTVAL)
		     (BLOCKS (APPLYFORM APPLYFORM ONCE ONCE1 OPAQUE SIMPLEP SUBSTVAL))))



(* Tools for symbolic simplification of LISP forms)


(DEFINEQ

(SIMPLIFY

  [LAMBDA (FORM)                                       (* bas: " 6-NOV-79 16:51")

                                                       (* Eventually this will be a general symbolic simplification package, 

						       but for now its just a dummy entry)

    FORM])
)
(DEFINEQ

(APPLYFORM

  [LAMBDA (FN ARG1)                                    (* bas: " 6-NOV-79 17:24")

    (PROG (FNARG FNFORM)
          (RETURN (if
 (AND (LISTP FN):1='LAMBDA (LISTP (LISTP FN::1):1)
			   FN:2::1=NIL
			   (LITATOM FNARG←FN:2:1)
			   FNARG
			   (OR (PROGN FNFORM←(if
 FN::3
						 then
 <'PROGN ! FN::2>
					       else
 FN:3)
				      (SIMPLEP
 ARG1))
			       (ONCE
 FNARG FNFORM)))
		      then
 

          (* We know that FN is a LAMBDA with one non-NIL litatom argument, and that either FNARG can be safely evaluated multiple times or the 

	  function body only references it once.)



			   (if
 FNARG=ARG1
			       then
                    (* Arg and arg name are same so body will do)

				    FNFORM
			     else
 (SUBSTVAL
 ARG1 FNARG FNFORM))
		    else
 <FN ARG1>])

(ONCE

  [LAMBDA (ATOM FORM FLG)                              (* bas: "19-AUG-78 17:34")

    (DECLARE
 (SPECVARS FLG))
    (ONCE1
 ATOM FORM)
    (NEQ FLG (QUOTE FAILED])

(ONCE1

  [LAMBDA (A L)                                        (* bas: "18-SEP-79 17:03")

    (for
 I in
 L do
 [if
 (LISTP I)
		       then
 (OR (OPAQUE
 I A)
				(ONCE1
 A I))
		     elseif
 (EQ A I)
		       then
 (SETQ FLG (if
 FLG
					  then
 (QUOTE FAILED)
					else
 (QUOTE ONCE]
       until
 (EQ FLG (QUOTE FAILED])

(OPAQUE

  [LAMBDA (FORM VAR)                                   (* rmk: " 5-AUG-79 22:11")

                                                       (* Determines if VAR substitution can take place in FORM)

    (SELECTQ (CAR FORM)
	     (QUOTE T)
	     ([LAMBDA NLAMBDA]
	       (FMEMB VAR (CADR FORM)))
	     [PROG (for
 I in
 (CADR FORM) thereis
 (EQ VAR (if
 (LISTP I)
							     then
 (CAR I)
							   else
 I]
	     NIL])

(SIMPLEP

  [LAMBDA (FORM)                                       (* rmk: " 5-AUG-79 22:06")

                                                       (* Decides if a form is simple enough so that it can be evaluated 

						       repeatedly rather than taking a LAMBDA binding)

    (OR (ATOM FORM)
	(SELECTQ (CAR (LISTP FORM))
		 ((QUOTE CAR CDR CADR CDDR)
		   (LITATOM (CADR FORM)))
		 NIL)
	(STRINGP FORM])

(SUBSTVAL

  [LAMBDA (NEW OLD FORM)                               (* bas: " 8-MAR-79 20:39")

                                                       (* Substitutes NEW for OLD in FORM. Just like SUBST except is sensitive

						       to opacity)

    (if
 (LISTP FORM)
	then
 [if
 (OPAQUE
 FORM OLD)
		 then
 FORM
	       else
 (PROG (NSCR OSCR)
		          (RETURN (if
 [SETQ OSCR (for
 I in
 FORM thereis
 (NEQ I (SETQ NSCR
									       (SUBSTVAL
 NEW OLD I]
				      then
 (for
 I in
 FORM collect
 (if
 (NULL OSCR)
								      then
 (SUBSTVAL
 NEW OLD I)
								    elseif
 (EQ OSCR I)
								      then
 (SETQ OSCR NIL)
									   NSCR
								    else
 I))
				    else
 FORM]
      elseif
 (EQ FORM OLD)
	then
 NEW
      else
 FORM])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: APPLYFORM APPLYFORM ONCE ONCE1 OPAQUE SIMPLEP SUBSTVAL)
]
(DECLARE: DONTCOPY
  (FILEMAP (NIL (489 794 (SIMPLIFY 501 . 792)) (795 3930 (APPLYFORM 807 . 1652) (ONCE 1656 . 1837) (
ONCE1 1841 . 2210) (OPAQUE 2214 . 2666) (SIMPLEP 2670 . 3089) (SUBSTVAL 3093 . 3928)))))
STOP