Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0039/disp9.l
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)