perm filename UTIL.LSP[P,BGB] blob
sn#009283 filedate 1974-04-16 generic text, type T, neo UTF8
00100 (DEFPROP ALPHA#
00200 (LAMBDA(LL)
00300 (PROG (ALPHABET)
00400 (SETQ ALPHABET
00500 (QUOTE
00600 (# A
00700 B
00800 C
00900 D
01000 E
01100 F
01200 G
01300 H
01400 I
01500 J
01600 K
01700 L
01800 M
01900 N
02000 O
02100 P
02200 Q
02300 R
02400 S
02500 T
02600 U
02700 V
02800 W
02900 X
03000 Y
03100 Z)))
03200 (RETURN
03300 (MAPCAR (FUNCTION CAR)
03400 (ATIZ#
03500 (MAPCAR (FUNCTION
03600 (LAMBDA(X)
03700 (APPEND
03800 (MAPCAR
03900 (FUNCTION
04000 (LAMBDA(Y)
04100 (READLIST
04200 (LIST (QUOTE //) Y))))
04300 (EXPLODEC X))
04400 (NCONS (NCONS X)))))
04500 LL))))))
04600 EXPR)
04700
04800 (DEFPROP WH
04900 (LAMBDA NIL
05000 (THTRACE (THEOREM T T)
05100 (THGOAL T T)
05200 (THASSERT T T)
05300 (THERASE T T)
05400 (THBKPT T T)))
05500 EXPR)
05600
05700 (DEFPROP PP#
05800 (LAMBDA(L)
05900 ((LAMBDA(H)
06000 (MAPC (FUNCTION
06100 (LAMBDA(C)
06200 (COND
06300 ((ATOM C)
06400 (MAPC (FUNCTION
06500 (LAMBDA(F)
06600 (COND
06700 ((SETQ L (GET C F))
06800 (TERPRI)
06900 (TERPRI)
07000 (SPRINT
07100 (LIST (QUOTE DEFPROP) C L F)
07200 LINEL
07300 0)))))
07400 H))
07500 ((SETQ H (APPEND C H))))))
07600 L))
07700 (COND ((NULL (CDR L)) L#) (T L##))))
07800 FEXPR)
07900
08000 (DEFPROP L#
08100 (NIL THEOREM THSUCCEED THFAIL VALUE)
08200 VALUE)
08300
00100 (DEFPROP LAMBDAFIX
00200 (LAMBDA(L)
00300 (PROG (INFILE OUTFILE ICH OCH NAME BODY TAG A B #FIX#)
00400 (PRINC (QUOTE INPUT/ FILE?))
00500 (SETQ INFILE (READ))
00600 (PRINT (QUOTE OUTPUT/ FILE?))
00700 (SETQ OUTFILE (READ))
00800 (SETQ ICH (QUOTE IN))
00900 (SETQ OCH (QUOTE OUT))
01000 (EVAL (LIST (QUOTE OUTPUT) OCH (QUOTE DSK:) OUTFILE))
01100 (EVAL (LIST (QUOTE INPUT) ICH (QUOTE DSK:) INFILE))
01200 (INC ICH NIL)
01300 (OUTC OCH NIL)
01400 Z (SETQ A (ERRSET (READ)))
01500 (COND ((EQ A (QUOTE $EOF$)) (OUTC NIL T)
01600 (INC NIL T)
01700 (RETURN (QUOTE DONE)))
01800 ((ATOM A) (TERPRI) (PRINT A) (GO Z))
01900 (T (SETQ A (CAR A))))
02000 (FIXλ A)
02100 (COND
02200 ((AND (MEMQ (CAR A) (QUOTE (DEFPROP DEFUN DE DF DM)))
02300 (NOT
02400 (MEMQ (CAR (LAST A))
02500 (QUOTE (THSUCCEED THFAIL)))))
02600 (EVAL (LIST (QUOTE GRINDEF) (EVAL A)))
02700 (OUTC NIL NIL)
02800 (PRINC (CADR A))
02900 (PRINC (QUOTE / ))
03000 (OUTC OCH NIL)
03100 (REMOB (CADR A)))
03200 (T (TERPRI)
03300 (PRINT A)
03400 (OUTC NIL NIL)
03500 (PRINT A)
03600 (OUTC OCH NIL)))
03700 (GO Z)))
03800 FEXPR)
03900
04000 (DEFPROP #FIXλ#
04100 (LAMBDA(L)
04200 (COND
04300 ((LESSP (LENGTH (CDDR L)) 2) (#FINDλ# (CDDR L)))
04400 (T (RPLACA (LAST (CDDR L))
04500 (LIST (QUOTE RETURN) (CAR (LAST (CDDR L)))))
04600 (RPLACD (CDR L)
04700 (LIST (APPEND (QUOTE (PROG NIL)) (CDDR L))))
04800 (#FINDλ# (CDDR (CADDR L))))))
04900 EXPR)
05000
05100 (DEFPROP #FINDλ#
05200 (LAMBDA(L)
05300 (MAPC (FUNCTION
05400 (LAMBDA(L1)
05500 (COND ((ATOM L1) NIL)
05600 ((EQ (CAR L1) (QUOTE LAMBDA)) (#FIXλ# L1))
05700 (T (#FINDλ# L1)))))
05800 L))
05900 EXPR)
06000
06100 (DEFPROP FIXλ
06200 (LAMBDA (L) (PROG NIL (#FINDλ# L) (RETURN L)))
06300 EXPR)
06400
06500 (DEFPROP MACROFIX
06600 (LAMBDA NIL
06700 (PROG (INFILE OUTFILE ICH OCH A)
06800 (PRINC (QUOTE INPUT/ FILE?))
06900 (SETQ INFILE (READ))
07000 (PRINC (QUOTE OUTPUT/ FILE?))
07100 (SETQ OUTFILE (READ))
07200 (SETQ ICH (QUOTE IN))
07300 (SETQ OCH (QUOTE OUT))
07400 (EVAL (LIST (QUOTE INPUT) ICH (QUOTE DSK:) INFILE))
07500 (EVAL (LIST (QUOTE OUTPUT) OCH (QUOTE DSK:) OUTFILE))
07600 (INC ICH NIL)
07700 (OUTC OCH NIL)
07800 Z (SETQ A (READCH))
07900 (AND (NUMBERP A) (GO Y))
08000 (AND (EQ A (QUOTE $EOF$)) (RETURN (QUOTE DONE)))
08100 (AND (EQ A (QUOTE $)) (SETQ A (PRINC (#READ#))) (GO X))
08200 (AND (EQ A (QUOTE ')) (SETQ A (QUOTE /@)))
08300 Y (PRINC A)
08400 X (GO Z)
08500 (OUTC NIL NIL)
08600 (PRINC A)
08700 (OUTC OCH NIL)
08800 (GO Z)))
08900 EXPR)
09000
09100
10200
10300 (DEFPROP #READ#
10400 (LAMBDA NIL
10500 (PROG (CHAR)
10600 (RETURN
10700 (COND
10800 ((EQ (SETQ CHAR (READCH)) (QUOTE ?))
10900 (LIST (QUOTE THV) (READ)))
11000 ((EQ CHAR (QUOTE E)) (LIST (QUOTE THEV) (READ)))
11100 ((EQ CHAR (QUOTE ←)) (LIST (QUOTE THNV) (READ)))
11200 ((EQ CHAR (QUOTE &))
11300 (PROG (A)
11400 (PRINC (QUOTE /@))
11500 (PRINC (QUOTE /"))
11600 CHLP (COND
11700 ((EQ (QUOTE &) (SETQ A (READCH)))
11800 (PRINC (QUOTE /"))
11900 (RETURN (QUOTE (QUOTE COMMENT)))))
12000 (PRINC A)
12100 (OUTC NIL NIL)
12200 (PRINC A)
12300 (OUTC OCH NIL)
12400 (GO CHLP)))
12500 ((EQ CHAR (QUOTE T)) (QUOTE (THTBF THTRUE)))
12600 ((EQ CHAR (QUOTE R)) (QUOTE THRESTRICT))
12700 ((EQ CHAR (QUOTE G)) (QUOTE THGOAL))
12800 ((EQ CHAR (QUOTE A)) (QUOTE THASSERT))
12900 ((PRINT (QUOTE ILLEGAL-PREFIX))
13000 (PRINC (QUOTE $))
13100 (PRINC CHAR)
13200 (PRINC (READ))
13300 (ERR NIL))))))
13400 EXPR)
00100 (QUOTE (END OF FILE))