Определение Лисп-компилятора на Лиспе
(defun compile-(s)(append (comp- s Nil)'(Ap Stop)))
(defun comp- (S N)(cond
((atom S) (list 'LD (adr S N)))
((eq (car S)'QUOTE) (list 'LDC (cadr S))) ((eq (car S)'CONS) (append (comp-(caddr S)N) (comp-(cadr S)N) 'CONS)) ((eq (car S)'CAR) (append (comp-(cadr S)N)'CAR)) ((eq (car S)'+) (append (comp-(cadr S)N) (comp- (caddr S)N) 'ADD))
((eq (car S)'IF) (let ( (then (list (comp-(caddr S)N) '(JOIN))) (else (list (comp-(cadddr S)N) '(JOIN)))) (append (comp-(cadr S)N) (list 'SEL then else))))
((eq (car S)'LAMBDA) (list 'LDF (comp-(caddr S) (append (cadr S) N)) 'RTN))
((eq (car S)'LET) (let* ((args (value (cddr S))) (mem (cons (var (cddr S)) N)) (body (append (comp-(cadr S)mem) 'RTN))) ((append (map #'(lambda(x)(comp- x N)) args) (list body 'AP)))))
((eq (car S)'LABEL) (let* ((args (value (cddr S))) (mem (cons (var (cddr S)) N)) (body (append (comp-(cadr S)mem) 'RTN))) ((append '(DUM) (map #'(lambda(x)(comp- x mem)) args) (list 'LDF body 'RAP))))) (T (append (map #'(lambda(x)(comp- x N)) (cdr S)) (list body 'AP)) ) ))
