(FILECREATED " 9-May-84 09:27:23" {PHYLUM}<DESRIVIERES>NLISP>CONVERTER.;1
 2554   

      changes to:  (VARS CONVERTERCOMS)
		   (FNS CONVERT-TO-INTERLISP U-CASE-AND-DOT U-CASE-AND-DOT-ATOMS))


(PRETTYCOMPRINT CONVERTERCOMS)

(RPAQQ CONVERTERCOMS
 ((FNS CONVERT-TO-INTERLISP U-CASE-AND-DOT U-CASE-AND-DOT-ATOMS)))
(DEFINEQ

(CONVERT-TO-INTERLISP

  [LAMBDA (FILE NEW-FILE-NAME)                               (* edited: " 8-May-84 13:58")

    (PROG (X EXP UEXP EXPR-LIST STREAM COMS FNS)
          (CLOSEF? FILE)
          (SETQ STREAM (OPENTEXTSTREAM FILE NIL))
          (SETQ COMS (CONS NIL NIL))
          (SETQ FNS (CONS NIL NIL))
          [NLSETQ (while
 T
		     do
 (SETQ EXP (READ STREAM T))
			(SETQ UEXP (U-CASE-AND-DOT-ATOMS
 EXP))
			(COND
			  [(NLISTP UEXP)
			    (printout
 NIL "[" UEXP "] " T)
			    (TCONC COMS (LIST (QUOTE P)
					      (LIST (QUOTE QUOTE)
						    UEXP]
			  ((EQ (CAR UEXP)
			       (QUOTE DEFUN))
			    (printout
 NIL (CADR UEXP)
				      ", ")
			    (ERSETQ (EVAL UEXP))
			    (TCONC FNS (CADR UEXP)))
			  ((EQ (CAR UEXP)
			       (QUOTE DEFINEQ))
			    (printout
 NIL (CAADR UEXP)
				      ", ")
			    (ERSETQ (EVAL UEXP))
			    (TCONC FNS (CAADR UEXP)))
			  ((EQ (CAR UEXP)
			       (QUOTE SETQ))
			    (printout
 NIL (CADR UEXP)
				      ", ")
			    (TCONC X UEXP))
			  (T (printout
 NIL "(" (CAR UEXP)
				       ") ")
			     (TCONC X UEXP]
          (printout
 NIL T)
          (CLOSEF? STREAM)
          (SETQ EXPR-LIST (CAR X))
          [FOR
 E IN
 EXPR-LIST DO
 (IF
 (NEQ E (QUOTE STOP))
				     THEN
 (ERSETQ (EVAL E T]
          (SETTOPVAL (PACK (LIST NEW-FILE-NAME (QUOTE COMS)))
		     COMS)
          (RETURN EXPR-LIST])

(U-CASE-AND-DOT

  [LAMBDA (LITATOM)                                          (* edited: " 8-May-84 13:01")

    (PROG (EXPLODED.VERSION)
          (SETQ EXPLODED.VERSION (UNPACK LITATOM))
          (RETURN (COND
		    ((MEMBER (QUOTE -)
			     EXPLODED.VERSION)
		      (PACK (DSUBST (QUOTE %.)
				    (QUOTE -)
				    EXPLODED.VERSION)))
		    (T LITATOM])

(U-CASE-AND-DOT-ATOMS

  [LAMBDA (X)                                                (* edited: " 8-May-84 13:10")

    (PROG NIL
          [COND
	    ((LITATOM X)
	      (RETURN (U-CASE-AND-DOT
 X]
          (COND
	    ((NLISTP X)
	      (RETURN X)))
          (COND
	    ((EQ (CAR X)
		 (QUOTE *))
	      (RETURN X)))
          (RETURN (for
 E in
 X collect
 (U-CASE-AND-DOT-ATOMS
 E])
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (321 2532 (CONVERT-TO-INTERLISP 331 . 1752) (U-CASE-AND-DOT 1754 . 2121) (
U-CASE-AND-DOT-ATOMS 2123 . 2530)))))
STOP