Кое-что о Лиспе на Атари-8

[ezswift]

Вообще-то сделал.
Вот результат печати:

(DEFINEQ PP
(LAMBDA NIL
  (PPRINT S-EXP 2))
)

(DEFINEQ P
(LAMBDA NIL
  (PPRINT (CAR CURR) 2))
)

(DEFINEQ PPRINT
(LAMBDA (X IND)
  (PROG (TFLG)
        (PPAUX X IND)
        (TERPRI)))
)

(DEFINEQ PPAUX
(LAMBDA (X INDTN)
  (COND ((ATOM X)
         (PRIN2 X) (SETQ TFLG))
        ((ATOM (CAR X))
         ((LAMBDA (Y)
             (COND (Y (MULTARGS X INDTN (CDR Y)))
                   ((PROGN (PRIN1 LPAR)
                           (PRIN2 (CAR X))
                           (PPARGS (CDR X) INDTN)
                           (PRIN1 RPAR)
                           (SETQ TFLG))
                   )))
          (ASSOC (CAR X) *FORMATS*)))
        (((LAMBDA (IND1)
             (PROGN (PRIN1 LPAR)
                    (SETQ TFLG T)
                    (PPAUX (CAR X) IND1)
                    (TABRET INDTN)
                    (PPARGS (CDR X) IND1)
                    (PRIN1 RPAR)
                    (SETQ TFLG)))
          (+ INDTN 1))
        )))
)

(DEFINEQ MULTARGS
(LAMBDA (X INDTN L)
  ((LAMBDA (INDTN2)
      (PROGN (TABRET INDTN)
             (PRIN1 LPAR)
             (PRIN2 (CAR X))
             (PRIN1 BLANK)
             (PPAUX (CAR (CDR X)) INDTN2)
             (COND ((CDR (CDR X))
                    (MAPCAR (CDR (CDR X))
                            (QUOTE (LAMBDA (Y)
                               (PROG NIL
                                     (TABRET INDTN2)
                                     (PPAUX Y INDTN2)))))))
             (PRIN1 RPAR)
             (SETQ TFLG)))
   (+ INDTN (CAR L))))
)

(DEFINEQ PPARGS
(LAMBDA (X INDTN)
  (PROG NIL
        LOOP
        (COND ((EQ X)
               (RETURN))
              ((ATOM X)
               (PRIN1 (QUOTE " . ")) (PRIN1 X) (RETURN)))
        (PRIN1 BLANK)
        (PPAUX (CAR X) INDTN)
        (SETQ X (CDR X))
        (GO LOOP)))
)

(DEFINEQ TABRET
(LAMBDA (N)
  (PROG NIL
        (COND (TFLG (RETURN))
              ((TERPRI)
              ))
        (SETQ TFLG T)
        (COND ((> N LINE-WIDTH)
               (TERPRI) (TABX (SUB N LINE-WIDTH)))
              ((TABX N)
              ))))
)

(DEFINEQ *FORMATS*(NIL)
)

(DEFINEQ LPAR(NIL)
)

(DEFINEQ BLANK(NIL)
)

(DEFINEQ RPAR(NIL)
)

(DEFINEQ LINE-WIDTH(NIL)
)

(DEFINEQ TABX
(LAMBDA (N)
  (PROG (COUNT)
        (SETQ COUNT N)
        LOOP
        (SETQ COUNT (SUB COUNT 1))
        (COND ((> COUNT 0)
               (PRIN1 (QUOTE " ")) (GO LOOP)))
        (RETURN)))
)

(DEFINEQ LDUMP
(LAMBDA (PROPS)
  (PROGN (OPEN 1 8 (QUOTE P:))
         (PR# 1)
         (MAPCAR PROPS
                 (LAMBDA (X)
                    (PROGN (TERPRI)
                           (PRIN1 (QUOTE "(DEFINEQ "))
                           (PRIN1 X)
                           (PPRINT (GETD X))
                           (PRINT RPAR))))
         (PR# 0)
         (CLOSE 1)))
)

А вот файлик с программами. (нужно учесть что в текстовом редакторе формы не напечатать!)
pp.atr.zip
Это не zip, Надо убрать расширение.

zen

[Advertiser]