Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50216/disp9.l
Click 43,50216/disp9.l to see without markup as text/plain
There are 2 other files named disp9.l in the archive. Click here to see a list.
(DEFPROP MAX(LAMBDA(X Y)(COND((LESSP X Y)Y)(T X)))EXPR)
(SETQ ALLSTAR NIL)
(SETQ TALLPAR NIL)

 (DEFPROP TALLPAR T SPECIAL)


(DEFPROP ALLSTAR T SPECIAL)

       (DEFPROP BLANK T SPECIAL)
(DEFPROP PLUSS T SPECIAL)
(DEFPROP PERIOD T SPECIAL)
(DEFPROP SLASH T SPECIAL)
(DEFPROP COMMA T SPECIAL)
(DEFPROP LPAR T SPECIAL)
(DEFPROP RPAR T SPECIAL)
(DEFPROP EQSIGN T SPECIAL)
(DEFPROP DASH T SPECIAL)
(DEFPROP STAR T SPECIAL)
(DEFPROP DOLLAR T SPECIAL)

       (DEFPROP COLON T SPECIAL)
(SPECIAL *U HMESH *N **U)

(QUOTE (FILE ILIAD))

(DEFPROP SCYLLA
 (LAMBDA (N V)
  (PROG (W X)
	(COND ((NULL V) (PRINC BLANK)
			(RETURN (TERPRI))))
	(SETQ W V)
	(SETQ X 1)
   A	(COND ((NOT (EQUAL (CDAAR W) N))
	       (GO C)))
	(COND ((EQUAL X (CAAAR W)) (GO B)))
	(COND ((GREATERP X (CAAAR W))
	       (GO C)))
	(PRINC BLANK)
	(SETQ X (ADD1 X))
	(GO A)
   B	(PRINC (CDAR W))
	(SETQ X (PLUS X (WIDTH (CDAR W))))
   C	(SETQ W (CDR W))
	(COND ((NULL W) (RETURN (TERPRI))))
	(GO A)))
 EXPR)

(DEFPROP CHARYBDIS
 (LAMBDA (U START LINELENGTH)
  (PROG
   (V NAME D
      N
      M
      DM
      DDM
      BLANK
      PLUSS
      PERIOD
      SLASH
      COMMA
      LPAR
      RPAR
      EQSIGN
      DASH
      STAR
      DOLLAR
      OPLIST)
   (SETQ BLANK (QUOTE / ))
   (SETQ PLUSS (QUOTE /+))
   (SETQ PERIOD (QUOTE /.))
   (SETQ SLASH (QUOTE //))
   (SETQ COMMA (QUOTE /,))
   (SETQ LPAR (QUOTE /())
   (SETQ RPAR (QUOTE /)))
   (SETQ EQSIGN (QUOTE =))
   (SETQ DASH (QUOTE /-))
   (SETQ STAR (QUOTE *))
   (SETQ DOLLAR (QUOTE $))
   (SETQ OPLIST (QUOTE ((EQUAL . =)
			(QUOTIENT . //)
			(PLUS . /+)
			(TIMES . *)
			(EXPT . ^)
			(SETQ . :))))
(COND((ATOM U)NIL)
   ((ATOM(CAR U))NIL)
   ((EQ(QUOTE FIGURE)(CAAR U))(RETURN(PGRAPH U))))
(COND((EQ(LEAD U)(Q SETQ))(SETQ NAME(CADR U))))
   (SETQ V
	 (COND ((ATOM U) U)
	       ((ATOM (CAR U)) (PUTWIDTH U))
	       ((NUMBERP (CDAR U)) U)
	       (T (PUTWIDTH U))))
   (COND ((EQ (KEY U) (QUOTE ELSE))
	  (GO ELSE)))
   (COND ((GREATERP (WIDTH V) LINELENGTH)
	  (GO TROUBLE)))
   (SETQ D (APP V START 0 NIL))
   (SETQ N (SUPERSPAN V))
   (SETQ M (MINUS (SUBSPAN V)))
LOOP
   (SCYLLA N D)
   (COND ((OR (EQUAL N M) (LESSP N M))
	  (RETURN BLANK)))
   (SETQ N (SUB1 N))
   (GO LOOP)
TROUBLE
   (COND ((ATOM U) (PRINC U)
		   (RETURN (TERPRI))))
   (COND ((EQ (KEY V) (QUOTE MINUS))
	  (GO MINUS)))
   (COND ((MEMBER (KEY U)
		  (QUOTE (EQUAL QUOTIENT
				EXPT
				SETQ)))
	  (GO BINARY)))
   (COND ((OR (EQ (KEY U) (QUOTE PLUS))
	      (EQ (KEY U) (QUOTE TIMES)))
	  (GO STEP1)))
   (COND ((EQ (KEY U) (QUOTE MATRIX))
	  (GO MATRIXTOOWIDESPECILCASE)))
   (COND ((EQ (KEY U) (QUOTE ELSE))
	  (GO ELSE)))
   (CHARYBDIS (KEY U) START LINELENGTH)
   (CHARYBDIS (CONS (QUOTE ELSE) (CDR U))
	      START
	      LINELENGTH)
   (RETURN BLANK)
MINUS
   (CHARYBDIS DASH START LINELENGTH)
   (CHARYBDIS (CADR V)
	      (PLUS START 3)
	      (DIFFERENCE LINELENGTH 3))
   (RETURN BLANK)
ELSE
   (CHARYBDIS (CADR V)
	      (PLUS START 3)
	      (DIFFERENCE LINELENGTH 3))
   (COND ((NULL (CDDR U)) (RETURN BLANK)))
   (PRND START COMMA)
   (CHARYBDIS (CONS (QUOTE ELSE) (CDDR V))
	      START
	      LINELENGTH)
   (RETURN BLANK)
BINARY
   (CHARYBDIS (CADR V)
	      (PLUS START 3)
	      (DIFFERENCE LINELENGTH 3))
   (PRND START (OPSRCH (KEY U) OPLIST))
(COND((AND(EQ(KEY U)(Q SETQ))(EQ(KEY(CADDR U))(Q MATRIX)))
        (RPLACD(CADDR V)(CONS NAME(CDR(CADDR V))))))
   (CHARYBDIS (CADDR V)
	      (PLUS START 3)
	      (DIFFERENCE LINELENGTH 3))
   (RETURN BLANK)
STEP1
   (SETQ V (CONS (CAAR V) (CDR V)))
   (SETQ M (CDR V))
   (COND ((GREATERP (WIDTH (CADR V))
		    (DIFFERENCE LINELENGTH
				3))
	  (GO FTTL)))
STEP
   (SETQ DM (CDR M))
   (SETQ DDM (CDR DM))
   (RPLACD DM NIL)
   (COND ((GREATERP (WIDTH V)
		    (DIFFERENCE LINELENGTH
				3))
	  (GO SPLIT)))
   (RPLACD DM DDM)
   (SETQ M (CDR M))
   (GO STEP)
SPLIT
   (RPLACD M NIL)
   (CHARYBDIS V
	      (PLUS START 3)
	      (DIFFERENCE LINELENGTH 3))
SPLIT2
   (PRND START (OPSRCH (KEY U) OPLIST))
   (RPLACD DM DDM)
   (SETQ M
	 (LESSP (WIDTH (CONS (KEY U) DM))
		(DIFFERENCE LINELENGTH 3)))
   (CHARYBDIS (CONS (KEY U) DM)
	      (COND (M (PLUS START 3))
		    (T START))
   (COND(M(DIFFERENCE LINELENGTH 3))
        (T LINELENGTH)))
   (RETURN BLANK)
FTTL
   (CHARYBDIS (CADR V)
	      (PLUS START 3)
	      (DIFFERENCE LINELENGTH 3))
   (COND ((NULL (CDDR V)) (RETURN BLANK)))
   (SETQ DM (CDDR V))
   (SETQ DDM (CDR DM))
   (GO SPLIT2)
MATRIXTOOWIDESPECILCASE
(COND((ATOM(CADR U))(PROG2(SETQ NAME(CADR U))(RPLACD U(CDDR U)))))
   (SETQ M 1)
   (SETQ DM (CDR U))
   (SETQ N 1)
MLOOP
(TERPRI)
   (CHARYBDIS (LIST (QUOTE SETQ)
		    (LIST(COND((NULL NAME)(Q WS))(T NAME))M N)
		    (ELT N (CAR DM)))
	      START
	      LINELENGTH)
   (COND ((EQUAL N (LENGTH (CADR U)))
	  (GO NXTROW)))
   (SETQ N (ADD1 N))
   (GO MLOOP)
NXTROW
   (COND ((NULL (SETQ DM (CDR DM)))
	  (RETURN (QUOTE END))))
   (SETQ N 1)
   (SETQ M (ADD1 M))
   (GO MLOOP)))
 EXPR)

(DEFPROP KEY
	 (LAMBDA (U) (COND ((ATOM U) NIL)
			   ((ATOM (CAR U))
			    (CAR U))
			   (T (CAAR U))))
	 EXPR)

(DEFPROP PRND
 (LAMBDA (START OP)
	 (COND ((ONEP START) (PRINC OP)
			     (TERPRI))
	       (T (PROG2 (PRINC BLANK)
			 (PRND (SUB1 START)
			       OP)))))
 EXPR)

(DEFPROP OPSRCH
 (LAMBDA (NAME OPLIST)
  (CDR
   (SASSOC
    NAME
    OPLIST
    (FUNCTION (LAMBDA NIL
		      (CONS NIL COMMA))))))
 EXPR)

(DEFPROP APP
 (LAMBDA (U X Y D)
  (COND ((ATOM U)
	 (NCONC D
		(LIST (CONS (CONS X Y) U))))
	((AND (ATOM (CAAR U))
	      (NOT (NUMBERP (CAAR U)))
	      (GET (CAAR U) (QUOTE APP)))
	 (APPLY (GET (CAAR U) (QUOTE APP))
		(LIST U X Y D)))
	(T (APPELSE U X Y D))))
 EXPR)

(DEFPROP WIDTH
 (LAMBDA (U) (COND ((ATOM U) (FLATC U))
		   (T (CDAR (PUTWIDTH U)))))
 EXPR)

(DEFPROP FLATC(LAMBDA(X)(PROG(V CNT)
     (SETQ CNT 0)
     (SETQ V (EXPLODE X))
LOOP (COND((NULL V)(RETURN CNT)))
     (SETQ CNT(ADD1 CNT))
     (COND((EQ(CAR V)(QUOTE //))(GO SLASH)))
     (SETQ V(CDR V))
     (GO LOOP)
SLASH (SETQ V(CDDR V))
     (GO LOOP)
))EXPR)
(DEFPROP SUPERSPAN
 (LAMBDA (U)
  (COND ((ATOM U) 0)
	((NUMBERP (CDR U))
	 (SUPERSPAN (CAR U)))
	((AND (NOT (ATOM (CAR U)))
	      (ATOM (CAAR U))
	      (NOT (NUMBERP (CAAR U)))
	      (GET (CAAR U)
		   (QUOTE SUPERSPAN)))
	 (APPLY (GET (CAAR U)
		     (QUOTE SUPERSPAN))
		(LIST U)))
	(T (MAX (SUPERSPAN (CAR U))
		(SUPERSPAN (CDR U))))))
 EXPR)

(DEFPROP SUBSPAN
 (LAMBDA (U)
  (COND ((ATOM U) 0)
	((NUMBERP (CDR U))
	 (SUBSPAN (CAR U)))
	((AND (NOT (ATOM (CAR U)))
	      (ATOM (CAAR U))
	      (NOT (NUMBERP (CAAR U)))
	      (GET (CAAR U)
		   (QUOTE SUBSPAN)))
	 (APPLY (GET (CAAR U)
		     (QUOTE SUBSPAN))
		(LIST U)))
	(T (MAX (SUBSPAN (CAR U))
		(SUBSPAN (CDR U))))))
 EXPR)


(DEFPROP PUTWIDTH
 (LAMBDA (U)
  (COND
   ((ATOM U) U)
((AND(ATOM(CAR U))(ATOM(CDR U)))U)
   ((AND (NOT (ATOM (CAR U)))
	 (NUMBERP (CDAR U)))
    U)
   (T
    ((LAMBDA (MP)
      (COND
       ((AND (ATOM (CAR U))
	     (GET (CAR U) (QUOTE WIDTH)))
	(CONS
	 (CONS (CAR U)
	       (APPLY (GET (CAR U)
			   (QUOTE WIDTH))
		      (LIST (CONS (CAR U)
				  MP))))
	 MP))
       (T (CONS (CONS (PUTWIDTH (CAR U))
		      (PLUS 2
			    (WIDTH (CAR U))
			    (ARGWIDTH MP)))
		MP))))
(COND
  ((AND(EQ(CAR U)(QUOTE MATRIX))(NOT(ATOM(CADR U))))
   (MAPCAR(FUNCTION(LAMBDA(J)(MAPCAR(FUNCTION PUTWIDTH)J)
          )        )
          (CDR U)
  ))
  (T(MAPCAR(FUNCTION PUTWIDTH)
(CDR U)))
)
      ))))
 EXPR)

(DEFPROP ARGWIDTH
 (LAMBDA (U)
  (COND ((NULL U) 0)
	((NULL (CDR U)) (WIDTH (CAR U)))
	(T (PLUS 1
		 (WIDTH (CAR U))
		 (ARGWIDTH (CDR U))))))
 EXPR)

(QUOTE (FILE TMS))

(DEFPROP APPTIMES
 (LAMBDA (U X Y D)
  (PROG
   (P F1 F2 F3 S K)
    (SETQ F1 0)
   (SETQ U (CDR U))
LOOP
   (COND ((NULL U) (RETURN D)))
   (SETQ P (PARFACP (CAR U)))
   (SETQ K (KEY (CAR U)))
   (SETQ S (COND ((AND(NOT(NUMBERP F1))
     (TIMSPACEP F1 F2 F3 U K)) 1)
		 (T 0)))
   (COND ((ONEP S)
	  (SETQ D (APP STAR X Y D))))
   (SETQ D (COND (P (APPPARU (CAR U)
			     (PLUS X S)
			     Y
			     D))
		 (T (APP (CAR U)
			 (PLUS X S)
			 Y
			 D))))
   (SETQ F1
	 (OR (AND (ATOM (CAR U))
		  (NOT (NUMBERP (CAR U))))
	     (RATIONALP (CAR U))))
   (SETQ F2(OR (EQ K (QUOTE QUOTIENT))(EQ K(QUOTE DERIV))(AND(EQ K(QUOTE EXPT))(ZEROP(SQRTEST(CADDAR U))))))
   (SETQ F3(NUMBERP(CAR U)))
   (SETQ X (PLUS X
		 S
		 (COND (P 2) (T 0))
		 (WIDTH (CAR U))))
   (SETQ U (CDR U))
   (GO LOOP)))
 EXPR)

(DEFPROP TIMWIDTH
 (LAMBDA (U)
  (PROG
   (P F1 F2 F3 S K W)
   (SETQ F1 0)
   (SETQ U (CDR U))
   (SETQ W 0)
LOOP
   (COND ((NULL U) (RETURN W)))
   (SETQ P (PARFACP (CAR U)))
   (SETQ K (KEY (CAR U)))
   (SETQ S (COND ((AND(NOT(NUMBERP F1))
     (TIMSPACEP F1 F2 F3 U K)) 1)
		 (T 0)))
   (SETQ W (PLUS W
		 S
		 (COND (P 2) (T 0))
		 (WIDTH (CAR U))))
   (SETQ F1
	 (OR (AND (ATOM (CAR U))
		  (NOT (NUMBERP (CAR U))))
	     (RATIONALP (CAR U))))
   (SETQ F2(OR (EQ K (QUOTE QUOTIENT))(EQ K(QUOTE DERIV))(AND(EQ K(QUOTE EXPT))(ZEROP(SQRTEST(CADDAR U))))))
   (SETQ F3(NUMBERP(CAR U)))
   (SETQ U (CDR U))
   (GO LOOP)))
 EXPR)

(DEFPROP PARFACP
 (LAMBDA (U) (MEMBER (KEY U)
		     (QUOTE (PLUS DIFFERENCE
				  MINUS
				  TIMES))))
 EXPR)

(DEFPROP TIMSPACEP
 (LAMBDA (F1 F2 F3 U K)
  (OR ALLSTAR
   (AND F1
	(OR (ATOM (CAR U))
	    (EQ (KEY (CAR U)) (QUOTE SUB))
	    (RATIONALP (CAR U))
	    (AND (EQ K (QUOTE EXPT))
(OR(EQ( SQRTEST(CADDAR U))T)		 (ATOM (CADAR U))))
	    (AND (ATOM K)
		 (NOT (NUMBERP K))
		 (NOT (GET K
			   (QUOTE APP))))))
   (AND F2(OR (EQ K (QUOTE QUOTIENT))(EQ K(QUOTE DERIV))(AND(EQ K(QUOTE EXPT))(ZEROP(SQRTEST(CADDAR U))))))
   (AND F3(OR(NUMBERP(CAR U))(RATIONALP(CAR U))
    (AND(EQ K(QUOTE EXPT))(NUMBERP(CADAR U)))))
))
 EXPR)
(DEFPROP APPEXPT
 (LAMBDA (U X Y D)
  (COND
   ((NULL (SQRTEST (CADDR U)))
    (COND
     ((SINORLOGETC(KEY(CADR U)))
      (APP
       (PUTWIDTH (CONS (LIST (QUOTE EXPT)
			     (KEY (CADR U))
			     (CADDR U))
		       (CDADR U)))
       X
       Y
       D))
     ((APP
       (CADDR U)
       (PLUS X
	     (WIDTH (CADR U))
	     (COND ((OR (ATOM (CADR U))
			(EQ (KEY (CADR U))
			    (QUOTE SUB)))
		    0)
		   (T 2)))
       (PLUS
	1
	Y
	(SUPERSPAN (CADR U))
	(SUBSPAN (CADDR U))
	(COND ((ZEROP (SUPERSPAN (CADR U)))
	       0)
	      (TALLPAR 0)
	      (T -1)))
       (COND ((OR (ATOM (CADR U))
		  (EQ (KEY (CADR U))
		      (QUOTE SUB)))
	      (APP (CADR U) X Y D))
	     (T (APPPARU (CADR U)
			 X
			 Y
			 D)))))))
   ((NUMBERP (SQRTEST (CADDR U)))
    (APP (PUTWIDTH (LIST (QUOTE QUOTIENT)
			 1
			 (LIST (QUOTE SQRT)
			       (CADR U))))
	 X
	 Y
	 D))
   ((APP (PUTWIDTH (LIST (QUOTE SQRT)
			 (CADR U)))
	 X
	 Y
	 D))))
 EXPR)

(DEFPROP SINORLOGETC(LAMBDA(KC)(AND
   KC
   (ATOM KC)
   (NOT(NUMBERP KC))
   (NULL(GET KC(QUOTE APP)))
))EXPR)

(DEFPROP SQRTEST
 (LAMBDA (X)
  (COND ((EQUAL X (QUOTE ((QUOTIENT . 3)
			  1
			  2)))
	 T)
	((OR (EQUAL X
		    (QUOTE ((QUOTIENT . 5)
			    ((MINUS . 3) 1)
			    2)))
	     (EQUAL X (QUOTE ((QUOTIENT . 4)
			      -1
			      2)))
	     (EQUAL X
		    (QUOTE ((MINUS . 5)
			    ((QUOTIENT . 3)
			     1
			     2)))))
	 0)
	(T NIL)))
 EXPR)

(DEFPROP APPFRAC
 (LAMBDA (U X Y D)
  (COND
   ((RATIONALP U)
    (APP (CADDR U)
	 (PLUS X 1 (WIDTH (CADR U)))
	 Y
	 (APP SLASH
	      (PLUS X (WIDTH (CADR U)))
	      Y
	      (APP (CADR U) X Y D))))
   (T
    ((LAMBDA (W)
      (APP
       (CADR U)
       (PLUS
	X
	(QUOTIENT
	 (DIFFERENCE W (WIDTH (CADR U)))
	 2))
       (PLUS Y 1 (SUBSPAN (CADR U)))
       (APPHOR
	X
	(PLUS X W -1)
	Y
	(APP
	 (CADDR U)
	 (PLUS
	  X
	  (QUOTIENT
	   (DIFFERENCE W (WIDTH (CADDR U)))
	   2))
	 (SUB1
	  (DIFFERENCE
	   Y
	   (SUPERSPAN (CADDR U))))
	 D))))
     (WIDTH U)))))
 EXPR)

(DEFPROP RATIONALP
	 (LAMBDA (U)
		 (AND (EQ (KEY U)
			  (QUOTE QUOTIENT))
		      (NUMBERP (CADR U))
		      (NUMBERP (CADDR U))))
	 EXPR)

(DEFPROP EXPTWIDTH
 (LAMBDA (U)
  (COND ((NULL (SQRTEST (CADDR U)))
	 (PLUS (WIDTH (CADR U))
	       (WIDTH (CADDR U))
	       (COND ((OR (ATOM (CADR U))
        (SINORLOGETC(KEY(CADR U)))
			  (EQ (KEY (CADR U))
			      (QUOTE SUB)))
		      0)
		     (T 2))))
	((NUMBERP (SQRTEST (CADDR U)))
	 (PLUS 10 (WIDTH (CADR U))))
	(T (PLUS 6 (WIDTH (CADR U))))))
 EXPR)

(DEFPROP FRACWIDTH
 (LAMBDA (U)
  (COND ((RATIONALP U)
	 (PLUS 1
	       (WIDTH (CADR U))
	       (WIDTH (CADDR U))))
	(T (PLUS 2
		 (MAX (WIDTH (CADR U))
		      (WIDTH (CADDR U)))))))
 EXPR)

(DEFPROP EXPTSUPR
 (LAMBDA (U)
  (COND
   ((NULL (SQRTEST (CADDR U)))
    (PLUS
     (SUPERSPAN (CADR U))(HEIGHT(CADDR U))
     (COND
      ((NOT (OR (ZEROP (SUPERSPAN (CADR U)))
		TALLPAR))
       -1)
      (T 0))
     ))
   ((NUMBERP (SQRTEST (CADDR U))) 1)
   (T (SUPERSPAN (CADR U)))))
 EXPR)

(DEFPROP EXPTSUB
 (LAMBDA (U)
  (COND ((NULL (SQRTEST (CADDR U)))
	 (SUBSPAN (CADR U)))
	((NUMBERP (SQRTEST (CADDR U)))
	 (HEIGHT (CADR U)))
	(T (SUBSPAN (CADR U)))))
 EXPR)

(DEFPROP FRACSUPR
 (LAMBDA (U) (COND ((RATIONALP U) 0)
		   (T (HEIGHT (CADR U)))))
 EXPR)

(DEFPROP FRACSUB
 (LAMBDA (U) (COND ((RATIONALP U) 0)
		   (T (HEIGHT (CADDR U)))))
 EXPR)

(DEFPROP HEIGHT
	 (LAMBDA (U) (PLUS (SUPERSPAN U)
			   1
			   (SUBSPAN U)))
	 EXPR)

(DEFPROP TIMES APPTIMES APP)

(DEFPROP EXPT APPEXPT APP)

(DEFPROP QUOTIENT APPFRAC APP)

(DEFPROP TIMES TIMWIDTH WIDTH)

(DEFPROP EXPT EXPTWIDTH WIDTH)

(DEFPROP QUOTIENT FRACWIDTH WIDTH)

(DEFPROP EXPT EXPTSUPR SUPERSPAN)
(DEFPROP QUOTIENT FRACSUPR SUPERSPAN)

(DEFPROP EXPT EXPTSUB SUBSPAN)

(DEFPROP QUOTIENT FRACSUB SUBSPAN)

(QUOTE (FILE ELPL1 ))

(DEFPROP APPARG
 (LAMBDA (U X Y D)
  ((LAMBDA (W)
    (COND ((NULL U) D)
	  ((NULL (CDR U))
	   (APP (CAR U) X Y D))
	  (T (APPARG (CDR U)
		     (ADD1 W)
		     Y
		     (APP COMMA
			  W
			  Y
			  (APP (CAR U)
			       X
			       Y
			       D))))))
   (COND ((NULL U) X)
	 (T (PLUS X (WIDTH (CAR U)))))))
 EXPR)

(DEFPROP APPELSE
 (LAMBDA (U X Y D)
  ((LAMBDA (W B P)
    (APPRPAR
     (PLUS X 1 W (ARGWIDTH (CDR U)))
     Y
     B
     P
     (APPARG
      (CDR U)
      (PLUS X 1 W)
      Y
      (APPLPAR
       (PLUS X W)
       Y
       B
       P
       (APP (PUTWIDTH (LIST (QUOTE TIMES)
			    (KEY U)))
	    X
	    Y
	    D)))))
   (WIDTH (CAAR U))
   (DIFFERENCE Y (SUBSPAN (CDR U)))
   (PLUS Y (SUPERSPAN (CDR U)))))
 EXPR)

(DEFPROP APPEQ
 (LAMBDA (U X Y D)
	 ((LAMBDA (W)
		  (APP (CADDR U)
		       (PLUS X 3 W)
		       Y
		       (APP EQSIGN
			    (PLUS X 1 W)
			    Y
			    (APP (CADR U)
				 X
				 Y
				 D))))
	  (WIDTH (CADR U))))
 EXPR)

(DEFPROP APPLPAR
 (LAMBDA (X Y Y1 Y2 D)
  (COND ((NOT TALLPAR) (APP LPAR X Y D))
	(T (APP LPAR
		X
		Y2
		(COND ((EQUAL Y1 Y2) D)
		      (T (APPLPAR X
				  Y
				  Y1
				  (SUB1 Y2)
				  D)))))))
 EXPR)

(DEFPROP APPRPAR
 (LAMBDA (X Y Y1 Y2 D)
  (COND ((NOT TALLPAR) (APP RPAR X Y D))
	(T (APP RPAR
		X
		Y2
		(COND ((EQUAL Y1 Y2) D)
		      (T (APPRPAR X
				  Y
				  Y1
				  (SUB1 Y2)
				  D)))))))
 EXPR)

(DEFPROP APPHOR
 (LAMBDA (X1 X2 Y D)
	 (APP DASH
	      X2
	      Y
	      (COND ((EQUAL X1 X2) D)
		    (T (APPHOR X1
			       (SUB1 X2)
			       Y
			       D)))))
 EXPR)

(DEFPROP APPPARU
 (LAMBDA (U X Y D)
  ((LAMBDA (BOT TOP)
	   (APPRPAR (PLUS X 1 (WIDTH U))
		    Y
		    BOT
		    TOP
		    (APP U
			 (ADD1 X)
			 Y
			 (APPLPAR X
				  Y
				  BOT
				  TOP
				  D))))
   (DIFFERENCE Y (SUBSPAN U))
   (PLUS Y (SUPERSPAN U))))
 EXPR)

(DEFPROP EQUAL APPEQ APP)

(DEFPROP APPSUM
 (LAMBDA (U X Y D)
  (COND
   ((NULL U) D)
   (T
    ((LAMBDA (AC SC DP)
      (APPSUM
       (CDR U)
       (PLUS X (WIDTH AC) (COND (DP 5)
				(T 3)))
       Y
       (COND
	(DP
	 ((LAMBDA (BOT TOP)
	   (APPRPAR
	    (PLUS X 4 (WIDTH AC))
	    Y
	    BOT
	    TOP
	    (APP AC
		 (PLUS X 4)
		 Y
		 (APPLPAR (PLUS X 3)
			  Y
			  BOT
			  TOP
			  (APP SC
			       (ADD1 X)
			       Y
			       D)))))
	  (DIFFERENCE Y (SUBSPAN AC))
	  (PLUS Y (SUPERSPAN AC))))
	(T (APP AC
		(PLUS X 3)
		Y
		(APP SC (ADD1 X) Y D))))))
     (ABSYM (CAR U))
     (COND ((SYMINUSP (CAR U)) DASH)
	   (T PLUSS))
     (MEMBER (KEY (ABSYM (CAR U)))
	     (QUOTE (PLUS DIFFERENCE)))))))
 EXPR)

(DEFPROP APPPLUS
 (LAMBDA (U X Y D)
	 (APPSUM (CDDR U)
		 (PLUS X (WIDTH (CADR U)))
		 Y
		 (APP (CADR U) X Y D)))
 EXPR)

(DEFPROP SUMWIDTH
 (LAMBDA (U) (PLUS (WIDTH (CADR U))
		   (SUMWIDTHA (CDDR U))))
 EXPR)

(DEFPROP SUMWIDTHA
 (LAMBDA (U)
  (COND
   ((NULL U) 0)
   (T
    (PLUS
     (COND
      ((MEMBER (KEY (ABSYM (CAR U)))
	       (QUOTE (PLUS DIFFERENCE)))
       5)
      (T 3))
     (WIDTH (ABSYM (CAR U)))
     (SUMWIDTHA (CDR U))))))
 EXPR)

(DEFPROP SYMINUSP
 (LAMBDA (X)
	 (OR (AND (NUMBERP X) (MINUSP X))
	     (AND (NOT (ATOM X))
		  (EQ (KEY X)
		      (QUOTE MINUS)))))
 EXPR)

(DEFPROP ABSYM
 (LAMBDA (X)
	 (COND ((AND (NUMBERP X) (MINUSP X))
		(MINUS X))
	       ((AND (NOT (ATOM X))
		     (EQ (KEY X)
			 (QUOTE MINUS)))
		(CADR X))
	       (T X)))
 EXPR)

(DEFPROP APPNEG
	 (LAMBDA (U X Y D) (APPSUM (LIST U)
				   (SUB1 X)
				   Y
				   D))
	 EXPR)

(DEFPROP MINUSWIDTH
 (LAMBDA (U) (SUB1 (SUMWIDTHA (LIST U))))
 EXPR)

(DEFPROP PLUS APPPLUS APP)

(DEFPROP MINUS APPNEG APP)

(DEFPROP PLUS SUMWIDTH WIDTH)

(DEFPROP MINUS MINUSWIDTH WIDTH)

(QUOTE (FILE STD1))

(DEFPROP APPDERIV
 (LAMBDA (U X Y D)
  (PROG
   (P WID ORD1 AB DLIST DCU DOC NU ORD2)
   (SETQ NU
	 (MEMBER (KEY (CADR U))
		 (QUOTE (PLUS MINUS
			      QUOTIENT
			      DIFFERENCE))))
   (SETQ P D)
   (SETQ DCU (DERNUMP (CADR U)))
   (SETQ DOC (DORDER (CDDR U)))
   (SETQ
    WID
    (DIFFERENCE
     (WIDTH U)
     (COND (DCU 0)
	   (T (PLUS (WIDTH (CADR U))
		    (COND (NU 2) (T 0)))))))
   (SETQ ORD1 (COND (DCU (SUBSPAN (CADR U)))
		    (T 0)))
   (SETQ P (APPHOR X (PLUS X WID -1) Y P))
   (SETQ
    P
    (APP
     (COND ((AND (NUMBERP DOC) (ONEP DOC))
	    (QUOTE D))
	   (T (PUTWIDTH (LIST (QUOTE EXPT)
			      (QUOTE D)
			      DOC))))
     X
     (PLUS Y 1 ORD1)
     P))
   (SETQ AB X)
   (SETQ DLIST (CDDR U))
   (SETQ ORD2 (DIFFERENCE Y (DERSKP DLIST)))
LOOP
   (COND ((NULL DLIST) (GO OUT)))
   (SETQ P (APP (QUOTE D) AB ORD2 P))
   (SETQ P
	 (APP (CAR DLIST) (ADD1 AB) ORD2 P))
   (COND ((NULL (CDR DLIST)) (GO OUT)))
   (COND
    ((NOT (AND (NUMBERP (CADR DLIST))
	       (ONEP (CADR DLIST))))
     (SETQ P (APP (CADR DLIST)
		  (PLUS AB
			(WIDTH (CAR DLIST))
			1)
		  (ADD1 ORD2)
		  P))))
   (SETQ AB (PLUS AB
		  (WIDTH (CAR DLIST))
		  1
		  (WIDTH (CADR DLIST))))
   (SETQ DLIST (CDDR DLIST))
   (GO LOOP)
OUT(SETQ
    P
    (COND
     (DCU
      (COND (NU (APPPARU (CADR U)
			 (PLUS X
			       (WIDTH DOC)
			       1)
			 (PLUS Y 1 ORD1)
			 P))
	    (T (APP (CADR U)
		    (PLUS X (WIDTH DOC) 1)
		    (PLUS Y 1 ORD1)
		    P))))
     (T (COND (NU (APPPARU (CADR U)
			   (PLUS X WID)
			   Y
			   P))
	      (T (APP (CADR U)
		      (PLUS X WID)
		      Y
		      P))))))
   (RETURN P)))
 EXPR)

(DEFPROP DERNUMP
	 (LAMBDA (U)
		 (AND (LESSP (WIDTH U) 11)
		      (DERNUMPA U)))
	 EXPR)

(DEFPROP DERNUMPA
 (LAMBDA (U)
  (OR (ATOM U)
      (AND (MEMBER (CAR U)
		   (QUOTE (PLUS TIMES
				EXPT
				MINUS
				SUB)))
	   (DERNUMPB (CDR U)))))
 EXPR)

(DEFPROP DERNUMPB
 (LAMBDA (U) (OR (NULL U)
		 (AND (DERNUMPA (CAR U))
		      (DERNUMPB (CDR U)))))
 EXPR)

(DEFPROP DORDER
 (LAMBDA (U)
  (COND
   ((NULL U) 0)
   ((NULL (CDR U)) 1)
   (T
    (PUTWIDTH (DERSMP (CADR U)
		      (DORDER (CDDR U)))))))
 EXPR)

(DEFPROP DERSMP
 (LAMBDA (X U)
  (COND
   ((NUMBERP U)
    (COND ((NUMBERP X) (PLUS X U))
	  (T (COND ((ZEROP U)
		    (LIST (QUOTE PLUS) X))
		   (T (LIST (QUOTE PLUS)
			    U
			    X))))))
   ((NUMBERP (CADR U))
    (COND
     ((NUMBERP X)
      (CONS (QUOTE PLUS)
	    (CONS (PLUS X (CADR U))
		  (CDDR U))))
     (T (CONS (QUOTE PLUS)
	      (CONS (CADR U)
		    (CONS X (CDDR U)))))))
   (T (CONS (QUOTE PLUS)
	    (CONS X (CDR U))))))
 EXPR)

(DEFPROP DERWIDTH
 (LAMBDA (U)
  ((LAMBDA (DNP WAD DOR)
    (PLUS (COND (DNP 0) (T WAD))
	  (MAX (PLUS 1
		     (COND (DNP WAD) (T 0))
		     (WIDTH DOR))
	       (DERWIDTHA (CDDR U)))))
   (DERNUMP (CADR U))
   (PLUS
    (WIDTH (CADR U))
    (COND
     ((MEMBER (KEY (CADR U))
	      (QUOTE (PLUS MINUS
			   TIMES
			   QUOTIENT
			   DIFFERENCE)))
      2)
     (T 0)))
   (DORDER (CDDR U))))
 EXPR)

(DEFPROP DERWIDTHA
 (LAMBDA (V)
  (COND ((NULL V) 0)
	((NULL (CDR V))
	 (PLUS 2 (WIDTH (CAR V))))
	(T (PLUS 1
		 (WIDTH (CAR V))
		 (WIDTH (CADR V))
		 (DERWIDTHA (CDDR V))))))
 EXPR)

(DEFPROP DERSKP
 (LAMBDA (V)
	 (COND ((NULL (CDR V)) 1)
            ((NOT(NUMBERP(CADR V)))(DERSKP(CDR V)))
                ((NOT(ONEP(CADR V)))2)
                (T(DERSKP(CDDR V)))))
 EXPR)
(DEFPROP DERSUBSPAN
 (LAMBDA (U)
	 (MAX (COND ((DERNUMP U) 0)
		    (T (SUBSPAN (CADR U))))
	      (PLUS (DERSKP (CDDR U))
		    -1
		    (HEIGHT (CDDR U)))))
 EXPR)

(DEFPROP DERSUPERSPAN
 (LAMBDA (U)
  ((LAMBDA (DU)
    (MAX
     (PLUS (COND (DU (SUBSPAN (CADR U)))
		 (T 0))
	   (COND ((EQUAL (DORDER (CDDR U))
			 1)
		  1)
		 (T 2)))
     (COND ((NOT DU) (SUPERSPAN (CADR U)))
	   (T (HEIGHT (CADR U))))))
   (DERNUMP (CADR U))))
 EXPR)

(DEFPROP APPSETQ
 (LAMBDA (U X Y D)
	 ((LAMBDA (W)
		  (APP (CADDR U)
		       (PLUS X 5 W)
		       Y
		       (APP COLON
			    (PLUS X 1 W)
			    Y
			    (APP (CADR U)
				 X
				 Y
				 D))))
	  (WIDTH (CADR U))))
 EXPR)

(DEFPROP SETQWIDTH
	 (LAMBDA (U)
		 (PLUS 5
		       (WIDTH (CADR U))
		       (WIDTH (CADDR U))))
	 EXPR)

(QUOTE (FILE DEF3))

(DEFPROP TIMES APPTIMES APP)

(DEFPROP EXPT APPEXPT APP)

(DEFPROP QUOTIENT APPFRAC APP)

(DEFPROP TIMES TIMWIDTH WIDTH)

(DEFPROP EXPT EXPTWIDTH WIDTH)

(DEFPROP QUOTIENT FRACWIDTH WIDTH)

(DEFPROP EXPT EXPTSUPR SUPERSPAN)

(DEFPROP QUOTIENT FRACSUPR SUPERSPAN)

(DEFPROP EXPT EXPTSUB SUBSPAN)

(DEFPROP QUOTIENT FRACSUB SUBSPAN)

(DEFPROP PLUS APPPLUS APP)

(DEFPROP MINUS APPNEG APP)

(DEFPROP PLUS SUMWIDTH WIDTH)

(DEFPROP MINUS MINUSWIDTH WIDTH)

(DEFPROP EQUAL APPEQ APP)

(SETQ TALLPAR NIL)

(DEFPROP DERIV APPDERIV APP)

(DEFPROP DERIV DERSUBSPAN SUBSPAN)

(DEFPROP DERIV DERSUPERSPAN SUPERSPAN)

(DEFPROP DERIV DERWIDTH WIDTH)

(DEFPROP SETQ APPSETQ APP)

(DEFPROP SETQ SETQWIDTH WIDTH)

(SETQ COLON (QUOTE :))

(DEFPROP APPUNQUOTE(LAMBDA(U X Y D)(APP(CADR U)(ADD1 X)Y(APP(QUOTE ')X Y D)))EXPR)
(DEFPROP UNQUOTE APPUNQUOTE APP)
(DEFPROP UNQUOTE UNQUOTEWIDTH WIDTH)
(DEFPROP UNQUOTEWIDTH (LAMBDA(X)(ADD1(WIDTH(CADR X))))EXPR)
(DEFPROP APPMATRIX 
 (LAMBDA (*U X Y D) 
  (PROG (B P HMESH TALLPAR) 
(COND((ATOM(CADR *U))(RPLACD *U(CDDR *U))))
	(SETQ TALLPAR T) 
	(SETQ 
	 HMESH 
	 (MAPLIST 
	  (FUNCTION 
	   (LAMBDA (X) 
	    (WICOL 
	     (DIFFERENCE 
	      (ADD1 (LENGTH (CADR *U))) 
	      (LENGTH X)) 
	     (CDR *U)))) 
	  (CADR *U))) 
	(SETQ B (DIFFERENCE Y (SUBSPAN *U))) 
	(SETQ P (PLUS Y (SUPERSPAN *U))) 
	(SETQ 
	 D 
	 (APPRPAR 
	  (SUB1 (PLUS X (WIDTH *U))) 
	  Y 
	  B 
	  P 
	  (APPMATRIXA 
	   (CDR *U) 
	   (ADD1 X) 
	   (DIFFERENCE (PLUS Y 
			     (SUPERSPAN *U)) 
		       (SUPERSPAN (CADR *U))) 
	   (APPLPAR X Y B P D)))) 
	(RETURN D))) 
 EXPR) 
(DEFPROP APPMATRIXA 
 (LAMBDA (U X Y D) 
  (COND  
   ((NULL U) D) 
   (T 
    (APPMATRIXA 
     (CDR U) 
     X 
     (DIFFERENCE 
      Y 
      (PLUS 
       (SUBSPAN 
	(CAR U)) 
	2 
	(COND ((NULL (CDR U)) 0) 
	      (T (SUPERSPAN (CADR U)))))) 
      (APPROW (CAR U) HMESH X Y D))))) 
 EXPR) 
 
(DEFPROP APPROW 
 (LAMBDA (U HMESH X Y D) 
  (COND 
   ((NULL U) D) 
   (T 
    (APPROW 
     (CDR U) 
     (CDR HMESH) 
     (PLUS X (CAR HMESH)) 
     Y 
     (APP 
      (COND((ATOM(KEY U))(KEY U))(T(CAR U)))      (PLUS 
       X 
       (QUOTIENT 
	(DIFFERENCE (CAR HMESH) 
		    (WIDTH (CAR U))) 
	2)) 
      Y 
      D))))) 
 EXPR) 
(DEFPROP MXSUPR 
	 (LAMBDA (U) 
		 (QUOTIENT (AUXSUP (CDR U)) 
			   2)) 
	 EXPR) 
 
(DEFPROP MTXSUB 
 (LAMBDA (U) (DIFFERENCE (AUXSUP (CDR U)) 
			 (ADD1 (MXSUPR U)))) 
 EXPR) 
 
(DEFPROP MATRIX APPMATRIX APP) 
 
(DEFPROP MATRIX MTXWTH WIDTH) 
 
(DEFPROP MATRIX MXSUPR SUPERSPAN) 
 
(DEFPROP MATRIX MTXSUB SUBSPAN) 
(DEFPROP MAXL1 
 (LAMBDA (X) (COND ((NULL X) 0) 
		   ((MAX (CAR X) 
			 (MAXL1 (CDR X)))))) 
 EXPR) 
 
(DEFPROP PLUSL 
 (LAMBDA (X) 
	 (COND ((NULL X) 0) 
	       ((PLUS (CAR X) 
		      (PLUSL (CDR X)))))) 
 EXPR) 
 
(DEFPROP WICOL 
 (LAMBDA (*N U) 
  (MAXL1 
   (MAPCAR 
    (FUNCTION 
     (LAMBDA (X) 
	     (PLUS 3 
		   (WIDTH (ELT *N  X))))) 
    U))) 
 EXPR) 
 
(DEFPROP ELT 
	 (LAMBDA (N U) 
	(NTH U N))
	 EXPR) 
(DEFPROP MTXWTH 
 (LAMBDA (**U) 
  (PLUS 
   1 
   (PLUSL 
    (MAPLIST 
     (FUNCTION 
      (LAMBDA (X) 
       (WICOL 
	(DIFFERENCE (ADD1 (LENGTH (CADR **U))) 
		    (LENGTH X)) 
	(CDR **U)))) 
     (CADR **U))))) 
 EXPR) 
 



(DEFPROP AUXSUP
 (LAMBDA (U)
  (SUB1 (PLUSL (MAPLIST (FUNCTION (LAMBDA (X) (ADD1 (HEIGHT (CAR X))))) U))))
 EXPR)