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))