pLISP
© '98 Thomas Mahler

SECD Compiler for LISPKIT Lisp

Preliminaries

Copyright: Copyright © 1998 ICS Institut fuer Cybernetic und Systemtheorie, Bochum, Germany. All rights reserved.
Copyright © 1997,98 Thomas Mahler
This is copyrighted software. By using the software, you agree to the following terms and conditions.
1. License for personal non-commercial use.: You may use the software only for your personal, noncommercial use.
2. No redistribution.: You may not distribute copies of the software to others. You may not place the software on any web site, Internet server, electronic bulletin board, or other information retrieval systems.
3. No warranty.: THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND. TO THE MAXIMUM EXTENT PERMITTED BY LAW, THE AUTHOR DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
4. Disclaimer.: IN NO EVENT WILL THE AUTHOR BE LIABLE TO YOU FOR ANY DAMAGES, INCLUDING ANY LOST PROFITS, LOST SAVINGS, OR OTHER INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE.
5. Notice of experimental software.: THIS SOFTWARE CONTAINS PROGRAMS OF AN EXPERIMENTAL NATURE, INCLUDING PROGRAMS THAT HAVE NOT BEEN FULLY TESTED. YOU AGREE TO ASSUME ALL RISKS INVOLVED IN THE USE OF EXPERIMENTAL AND UNTESTED SOFTWARE.
6. General.: For commercial use or if you intend to modify the code and to distribute modified code please contact the author:
mailto:thomas.mahler@essen.netsurf.de
http://www.techno.net/pcl/tm

About the Compiler

The Compiler for P. Hendersons LISPKIT to SECD Code has been included into this package as an example how use PLISP to perform some more complex tasks.
The compiled code CANNOT be used with the PLISP VM!
The compiler's source code has been adopted from P. Henderson in his classic Functional Programming: Application and Implementation, 1980, Prentice Hall.
See secd-test.html for an interesting example, where the compiler is used to bootrap itself.

 (define COMPILE (lambda (E)
    (COMP E (quote NIL) (quote (4 21)))))

 (define COMP (lambda (E N C)
    (if (atomp E)
        (cons (quote 1) (cons (LOCATION E N) C))
    (if (equal (car E) (quote QUOTE))
        (cons (quote 2) (cons (car (cdr E)) C))
    (if (equal (car E) (quote ADD))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 15) C)))
    (if (equal (car E) (quote SUB))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 16) C)))
    (if (equal (car E) (quote MUL))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 17) C)))
    (if (equal (car E) (quote DIV))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 18) C)))
    (if (equal (car E) (quote REM))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 19) C)))
    (if (equal (car E) (quote LEQ))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 20) C)))
    (if (equal (car E) (quote EQ))
        (COMP (car (cdr E)) N (COMP (car (cdr (cdr E))) N (cons (quote 14) C)))
    (if (equal (car E) (quote CAR))
        (COMP (car (cdr E)) N (cons (quote 10) C))
    (if (equal (car E) (quote CDR))
        (COMP (car (cdr E)) N (cons (quote 11) C))
    (if (equal (car E) (quote ATOM))
        (COMP (car (cdr E)) N (cons (quote 12) C))
    (if (equal (car E) (quote CONS))
        (COMP (car (cdr (cdr E))) N (COMP (car (cdr E)) N (cons (quote 13) C)))
    (if (equal (car E) (quote IF))
        (COMP (car (cdr E)) N (cons (quote 8)
                                    (cons (COMP (car (cdr (cdr E))) N (quote (9))) (cons (COMP (car (cdr (cdr (cdr E)))) N (quote (9))) C))))
         
    (if (equal (car E) (quote LAMBDA))
        (cons (quote 3) (cons (COMP (car (cdr (cdr E))) (cons (car (cdr E)) N)
                                    (quote (5))) C))
    (if (equal (car E) (quote LET))
        (COMPLIS (EXPRS (cdr (cdr E))) N (cons (quote 3)
                           (cons (COMP (car (cdr E)) (cons (VARS (cdr (cdr E))) N) (quote (5))) (cons (quote 4) C))))
    (if (equal (car E) (quote LETREC))
        (cons (quote 6) (COMPLIS (EXPRS (cdr (cdr E))) (cons (VARS (cdr (cdr E))) N)
                         (cons (quote 3) (cons (COMP (car (cdr E)) (cons (VARS (cdr (cdr E))) N) (quote (5))) (cons (quote 7) C)))))
        (COMPLIS (cdr E) N (COMP (car E) N (cons (quote 4) C))))))))))))))))))))))

 (define COMPLIS (lambda (E N C)
    (if (equal E (quote NIL)) (cons (quote 2) (cons (quote NIL) C))
        (COMPLIS (cdr E) N (COMP (car E) N (cons (quote 13) C))))))
 (define LOCATION (lambda (E N)
   (if (member E (car N))       (cons 0 (POSN E (car N)))
      (INCAR (LOCATION E (cdr N))))))
   
 (define POSN (lambda (E N)
      (if (equal E (car N)) 0 (+1 (POSN E (cdr N))))))
 (define INCAR (lambda (L) (cons (+1 (car L)) (cdr L))))

 (define VARS (lambda (D)
    (if (equal D (quote NIL)) (quote NIL)
        (cons (car (car D)) (VARS (cdr D))))))


 (define EXPRS (lambda (D)
    (if (equal D (quote NIL)) (quote NIL)
        (cons (cdr (car D)) (EXPRS (cdr D))))))