Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50216/bpre1.l
There are 2 other files named bpre1.l in the archive. Click here to see a list.
(DEFPROP MAX(LAMBDA(X Y)(COND((LESSP X Y)Y)(T X)))EXPR)
(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO)
(DEFPROP MCONS
(LAMBDA (L)
(COND ((NULL (CDDR L)) (CADR L))
(T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L))))))
MACRO)
(MAPC (FUNCTION (LAMBDA (X)
(PUTPROP (CAR X)
(CDR X)
(Q OP))))
(Q ((= 10 10 EQUAL)
(/+ 20 20 PLUS)
(* 30 30 TIMES)
(// 30 34 QUOTIENT)
(/- 20 24 DIFFERENCE)
(** 57 40 EXPT)
(/, 6 6 NIL)
(' 100 75 UNQUOTE)
(^ 57 40 EXPT)
(: 60 4 SETQ)
(/( 70 100)
(/) 0 -100)
)))
(PUTPROP(INTERN(ASCII 42))(Q(100 67 QUOTE))(Q OP))
(PUTPROP(INTERN(ASCII 175))(Q(-500 0))(Q OP))
(DEFPROP **X T SPECIAL)
(DEFPROP **Y T SPECIAL)
(DEFPROP BIGGET(LAMBDA(**X **Y)(PROG(ANS)
(SETQ ANS(ERRSET(GET1 **X **Y)NIL))
(COND(ANS(RETURN(CAR ANS))))
))EXPR)
(DEFPROP EXPT(LAMBDA(X Y)(PROG (ANS)
(SETQ ANS 1)
LOOP (COND((ZEROP Y)(RETURN ANS)))
(SETQ ANS(*TIMES X ANS))
(SETQ Y(SUB1 Y))
(GO LOOP)
))EXPR)
(DEFPROP EVEN(LAMBDA(X)(ZEROP(REMAINDER X 2)))EXPR)
(DEFPROP ODD(LAMBDA(X)(ONEP(REMAINDER X 2)))EXPR)
(DEFPROP POSFACTORS(LAMBDA(X)(COND
((OR(BIGGET X(QUOTE POSNUM))(BIGGET X(QUOTE NEGNUM)))
(ERLIST(QUOTE(POSFACTORS OF BIGNUM))))
(T(*POSFACTORS X))
))EXPR)
(MAPC
(FUNCTION
(LAMBDA (X)
(SET (CAR X)
(INTERN (LIST (CAR NIL)
(Q PNAME)
(LIST (CDDR (LSH (CADR X)
35))))))))
(Q ((TB 11) (LF 12)
(VT 13)
(FF 14)
(CR 15)
(RO 177)
(SP 40)
(CO 54)
(LP 50)
(RP 51)
(PT 56)
(AM 175)
(SL 57))))
(DEFPROP AM T SPECIAL)
(DEFPROP RO T SPECIAL)
(DEFPROP CR T SPECIAL)
(DEFPROP LF T SPECIAL)
(DEFPROP SP T SPECIAL)
(DEFPROP PT T SPECIAL)
(DEFPROP CO T SPECIAL)
(DEFPROP RP T SPECIAL)
(DEFPROP LP T SPECIAL)
(DEFPROP SL T SPECIAL)
(DEFPROP OP T SPECIAL)
(DEFPROP SYM T SPECIAL)
(DEFPROP TEMP1 T SPECIAL)
(DEFPROP TEMP2 T SPECIAL)
(DEFPROP COML T SPECIAL)
(DEFPROP ALI T SPECIAL)
(DEFPROP PDL T SPECIAL)
(DEFPROP SWITCH T SPECIAL)
(DEFPROP MYTURN T SPECIAL)
(DEFPROP TALLPAR T SPECIAL)
(DEFPROP COLON T SPECIAL)
(DEFPROP PERIOD T SPECIAL)
(DEFPROP SLASH T SPECIAL)
(DEFPROP BLANK T SPECIAL)
(DEFPROP ALLSTAR T SPECIAL)
(DEFPROP WARNING T SPECIAL)
(DEFPROP ERTALK T SPECIAL)
(DEFPROP SIMP T SPECIAL)
(DEFPROP EXPRLIST T SPECIAL)
(DEFPROP EQUATLIST T SPECIAL)
(DEFPROP FUNLIST T SPECIAL)
(DEFPROP MLABHIST T SPECIAL)
(DEFPROP DEPENDLIST T SPECIAL)
(DEFPROP *X T SPECIAL)
(DEFPROP PRED T SPECIAL)
(DEFPROP OLDSYS T SPECIAL)
(DEFPROP GRADLIST T SPECIAL)
(DEFPROP EXPR T SPECIAL)
(DEFPROP ORDL T SPECIAL)
(DEFPROP EXPOP T SPECIAL)
(DEFPROP EXPON T SPECIAL)
(DEFPROP ORDLA T SPECIAL)
(DEFPROP ORDLB T SPECIAL)
(DEFPROP ONET T SPECIAL)
(DEFPROP ZEROT T SPECIAL)
(DEFPROP MONET T SPECIAL)
(QUOTE (FILE EXTRA))
(DEFPROP PRINLIST
(LAMBDA (X)
(PROG()
(TERPRI)
(MAPCAR
(FUNCTION
(LAMBDA (Y) (PROG2 (PRINC Y)
(PRINC SP))))
X)
(TERPRI)))
EXPR)
(DEFPROP ERLIST
(LAMBDA (X)
(PROG2 (PRINLIST X) (ERR NIL)))
EXPR)
(DEFPROP ONEP
(LAMBDA (X) (MCONS (Q EQ) 1 (CDR X)))
MACRO)
(PUTPROP (QUOTE GET1)(GET(QUOTE GET)(QUOTE SUBR))(QUOTE SUBR))
(DEFPROP GET
(LAMBDA (X Y)
(COND ((NUMBERP X) NIL)
((GET1 X Y))))
EXPR)
(QUOTE (PRE1 AUG27))
(DEFPROP SOURCE
(LAMBDA NIL
(PROG
(CH COML)
READ
(COND ((EQ (SETQ CH (READCH)) AM)
(RETURN (REVERSE (MCONS AM
RP
COML))))
((EQ CH RO)
(COND (COML (PRINC (CAR COML))
(SETQ COML
(CDR COML)))
((PRINC CR))))
((EQ CH PT)
(ERLIST (Q (NO DECIMALS))))
((AND (NOT (NUMBERP CH))
(LESSP
(
LSH (MAKNUM (CAAR
(GET CH (Q PNAME)))
(QUOTE FIXNUM))
-11.)
32.)))
((SETQ COML (CONS CH COML))))
(GO READ)))
EXPR)
(DEFPROP SYL
(LAMBDA NIL
(PROG
(NAME1 NAME2)
(SETQ SYM TEMP1)
(SETQ OP TEMP2)
(SETQ TEMP2 (SETQ TEMP1 NIL))
(COND ((AND SYM OP) (RETURN NIL)))
LOOP
(COND ((NULL COML)
(SETQ OP (GET AM (Q OP)))
(GO OP1))
((EQ (CAR COML) SP) (GO SPACE))
((SETQ OP (GET (CAR COML) (Q OP)))
(COND ((EQ OP (GET AM (Q OP)))
(SETQ OP (GET RP (Q OP))))
((AND
(EQ OP (GET (Q *) (Q OP)))
(EQ (CADR COML) (Q *)))
(SETQ COML (CDR COML))
(SETQ OP (GET (Q **) (Q OP)))))
(GO OP)))
(SETQ NAME1 (CONS (CAR COML) NAME1))
(SETQ COML (CDR COML))
(GO LOOP)
SPACE
(SETQ COML (CDR COML))
(COND
(NAME1
(SETQ NAME1
(READLIST (REVERSE NAME1))))
(T (GO LOOP)))
(SETQ NAME1
(COND (ALI NAME1)
((COND ((GET NAME1
(Q ALIAS)))
(NAME1)))))
(COND
((AND (NOT ALI)
(SETQ NAME2
(GET NAME1
(QUOTE TOPCOM))))
(COND
((NOT (EQUAL PDL
(Q ((0 0 -1000) NIL))))
(ERLIST (APPEND(QUOTE(ILLEGAL USE OF))(LIST NAME1)))))
(SETQ ALI (MEMQ NAME2
(Q (ALIAS ALIASKILL))))
(COND
(SYM (SETQ TEMP1 NAME2)
(SETQ TEMP2 LP)
(RETURN (SETQ OP
(GET CO (Q OP))))))
(SETQ SYM NAME2)
(RETURN (SETQ OP (GET LP (Q OP)))))
((SETQ NAME2 (GET NAME1 (Q OP)))
(RETURN (SETQ OP NAME2)))
(SYM (SETQ TEMP1 NAME1)
(RETURN (SETQ OP
(GET CO (Q OP))))))
(SETQ SYM NAME1)
(SETQ NAME1 NIL)
(GO LOOP)
OP (SETQ COML (CDR COML))
OP1(SETQ
NAME1
(COND
(NAME1 (READLIST (REVERSE NAME1)))))
(SETQ NAME1
(COND (ALI NAME1)
((COND ((GET NAME1
(Q ALIAS)))
(NAME1)))))
(COND
((AND (NOT ALI)
(SETQ NAME2
(GET NAME1
(QUOTE TOPCOM))))
(COND
((NOT (EQUAL PDL
(Q ((0 0 -1000) NIL))))
(ERLIST (APPEND(QUOTE(ILLEGAL USE OF))(LIST NAME1)))))
(SETQ ALI (MEMQ NAME2
(Q (ALIAS ALIASKILL))))
(COND
(SYM (SETQ TEMP1 NAME2)
(SETQ TEMP2 LP)
(RETURN (SETQ OP
(GET CO (Q OP))))))
(SETQ SYM NAME2)
(RETURN (SETQ OP (GET LP (Q OP)))))
((SETQ NAME2 (GET NAME1 (Q OP)))
(SETQ TEMP2 OP)
(RETURN (SETQ OP NAME2)))
((AND SYM NAME1)
(SETQ TEMP1 NAME1)
(SETQ TEMP2 OP)
(RETURN (SETQ OP (GET CO (Q OP)))))
(T (RETURN (SETQ SYM
(COND (SYM)
(NAME1))))))))
EXPR)
(DEFPROP PRE1
(LAMBDA (COML)
(PROG
(OP SYM TEMP1 TEMP2 PDL PREC FNS ALI)
(SETQ PREC 0)
(SETQ PDL (Q ((0 0 -1000) NIL)))
READ
(SYL)
(COND (SYM (SETQ PDL
(CONS (CONS PREC
(NCONS SYM))
PDL)))
((EQ (CADDR OP) (Q DIFFERENCE))
(SETQ OP (Q (50 55 MINUS)))
(SETQ PDL
(CONS (NCONS PREC) PDL)))
((EQ (CADDR OP) (Q PLUS))
(GO READ))
((SETQ PDL
(CONS (NCONS PREC) PDL))))
LOOP
(COND
((LESSP (PLUS PREC (CAR OP))
(PLUS 1
(CAR (CADR PDL))
(CADDR (CADR PDL))))
(SETQ
PDL
(CONS
(COND
((AND
(CADDR PDL)
(CDR (CADDR PDL))
(NOT (ATOM (CADR (CADDR PDL))))
(EQ (CADDDR (CADR PDL))
(CAADR (CADDR PDL)))
(EQ (CAR (CADR PDL))
(CAR (CADDR PDL)))
(EQ (CADR (CADR PDL))
(CADDR (CADR PDL))))
(CONS
(CAR (CADR PDL))
(NCONS (APPEND (CADR (CADDR PDL))
(CDR (CAR PDL))))))
((CONS
(CAR (CADR PDL))
(NCONS
(APPEND (CDDDR (CADR PDL))
(CDR (CADDR PDL))
(CDR (CAR PDL)))))))
(CDDDR PDL)))
(GO LOOP))
((COND
((CDDR OP)
(SETQ PDL (CONS (CONS PREC OP) PDL)))
((COND
((MINUSP (CAR OP))
(RETURN (COND ((CDR (CAR PDL))
(CADR (CAR PDL))))))
((ZEROP (CAR OP))
(COND ((NULL (CDAR PDL)))
((NUMBERP(CADR(CAR PDL)))) ((EQ (CAADR (CAR PDL))
(Q SQRT))
(SETQ PDL
(CONS
(LIST
(CAAR PDL)
(LIST
(Q EXPT)
(CADADR (CAR PDL))
(Q (QUOTIENT 1
2))))
(CDR PDL)))))
(COND (FNS (PUTPROP (Q /,)
(CAR FNS)
(Q OP))
(SETQ FNS (CDR FNS))))
(SETQ PREC
(MAX -100
(PLUS PREC (CADR OP))))
(SYL)
(GO LOOP))
((SETQ PREC (PLUS PREC (CADR OP)))
(SETQ FNS (CONS (GET (Q /,) (Q OP))
FNS))
(COND
((CDAR PDL)
(PUTPROP
(Q /,)
((LAMBDA (X)
(MCONS (CAR X)
(CADR X)
(CDR (CAR PDL))))
(GET (Q /,) (Q OP)))
(Q OP))
(SETQ PDL
(MCONS (CONS PREC
(GET (Q /,)
(Q OP)))
(NCONS PREC)
(CDR PDL))))
((SETQ PDL (CDR PDL))))))))))
(GO READ)))
EXPR)
(DEFPROP SYLIST
(LAMBDA (COML)
(PROG (OP SYM TEMP1 TEMP2 ANS)
LOOP (SYL)
(SETQ ANS (CONS OP (CONS SYM ANS)))
(COND ((EQ OP (GET AM (Q OP)))
(RETURN (REVERSE ANS))))
(GO LOOP)))
EXPR)
(DEFPROP PRE
(LAMBDA NIL (PRE1 (SOURCE)))
EXPR)