(FILECREATED "11-Feb-86 23:07:19" {QV}<IDL>SOURCES>ELAMTRAN.;3
 5705   

      changes to:  (VARS ELAMTRANCOMS)
		   (FNS ELAMTRAN)

      previous date: "25-JAN-83 16:01:50" {QV}<IDL>SOURCES>ELAMTRAN.;2)


(* Copyright (c) 1983, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT ELAMTRANCOMS)

(RPAQQ ELAMTRANCOMS
 ((* Contains translator for user's ELAMBDA functions.)
		       (DECLARE: FIRST (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
					      LAMBDATRAN))
		       (FNS ELAMARGLIST ELAMTRAN PPELAM)
		       (ADDVARS (LAMBDASPLST ELAMBDA))
		       (ALISTS (LAMBDATRANFNS ELAMBDA)
			       (PRETTYPRINTMACROS ELAMBDA))
		       (PROP INFO ELAMBDA)))



(* Contains translator for user's ELAMBDA functions.)


(DECLARE: FIRST 
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   LAMBDATRAN)
)
(DEFINEQ

(ELAMARGLIST

  [LAMBDA (DEF)                                        (* rmk: " 8-MAR-80 16:30" posted: " 6-APR-78 10:28")

                                                       (* Returns the arglist of an ELAMBDA.

						       Called via LAMBDATRANFNS entry)

    (if
 (LISTP DEF:2)
	then
 (for
 A in
 DEF:2 unless
 (LISTP A):1='TITLE collect
 (if
 (LISTP A)
								   then
 A:1
								 else
 A))
      else
 DEF:2])

(ELAMTRAN

  [LAMBDA (FORM)                                             (* rmk: "12-MAR-80 08:59" posted: "29-SEP-77 15:41")


          (* Translator for the user's ELAMBDA's. Converts expectations in arguments to a call on EAPPLY*.

	  Does not deal with types, coercions, or error messages at all.)



    (if
 (
NLISTP
 (
CADR
 FORM))
	then
 (
LISPXPRIN1
 "{in " T)
	       (
LISPXPRIN2
 FAULTFN T)
	       (
LISPXPRIN1
 "} non-list argument specification " T)
	       (
LISPXPRINT
 (
CADR
 FORM)
			     T)
	       (
ERROR!
))
    (
PROG
 (EXPECTS VNAMES TOP TITLEFORM EFORM)
	    [for
 V in
 (
CADR
 FORM) do
 (if
 (
NLISTP
 V)
						 then
 (push
 EXPECTS NIL)
							(push
 VNAMES V)
					       elseif
 (
EQ
 (
CAR
 V)
							      (
QUOTE
 TITLE))
						 then
 (
SETQ
 TITLEFORM V)
					       else
 (push
 EXPECTS (
CADR
 V))
						      (push
 VNAMES (
CAR
 V]
	    (
SETQ
 EXPECTS (
DREVERSE
 EXPECTS))
	    (
PROG
 ((GLITCH (
EXPCHK
 EXPECTS)))
		    (if
 GLITCH
			then
 (
LISPXPRIN1
 "{in " T)
			       (
LISPXPRIN2
 FAULTFN T)
			       (
LISPXPRIN1
 "} illegal EXPECTS declaration" T)
			       (
LISPXPRINT
 (
CAR
 GLITCH)
					     T)
			       (
ERROR!
)))
	    (
SETQ
 VNAMES (
DREVERSE
 VNAMES))
	    [
SETQ
 EFORM (
CONS
 (
QUOTE
 EAPPLY*)
				  (
CONS
 [
LIST
 (
QUOTE
 FUNCTION)
						  (
CONS
 (
QUOTE
 LAMBDA)
							  (
CONS
 VNAMES (
CDDR
 FORM]
					  (
CONS
 (
KWOTE
 EXPECTS)
						  VNAMES]
	    (
SETQ
 TITLEFORM (if
 [
AND
 (
NULL
 TITLEFORM)
					   (
OR
 (
EQ
 FORM (
GETD
 FAULTFN))
						 (
EQ
 FORM (
GETP
 FAULTFN (
QUOTE
 EXPR]
				  then
 (
LIST
 (
CONS
 (
QUOTE
 LIST)
							 (
CONS
 (
KWOTE
 FAULTFN)
								 VNAMES)))
				else
 (
CDR
 TITLEFORM)))

          (* Conjure up a title if none given. Otherwise, strip off the TITLE key word. This means that a specification 

	  (TITLE) will have the effect off preventing our automatic generation here.)



	    [
SETQ
 TOP
	      (
CONS

		(
QUOTE
 LAMBDA)
		(
CONS

		  VNAMES
		  (
CONS
 [
CONS
 COMMENTFLG (
QUOTE
 (ASSERT: (CLISP
 ELAMBDA]
			  (if
 TITLEFORM
			      then
                         (* Put out CONVERTs so the title will reference 

							     converted arguments)

			       [
NCONC1
 (for
 V in
 VNAMES as
 E in
 EXPECTS when
 E
					    collect
 (
LIST
 (
QUOTE
 SETQ)
							      V
							      (
LIST
 (
QUOTE
 CONVERT)
								      V)))
					 (
SUBPAIR

					   (
QUOTE
 (
EF
 . TFORM))
					   (
CONS
 EFORM TITLEFORM)
					   (
QUOTE
 (
PROG
 ((ELAMVAL EF))
							    (DECLARE
 (
LOCALVARS
 ELAMVAL))
							    [
AND
 (
IDLARRAYP
 ELAMVAL)
								   (
ASSIGN
 (
AT
 ELAMVAL
										   (
CONSTANT

										     (
TITLE
))) . 
									     TFORM]
							    (
RETURN
 ELAMVAL]
			    else
 (
LIST
 EFORM]
	    (
DWIMIFY0?
 TOP TOP NIL NIL NIL FAULTFN)
	    (
RETURN
 TOP])

(PPELAM

  [LAMBDA (FORM)                                       (* rmk: "12-MAR-80 08:46" posted: "31-AUG-77 16:21")

                                                       (* Special prettyprinter for ELAMBDA's.

						       Called from PRETTYPRINTMACROS)

    (if
 (OR (NLISTP FORM::1)
	    (AND PRETTYTRANFLG (GETHASH FORM CLISPARRAY)))
	then
 FORM
      else
 (PROG [(VLIST (FORM:2))
		  (FORMPOS (2+(POSITION]
	         (PRIN1 "[ELAMBDA ")
	         (if
 (LISTP VLIST)
		     then
 (PRIN1 "(")
			  (for
 V (VARPOS ←(POSITION))
			       LASTLIST←T in
 VLIST do
 (if
 LASTLIST
							  then
 (TAB VARPOS 0)
							else
 (SPACES 1))
						      (LASTLIST←(LISTP V))
						      (printout
 NIL .PPF V))
			  (PRIN3 ")")
		   else
 (PRIN2 VLIST))
	         (if
 (AND (LISTP FORM←FORM::2)
			  FORM:1~=COMMENTFLG)
		     then
 (printout
 NIL .TAB0 FORMPOS))
	         (PRINTDEF FORM FORMPOS T T FNSLST)
	         (PRIN1 "]"))
	   NIL])
)

(ADDTOVAR LAMBDASPLST
 ELAMBDA)

(ADDTOVAR LAMBDATRANFNS
 [ELAMBDA ELAMTRAN
                            EXPR ELAMARGLIST])

(ADDTOVAR PRETTYPRINTMACROS
 (ELAMBDA . PPELAM))

(PUTPROPS ELAMBDA INFO
 BINDS)
(PUTPROPS ELAMTRAN COPYRIGHT ("Xerox Corporation" 1983 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (842 5403 (ELAMARGLIST 852 . 1313) (ELAMTRAN 1315 . 4404) (PPELAM 4406 . 5401)))))
STOP