├── .gitignore ├── ChangeLog.orig ├── Makefile ├── Makefile.orig ├── README.md ├── README.orig ├── Vagrantfile ├── bigloo ├── book.scm ├── hack.scm └── rtbook.scm ├── common ├── additional-libs.scm ├── book.scm ├── compat │ ├── callcc.scm │ ├── gensym.scm │ ├── load-relative.scm │ ├── property-lists.scm │ └── symbol-append.scm ├── definitions.scm ├── format.scm ├── generics.scm ├── meroonet.scm ├── pp.scm ├── syntax.scm └── toplevel.scm ├── gambit ├── book.scm └── gambit-book.scm ├── guile ├── book.scm └── guile-book.scm ├── meroonet ├── Imakefile ├── Notice ├── meroonet.scm ├── oo-tests.scm ├── oo-tmp.scm ├── variante1.scm ├── variante2.scm ├── variante3.scm ├── variante4.scm └── variante5.scm ├── mitscheme ├── book.scm └── mit-book.scm ├── perl └── check.prl ├── reflection.doc ├── si ├── after.scm ├── bibexp.scm ├── bibrun.scm ├── chap8j.scm ├── chap9b.scm ├── chap9c.scm ├── example.scm ├── fact.scm ├── ffact.scm ├── fib.scm ├── foo.scm ├── loading.scm ├── reflisp.scm └── tmp.scm └── src ├── c ├── Imakefile ├── c10ex.c ├── c10kex.c ├── chap10ex.c ├── chap10kex.c ├── loop.c ├── rt.c ├── rt.h ├── scheme.c ├── scheme.h ├── schemeklib.c └── schemelib.c ├── chap1.scm ├── chap1.tst ├── chap10a.scm ├── chap10b.scm ├── chap10c.scm ├── chap10d.scm ├── chap10e.scm ├── chap10e.tst ├── chap10ex.scm ├── chap10f.scm ├── chap10g.scm ├── chap10h.scm ├── chap10i.scm ├── chap10j.scm ├── chap10j.tst ├── chap10k.scm ├── chap10k.tst ├── chap10l.scm ├── chap10m.scm ├── chap10n.scm ├── chap10p.scm ├── chap1a.scm ├── chap1b.scm ├── chap1c.scm ├── chap1d.scm ├── chap2a.scm ├── chap2a.tst ├── chap2b.scm ├── chap2b.tst ├── chap2c.scm ├── chap2c.tst ├── chap2d.scm ├── chap2e.scm ├── chap2e.tst ├── chap2f.scm ├── chap2f.tst ├── chap2g.scm ├── chap2g.tst ├── chap2h.scm ├── chap2h.tst ├── chap3a.scm ├── chap3a.tst ├── chap3b.scm ├── chap3c.scm ├── chap3d.scm ├── chap3e.scm ├── chap3f.scm ├── chap3f.tst ├── chap3g.scm ├── chap3h.scm ├── chap3i.scm ├── chap3j.scm ├── chap4.scm ├── chap4.tst ├── chap4a.scm ├── chap4a.tst ├── chap5-bench.scm ├── chap5a.scm ├── chap5b.scm ├── chap5b.tst ├── chap5c.scm ├── chap5c.tst ├── chap5d.scm ├── chap5e.scm ├── chap5e.tst ├── chap5f.scm ├── chap5g.scm ├── chap5g.tst ├── chap5h.scm ├── chap6a.scm ├── chap6b.scm ├── chap6b.tst ├── chap6c.scm ├── chap6d.scm ├── chap6dd.scm ├── chap6dd.tst ├── chap6e.scm ├── chap6f.scm ├── chap6g.scm ├── chap6g.tst ├── chap6h.scm ├── chap7a.scm ├── chap7b.scm ├── chap7c.scm ├── chap7d.scm ├── chap7d.tst ├── chap7e.scm ├── chap7f.scm ├── chap7g.scm ├── chap7h.scm ├── chap7i.scm ├── chap8.tst ├── chap8a.scm ├── chap8a.tst ├── chap8b.scm ├── chap8b.tst ├── chap8c.scm ├── chap8d.scm ├── chap8e.scm ├── chap8f.scm ├── chap8g.scm ├── chap8h.scm ├── chap8h.tst ├── chap8i.scm ├── chap8i.tst ├── chap8j.scm ├── chap8j.tst ├── chap8k.scm ├── chap9a.scm ├── chap9a.tst ├── chap9b.scm ├── chap9c.scm ├── chap9c.tst ├── chap9d.scm ├── chap9e.scm ├── chap9f.scm ├── chap9z.scm ├── scheme.tst ├── showGC.s2c ├── syntax.tst └── tester.scm /.gitignore: -------------------------------------------------------------------------------- 1 | o/* 2 | /TAGS 3 | \#*\# 4 | .\#* 5 | .vagrant 6 | README.html 7 | -------------------------------------------------------------------------------- /Vagrantfile: -------------------------------------------------------------------------------- 1 | # -*- mode: ruby -*- 2 | # vi: set ft=ruby : 3 | 4 | # All Vagrant configuration is done below. The "2" in Vagrant.configure 5 | # configures the configuration version (we support older styles for 6 | # backwards compatibility). Please don't change it unless you know what 7 | # you're doing. 8 | Vagrant.configure(2) do |config| 9 | config.vm.box = "appleby/lisp-in-small-pieces-vm" 10 | end 11 | -------------------------------------------------------------------------------- /bigloo/book.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; This file defines an interpreter containing all that is needed to 17 | ;;; interpret the programs of C. Queinnec's book. This file is to be 18 | ;;; compiled by Bigloo. It contains Meroonet, the syntax-case package 19 | ;;; of Hieb and Dybvig, and the tester utility to run test suites. 20 | 21 | (module book (main main) 22 | ;; Import the run-time of this interpreter 23 | (import (rtbook "bigloo/rtbook.scm")) ) 24 | 25 | ;;; Start the interpreter. In fact everything comes from the rtbook 26 | ;;; module which is separately compiled in order to provide a library 27 | ;;; which can be linked with other programs. See an example with the 28 | ;;; test.chap6a.bgl entry of the Makefile. 29 | 30 | (define (main options) 31 | (format #f "") ; forces rtbookp to be linked 32 | (start) ) 33 | 34 | ;;; end of book.scm 35 | -------------------------------------------------------------------------------- /bigloo/hack.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: hack.bgl,v 1.5 1998/05/01 09:38:43 queinnec Exp queinnec $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; NOTE: I'm not sure whether the following comments are any longer relevant. 19 | 20 | ;(display "starting hack.scm")(newline) ;; DEBUG 21 | 22 | ;;; Three macros are defined in meroonet.scm: define-class, 23 | ;;; define-method and define-generic. They must be compiled and made 24 | ;;; pervasive so that interpreters containing meroonet.o code make 25 | ;;; these macros available. Fortunately, they are not needed by 26 | ;;; meroonet itself so they must be only installed at run-time. 27 | 28 | (define-macro (define-meroonet-macro call . body) 29 | `(begin (eval '(define-macro ,call . ,body)) 30 | (define-macro ,call . ,body) ) ) 31 | 32 | ;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo 33 | ;;; The define-abbreviation macro is used throughout the book and 34 | ;;; should be present in the generated interpreter. 35 | 36 | ;;; This code is compiled with Bigloo so it is expanded by Bigloo's 37 | ;;; expand which knows the define-meroonet-macro which was defined 38 | ;;; just before. It will generate a Dybvig-macro named 39 | ;;; define-abbreviation whose aim is to be a Dybvig-macro 40 | ;;; definer. That's why define-meroonet-macro and define-abbreviation 41 | ;;; use the same expander (except that macros defined by 42 | ;;; define-meroonet-macro call a compiled expander whereas macros 43 | ;;; defined by define-abbreviation are interpreted since they are 44 | ;;; defined on the fly). 45 | 46 | (define-meroonet-macro (define-abbreviation call . body) 47 | `(begin (eval '(define-macro ,call . ,body)) 48 | (define-macro ,call . ,body) ) ) 49 | 50 | ;(display "end of hack.scm")(newline) ;; DEBUG 51 | 52 | ;;; end of hack.scm 53 | -------------------------------------------------------------------------------- /common/additional-libs.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; pp is already present but not format. but format needs internal functions 17 | ;;; of pp so redefine pp. 18 | 19 | (load-relative "common/pp.scm") 20 | (load-relative "common/format.scm") 21 | 22 | ;;; Load the test-driver. 23 | 24 | (load-relative "src/tester.scm") 25 | -------------------------------------------------------------------------------- /common/book.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: book.scm,v 1.6 1996/02/11 14:09:30 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (load-relative "common/definitions.scm") 19 | (load-relative "common/additional-libs.scm") 20 | (load-relative "common/syntax.scm") 21 | (load-relative "common/meroonet.scm") 22 | (load-relative "common/generics.scm") 23 | (load-relative "common/toplevel.scm") 24 | 25 | ;;; Warp into the new toplevel. 26 | (start) 27 | ;;; end of book.scm 28 | -------------------------------------------------------------------------------- /common/compat/callcc.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | (define call/cc call-with-current-continuation) 17 | -------------------------------------------------------------------------------- /common/compat/gensym.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | (define gensym 17 | (let ((counter 99)) 18 | (lambda args 19 | (set! counter (+ counter 1)) 20 | (string->symbol 21 | (string-append 22 | (if (pair? args) (car args) "G") 23 | (number->string counter) ) ) ) ) ) 24 | -------------------------------------------------------------------------------- /common/compat/load-relative.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; This is a hack to support Guile. In Bigloo, Mit, and Gambit, if 17 | ;;; the argument to `load' is a relative path, it's considered to be 18 | ;;; relative to the scheme process' current working directory. In 19 | ;;; Guile, however, it's considered to be relative to the file which 20 | ;;; contains the `load' form. As such, we use `load-relative' in place 21 | ;;; of `load' in all common/* files, and override `load-relative' in 22 | ;;; guile/guile-book.scm. All other schemes merely include this file. 23 | (define load-relative load) 24 | -------------------------------------------------------------------------------- /common/compat/property-lists.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | (define putprop 'wait) 17 | (define getprop 'wait) 18 | 19 | (let ((properties '())) 20 | (set! putprop 21 | (lambda (symbol key value) 22 | (let ((plist (assq symbol properties))) 23 | (if (pair? plist) 24 | (let ((couple (assq key (cdr plist)))) 25 | (if (pair? couple) 26 | (set-cdr! couple value) 27 | (set-cdr! plist (cons (cons key value) 28 | (cdr plist) )) ) ) 29 | (let ((plist (list symbol (cons key value)))) 30 | (set! properties (cons plist properties)) ) ) ) 31 | value ) ) 32 | (set! getprop 33 | (lambda (symbol key) 34 | (let ((plist (assq symbol properties))) 35 | (if (pair? plist) 36 | (let ((couple (assq key (cdr plist)))) 37 | (if (pair? couple) 38 | (cdr couple) 39 | #f ) ) 40 | #f ) ) ) ) ) 41 | -------------------------------------------------------------------------------- /common/compat/symbol-append.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | (define (symbol-append . args) 17 | (string->symbol 18 | (apply string-append 19 | (map (lambda (s) 20 | (cond ((string? s) s) 21 | ((symbol? s) (symbol->string s)) 22 | ((number? s) (number->string s)) 23 | (else (error 'symbol-append 'bad-args args)) ) ) 24 | args ) ) ) ) 25 | -------------------------------------------------------------------------------- /common/definitions.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; Missing functions: 17 | 18 | (define (atom? x) (not (pair? x))) 19 | 20 | (define (iota start end) 21 | (if (< start end) 22 | (cons start (iota (+ 1 start) end)) 23 | '() ) ) 24 | 25 | (define (every? p . args) 26 | (let andmap ((args args) (value #t)) 27 | (if (let any-at-end? ((ls args)) 28 | (and (pair? ls) 29 | (or (not (pair? (car ls))) 30 | (any-at-end? (cdr ls))))) 31 | value 32 | (let ((value (apply p (map car args)))) 33 | (and value (andmap (map cdr args) value)))))) 34 | 35 | (define (any? p . args) 36 | (let ormap ((args args) (value #f)) 37 | (if (let any-at-end? ((ls args)) 38 | (and (pair? ls) 39 | (or (not (pair? (car ls))) 40 | (any-at-end? (cdr ls))))) 41 | value 42 | (let ((value (apply p (map car args)))) 43 | (or value (ormap (map cdr args) value)))))) 44 | 45 | ;;; Calls to this function might be generated by syntax-case.scm 46 | 47 | (define (list* . args) 48 | (if (pair? args) 49 | (if (pair? (cdr args)) 50 | (cons (car args) (apply list* (cdr args))) 51 | (car args) ) 52 | (quote ()) ) ) 53 | 54 | ;;; Name the Un*x ports 55 | (define stdout-port (current-output-port)) 56 | (define stderr-port (current-error-port)) 57 | 58 | ;;; Quick and dirty: sometimes very big objects are printed, limit 59 | ;;; them to something affordable. 60 | (define *bounded-length* 4) 61 | (define *bounded-depth* 3) 62 | 63 | (define (bounded-display o stream) 64 | (define (print-list o* len dep) 65 | (cond ((null? o*) #t) 66 | ((atom? o*) (display " . " stream) 67 | (display o* stream) ) 68 | ((pair? o*) 69 | (print (car o*) len (+ dep 1)) 70 | (if (pair? (cdr o*)) (display " " stream)) 71 | (print-list (cdr o*) (+ len 1) dep) ) ) ) 72 | (define (print o len dep) 73 | (cond ((Object? o) 74 | (display "#<" stream) 75 | (display (Class-name (object->class o)) stream) 76 | (display ">" stream) ) 77 | ((atom? o) (display o stream)) 78 | (else (if (or (> len *bounded-length*) 79 | (> dep *bounded-depth*) ) 80 | (display "&&&" stream) 81 | (begin 82 | (display "(" stream) 83 | (print-list o len dep) 84 | (display ")" stream) ) ) ) ) ) 85 | (print o 0 0) ) 86 | ;;; Test: (bounded-display (call-with-input-file "si/reflisp.scm" read) stdout-port) 87 | 88 | ;;; Generally, when an error is detected in one of my programs, a 89 | ;;; -error function is called which calls itself wrong. The 90 | ;;; wrong function allows the test-driver to be aware that something 91 | ;;; went wrong. 92 | 93 | (define wrong 'wait) 94 | (define static-wrong 'wait) 95 | 96 | ;;; Defines specific locations for error handlers for meroonet.scm and 97 | ;;; tester.scm. They will be filled later. 98 | 99 | (define meroonet-error 'wait) 100 | (define tester-error 'wait) 101 | 102 | ;;; This variable is needed by meroonet/oo-tests.scm test suite. 103 | (define the-Point 'useful4tests) 104 | -------------------------------------------------------------------------------- /common/generics.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; The `show' and `clone' generic functions are predefined in Meroon not in 17 | ;;; Meroonet. The clone function that performs a shallow copy of a Meroonet 18 | ;;; object. 19 | 20 | (eval '(begin 21 | (define-generic (show (o) . stream) 22 | (let ((stream (if (pair? stream) (car stream) 23 | (current-output-port) ))) 24 | (bounded-display o stream) ) ) 25 | (define-generic (clone (o)) 26 | (list->vector (vector->list o)) ) ) ) 27 | 28 | -------------------------------------------------------------------------------- /common/meroonet.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; Load Meroonet. Meroonet defines three macros with 17 | ;;; define-meroonet-macro. 18 | (define-macro (define-meroonet-macro call . body) 19 | `(define-macro ,call . ,body) ) 20 | 21 | (load-relative "meroonet/meroonet.scm") 22 | -------------------------------------------------------------------------------- /common/syntax.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; All of bigloo, gambit, guile, and mit-scheme now have WHEN and 17 | ;;; UNLESS defined by default, and gambit complains if you try to 18 | ;;; redefine them. 19 | 20 | ;;; Two macros that I frequently use: 21 | ;; (define-syntax unless 22 | ;; (syntax-rules () 23 | ;; ((unless condition form ...) 24 | ;; (if (not condition) (begin form ...)) ) ) ) 25 | 26 | ;; (define-syntax when 27 | ;; (syntax-rules () 28 | ;; ((when condition form ...) 29 | ;; (if condition (begin form ...)) ) ) ) 30 | 31 | ;;; Since the define-abbreviation is also necessary for the book when non high 32 | ;;; level macros are defined, register define-abbreviation for syntax-case. 33 | 34 | (define-syntax define-abbreviation 35 | (syntax-rules () 36 | ((define-abbreviation call . body) 37 | (define-macro call . body) ) ) ) 38 | -------------------------------------------------------------------------------- /common/toplevel.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; This function loads a file expanded with syntax-expand. 17 | 18 | ;;; This function is not needed anymore, since the built-in load can 19 | ;;; now do syntax-case expansion. Leaving this here for now since the verbose 20 | ;;; loading might prove useful for debugging. -- appleby 21 | 22 | (define *syntax-case-load-verbose?* #f) 23 | 24 | (define (syntax-case-load file) 25 | (call-with-input-file file 26 | (lambda (in) 27 | (if *syntax-case-load-verbose?* 28 | (begin (newline) 29 | (display ";;; Loading ") 30 | (display file) 31 | (newline) ) ) 32 | (let loop ((e (read in))) 33 | (if (eof-object? e) 34 | file 35 | (let ((r (eval e))) 36 | (if *syntax-case-load-verbose?* 37 | (begin (display ";= ") 38 | (display r) 39 | (newline) ) ) 40 | (loop (read in)) ) ) ) ) ) ) 41 | 42 | ;;; This function will test a suite of tests. 43 | 44 | (define (test file) 45 | (suite-test 46 | file "?? " "== " #t 47 | make-toplevel 48 | equal? ) ) 49 | ;;; Test: 50 | ;;; (test "meroonet/oo-tests.scm") 51 | ;;; (test "src/syntax.tst") 52 | 53 | ;;; A small toplevel loop. 54 | (define (start) 55 | (display "[C. Queinnec's book] ") 56 | (display book-interpreter-name) 57 | (display "+Meroonet...") 58 | (newline) 59 | ;(set! *syntax-case-load-verbose?* #t) 60 | ;(set! load syntax-case-load) 61 | (interpreter 62 | "? " "= " #t 63 | make-toplevel ) 64 | (display " Ite LiSP est.") 65 | (newline) 66 | (exit 0) ) 67 | -------------------------------------------------------------------------------- /gambit/book.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | (load "gambit/gambit-book.scm") 16 | (load "common/compat/load-relative.scm") 17 | (load "common/compat/gensym.scm") 18 | (load "common/compat/property-lists.scm") 19 | (load "common/compat/symbol-append.scm") 20 | (load "common/book.scm") 21 | -------------------------------------------------------------------------------- /gambit/gambit-book.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; This file customizes the Gambit interpreter from Marc Feeley in order 17 | ;;; to run the source files of the book. I did not try to compile it yet. 18 | ;;; Under Unix, start gsi as: 19 | ;;; gsi '(include "gambit/book.scm")' 20 | ;;; 21 | ;;; See mit-scheme/mit-book.scm for a fully-commented version of this 22 | ;;; file that can be used as a template for ports to other scheme's. 23 | 24 | ;;; Gambit-specific code. 25 | 26 | ;;; Last-pair and reverse! are need to run the book sources and are included in 27 | ;;; both Bigloo and Mit-Scheme, but missing in Gambit. 28 | 29 | (define (last-pair l) 30 | (if (pair? l) 31 | (if (pair? (cdr l)) 32 | (last-pair (cdr l)) 33 | l ) 34 | (support-error 'last-pair l) ) ) 35 | 36 | (define (reverse! l) 37 | (define (nreverse l r) 38 | (if (pair? l) 39 | (let ((cdrl (cdr l))) 40 | (set-cdr! l r) 41 | (nreverse cdrl l) ) 42 | r ) ) 43 | (nreverse l '()) ) 44 | 45 | ;;; General definitions. 46 | 47 | (define book-interpreter-support 'gsi) 48 | 49 | (define book-interpreter-name "Gambit") 50 | 51 | (define (system command) 52 | (shell-command command)) 53 | 54 | (define flush-buffer force-output) 55 | 56 | (define (get-internal-run-time) 57 | (time->seconds (current-time))) 58 | 59 | (define (display-exception values) 60 | (let ((exc (car values))) 61 | (display exc) 62 | (cond ((unbound-global-exception? exc) 63 | (display ", VAR = ") 64 | (display (unbound-global-exception-variable exc)) 65 | (display ", RTE = ") 66 | (display (unbound-global-exception-rte exc)) ) 67 | ((datum-parsing-exception? exc) 68 | (display ", KIND = ") 69 | (display (datum-parsing-exception-kind exc)) 70 | (display ", PARAMS = ") 71 | (display (datum-parsing-exception-parameters exc)) ) 72 | ((error-exception? exc) 73 | (display ", MESSAGE = ") 74 | (display (error-exception-message exc)) 75 | (display ", PARAMS = ") 76 | (display (error-exception-parameters exc)) ) 77 | ((type-exception? exc) 78 | (display ", PROC = ") 79 | (display (type-exception-procedure exc)) 80 | (display ", ARGS = ") 81 | (display (type-exception-arguments exc)) 82 | (display ", ARGNUM = ") 83 | (display (type-exception-arg-num exc)) 84 | (display ", TYPEID = ") 85 | (display (type-exception-type-id exc)) ) ) ) ) 86 | 87 | (define (make-toplevel read print-or-check err) 88 | (set! tester-error err) 89 | (set! meroonet-error err) 90 | (current-user-interrupt-handler 91 | (lambda () 92 | (newline stderr-port) 93 | (display "*** INTERRUPT" stderr-port) 94 | (newline stderr-port) 95 | (err '***) ) ) 96 | (lambda () 97 | (with-exception-catcher err 98 | (lambda () 99 | (let* ((e (read)) 100 | (r (eval e)) ) 101 | (print-or-check r) ) ) ) ) ) 102 | -------------------------------------------------------------------------------- /guile/book.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | (primitive-load "guile/guile-book.scm") 16 | (primitive-load "common/compat/property-lists.scm") 17 | (primitive-load "common/book.scm") 18 | -------------------------------------------------------------------------------- /guile/guile-book.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | 16 | ;;; This file is used to customize Guile in order to run the source 17 | ;;; files of the book. 18 | ;;; 19 | ;;; See mit-scheme/mit-book.scm for a fully-commented version of this 20 | ;;; file that can be used as a template for ports to other scheme's. 21 | 22 | ;;; Guile-specific code. 23 | 24 | ;;; Guile's eval requires a second argument, the environment. Redefine eval to 25 | ;;; make the second argument optional, so as not to break code that expects a 26 | ;;; one-arg eval. 27 | (define native-eval eval) 28 | 29 | (define (eval exp . env) 30 | (native-eval exp (if (null? env) (interaction-environment) (car env))) ) 31 | 32 | ;;; Define `load-relative' to be `primitive-load', rather than `load' 33 | ;;; so that loading of files in common/* works as expected. See the 34 | ;;; comment in common/compat/load-relative.scm for more info. 35 | (define load-relative primitive-load) 36 | 37 | ;;; Guile doesn't have pp. Load pretty-print from common/pp.scm (which 38 | ;;; will get re-loaded from common/book.scm). 39 | (primitive-load "common/pp.scm") 40 | (define pp pretty-print) 41 | 42 | ;;; Pull in SRFI 43 for vector operations. 43 | (use-modules (srfi srfi-43)) 44 | 45 | ;;; General definitions. 46 | 47 | (define book-interpreter-support 'guile) 48 | 49 | (define book-interpreter-name "Guile") 50 | 51 | (define flush-buffer force-output) 52 | 53 | (define (get-internal-run-time) 54 | (current-time) ) 55 | 56 | (define (display-exception args) 57 | (if (and (symbol? (car args)) 58 | (= 5 (length args))) 59 | ;; Args smell like a guile exception. Call display-error. 60 | (apply display-error #f (current-error-port) (cdr args)) 61 | ;; Not a guile exception, most likely a call to wrong. 62 | (display args))) 63 | 64 | (define (make-toplevel read print-or-check err) 65 | (set! tester-error err) 66 | (set! meroonet-error err) 67 | (lambda () 68 | (catch #t 69 | (lambda () 70 | (let ((e (read))) 71 | (print-or-check (eval e (interaction-environment))) ) ) 72 | err ) ) ) 73 | -------------------------------------------------------------------------------- /meroonet/variante1.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: variante1.scm,v 1.5 2006/11/25 17:44:13 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This file is part of the Meroonet package. 19 | 20 | ;;; VARIANT 1: a simple-minded define-class 21 | 22 | ;;; a define-class that works only for interpreters, the class is 23 | ;;; created at macroexpansion time and grafted to the inheritance tree 24 | ;;; at that same time. The version in Meroonet is safer. 25 | 26 | (define-meroonet-macro (define-class name super-name 27 | own-field-descriptions ) 28 | (let ((class (register-class name super-name 29 | own-field-descriptions ))) 30 | (Class-generate-related-names class) ) ) 31 | 32 | ;;; end of variante1.scm 33 | -------------------------------------------------------------------------------- /meroonet/variante3.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: variante3.scm,v 1.2 1994/08/21 19:35:09 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This file is part of the Meroonet package. 19 | 20 | ;;; VARIANT 3: More reflective classes 21 | 22 | ;;; First make generic some functions so they can be specialized on 23 | ;;; new metaclasses. Then make Meroonet use these new functions 24 | ;;; instead. 25 | 26 | (define-generic (generate-related-names (class))) 27 | 28 | (define-method (generate-related-names (class Class)) 29 | (Class-generate-related-names class) ) 30 | 31 | ;;; The other initialization parameters must be given in correct order. 32 | 33 | (define-generic (initialize! (o) . args)) 34 | 35 | (define-method (initialize! (o Class) . args) 36 | (apply Class-initialize! o args) ) 37 | 38 | ;;; Define new metaclass with additional slots to hold the predicate, 39 | ;;; the allocator and the maker of the class. 40 | 41 | (define-class ReflectiveClass Class (predicate allocator maker)) 42 | 43 | (define-method (generate-related-names (class ReflectiveClass)) 44 | (let ((cname (symbol-append (Class-name class) '-class)) 45 | (predicate-name (symbol-append (Class-name class) '?)) 46 | (allocator-name (symbol-append 'allocate- (Class-name class))) 47 | (maker-name (symbol-append 'make- (Class-name class))) ) 48 | `(begin ,(call-next-method) 49 | (set-ReflectiveClass-predicate! ,cname ,predicate-name) 50 | (set-ReflectiveClass-allocator! ,cname ,allocator-name) 51 | (set-ReflectiveClass-maker! ,cname ,maker-name) ) ) ) 52 | 53 | ;;; To test it, we redefine define-class to use ReflectiveClass 54 | ;;; instead of Class. 55 | 56 | (define-meroonet-macro (define-class name super-name own-field-descriptions) 57 | (let ((class (register-ReflectiveClass 58 | name super-name own-field-descriptions ))) 59 | (generate-related-names class) ) ) 60 | 61 | (define (register-ReflectiveClass name super-name own-field-descriptions) 62 | (initialize! (allocate-ReflectiveClass) 63 | name 64 | (->Class super-name) 65 | own-field-descriptions ) ) 66 | 67 | ;;; Test a little the previous metaclass 68 | 69 | (define-class Point Object (x y)) 70 | 71 | (unless (let ((pt (make-Point 11 22))) 72 | (and (procedure? (ReflectiveClass-maker Point-class)) 73 | ((ReflectiveClass-predicate Point-class) pt) 74 | (equal? pt ((ReflectiveClass-maker Point-class) 11 22)) ) ) 75 | (meroonet-error "Failed tests on ReflectiveClass") ) 76 | -------------------------------------------------------------------------------- /meroonet/variante4.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: variante4.scm,v 1.5 2006/11/25 17:43:56 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This file is part of the Meroonet package. 19 | 20 | ;;; VARIANT 4: enhanced(?) define-method 21 | 22 | ;;; This ne define-method a la CLOS creates a generic function on the 23 | ;;; fly if it does not exist yet. The sole problem is to do it a 24 | ;;; evaluation-time and not at macro-expansion time. 25 | 26 | (define-meroonet-macro (define-method call . body) 27 | (parse-variable-specifications 28 | (cdr call) 29 | (lambda (discriminant variables) 30 | (let ((g (gensym))(c (gensym))) ; make g and c hygienic 31 | `(begin 32 | (unless (->Generic ',(car call)) 33 | (define-generic ,call) ) ; new 34 | (register-method 35 | ',(car call) 36 | (lambda (,g ,c) 37 | (lambda ,(flat-variables variables) 38 | (define (call-next-method) 39 | ((if (Class-superclass ,c) 40 | (vector-ref (Generic-dispatch-table ,g) 41 | (Class-number 42 | (Class-superclass ,c) ) ) 43 | (Generic-default ,g) ) 44 | . ,(flat-variables variables) ) ) 45 | . ,body ) ) 46 | ',(cadr discriminant) 47 | ',(cdr call) ) ) ) ) ) ) 48 | 49 | ;;; I am not really fond of that but we can nevertheless test the 50 | ;;; previous definition. 51 | 52 | (define-method (ugly a (b Class) . c) 53 | 'barf ) 54 | 55 | (unless (eq? 'barf (ugly 2 Field-class)) 56 | (meroonet-error "Failed test on define-method") ) 57 | 58 | ;;; end of variante4.scm 59 | -------------------------------------------------------------------------------- /meroonet/variante5.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: variante5.scm,v 1.3 1996/01/28 17:29:37 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This file is part of the Meroonet package. 19 | 20 | ;;; VARIANT 5: next-method? 21 | 22 | (define-meroonet-macro (define-method call . body) 23 | (parse-variable-specifications 24 | (cdr call) 25 | (lambda (discriminant variables) 26 | (let ((g (gensym))(c (gensym))) ; make g and c hygienic 27 | `(register-method 28 | ',(car call) 29 | (lambda (,g ,c) 30 | (lambda ,(flat-variables variables) 31 | ,@(generate-next-method-functions g c variables) 32 | . ,body ) ) 33 | ',(cadr discriminant) 34 | ',(cdr call) ) ) ) ) ) 35 | 36 | ;;; It would be better to generate these functions only if the 37 | ;;; identifiers call-next-method or next-method? occurs somewhere in 38 | ;;; the body of the method. 39 | 40 | (define (generate-next-method-functions g c variables) 41 | (let ((get-next-method (gensym))) 42 | `((define (,get-next-method) 43 | (if (Class-superclass ,c) 44 | (vector-ref (Generic-dispatch-table ,g) 45 | (Class-number (Class-superclass ,c)) ) 46 | (Generic-default ,g) ) ) 47 | (define (call-next-method) 48 | ((,get-next-method) . ,(flat-variables variables)) ) 49 | (define (next-method?) 50 | (not (eq? (,get-next-method) (Generic-default ,g))) ) ) ) ) 51 | 52 | ;;; Testing next-method? 53 | 54 | (define-class Point Object (x y)) 55 | 56 | (define-class ColoredPoint Point (color)) 57 | 58 | (define-generic (g1 (a))) 59 | 60 | (define-generic (g2 (a)) 61 | 'g2 ) 62 | 63 | (define-method (g1 (a Point)) 64 | (next-method?) ) 65 | 66 | (define-method (g2 (a Point)) 67 | (next-method?) ) 68 | 69 | (define-method (g1 (a ColoredPoint)) 70 | (next-method?) ) 71 | 72 | (define-method (g2 (a ColoredPoint)) 73 | (next-method?) ) 74 | 75 | (unless (let ((pt (make-Point 11 22)) 76 | (cpt (make-ColoredPoint 33 44 'orange)) ) 77 | (and (not (g1 pt)) 78 | (not (g2 pt)) 79 | (g1 cpt) 80 | (g2 cpt) ) ) 81 | (meroonet-error "Failed tests on next-method?") ) 82 | 83 | ;;; end of variante5.scm 84 | -------------------------------------------------------------------------------- /mitscheme/book.scm: -------------------------------------------------------------------------------- 1 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 2 | ;;; This file is derived from the files that accompany the book: 3 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 4 | ;;; or Lisp In Small Pieces (Cambridge University Press). 5 | ;;; By Christian Queinnec 6 | ;;; The original sources can be downloaded from the author's website at 7 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 8 | ;;; This file may have been altered from the original in order to work with 9 | ;;; modern schemes. The latest copy of these altered sources can be found at 10 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 11 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 12 | ;;; repo mentioned above. 13 | ;;; Check the README file before using this file. 14 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 15 | (load "mitscheme/mit-book.scm") 16 | (load "common/compat/load-relative.scm") 17 | (load "common/compat/callcc.scm") 18 | (load "common/compat/gensym.scm") 19 | (load "common/compat/property-lists.scm") 20 | (load "common/book.scm") 21 | -------------------------------------------------------------------------------- /perl/check.prl: -------------------------------------------------------------------------------- 1 | #! /usr/local/bin/perl 2 | # Check if a test is correct. 3 | # Syntax: check.prl resulting-file test-name 4 | $usage = "Usage: check.prl resulting-file test-name" ; 5 | # Given the name of the test, this script tries to know if the results are 6 | # correct. Given tester.scm, single tests are correct but the interpreter 7 | # stops as soon as it encounters an error. The name of the test allows to 8 | # know what sort of test it is. 9 | 10 | # Main: 11 | if ( @ARGV == 2 ) { 12 | ($file,$test) = @ARGV ; 13 | } else { 14 | die $usage ; 15 | } 16 | 17 | $_ = $test ; 18 | # If the name of the test is normal then all tests should be done. 19 | # In that case tester returns the symbol DONE. 20 | $string = "= done" ; 21 | # This is the case for tests that share allocation frame as in Lisp 22 | $string = "The following test forces a continuation to return multiply" 23 | if /shared\./ ; 24 | # This is for shallow-binding in presence of Scheme continuation 25 | $string = "shallow binding without unwind-protect when escaping" 26 | if /shallow\./ ; 27 | # eval as a function fails to access the current lexical environment 28 | $string = "eval as a function will fail" 29 | if /evalf\./ ; 30 | # escape a la CommonLisp fail are not full Scheme continuations. 31 | $string = "(to return multiply|out of their dynamic extent)" 32 | if /dynext\./ ; 33 | # Don't inspect the result of a test prefixed by no. A no.test is 34 | # generally temporary, it is in the course of being fixed. 35 | # a test prefixed by loop can only be done (and killed) by hand. 36 | # A test prefixed by big may fail because of memory. 37 | if ( /(no|loop|big)\./ ) { 38 | print "\n\n\t\t$test is SKIPPED\n\n" ; 39 | exit 0 ; 40 | }; 41 | 42 | # Scan the file until finding the string and exit accordingly 43 | open(RESULT,"<$file"); 44 | while ( ) { 45 | if ( /$string/i ) { 46 | print "\n\n\t\t$test is SUCCESSFUL\n\n" ; 47 | exit 0 ; 48 | } 49 | } 50 | # If we arrive there then the test was wrong. 51 | print "\n\n\t\tFAILING $test \n\n" ; 52 | exit 1 ; 53 | 54 | # end of check.prl 55 | -------------------------------------------------------------------------------- /si/after.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: after.scm,v 1.1 1994/09/03 16:18:20 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This file uses some global variables. It tests global variable 19 | ;;; linking. Compile it with : 20 | ;;; (compile-file "si/after.scm" "o/after.so") 21 | ;;; builds the executable with: 22 | ;;; (build-application "o/a.out" "o/fact.so" "o/fib.so" "o/foo.so" "o/after.so") 23 | ;;; and runs the total program with: 24 | ;;; (run-application 400 "o/a.out") 25 | 26 | (set! fib fact) 27 | 28 | (display (list (fact 6) ; 89 29 | (dynamic-let (x -34) 30 | (bar 'bar) ) 31 | ;; force a long-goto 32 | (if (fib 1) 33 | (list 1 2 3 4 5 6 7 8 9 10 34 | 1 2 3 4 5 6 7 8 9 20 35 | 1 2 3 4 5 6 7 8 9 30 36 | 1 2 3 4 5 6 7 8 9 40 37 | 1 2 3 4 5 6 7 8 9 50 38 | 1 2 3 4 5 6 7 8 9 60 39 | 1 2 3 4 5 6 7 8 9 70 40 | 1 2 3 4 5 6 7 8 9 80 41 | 1 2 3 4 5 6 7 8 9 90 42 | 1 2 3 4 5 6 7 8 9 100 43 | 1 2 3 4 5 6 7 8 9 110 44 | 1 2 3 4 5 6 7 8 9 120 45 | 1 2 3 4 5 6 7 8 9 130 46 | 1 2 3 4 5 6 7 8 9 140 47 | 1 2 3 4 5 6 7 8 9 150 #t) 48 | (list 1 2 3 4 5 6 7 8 9 10 49 | 1 2 3 4 5 6 7 8 9 20 50 | 1 2 3 4 5 6 7 8 9 30 51 | 1 2 3 4 5 6 7 8 9 40 52 | 1 2 3 4 5 6 7 8 9 50 53 | 1 2 3 4 5 6 7 8 9 60 54 | 1 2 3 4 5 6 7 8 9 70 55 | 1 2 3 4 5 6 7 8 9 80 56 | 1 2 3 4 5 6 7 8 9 90 57 | 1 2 3 4 5 6 7 8 9 100 58 | 1 2 3 4 5 6 7 8 9 110 59 | 1 2 3 4 5 6 7 8 9 120 60 | 1 2 3 4 5 6 7 8 9 130 61 | 1 2 3 4 5 6 7 8 9 140 62 | 1 2 3 4 5 6 7 8 9 150 #f ) ) 63 | )) 64 | ;;; prints (720 (bar . -34) (1 2 ... #t)) 65 | 66 | ;;; reload fib 67 | (load "o/fib.so") 68 | 69 | ;;; prints 89. 70 | (display ((global-value 'fib) 10)) 71 | 72 | ;;; end of after.scm 73 | -------------------------------------------------------------------------------- /si/bibexp.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: bibexp.scm,v 1.2 1994/08/21 19:35:32 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define (fact2 n) (if (= n 0) 1 (* n (fact2 (- n 1))))) 19 | 20 | (define-abbreviation (factorial n) 21 | (if (and (integer? n) (> n 0)) (fact2 n) `(fact1 ,n)) ) 22 | 23 | ;;; end of bibexp.scm 24 | -------------------------------------------------------------------------------- /si/bibrun.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: bibrun.scm,v 1.2 1994/08/21 19:35:32 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define (fact1 n) (if (= n 0) 1 (* n (fact1 (- n 1))))) 19 | 20 | ;;; end of bibrun.scm 21 | -------------------------------------------------------------------------------- /si/chap9b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap9b.scm,v 1.2 1994/08/21 19:35:32 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define (fact1 n) (if (= n 0) 1 (* n (fact1 (- n 1))))) 19 | 20 | (define-abbreviation (factorial n) 21 | (define (fact2 n) (if (= n 1) 1 (* n (fact2 (- n 1))))) 22 | (if (and (integer? n) (> n 0)) (fact2 n) `(fact1 ,n)) ) 23 | 24 | (define (some-facts) 25 | (list (factorial 5) (factorial (+ 3 2))) ) 26 | 27 | ;;; end of chap9b.scm 28 | -------------------------------------------------------------------------------- /si/chap9c.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap9c.scm,v 1.2 1994/08/21 19:35:32 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define (fact n) (if (= n 0) 1 (* n (fact (- n 1))))) 19 | 20 | (define-abbreviation (factorial n) 21 | (if (and (integer? n) (> n 0)) (fact n) `(fact ,n)) ) 22 | 23 | ;;; end of chap9c.scm 24 | -------------------------------------------------------------------------------- /si/example.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (set! fact 19 | ((lambda (fact) (lambda (n) 20 | (if (< n 0) 21 | "Toctoc la tete!" 22 | (fact n fact (lambda (x) x)) ) )) 23 | (lambda (n f k) 24 | (if (= n 0) 25 | (k 1) 26 | (f (- n 1) f (lambda (r) (k (* n r)))) ) ) ) ) 27 | 28 | ;;; end of example.scm 29 | -------------------------------------------------------------------------------- /si/fact.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Test for chap7e.scm. 19 | ;;; Be above directories /si/ and /so/ then evaluate: 20 | ;;; (compile-file "si/fact.scm" "o/fact.so") 21 | ;;; It generates the file o/fact.so that can be read. 22 | 23 | (set! fact 24 | (lambda (n) 25 | (if (= n 0) 1 26 | (* n (fact (- n 1))) ) ) ) 27 | 28 | ;;;; end of fact.scm 29 | -------------------------------------------------------------------------------- /si/ffact.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; (compile-file "si/ffact") 19 | ;;; (run-application "si/ffact") 20 | ;;; (disassemble *code*) 21 | 22 | ((lambda (fact) (fact 5 fact (lambda (x) x))) 23 | (lambda (n f k) (if (= n 0) (k 1) (f (- n 1) f (lambda (r) (k (* n r)))))) ) 24 | 25 | ;;; Code: 26 | ;((NON-CONT-ERR) 27 | ; (FINISH) 28 | ; (RESTAURE-ENV) 29 | ; (RETURN) 30 | ; 31 | ; (CREATE-CLOSURE) 32 | ; (SHORT-GOTO 59) 33 | ; 34 | ; (ARITY=?4) ; (lambda (n f k) \ldots) 35 | ; (EXTEND-ENV) 36 | ; (SHALLOW-ARGUMENT-REF0) 37 | ; (PUSH-VALUE) 38 | ; (CONSTANT0) 39 | ; (POP-ARG1) 40 | ; (CALL2-=) 41 | ; (SHORT-JUMP-FALSE 10) 42 | ; (SHALLOW-ARGUMENT-REF2) 43 | ; (PUSH-VALUE) 44 | ; (CONSTANT1) 45 | ; (PUSH-VALUE) 46 | ; (ALLOCATE-FRAME2) 47 | ; (POP-FRAME!0) 48 | ; (POP-FUNCTION) 49 | ; (FUNCTION-GOTO) 50 | ; (SHORT-GOTO 39) 51 | ; (SHALLOW-ARGUMENT-REF1) 52 | ; (PUSH-VALUE) 53 | ; (SHALLOW-ARGUMENT-REF0) 54 | ; (PUSH-VALUE) 55 | ; (CONSTANT1) 56 | ; (POP-ARG1) 57 | ; (CALL2--) 58 | ; (PUSH-VALUE) 59 | ; (SHALLOW-ARGUMENT-REF1) 60 | ; (PUSH-VALUE) 61 | ; (CREATE-CLOSURE) 62 | ; (SHORT-GOTO 19) 63 | ; 64 | ; (ARITY=?2) ; (lambda (r) (k (* n r))) 65 | ; (EXTEND-ENV) 66 | ; (DEEP-ARGUMENT-REF 1 2) 67 | ; (PUSH-VALUE) 68 | ; (DEEP-ARGUMENT-REF 1 0) 69 | ; (PUSH-VALUE) 70 | ; (SHALLOW-ARGUMENT-REF0) 71 | ; (POP-ARG1) 72 | ; (CALL2-*) 73 | ; (PUSH-VALUE) 74 | ; (ALLOCATE-FRAME2) 75 | ; (POP-FRAME!0) 76 | ; (POP-FUNCTION) 77 | ; (FUNCTION-GOTO) 78 | ; (RETURN) 79 | ; 80 | ; (PUSH-VALUE) 81 | ; (ALLOCATE-FRAME4) 82 | ; (POP-FRAME!2) 83 | ; (POP-FRAME!1) 84 | ; (POP-FRAME!0) 85 | ; (POP-FUNCTION) 86 | ; (FUNCTION-GOTO) 87 | ; (RETURN) 88 | ; 89 | ; (PUSH-VALUE) 90 | ; (ALLOCATE-FRAME2) 91 | ; (POP-FRAME!0) 92 | ; (EXTEND-ENV) 93 | ; (SHALLOW-ARGUMENT-REF0) 94 | ; (PUSH-VALUE) 95 | ; (SHORT-NUMBER 5) 96 | ; (PUSH-VALUE) 97 | ; (SHALLOW-ARGUMENT-REF0) 98 | ; (PUSH-VALUE) 99 | ; (CREATE-CLOSURE) 100 | ; (SHORT-GOTO 4) 101 | ; 102 | ; (ARITY=?2) ; (lambda (x) x) 103 | ; (EXTEND-ENV) 104 | ; (SHALLOW-ARGUMENT-REF0) 105 | ; (RETURN) 106 | ; 107 | ; (PUSH-VALUE) 108 | ; (ALLOCATE-FRAME4) 109 | ; (POP-FRAME!2) 110 | ; (POP-FRAME!1) 111 | ; (POP-FRAME!0) 112 | ; (POP-FUNCTION) 113 | ; (FUNCTION-GOTO) 114 | ; (RETURN) 115 | ; ) 116 | 117 | ;;; end of ffact.scm 118 | -------------------------------------------------------------------------------- /si/fib.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; (compile-file "si/fib") 19 | 20 | (set! fib (lambda (n) 21 | (if (= n 0) 1 22 | (if (= n 1) 1 23 | (+ (fib (- n 1)) (fib (- n 2))) ) ) )) 24 | 25 | ;;; end of fib.scm 26 | -------------------------------------------------------------------------------- /si/foo.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This file introduces a lot of things to test. 19 | ;;; (compile-file "si/foo") 20 | ;;; (run-application 100 "si/foo") 21 | 22 | (set! foo '(a b)) 23 | 24 | (set! bar 25 | (lambda (x) 26 | (cons x (dynamic x)) ) ) 27 | 28 | (set! hux (dynamic-let (x '(c d)) 29 | (dynamic-let (y 'foo) 30 | (dynamic-let (x foo) 31 | (bar 'bar) ) ) )) 32 | 33 | (display (list foo hux)) 34 | 35 | ;;; end of foo.scm 36 | -------------------------------------------------------------------------------- /si/loading.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Try load. si/fact.so will assign to fact so it can be used after. 19 | 20 | (display (load "si/fact.so")) 21 | 22 | (display (fact 5)) 23 | 24 | ;;; end of loading.scm 25 | -------------------------------------------------------------------------------- /src/c/Imakefile: -------------------------------------------------------------------------------- 1 | # $Id: Imakefile,v 1.5 1994/08/21 19:36:30 queinnec Exp $ 2 | 3 | ###(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ### This file is derived from the files that accompany the book: 5 | ### LISP Implantation Semantique Programmation (InterEditions, France) 6 | ### or Lisp In Small Pieces (Cambridge University Press). 7 | ### By Christian Queinnec 8 | ### The original sources can be downloaded from the author's website at 9 | ### http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ### This file may have been altered from the original in order to work with 11 | ### modern schemes. The latest copy of these altered sources can be found at 12 | ### https://github.com/appleby/Lisp-In-Small-Pieces 13 | ### If you want to report a bug in this program, open a GitHub Issue at the 14 | ### repo mentioned above. 15 | ### Check the README file before using this file. 16 | ###(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | work : scheme.o schemelib.o schemeklib.o 19 | clean :: cleanMakefile 20 | 21 | CC = gcc 22 | CFLAGS = -ansi -pedantic -gg 23 | 24 | # scheme.[hc] is the minimal runtime library used for chap10e.scm. 25 | # schemelib.c is the definition of the predefined global variables. 26 | # schemeklib.c is the definition of the predefined global variables when 27 | # using a CPS conversion. 28 | # rt.[hc] is an adaptation of an older library used for chap6f.scm 29 | 30 | scheme.o : scheme.h 31 | schemelib.o : scheme.h 32 | schemeklib.o : scheme.h 33 | rt.o : rt.h 34 | 35 | LIB = scheme.o schemelib.o 36 | #LIB = scheme.o schemeklib.o 37 | 38 | chap10e : chap10e.c ${LIB} 39 | ${CC} ${CFLAGS} -o chap10e chap10e.c ${LIB} 40 | chap10e 41 | -------------------------------------------------------------------------------- /src/c/c10ex.c: -------------------------------------------------------------------------------- 1 | /* Compiler to C $Revision: 4.3 $ 2 | (begin 3 | (set! index 1) 4 | ((lambda (cnter . tmp) 5 | (set! tmp 6 | (cnter (lambda (i) (lambda x (cons i x))))) 7 | (if cnter (cnter tmp) index)) 8 | (lambda (f) (set! index (+ 1 index)) (f index)) 9 | 'foo)) */ 10 | 11 | #include "scheme.h" 12 | 13 | /* Global environment: */ 14 | SCM_DefineGlobalVariable(INDEX, "index"); 15 | 16 | /* Quotations: */ 17 | #define thing3 SCM_nil /* () */ 18 | SCM_DefineString(thing4_object, "foo"); 19 | #define thing4 SCM_Wrap(&thing4_object) 20 | SCM_DefineSymbol(thing2_object, thing4); /* foo */ 21 | #define thing2 SCM_Wrap(&thing2_object) 22 | #define thing1 SCM_Int2fixnum(1) 23 | #define thing0 thing1 /* 1 */ 24 | 25 | /* Functions: */ 26 | SCM_DefineClosure(function_0, SCM_Empty); 27 | 28 | SCM_DeclareFunction(function_0) 29 | { 30 | SCM_DeclareLocalVariable(F, 0); 31 | return ((INDEX = SCM_Plus(thing1, 32 | SCM_CheckedGlobal(INDEX))), 33 | SCM_invoke1(F, SCM_CheckedGlobal(INDEX))); 34 | } 35 | 36 | SCM_DefineClosure(function_1, SCM I; 37 | ); 38 | 39 | SCM_DeclareFunction(function_1) 40 | { 41 | SCM_DeclareLocalDottedVariable(X, 0); 42 | return SCM_cons(SCM_Free(I), X); 43 | } 44 | 45 | SCM_DefineClosure(function_2, SCM_Empty); 46 | 47 | SCM_DeclareFunction(function_2) 48 | { 49 | SCM_DeclareLocalVariable(I, 0); 50 | return SCM_close(SCM_CfunctionAddress(function_1), -1, 1, I); 51 | } 52 | 53 | SCM_DefineClosure(function_3, SCM_Empty); 54 | 55 | SCM_DeclareFunction(function_3) 56 | { 57 | SCM TMP_2; 58 | SCM CNTER_1; 59 | return ((INDEX = thing0), 60 | (CNTER_1 = SCM_close(SCM_CfunctionAddress(function_0), 1, 0), 61 | TMP_2 = SCM_cons(thing2, 62 | thing3), 63 | (TMP_2 = SCM_allocate_box(TMP_2), 64 | ((SCM_Content(TMP_2) = SCM_invoke1(CNTER_1, 65 | SCM_close 66 | (SCM_CfunctionAddress 67 | (function_2), 1, 0))), 68 | ((CNTER_1 != SCM_false) 69 | ? SCM_invoke1(CNTER_1, SCM_Content(TMP_2)) 70 | : SCM_CheckedGlobal(INDEX)))))); 71 | } 72 | 73 | 74 | /* Expression: */ 75 | int main(void) 76 | { 77 | SCM r; 78 | int i; 79 | for (i=0; i<=10000; i++) r = (SCM_invoke0(SCM_close(SCM_CfunctionAddress(function_3), 0, 0))); 80 | SCM_print(r); 81 | exit(0); 82 | } 83 | 84 | /* End of generated code. */ 85 | -------------------------------------------------------------------------------- /src/c/chap10ex.c: -------------------------------------------------------------------------------- 1 | /* Compiler to C $Revision: 4.0 $ 2 | (BEGIN 3 | (SET! INDEX 1) 4 | ((LAMBDA 5 | (CNTER . TMP) 6 | (SET! TMP (CNTER (LAMBDA (I) (LAMBDA X (CONS I X))))) 7 | (IF CNTER (CNTER TMP) INDEX)) 8 | (LAMBDA (F) (SET! INDEX (+ 1 INDEX)) (F INDEX)) 9 | 'FOO)) */ 10 | 11 | #include "scheme.h" 12 | 13 | /* Global environment: */ 14 | SCM_DefineGlobalVariable(INDEX,"INDEX"); 15 | 16 | /* Quotations: */ 17 | #define thing3 SCM_nil /* () */ 18 | SCM_DefineString(thing4_object,"FOO"); 19 | #define thing4 SCM_Wrap(&thing4_object) 20 | SCM_DefineSymbol(thing2_object,thing4); /* FOO */ 21 | #define thing2 SCM_Wrap(&thing2_object) 22 | #define thing1 SCM_Int2fixnum(1) 23 | #define thing0 thing1 /* 1 */ 24 | 25 | /* Functions: */ 26 | SCM_DefineClosure(function_0, SCM_Empty); 27 | 28 | SCM_DeclareFunction(function_0) { 29 | SCM_DeclareLocalVariable(F,0); 30 | return ((INDEX=SCM_Plus(thing1, 31 | SCM_CheckedGlobal(INDEX))), 32 | SCM_invoke1(F, 33 | SCM_CheckedGlobal(INDEX))); 34 | } 35 | 36 | SCM_DefineClosure(function_1, SCM I; ); 37 | 38 | SCM_DeclareFunction(function_1) { 39 | SCM_DeclareLocalDottedVariable(X,0); 40 | return SCM_cons(SCM_Free(I), 41 | X); 42 | } 43 | 44 | SCM_DefineClosure(function_2, SCM_Empty); 45 | 46 | SCM_DeclareFunction(function_2) { 47 | SCM_DeclareLocalVariable(I,0); 48 | return SCM_close(SCM_CfunctionAddress(function_1),-1,1,I); 49 | } 50 | 51 | SCM_DefineClosure(function_3, SCM_Empty); 52 | 53 | SCM_DeclareFunction(function_3) { 54 | SCM TMP_2; SCM CNTER_1; 55 | return ((INDEX=thing0), 56 | (CNTER_1=SCM_close(SCM_CfunctionAddress(function_0),1,0), 57 | TMP_2=SCM_cons(thing2, 58 | thing3), 59 | (TMP_2= SCM_allocate_box(TMP_2), 60 | ((SCM_Content(TMP_2)= 61 | SCM_invoke1(CNTER_1,SCM_close(SCM_CfunctionAddress 62 | (function_2),1,0))), 63 | ((CNTER_1 != SCM_false) 64 | ? SCM_invoke1(CNTER_1, 65 | SCM_Content(TMP_2)) 66 | : SCM_CheckedGlobal(INDEX)))))); 67 | } 68 | 69 | 70 | /* Expression: */ 71 | int main(void) { 72 | SCM_print(SCM_invoke0(SCM_close(SCM_CfunctionAddress(function_3), 73 | 0,0))); 74 | exit(0); 75 | } 76 | 77 | /* End of generated code. */ 78 | -------------------------------------------------------------------------------- /src/c/loop.c: -------------------------------------------------------------------------------- 1 | /* $Id 2 | * Essai de faire boucler cpp. Ben non! cela ne boucle pas!!! 3 | */ 4 | 5 | #define LOOP(x) (x+LOOP(x+1)) 6 | #define BAR(x) (x+LOOP(x+1)) 7 | 8 | int main () { 9 | int i = 0; 10 | return BAR(i); 11 | } 12 | -------------------------------------------------------------------------------- /src/chap1.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap1.tst,v 4.0 1995/07/10 06:50:32 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Testing functions of chapter 1. 19 | 20 | (set! k (lambda (a b) a)) 21 | --- 22 | (k 1 2) 23 | 1 24 | 25 | ;;; end of chap1.tst 26 | -------------------------------------------------------------------------------- /src/chap10d.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10d.scm,v 4.0 1995/07/10 06:50:37 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Testing chap10c.scm by direct interpretation of the objectified code. 19 | 20 | ;;; This vector will contain the definitions of all lifted functions. 21 | 22 | (define *runtime-functions* '()) 23 | 24 | (define-method (evaluate (o Flattened-Program) sr) 25 | (set! *runtime-functions* 26 | (apply vector (reverse (Flattened-Program-definitions o))) ) 27 | (set! sg.global 28 | (append (map (lambda (qv) (cons qv (Quotation-Variable-value qv))) 29 | (Flattened-Program-quotations o) ) 30 | sg.global ) ) 31 | (evaluate (Flattened-Program-form o) sr) ) 32 | 33 | (define-method (evaluate (e Closure-Creation) sr) 34 | (let ((def (vector-ref *runtime-functions* (Closure-Creation-index e)))) 35 | (make-RunTime-Procedure 36 | (Function-Definition-body def) 37 | (Function-Definition-variables def) 38 | (evaluate (Closure-Creation-free e) sr) ) ) ) 39 | 40 | (define-method (evaluate (e No-Free) sr) 41 | '() ) 42 | 43 | (define-method (evaluate (e Free-Environment) sr) 44 | (cons (cons (Reference-variable (Free-Environment-first e)) 45 | (evaluate (Free-Environment-first e) sr) ) 46 | (evaluate (Free-Environment-others e) sr) ) ) 47 | 48 | (define-method (evaluate (e Free-Reference) sr) 49 | (cdr (assq (Free-Reference-variable e) sr)) ) 50 | 51 | (define-method (show (o Quotation-Variable) . stream) 52 | (let ((stream (if (pair? stream) (car stream) (current-output-port)))) 53 | (format stream "" 54 | (Quotation-Variable-name o) 55 | (Quotation-Variable-value o) ) ) ) 56 | 57 | ;;; Reuse scheme10b and test-scheme10b but update the compiler. 58 | 59 | (define (compile-expression e) 60 | (extract-things! (lift! (Sexp->object e))) ) 61 | 62 | ;;; end of chap10d.scm 63 | -------------------------------------------------------------------------------- /src/chap10e.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10e.tst,v 4.0 1995/07/10 06:50:39 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Additional tests for chap10e the compiler from Scheme to C. 19 | 20 | ;;; negative numbers 21 | (- 3 33) 22 | -30 23 | ;;; explicit syntax for booleans 24 | (if (car (cons #f #t)) 'void #t) 25 | #t 26 | 27 | ;;; test closures sharing 28 | (if (car (cons 2 3)) 29 | 22 33 ) 30 | 22 31 | ;;; This would need to recognize functions equivalence modulo alpha-conversion. 32 | ((lambda (x) 33 | (list (lambda () x) (lambda () x)) ) 34 | 'x ) 35 | (?- ?-) 36 | 37 | ;;; foreign interface 38 | (list (system "date")) 39 | --- 40 | 41 | ;;; This program was used as a running example of the compiler. It is 42 | ;;; no longer true since the example is now in src/chap10ex.scm. 43 | ;;; Pay attention that `if' should be ternary for objectify. 44 | (begin 45 | (set! foo (lambda (l c) 46 | ((lambda (max) 47 | ((lambda (walk) (walk l walk c)) 48 | (lambda (l f c) 49 | (if (pair? l) 50 | (begin (if (< max (car l)) 51 | (set! max (car l)) 52 | #t ) 53 | (f (cdr l) f (lambda (max min) 54 | (if (< (car l) min) 55 | (cons max (car l)) 56 | (c max min) ) ) ) ) 57 | (c max 100) ) ) ) ) 58 | 0 ) )) 59 | (foo '(1 2 3 2 1) cons) ) 60 | (3 . 1) 61 | 62 | ;;; end of chap10e.tst 63 | -------------------------------------------------------------------------------- /src/chap10ex.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10ex.scm,v 4.0 1995/07/10 06:50:39 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This is the running example of chapter 10. This expression will be 19 | ;;; compiled to C in the src/c/chap10ex.c file. It contains at least 20 | ;;; one example of all syntactic structures. 21 | 22 | (begin 23 | (set! index 1) 24 | ((lambda (cnter . tmp) 25 | (set! tmp (cnter (lambda (i) (lambda x (cons i x))))) 26 | (if cnter (cnter tmp) index) ) 27 | (lambda (f) 28 | (set! index (+ 1 index)) 29 | (f index) ) 30 | 'foo ) ) 31 | 32 | ;;; end of chap10ex.scm 33 | -------------------------------------------------------------------------------- /src/chap10j.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10j.scm,v 4.0 1995/07/10 06:50:44 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Simple-minded initialization analysis. 19 | ;;; Just use the regular code-walker that has the advantage to walk 20 | ;;; programs in the evaluation order. 21 | 22 | ;;; Retrofit the representation of global variables. 23 | 24 | (define-class Global-Variable Variable (initialized?)) 25 | 26 | (define (objectify-free-global-reference name r) 27 | (let ((v (make-Global-Variable name #f))) 28 | (set! g.current (cons v g.current)) 29 | (make-Global-Reference v) ) ) 30 | 31 | (define (compile->C e out) 32 | (set! g.current '()) 33 | (let ((prg (extract-things! 34 | (lift! (initialization-analyze! (Sexp->object e))) ))) 35 | (gather-temporaries! (closurize-main! prg)) 36 | (generate-C-program out e prg) ) ) 37 | 38 | ;;; The analysis 39 | 40 | (define (initialization-analyze! e) 41 | (call/cc (lambda (exit) (inian! e (lambda () (exit 'finished))))) 42 | e ) 43 | 44 | (define-generic (inian! (e) exit) 45 | (update-walk! inian! e exit) ) 46 | 47 | (define-method (inian! (e Global-Assignment) exit) 48 | (call-next-method) 49 | (let ((gv (Global-Assignment-variable e))) 50 | (set-Global-Variable-initialized?! gv #t) 51 | (inian-warning "Surely initialized variable" gv) 52 | e ) ) 53 | 54 | ;;; Predefined global variables are initialized. 55 | 56 | (define-method (inian! (e Global-Reference) exit) 57 | (let ((gv (Global-Reference-variable e))) 58 | (cond ((Predefined-Variable? gv) e) 59 | ((Global-Variable-initialized? gv) e) 60 | (else (inian-error "Surely uninitialized variable" gv) 61 | (exit) ) ) ) ) 62 | 63 | (define-method (inian! (e Alternative) exit) 64 | (inian! (Alternative-condition e) exit) 65 | (exit) ) 66 | 67 | (define-method (inian! (e Application) exit) 68 | (call-next-method) 69 | (exit) ) 70 | 71 | (define-method (inian! (e Function) exit) 72 | e ) 73 | 74 | ;;; Modify the compiler. 75 | 76 | (define-method (reference->C (v Global-Variable) out) 77 | (cond ((Global-Variable-initialized? v) 78 | (variable->C v out) ) 79 | (else (format out "SCM_CheckedGlobal") 80 | (between-parentheses out 81 | (variable->C v out) ) ) ) ) 82 | 83 | ;;; Trace 84 | 85 | (define (inian-warning msg gv) 86 | (format #t "INIAN: ~A : ~A~%" (Global-Variable-name gv) msg) ) 87 | 88 | (define (inian-error msg gv) 89 | (format #t "INIAN: ~A : ~A~%" (Global-Variable-name gv) msg) ) 90 | 91 | ;;; end of chap10j.scm 92 | -------------------------------------------------------------------------------- /src/chap10j.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10j.tst,v 4.0 1995/07/10 06:50:46 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Some tests about initialization analysis 19 | 20 | (set! x 22) 21 | 22 22 | (set! x y) 23 | *** ; y uninitialized 24 | (begin (set! x (lambda () y)) 25 | (set! y (lambda () x)) 26 | (x) ) 27 | --- 28 | (begin (set! x (lambda () y)) 29 | (set! y (x)) ) 30 | *** ; y uninitialized 31 | ((lambda (x) 32 | (set! y x) 33 | y ) 34 | 33 ) 35 | 33 36 | 37 | ;;; end of chap10j.tst 38 | -------------------------------------------------------------------------------- /src/chap10k.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10k.tst,v 4.0 1995/07/10 06:50:48 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Additional tests for chap10k (compiler to C with CPS) 19 | 20 | ;;; testing non duplication of the continuation (Look generated code). 21 | (list (if #t 33 44)) 22 | (33) 23 | 24 | ;;; end of chap10k.tst 25 | -------------------------------------------------------------------------------- /src/chap10m.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10m.scm,v 4.0 1995/07/10 06:50:50 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; The letify generic function that take an AST with possible sharing 19 | ;;; and copies it in a pure tree, trying at the same time to insert 20 | ;;; let forms where possible. 21 | 22 | ;;; Only local variables are cloned. Global or predefined variables 23 | ;;; stay the same (and are shared between the input and the result of 24 | ;;; letify). 25 | 26 | (define-generic (letify (o Program) env) 27 | (update-walk! letify (clone o) env) ) 28 | 29 | ;;; Tell how to clone Variables. Not useful for the following: 30 | ;;; Global-Variable 31 | ;;; Predefined-Variable 32 | ;;; Local-Variable 33 | ;;; Quotation-Variable 34 | ;;; Renamed-Local-Variable (introduced by gather-temporaries) 35 | ;;; Global-Variable 36 | 37 | (define-method (clone (o Pseudo-Variable)) 38 | (new-Variable) ) 39 | 40 | ;;; If letify is used in other places, it might be interesting to add 41 | ;;; these methods. 42 | 43 | ;(define-method (clone (o Renamed-Local-Variable)) 44 | ; (new-renamed-variable o) ) 45 | 46 | ;(define-method (clone (o Local-Variable)) 47 | ; (new-renamed-variable o) ) 48 | 49 | (define-method (letify (o Function) env) 50 | (let* ((vars (Function-variables o)) 51 | (body (Function-body o)) 52 | (new-vars (map clone vars)) ) 53 | (make-Function 54 | new-vars 55 | (letify body (append (map cons vars new-vars) env)) ) ) ) 56 | 57 | ;;; Don't preserve continuations as they are. 58 | 59 | ;;; Other types of references: 60 | ;;; Global-Reference 61 | ;;; Predefined-Reference 62 | ;;; Free-Reference (introduced by lift!). 63 | 64 | (define-method (letify (o Local-Reference) env) 65 | (let* ((v (Local-Reference-variable o)) 66 | (r (assq v env)) ) 67 | (if (pair? r) 68 | (make-Local-Reference (cdr r)) 69 | (letify-error "Disappeared variable" o) ) ) ) 70 | 71 | (define-method (letify (o Regular-Application) env) 72 | (if (Function? (Regular-Application-function o)) 73 | (letify (process-closed-application 74 | (Regular-Application-function o) 75 | (Regular-Application-arguments o) ) 76 | env ) 77 | (make-Regular-Application 78 | (letify (Regular-Application-function o) env) 79 | (letify (Regular-Application-arguments o) env) ) ) ) 80 | 81 | (define-method (letify (o Fix-Let) env) 82 | (let* ((vars (Fix-Let-variables o)) 83 | (new-vars (map clone vars)) ) 84 | (make-Fix-Let 85 | new-vars 86 | (letify (Fix-Let-arguments o) env) 87 | (letify (Fix-Let-body o) 88 | (append (map cons vars new-vars) env) ) ) ) ) 89 | 90 | (define-method (letify (o Box-Creation) env) 91 | (let* ((v (Box-Creation-variable o)) 92 | (r (assq v env)) ) 93 | (if (pair? r) 94 | (make-Box-Creation (cdr r)) 95 | (letify-error "Disappeared variable" o) ) ) ) 96 | 97 | ;;; end of chap10m.scm 98 | -------------------------------------------------------------------------------- /src/chap10n.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10n.scm,v 4.0 1995/07/10 06:50:50 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Tests: this function redefines the one of chap10f.scm (for use by 19 | ;;; chap10e.scm) and allows to test letify in conjunction with chap10e. 20 | 21 | (define (compile->C e out) 22 | (set! g.current '()) 23 | (let* ((ee (letify (Sexp->object e) '())) 24 | (prg (extract-things! (lift! ee))) ) 25 | (gather-temporaries! (closurize-main! prg)) 26 | (generate-C-program out e prg) ) ) 27 | 28 | ;;; end of chap10n.scm 29 | -------------------------------------------------------------------------------- /src/chap10p.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap10p.scm,v 4.0 1995/07/10 06:50:51 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This function allows to test the CPS compiler with the 19 | ;;; initialization analysis. 20 | 21 | (define (compile->C e out) 22 | (set! g.current '()) 23 | (let* ((ee (letify (cpsify (initialization-analyze! (Sexp->object e))) '())) 24 | (prg (extract-things! (lift! ee))) ) 25 | (gather-temporaries! (closurize-main! prg)) 26 | (generate-C-program out e prg) ) ) 27 | 28 | ;;; end of chap10p.scm 29 | -------------------------------------------------------------------------------- /src/chap1a.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap1a.scm,v 4.0 1995/07/10 06:50:52 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; variants of chapter 1. 19 | 20 | ;;; This eprogn confers a special value to (begin): 21 | 22 | (define (eprogn exps env) 23 | (if (pair? exps) 24 | (if (pair? (cdr exps)) 25 | (begin (evaluate (car exps) env) 26 | (eprogn (cdr exps) env) ) 27 | (evaluate (car exps) env) ) 28 | empty-begin ) ) 29 | 30 | (define empty-begin 813) 31 | 32 | ;;; This is an explicit left-to-right evlis 33 | 34 | (define (evlis exps env) 35 | (if (pair? exps) 36 | (let ((argument1 (evaluate (car exps) env))) 37 | (cons argument1 (evlis (cdr exps) env)) ) 38 | '() ) ) 39 | 40 | ;;; end of chap1a.scm 41 | -------------------------------------------------------------------------------- /src/chap1b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap1b.scm,v 4.0 1995/07/10 06:50:53 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; variants of chapter 1. 19 | ;;; Sort of dynamic binding implementation. 20 | 21 | ;;; The version that will be included in the book 22 | 23 | ;(define (d.evaluate e env) 24 | ; (if (atom? e) \ldots 25 | ; (case (car e) 26 | ; \ldots 27 | ; ((lambda) (d.make-function (cadr e) (cddr e) env)) 28 | ; (else (d.invoke (d.evaluate (car e) env) 29 | ; (evlis (cdr e) env) 30 | ; env )) ) ) ) ; current environment 31 | 32 | ;;; The complete one. 33 | 34 | (define (d.evaluate e env) 35 | (if (atom? e) 36 | (cond ((symbol? e) (lookup e env)) 37 | ((or (number? e)(string? e)(char? e)(boolean? e)(vector? e)) 38 | e ) 39 | (else (wrong "Cannot evaluate" e)) ) 40 | (case (car e) 41 | ((quote) (cadr e)) 42 | ((if) (if (not (eq? (d.evaluate (cadr e) env) the-false-value)) 43 | (d.evaluate (caddr e) env) 44 | (d.evaluate (cadddr e) env) )) 45 | ((begin) (eprogn (cdr e) env)) 46 | ((set!) (update! (cadr e) env (d.evaluate (caddr e) env))) 47 | ((lambda) (d.make-function (cadr e) (cddr e) env)) 48 | (else (d.invoke (d.evaluate (car e) env) 49 | (evlis (cdr e) env) 50 | env )) ) ) ) ; current environment 51 | 52 | (define (d.invoke fn args env) 53 | (if (procedure? fn) 54 | (fn args env) 55 | (wrong "Not a function" fn) ) ) 56 | 57 | (define (d.make-function variables body env) 58 | (lambda (values current.env) 59 | (eprogn body (extend current.env variables values)) ) ) 60 | 61 | (define (d.make-closure fun env) 62 | (lambda (values current.env) 63 | (fun values env) ) ) 64 | 65 | ;;; end of chap1b.scm 66 | -------------------------------------------------------------------------------- /src/chap1c.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap1c.scm,v 4.0 1995/07/10 06:50:54 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; variants of chapter 1. 19 | 20 | (define (s.make-function variables body env) 21 | (lambda (values current.env) 22 | (let ((old-bindings 23 | (map (lambda (var val) 24 | (let ((old-value (getprop var 'apval))) 25 | (putprop var 'apval val) 26 | (cons var old-value) ) ) 27 | variables 28 | values ) )) 29 | (let ((result (eprogn body current.env))) 30 | (for-each (lambda (b) (putprop (car b) 'apval (cdr b))) 31 | old-bindings ) 32 | result ) ) ) ) 33 | 34 | (define (s.lookup id env) 35 | (getprop id 'apval) ) 36 | 37 | (define (s.update! id env value) 38 | (putprop id 'apval value) ) 39 | 40 | ;;; end of chap1c.scm 41 | -------------------------------------------------------------------------------- /src/chap1d.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap1d.scm,v 4.1 2006/11/27 14:01:25 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Variants of exercises for chapter 1. 19 | 20 | ;(define (tracing.evaluate exp env) 21 | ; (if \ldots \ldots 22 | ; (case (car exp) \ldots 23 | ; (else (let ((fn (evaluate (car e) env)) 24 | ; (arguments (evlis (cdr e) env)) ) 25 | ; (display `(calling ,(car e) with . ,arguments) 26 | ; *trace-port* ) 27 | ; (let ((result (invoke fn arguments))) 28 | ; (display `(returning from ,(car e) with ,result) 29 | ; *trace-port* ) 30 | ; result ) )) ) ) ) 31 | 32 | (define (evlis exps env) 33 | (define (evlis exps) 34 | ;; (assume (pair? exps)) 35 | (if (pair? (cdr exps)) 36 | (cons (evaluate (car exps) env) 37 | (evlis (cdr exps)) ) 38 | (list (evaluate (car exps) env)) ) ) 39 | (if (pair? exps) 40 | (evlis exps) 41 | '() ) ) 42 | 43 | (define (extend env names values) 44 | (cons (cons names values) env) ) 45 | 46 | (define (lookup id env) 47 | (if (pair? env) 48 | (let look ((names (caar env)) 49 | (values (cdar env)) ) 50 | (cond ((symbol? names) 51 | (if (eq? names id) values 52 | (lookup id (cdr env)) ) ) 53 | ((null? names) (lookup id (cdr env))) 54 | ((eq? (car names) id) 55 | (if (pair? values) 56 | (car values) 57 | (wrong "Too less values") ) ) 58 | (else (if (pair? values) 59 | (look (cdr names) (cdr values)) 60 | (wrong "Too less values") )) ) ) 61 | (wrong "No such binding" id) ) ) 62 | 63 | (define (s.make-function variables body env) 64 | (lambda (values current.env) 65 | (for-each (lambda (var val) 66 | (putprop var 67 | 'apval 68 | (cons val (getprop var 'apval)) ) ) 69 | variables values ) 70 | (let ((result (eprogn body current.env))) 71 | (for-each (lambda (var) 72 | (putprop var 'apval (cdr (getprop var 'apval))) ) 73 | variables ) 74 | result ) ) ) 75 | 76 | (define (s.lookup id env) 77 | (car (getprop id 'apval)) ) 78 | 79 | (define (s.update! id env value) 80 | (set-car! (getprop id 'apval) value) ) 81 | 82 | (define (chapter1d-scheme) 83 | (define (toplevel) 84 | (display (evaluate (read) env.global)) 85 | (newline) 86 | (toplevel) ) 87 | (display "Welcome to Scheme")(newline) 88 | (call/cc (lambda (end) 89 | (defprimitive end end 1) 90 | (toplevel) )) ) 91 | 92 | ;;; end of chap1d.scm 93 | -------------------------------------------------------------------------------- /src/chap2a.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2a.tst,v 4.0 1995/07/10 06:50:56 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Testing the chap2a interpreter 19 | 20 | 33 21 | 33 22 | xyy 23 | *** ; unexistant 24 | 'foo 25 | foo 26 | (if #t 1 2) 27 | 1 28 | (if #f 2 3) 29 | 3 30 | (begin 1 2 3) 31 | 3 32 | (begin (set! a 3) a) 33 | 3 34 | (cons 3 4) 35 | (3 . 4) 36 | ((lambda (x y) (cons x y)) 37 | 1 2 ) 38 | (1 . 2) 39 | cons 40 | *** ; cons not a variable 41 | ((lambda (f) (f 1 2)) 42 | cons ) 43 | *** ; cons not a variable 44 | (apply (lambda (x y) (cons y x)) '1 '2 '()) 45 | (2 . 1) 46 | 47 | ; no computation in functional position 48 | ((if #t cons list) 1 22) 49 | *** 50 | 51 | 52 | ;;; end of chap2a.tst 53 | -------------------------------------------------------------------------------- /src/chap2b.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2b.tst,v 4.0 1995/07/10 06:50:58 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; testing chap2b 19 | 20 | 33 21 | 33 22 | xyy 23 | *** ; unexistant 24 | 'foo 25 | foo 26 | (if #t 1 2) 27 | 1 28 | (if #f 2 3) 29 | 3 30 | (begin 1 2 3) 31 | 3 32 | (begin (set! a 3) a) 33 | 3 34 | (cons 3 4) 35 | (3 . 4) 36 | ((lambda (x y) (cons x y)) 37 | 1 2 ) 38 | (1 . 2) 39 | cons 40 | *** ; cons not a variable 41 | ((lambda (f) (f 1 2)) 42 | cons ) 43 | *** ; cons not a variable 44 | (apply (lambda (x y) (cons y x)) '1 '2 '()) 45 | (2 . 1) 46 | 47 | ; no computation in functional position 48 | ((if #t cons list) 1 22) 49 | *** 50 | 51 | 52 | (flet ((square (x) (* x x))) 53 | (square 3) ) 54 | 9 55 | (apply (function cons) 1 2 '()) 56 | (1 . 2) 57 | (funcall (function cons) 1 2) 58 | (1 . 2) 59 | (funcall (function funcall) (function cons) 1 2) 60 | (1 . 2) 61 | 62 | ((lambda (f)(apply f (list 3))) 63 | (flet ((square (x) (* x x))) 64 | (function (lambda (x) (square (square x)))) )) 65 | 81 66 | 67 | (labels ((fact (n) (if (= n 0) 1 (* n (fact (- n 1)))))) 68 | (fact 5) ) 69 | 120 70 | (labels ((odd? (n) (if (= n 0) #f (even? (- n 1)))) 71 | (even? (n) (if (= n 0) #t (odd? (- n 1)))) ) 72 | (list (odd? 5) (odd? 4) (even? 5) (even? 4)) ) 73 | (#t #f #f #t) 74 | 75 | ;;; end of chap2b.tst 76 | -------------------------------------------------------------------------------- /src/chap2c.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2c.tst,v 4.0 1995/07/10 06:51:00 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | 33 19 | 33 20 | xyy 21 | *** ; unexistant 22 | 'foo 23 | foo 24 | (if #t 1 2) 25 | 1 26 | (if #f 2 3) 27 | 3 28 | (begin 1 2 3) 29 | 3 30 | (begin (set! a 3) a) 31 | 3 32 | (cons 3 4) 33 | (3 . 4) 34 | ((lambda (x y) (cons x y)) 35 | 1 2 ) 36 | (1 . 2) 37 | cons 38 | *** ; cons not a variable 39 | ((lambda (f) (f 1 2)) 40 | cons ) 41 | *** ; cons not a variable 42 | (apply (function (lambda (x y) (cons y x))) '1 '2 '()) 43 | (2 . 1) 44 | 45 | ; no computation in functional position 46 | ((if #t cons list) 1 22) 47 | *** 48 | 49 | (begin (set! foo 33) 50 | (dynamic foo) ) 51 | *** ; no dynamic variable foo 52 | (dynamic-let ((foo (* 2 3))) 53 | (dynamic foo) ) 54 | 6 55 | (begin (set! bar (function (lambda () (dynamic foo)))) 56 | (dynamic-let ((foo (* 2 3))) 57 | (apply bar '()) ) ) 58 | 6 59 | (begin (set! foo (function (lambda () (dynamic foo)))) 60 | (dynamic-let ((foo (* 2 3))) 61 | (apply foo '()) ) ) 62 | 6 63 | (dynamic-let ((foo (* 2 3))) 64 | (dynamic-set! foo (* 4 4)) 65 | (list (dynamic-let ((foo 55)) 66 | (dynamic-set! foo (* 5 5)) 67 | (dynamic foo) ) 68 | (dynamic foo) ) ) 69 | (25 16) 70 | 71 | 72 | 73 | 74 | ;;; end of chap2c.tst 75 | -------------------------------------------------------------------------------- /src/chap2e.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2e.tst,v 4.0 1995/07/10 06:51:02 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | 33 19 | 33 20 | xyy 21 | *** ; unexistant 22 | 'foo 23 | foo 24 | (if #t 1 2) 25 | 1 26 | (if #f 2 3) 27 | 3 28 | (begin 1 2 3) 29 | 3 30 | (begin (set! a 3) a) 31 | 3 32 | (cons 3 4) 33 | (3 . 4) 34 | ((lambda (x y) (cons x y)) 35 | 1 2 ) 36 | (1 . 2) 37 | cons 38 | *** ; cons not a variable 39 | ((lambda (f) (f 1 2)) 40 | cons ) 41 | *** ; cons not a variable 42 | (apply (function (lambda (x y) (cons y x))) '1 '2 '()) 43 | (2 . 1) 44 | 45 | ; no computation in functional position 46 | ((if #t cons list) 1 22) 47 | *** 48 | 49 | ;;; dynamic variables default to global variables 50 | (begin (set! foo 33) 51 | foo ) 52 | 33 53 | ; a surrounding dynamic is no longer needed 54 | (dynamic-let ((foo (* 2 3))) 55 | foo ) 56 | 6 57 | ;; wrong since the first reference to foo is global and not dynamic 58 | ;(begin (set! bar (function (lambda () foo))) 59 | ; (dynamic-let ((foo (* 2 3))) 60 | ; (apply bar '()) ) ) 61 | ; 6 62 | (dynamic-let ((foo (* 2 3))) 63 | (set! bar (function (lambda () foo))) 64 | (apply bar '()) ) 65 | 6 66 | (dynamic-let ((foo (* 2 3))) 67 | (set! bar (function (lambda () foo))) 68 | (dynamic-let ((foo 44)) 69 | (apply bar '()) ) ) 70 | 44 71 | (dynamic-let ((foo (* 2 3))) 72 | (set! foo (* 4 4)) 73 | (list (dynamic-let ((foo 55)) 74 | (set! foo (* 5 5)) 75 | foo ) 76 | foo ) ) 77 | (25 16) 78 | 79 | ;;; example from book 80 | ;(dynamic-let ((x 2)) 81 | ; (+ x ; dynamic 82 | ; (let ((x (+ ; lexical 83 | ; x x ))) ; dynamic 84 | ; (+ x ; lexical 85 | ; (dynamic x) ) ) ) ) ; dynamic 86 | ; 8 87 | (dynamic-let ((x 2)) 88 | (+ x ; dynamic 89 | ((lambda (x) (+ x ; lexical 90 | (dynamic x) )) ; dynamic 91 | (+ x x) ) ) ) ; dynamic 92 | 8 93 | 94 | ;;; end of chap2e.tst 95 | -------------------------------------------------------------------------------- /src/chap2f.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2f.tst,v 4.0 1995/07/10 06:51:04 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | 33 19 | 33 20 | xyy 21 | *** ; unexistant 22 | 'foo 23 | foo 24 | (if #t 1 2) 25 | 1 26 | (if #f 2 3) 27 | 3 28 | (begin 1 2 3) 29 | 3 30 | (begin (set! a 3) a) 31 | 3 32 | (cons 3 4) 33 | (3 . 4) 34 | ((lambda (x y) (cons x y)) 35 | 1 2 ) 36 | (1 . 2) 37 | cons 38 | --- ; cons now is a variable 39 | ((lambda (f) (f 1 2)) 40 | cons ) 41 | (1 . 2) 42 | (apply (lambda (x y) (cons y x)) '1 '2 '()) 43 | (2 . 1) 44 | ((if #t cons list) 1 22) 45 | (1 . 22) 46 | 47 | (bind/de 'x (* 2 3) (lambda () 44)) 48 | 44 49 | (bind/de 'x (* 2 3) 50 | (lambda () 51 | (assoc/de 'x (lambda (tag) 'no-tag)) ) ) 52 | 6 53 | (bind/de 'x (* 2 3) 54 | (lambda () 55 | (assoc/de 'yyy (lambda (tag) 'no-tag)) ) ) 56 | no-tag 57 | 58 | ;(bind/de 'x 2 59 | ; (lambda () (+ (assoc/de 'x error) 60 | ; (let ((x (+ 61 | ; (assoc/de 'x error) (assoc/de 'x error) ))) 62 | ; (+ x (assoc/de 'x error)) ) )) ) 63 | ; 6 64 | (bind/de 'x 2 65 | (lambda () (+ (assoc/de 'x error) 66 | ((lambda (x) (+ x (assoc/de 'x error))) 67 | (+ (assoc/de 'x error) (assoc/de 'x error)) ) ) ) ) 68 | 8 69 | (bind/de 'x (list 2) 70 | (lambda () (set-car! (assoc/de 'x error) 3) 71 | (assoc/de 'x error) ) ) 72 | (3) 73 | (bind/de 'x (list 2) 74 | (lambda () (set-car! (assoc/de 'x error) 3) 75 | (car (assoc/de 'x error)) ) ) 76 | 3 77 | 78 | ((lambda (key) 79 | (bind/de key (* 2 3) 80 | (lambda () 81 | (new-assoc/de key (lambda (tag) 'no-tag) eq?) ) ) ) 82 | '(x) ) 83 | 6 84 | ((lambda (key) 85 | (bind/de key (* 2 3) 86 | (lambda () 87 | (new-assoc/de key (lambda (tag) 'no-tag) equal?) ) ) ) 88 | '(x) ) 89 | 6 90 | (bind/de '(x) (* 2 3) 91 | (lambda () 92 | (new-assoc/de '(x) (lambda (tag) 'no-tag) eq?) ) ) 93 | no-tag 94 | (bind/de '(x) (* 2 3) 95 | (lambda () 96 | (new-assoc/de '(x) (lambda (tag) 'no-tag) equal?) ) ) 97 | 6 98 | ;;; same test with a closure instead of a primitive comparator 99 | (bind/de '(x) (* 2 3) 100 | (lambda () 101 | (new-assoc/de '(x) (lambda (tag) 'no-tag) 102 | (lambda (x y) (equal? x y)) ) ) ) 103 | 6 104 | 105 | 106 | ;;; end of chap2f.tst 107 | -------------------------------------------------------------------------------- /src/chap2g.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2g.scm,v 4.0 1995/07/10 06:51:05 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Scheme + introduction of let, letrec, label (added to chap1.scm) 19 | 20 | (define (evaluate e env) 21 | (if (atom? e) 22 | (cond ((symbol? e) (lookup e env)) 23 | ((or (number? e) (string? e) (char? e) (boolean? e) (vector? e)) 24 | e ) 25 | (else (wrong "Cannot evaluate" e)) ) 26 | (case (car e) 27 | ((quote) (cadr e)) 28 | ((if) (if (evaluate (cadr e) env) 29 | (evaluate (caddr e) env) 30 | (evaluate (cadddr e) env) )) 31 | ((begin) (eprogn (cdr e) env)) 32 | ((set!) (update! (cadr e) env (evaluate (caddr e) env))) 33 | ((lambda) (make-function (cadr e) (cddr e) env)) 34 | ((label) 35 | (let* ((name (cadr e)) 36 | (new-env (extend env (list name) (list 'void))) 37 | (def (caddr e)) 38 | (fun (make-function (cadr def) (cddr def) new-env)) ) 39 | (update! name new-env fun) 40 | fun ) ) 41 | ((let) 42 | (eprogn (cddr e) 43 | (extend env 44 | (map (lambda (binding) 45 | (if (symbol? binding) binding 46 | (car binding) ) ) 47 | (cadr e) ) 48 | (map (lambda (binding) 49 | (if (symbol? binding) 50 | the-non-initialized-marker 51 | (evaluate (cadr binding) env) ) ) 52 | (cadr e) ) ) ) ) 53 | ((letrec) 54 | (let ((new-env (extend env 55 | (map car (cadr e)) 56 | (map (lambda (binding) the-non-initialized-marker) 57 | (cadr e) ) ))) 58 | (map (lambda (binding) ;\relax {\tt map} to preserve chaos~! 59 | (update! (car binding) 60 | new-env 61 | (evaluate (cadr binding) new-env) ) ) 62 | (cadr e) ) 63 | (eprogn (cddr e) new-env) ) ) 64 | (else (invoke (evaluate (car e) env) 65 | (evlis (cdr e) env) )) ) ) ) 66 | 67 | 68 | (define the-non-initialized-marker (cons 'non 'initialized)) 69 | 70 | (define (lookup id env) 71 | (if (pair? env) 72 | (if (eq? (caar env) id) 73 | (let ((value (cdar env))) 74 | (if (eq? value the-non-initialized-marker) 75 | (wrong "Uninitialized binding" id) 76 | value ) ) 77 | (lookup id (cdr env)) ) 78 | (wrong "No such binding" id) ) ) 79 | 80 | 81 | ;;; patch chap1.scm 82 | (set! the-false-value #f) 83 | (definitial f the-false-value) 84 | 85 | 86 | ;;; end of chap2g.scm 87 | -------------------------------------------------------------------------------- /src/chap2g.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2g.tst,v 4.0 1995/07/10 06:51:06 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; tests on let. 19 | 20 | (let () 33) 21 | 33 22 | (let ((x 1)) x) 23 | 1 24 | (let ((x (* 2 3)) 25 | (y (* 4 5)) ) 26 | (+ x y) ) 27 | 26 28 | (let ((x 1)) 29 | 1 2 3 ) 30 | 3 31 | 32 | ;;; tests on uninitialied variables 33 | xyzy 34 | *** ; undefined 35 | 36 | ;;; tests on letrec 37 | (letrec ((fact (lambda (n) 38 | (if (= n 1) 1 (* n (fact (- n 1)))) ))) 39 | (letrec ((odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))) 40 | (even? (lambda (n) (if (= n 0) #t (odd? (- n 1))))) ) 41 | (list (fact 5) (odd? 5) (odd? 4) (even? 4) (even? 3)) ) ) 42 | (120 #t #f #t #f) 43 | 44 | ((label fact (lambda (n) (if (= n 1) 1 (* n (fact (- n 1)))))) 45 | 5 ) 46 | 120 47 | 48 | ;;; end of chap2g.tst 49 | -------------------------------------------------------------------------------- /src/chap2h.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2h.scm,v 4.0 1995/07/10 06:51:07 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Add innovation to chap1.scm ie allow (2 '(a b c)) or ((car cdr) '(a b)). 19 | 20 | (define (invoke fn args) 21 | (cond ((procedure? fn) (fn args)) 22 | ((number? fn) 23 | (if (= (length args) 1) 24 | (if (>= fn 0) (list-ref (car args) fn) 25 | (list-tail (car args) (- fn)) ) 26 | (wrong "Incorrect arity" fn) ) ) 27 | ((pair? fn) 28 | (map (lambda (f) (invoke f args)) 29 | fn ) ) 30 | (else (wrong "Cannot apply" fn)) ) ) 31 | 32 | ;;; end of chap2h.scm 33 | -------------------------------------------------------------------------------- /src/chap2h.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap2h.tst,v 4.0 1995/07/10 06:51:08 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (2 '(a b c d)) 19 | c 20 | (-1 '(a b c)) 21 | (b c) 22 | 23 | (2 '(foo bar hux wok)) 24 | hux 25 | (-2 '(foo bar hux wok)) 26 | (hux wok) 27 | (0 '(foo bar hux wok)) 28 | foo 29 | (2 (-3 '(a b c d e f g h))) 30 | f 31 | 32 | ((list + - *) 5 3) 33 | (8 2 15) 34 | 35 | ;;; end of chap2h.tst 36 | -------------------------------------------------------------------------------- /src/chap3a.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3a.scm,v 4.3 2006/11/13 11:45:52 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Excerpts from chapter 3 (not necessarily Scheme) 19 | 20 | ;; (defun fact (n) \[\em\hfill\cl\] 21 | ;; (prog (r) 22 | ;; (setq r 1) 23 | ;; loop (cond ((= n 1) (return r))) 24 | ;; (setq r (* n r)) 25 | ;; (setq n (- n 1)) 26 | ;; (go loop) ) ) 27 | 28 | ;; (defun fact2 (n) \[\em\hfill\cl\] 29 | ;; (prog (r) 30 | ;; (setq r 1) 31 | ;; loop (setq r (* (cond ((= n 1) (return r)) 32 | ;; ('else n) ) 33 | ;; r )) 34 | ;; (setq n (- n 1)) 35 | ;; (go loop) ) ) 36 | 37 | ;; (define *active-catchers* '()) 38 | 39 | ;; (define-syntax throw 40 | ;; (syntax-rules () 41 | ;; ((throw tag value) 42 | ;; (let* ((label tag) ; compute once 43 | ;; (escape (assv label ; compare with {\tt eqv?} 44 | ;; *active-catchers* )) ) 45 | ;; (if (pair? escape) 46 | ;; ((cdr escape) value) 47 | ;; (wrong "No associated catch to" label) ) ) ) ) ) 48 | 49 | ;; (define-syntax catch 50 | ;; (syntax-rules () 51 | ;; ((catch tag . body) 52 | ;; (let* ((saved-catchers *active-catchers*) 53 | ;; (result (block label 54 | ;; (set! *active-catchers* 55 | ;; (cons (cons tag 56 | ;; (lambda (x) 57 | ;; (return-from label x) ) ) 58 | ;; *active-catchers* ) ) 59 | ;; . body )) ) 60 | ;; (set! *active-catchers* saved-catchers) 61 | ;; result ) ) )) 62 | 63 | (define (find-symbol id tree) 64 | (if (pair? tree) 65 | (or (find-symbol id (car tree)) 66 | (find-symbol id (cdr tree)) ) 67 | (eq? tree id) ) ) 68 | 69 | ;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo 70 | ;;; Tests (test-chap3a "src/chap3a.tst") 71 | 72 | (define (test-chap3a file) 73 | (suite-test 74 | file 75 | "Scheme? " 76 | "Scheme= " 77 | #t 78 | (lambda (read check error) 79 | (set! wrong error) 80 | (lambda () 81 | (check (eval (read))) ) ) 82 | equal? ) ) 83 | 84 | ;;; end of chap3a.scm 85 | -------------------------------------------------------------------------------- /src/chap3a.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3a.tst,v 4.0 1995/07/10 06:51:09 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Test for chap3a.scm 19 | 20 | (find-symbol 'a '(a)) 21 | #t 22 | (find-symbol 'a '(b . c)) 23 | #f 24 | (find-symbol 'a '((((b . c) . d) e f . g) . a)) 25 | #t 26 | (find-symbol 'a '((((b . c) . d) e f . g) . h)) 27 | #f 28 | 29 | ;;; end of chap3a.tst 30 | -------------------------------------------------------------------------------- /src/chap3b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3b.scm,v 4.2 2005/07/19 09:20:44 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Excerpts from chapter 3 (not necessarily Scheme) 19 | 20 | ;; (define-syntax throw 21 | ;; (syntax-rules () 22 | ;; ((throw tag value) 23 | ;; (let* ((label tag) ; compute once 24 | ;; (escape (assv label (dynamic *active-catchers*))) ) 25 | ;; (if (pair? escape) 26 | ;; ((cdr escape) value) 27 | ;; (wrong "No associated catch to" label) ) ) ) ) ) 28 | 29 | ;; (define-syntax catch 30 | ;; (syntax-rules () 31 | ;; ((catch tag . body) 32 | ;; (block label 33 | ;; (dynamic-let ((*active-catchers* 34 | ;; (cons (cons tag (lambda (x) 35 | ;; (return-from label x) )) 36 | ;; (dynamic *active-catchers*) ) )) 37 | ;; . body ) ) ) ) ) 38 | 39 | ;; (define (find-symbol id tree) 40 | ;; (define (find tree) 41 | ;; (if (pair? tree) 42 | ;; (or (find (car tree)) 43 | ;; (find (cdr tree)) ) 44 | ;; (if (eq? tree id) (throw 'find #t) #f) ) ) 45 | ;; (catch 'find (find tree)) ) 46 | 47 | ;;; end of chap3b.scm 48 | -------------------------------------------------------------------------------- /src/chap3c.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3c.scm,v 4.1 1996/02/16 19:28:34 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Excerpts from chapter 3 (not necessarily Scheme) 19 | 20 | ;; (define-syntax block 21 | ;; (syntax-rules () 22 | ;; ((block label . body) 23 | ;; (let ((label (list 'label))) 24 | ;; (catch label . body) ) ) ) ) 25 | 26 | ;; (define-syntax return-from 27 | ;; (syntax-rules () 28 | ;; ((return-from label value) 29 | ;; (throw label value) ) ) ) 30 | 31 | ;; (define (find-symbol id tree) 32 | ;; (block find 33 | ;; (letrec ((find (lambda (tree) 34 | ;; (if (pair? tree) 35 | ;; (or (find (car tree)) 36 | ;; (find (cdr tree)) ) 37 | ;; (if (eq? id tree) (return-from find #t) 38 | ;; #f ) ) ))) 39 | ;; (find tree) ) ) ) 40 | 41 | ;;; end of chap3c.scm 42 | -------------------------------------------------------------------------------- /src/chap3d.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3d.scm,v 4.0 1995/07/10 06:51:12 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define (find-symbol id tree) 19 | (call/cc 20 | (lambda (exit) 21 | (define (find tree) 22 | (if (pair? tree) 23 | (or (find (car tree)) 24 | (find (cdr tree)) ) 25 | (if (eq? tree id) (exit #t) #f) ) ) 26 | (find tree) ) ) ) 27 | 28 | (define (fact n) 29 | (let ((r 1)(k 'void)) 30 | (call/cc (lambda (c) (set! k c) 'void)) 31 | (set! r (* r n)) 32 | (set! n ( - n 1)) 33 | (if (= n 1) r (k 'recurse)) ) ) ;\relax{\tt k}$\equiv$ {\tt goto}~! \endlisp 34 | 35 | 36 | ;;; end of chap3d.scm 37 | -------------------------------------------------------------------------------- /src/chap3e.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3e.scm,v 4.0 1995/07/10 06:51:13 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Excerpts from chapter 3 (not necessarily Scheme) 19 | 20 | (define (fact n) 21 | (let ((r 1)) 22 | (let ((k (call/cc (lambda (c) c)))) 23 | (set! r (* r n)) 24 | (set! n ( - n 1)) 25 | (if (= n 1) r (k k)) ) ) ) 26 | 27 | ;; (define-syntax catch 28 | ;; (syntax-rules 29 | ;; ((catch tag . body) 30 | ;; (let ((saved-catchers *active-catchers*)) 31 | ;; (unwind-protect 32 | ;; (block label 33 | ;; (set! *active-catchers* 34 | ;; (cons (cons tag (lambda (x) (return-from label x))) 35 | ;; *active-catchers* ) ) 36 | ;; . body ) 37 | ;; (set! *active-catchers* saved-catchers) ) ) ) ) ) 38 | 39 | ;; (define-syntax let/cc 40 | ;; (syntax-rules () 41 | ;; ((let/cc variable . body) 42 | ;; (block variable 43 | ;; (let ((variable (lambda (x) (return-from variable x)))) 44 | ;; . body ) ) ) ) ) 45 | 46 | ;;; end of chap3e.scm 47 | -------------------------------------------------------------------------------- /src/chap3f.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3f.tst,v 4.0 1995/07/10 06:51:15 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (block foo 33) 19 | 33 20 | (block foo 1 2 3) 21 | 3 22 | (block foo (+ 1 (return-from foo 2))) 23 | 2 24 | (return-from foo 3) 25 | *** ; no block foo 26 | ((block foo (lambda (x) (return-from foo x))) 27 | 3 ) 28 | *** ; obsolete block foo 29 | ((block a 30 | (* 2 (block b (return-from a (lambda (x) (return-from b x))))) ) 31 | 3 ) 32 | *** ; obsolete block b 33 | ((block a 34 | (* 2 (block b (return-from a (lambda (x) (return-from a x))))) ) 35 | 3 ) 36 | *** ; obsolete block a 37 | ; scope of block labels 38 | (block foo 39 | ((lambda (exit) 40 | (* 2 (block foo 41 | (* 3 (exit 5)) )) ) 42 | (lambda (x) (return-from foo x)) ) ) 43 | 5 44 | 45 | (catch 'bar 1) 46 | 1 47 | (catch 'bar 1 2 3) 48 | 3 49 | (throw 'bar 33) 50 | *** ; no catcher for bar 51 | (catch 'bar (throw 'bar 11)) 52 | 11 53 | (catch 'bar (* 2 (throw 'bar 5))) 54 | 5 55 | ((lambda (f) 56 | (catch 'bar (* 2 (f 5))) ) 57 | (lambda (x) (throw 'bar x)) ) 58 | 5 59 | ((lambda (f) 60 | (catch 'bar (* 2 (catch 'bar (* 3 (f 5))))) ) 61 | (lambda (x) (throw 'bar x)) ) 62 | 10 63 | (catch 2 64 | (* 7 (catch 1 65 | (* 3 (catch 2 66 | (throw 1 (throw 2 5)) )) )) ) 67 | 105 68 | (catch 2 (* 7 (throw 1 (throw 2 3)))) 69 | *** ; no catcher for 1 70 | 71 | (unwind-protect 1 2) 72 | 1 73 | ((lambda (c) 74 | (unwind-protect 1 (set! c 2)) 75 | c ) 76 | 0 ) 77 | 2 78 | ((lambda (c) 79 | (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) 80 | (set! c 1) ))) ) 81 | 0 ) 82 | 5 83 | ((lambda (c) 84 | (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) 85 | (set! c 1) ))) 86 | c ) 87 | 0 ) 88 | 1 89 | ((lambda (c) 90 | (block A (* 2 (unwind-protect (* 3 (return-from A 5)) 91 | (set! c 1) ))) ) 92 | 0 ) 93 | 5 94 | ((lambda (c) 95 | (block A (* 2 (unwind-protect (* 3 (return-from A 5)) 96 | (set! c 1) ))) 97 | c ) 98 | 0 ) 99 | 1 100 | 101 | (catch 1 (catch 2 (unwind-protect (throw 1 'foo) (throw 2 'bar) ) ) ) 102 | --- 103 | 104 | 105 | ;;; throw as a function 106 | (set! funcall (lambda (g . args) (apply g args))) 107 | --- 108 | (funcall throw 'bar 33) 109 | *** ; no catcher for bar 110 | (catch 'bar (funcall throw 'bar 11)) 111 | 11 112 | (catch 'bar (* 2 (funcall throw 'bar 5))) 113 | 5 114 | ((lambda (f) 115 | (catch 'bar (* 2 (f 5))) ) 116 | (lambda (x) (funcall throw 'bar x)) ) 117 | 5 118 | ((lambda (f) 119 | (catch 'bar (* 2 (catch 'bar (* 3 (f 5))))) ) 120 | (lambda (x) (funcall throw 'bar x)) ) 121 | 10 122 | (catch 2 123 | (* 7 (catch 1 124 | (* 3 (catch 2 125 | (funcall throw 1 (funcall throw 2 5)) )) )) ) 126 | 105 127 | (catch 2 (* 7 (funcall throw 1 (funcall throw 2 3)))) 128 | 3 129 | 130 | ;;; end of chap3f.tst 131 | -------------------------------------------------------------------------------- /src/chap3h.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap3h.scm,v 4.1 1996/02/16 19:28:34 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; UNWIND-PROTECT 19 | 20 | (define-class unwind-protect-cont continuation (cleanup r)) 21 | 22 | (define-class protect-return-cont continuation (value)) 23 | 24 | (define (evaluate-unwind-protect form cleanup r k) 25 | (evaluate form 26 | r 27 | (make-unwind-protect-cont k cleanup r) ) ) 28 | 29 | (define-method (resume (k unwind-protect-cont) v) 30 | (evaluate-begin (unwind-protect-cont-cleanup k) 31 | (unwind-protect-cont-r k) 32 | (make-protect-return-cont 33 | (unwind-protect-cont-k k) v ) ) ) 34 | 35 | (define-method (resume (k protect-return-cont) v) 36 | (resume (protect-return-cont-k k) (protect-return-cont-value k)) ) 37 | 38 | (define-method (resume (k throwing-cont) v) ; \modified 39 | (unwind (throwing-cont-k k) v (throwing-cont-cont k)) ) 40 | 41 | (define-class unwind-cont continuation (value target)) 42 | 43 | (define-method (unwind (k unwind-protect-cont) v target) 44 | (evaluate-begin (unwind-protect-cont-cleanup k) 45 | (unwind-protect-cont-r k) 46 | (make-unwind-cont 47 | (unwind-protect-cont-k k) v target ) ) ) 48 | 49 | (define-method (resume (k unwind-cont) v) 50 | (unwind (unwind-cont-k k) 51 | (unwind-cont-value k) 52 | (unwind-cont-target k) ) ) 53 | 54 | (define-method (block-lookup (r block-env) n k v) ; \modified 55 | (if (eq? n (block-env-name r)) 56 | (unwind k v (block-env-cont r)) 57 | (block-lookup (block-env-others r) n k v) ) ) 58 | 59 | ;;; end of chap3h.scm 60 | -------------------------------------------------------------------------------- /src/chap3i.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id$ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define (fact n k) 19 | (if (= n 1) (k 1) 20 | (fact (- n 1) (lambda (r) (k (* n r)))) ) ) 21 | 22 | (define (divide p q f) 23 | (f (quotient p q) (remainder p q)) ) 24 | 25 | (define (bezout n p k) ; assume $n>p$ 26 | (divide 27 | n p (lambda (q r) 28 | (if (= r 0) 29 | (if (= p 1) 30 | (k 0 1) ; since $ 0 \times 1 - 1 \times 0 = 1 $ 31 | (error "not relatively prime" n p) ) 32 | (bezout 33 | p r (lambda (u v) 34 | (k v (- u (* v q))) ) ) ) ) ) ) 35 | ;;; (bezout 45 5 list) 36 | ;;; (bezout 45 53 list) 37 | ;;; (bezout 1991 1960 list) 38 | 39 | (define (cc f) 40 | (let ((reified? #f)) 41 | (let ((k (the-current-continuation))) 42 | (if reified? k (begin (set! reified? #t) (f k))) ) ) ) 43 | 44 | 45 | (define (cps-fact n k) 46 | (if (= n 0) (k 1) (cps-fact (- n 1) (lambda (v) (k (* n v))))) ) 47 | 48 | (define (make-box value) 49 | (let ((box 50 | (call/cc 51 | (lambda (exit) 52 | (letrec 53 | ((behavior 54 | (call/cc 55 | (lambda (store) 56 | (exit (lambda (msg . new) 57 | (call/cc 58 | (lambda (caller) 59 | (case msg 60 | ((get) (store (cons (car behavior) 61 | caller ))) 62 | ((set) 63 | (store 64 | (cons (car new) 65 | caller ) ) ) ) ) ) )) ) ) )) 66 | ((cdr behavior) (car behavior)) ) ) ) ) ) 67 | (box 'set value) 68 | box ) ) 69 | 70 | ;;; end of chap3i.scm 71 | -------------------------------------------------------------------------------- /src/chap4a.tst: -------------------------------------------------------------------------------- 1 | ;;; Particular tests for the interpreter 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; testing eq? 19 | (eq? 'a 'b) 20 | #f 21 | (eq? 'a 'a) 22 | #t 23 | (eq? (cons 1 2) (cons 1 2)) 24 | #f 25 | ((lambda (a) (eq? a a)) 26 | (cons 1 2) ) 27 | #t 28 | ((lambda (a) (eq? a a)) 29 | (lambda (x) x) ) 30 | #t 31 | (eq? (lambda (x) 1) (lambda (x y) 2)) 32 | #f 33 | 34 | ;;; testing eqv? (same as eq? plus eqv?) 35 | (eqv? '1 '2) 36 | #f 37 | (eqv? 1 1) 38 | #t 39 | (eqv? 'a 'b) 40 | #f 41 | (eqv? 'a 'a) 42 | #t 43 | (eqv? (cons 1 2) (cons 1 2)) 44 | #f 45 | ((lambda (a) (eqv? a a)) 46 | (cons 1 2) ) 47 | #t 48 | ((lambda (a) (eqv? a a)) 49 | (lambda (x) x) ) 50 | #t 51 | (eqv? (lambda (x) 1) (lambda (x y) 2)) 52 | #f 53 | 54 | ;;; Testing the special OR (backtracking without side-effect). 55 | ((lambda (x) 56 | (or (begin (set! x (+ x 1)) 57 | #f ) 58 | (if (= x 1) 'OK 'KO) ) ) 59 | 1 ) 60 | OK 61 | ((lambda (x) 62 | (or (begin (set! x (+ x 1)) 63 | #f ) 64 | (if (= x 1) (begin (set! x 3) x) 'KO) ) ) 65 | 1 ) 66 | 3 67 | -------------------------------------------------------------------------------- /src/chap5-bench.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap5-bench.scm,v 4.0 1995/07/10 06:51:22 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | ;;; This expression serves to compare the speed of two denotational 18 | ;;; interpreters (chap5a and chap5d). 19 | 20 | (begin 21 | (set! primes 22 | (lambda (n f max) 23 | ((lambda (filter) 24 | (begin 25 | (set! filter (lambda (p) 26 | (lambda (n) (= 0 (remainder n p))) )) 27 | (if (> n max) 28 | '() 29 | (if (f n) 30 | (primes (+ n 1) f max) 31 | (cons n 32 | ((lambda (ff) 33 | (primes (+ n 1) 34 | (lambda (p) (if (f p) t (ff p))) 35 | max ) ) 36 | (filter n) ) ) ) ) ) ) 37 | 'wait ) ) ) 38 | (display (primes 2 (lambda (x) f) 300)) ) 39 | 40 | ;;; With interpreted-chap5a on blaye: 62. seconds 41 | ;;; With interpreted-chap5d on blaye: 58. seconds 42 | ;;; With compiled-chap5a on blaye: 20. seconds 43 | ;;; With compiled-chap5d on blaye: 12. seconds 44 | ;;; With interpreted-chap6a on blaye: 2. seconds 45 | ;;; Compiled to C on blaye: 0.02 seconds 46 | ;;; size: 47 | ;;; text data bss dec hex 48 | ;;; 28672 4096 96 32864 8060 49 | 50 | ;;; end of chap5-bench.scm 51 | -------------------------------------------------------------------------------- /src/chap5b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap5b.scm,v 4.0 1995/07/10 06:51:23 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | ;;; Semantics of the Lambda calculus 18 | 19 | (define (L-meaning e) 20 | ;(format #t "Meaning of ~a.~%" e) 21 | (cond ((symbol? e) (L-meaning-reference e)) 22 | ((eq? (car e) 'lambda) 23 | (L-meaning-abstraction (car (cadr e)) (caddr e)) ) 24 | ((eq? (car e) 'label) 25 | (L-meaning-label (cadr e) (caddr e)) ) 26 | (else (L-meaning-combination (car e) (cadr e))) ) ) 27 | 28 | (define (L-meaning-reference n) 29 | (lambda (r) 30 | (r n) ) ) 31 | 32 | (define (L-meaning-abstraction n e) 33 | (lambda (r) 34 | (lambda (v) 35 | ((L-meaning e) (extend r n v)) ) ) ) 36 | 37 | (define (L-meaning-combination e1 e2) 38 | (lambda (r) 39 | (((L-meaning e1) r) ((L-meaning e2) r)) ) ) 40 | 41 | (define (L-meaning-label n e) 42 | (lambda (r) 43 | (fix (lambda (v) 44 | ((L-meaning e) (extend r n v)) )) ) ) 45 | 46 | (define fix 47 | (let ((d (lambda (w) 48 | (lambda (f) 49 | (f (lambda (x) (((w w) f) x))) ) ))) 50 | (d d) ) ) 51 | 52 | 53 | ;;; Initial environment 54 | 55 | (define (r.init n) 56 | (wrong "No such variable" n) ) 57 | 58 | (define (extend fn pt im) 59 | (lambda (x) (if (equal? pt x) im (fn x))) ) 60 | 61 | (set! r.init (extend r.init 'a 1)) 62 | (set! r.init (extend r.init 'b 2)) 63 | (set! r.init (extend r.init 'c 3)) 64 | (set! r.init (extend r.init '+ (lambda (x) 65 | (lambda (y) (+ x y)) ))) 66 | (set! r.init (extend r.init '- (lambda (x) 67 | (lambda (y) (- x y)) ))) 68 | (set! r.init (extend r.init '* (lambda (x) 69 | (lambda (y) (* x y)) ))) 70 | (set! r.init (extend r.init '= (lambda (x) 71 | (lambda (y) 72 | (if (= x y) 73 | (lambda (x) (lambda (y) x)) 74 | (lambda (x) (lambda (y) y)) ) ) ) ) ) 75 | 76 | ;;; Testing 77 | 78 | (define (test-L file) 79 | (suite-test 80 | file 81 | "lambda? " 82 | "lambda= " 83 | #t 84 | (lambda (read check error) 85 | (set! wrong error) 86 | (lambda () 87 | (check ((L-meaning (read)) 88 | r.init ) ) ) ) 89 | equal? ) ) 90 | 91 | ;;; end of chap5b.scm 92 | -------------------------------------------------------------------------------- /src/chap5b.tst: -------------------------------------------------------------------------------- 1 | ;;; Test for Lambda-calculus 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | ;;; The initial environment maps identifiers to numbers and also contain 18 | ;;; the addition as a delta rule. 19 | 20 | a 21 | 1 22 | b 23 | 2 24 | (+ a) 25 | --- 26 | ((+ a) b) 27 | 3 28 | 29 | ((lambda (K) ((K a) b)) 30 | (lambda (x) (lambda (y) x)) ) 31 | 1 32 | 33 | ((lambda (S) 34 | ((lambda (K) (((S K) K) b)) 35 | (lambda (x) (lambda (y) x)) ) ) 36 | (lambda (f) (lambda (g) (lambda (x) ((f x) (g x))))) ) 37 | 2 38 | 39 | ;;; these three loop 40 | ((label fact (lambda (x) 41 | ((((= x) a) 42 | a ) 43 | ((* x) (fact ((- x) a))) ) )) 44 | a ) 45 | 1 46 | ((label fact (lambda (x) 47 | ((((= x) a) 48 | a ) 49 | ((* x) (fact ((- x) a))) ) )) 50 | ((+ b) b) ) 51 | 24 52 | 53 | ((lambda (Y) 54 | ((lambda (meta-fact) 55 | ((Y meta-fact) ((+ b) b)) ) 56 | (lambda (f) 57 | (lambda (x) 58 | ((((= x) a) 59 | a ) 60 | ((* x) (f ((- x) a))) ) ) ) ) ) 61 | (lambda (f) 62 | ((lambda (x) (f (lambda (y) ((x x) y)))) 63 | (lambda (x) (f (lambda (y) ((x x) y)))) ) ) ) 64 | 24 65 | 66 | ;;; end of chap5b.tst 67 | -------------------------------------------------------------------------------- /src/chap5c.tst: -------------------------------------------------------------------------------- 1 | ;;; Testing dynamic binding 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (dynamic-let (a 1) 2) 19 | 2 20 | (dynamic-let (a 1) 2 3 4) 21 | 4 22 | (dynamic-let (a 1) (dynamic a)) 23 | 1 24 | (dynamic-let (a 1) (+ (dynamic a) (dynamic a))) 25 | 2 26 | (dynamic-let (a 1) 27 | (dynamic-let (a (+ (dynamic a) (dynamic a))) 28 | (dynamic a) ) ) 29 | 2 30 | 31 | ;;; with respect to functions 32 | ((lambda (f) 33 | (dynamic-let (a 1) (f)) ) 34 | (lambda () (dynamic a)) ) 35 | 1 36 | ((lambda (f) 37 | (dynamic-let (a 1) 38 | (list (f) 39 | (dynamic-let (a 2) (f)) ) ) ) 40 | (lambda () (dynamic a)) ) 41 | (1 2) 42 | 43 | ;;; with respect to continuations 44 | (dynamic-let (a 1) 45 | ((call/cc (lambda (k) 46 | ((lambda (f) 47 | (dynamic-let (a 2) f) ) 48 | (lambda () (dynamic a)) ) ))) ) 49 | 1 50 | -------------------------------------------------------------------------------- /src/chap5e.tst: -------------------------------------------------------------------------------- 1 | ;;; Some tests for chap5e.scm 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | 3 19 | (3) 20 | '(a b) 21 | ((a b)) 22 | (car '(a b)) 23 | (a a) 24 | (if 1 2 3) 25 | (2) 26 | (+ 2 3) 27 | (5 5 5 5 5 5) 28 | (list 2 3 4) 29 | ((2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) 30 | (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) 31 | (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) 32 | (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) (2 3 4) ) 33 | (call/cc 34 | (lambda (k) 35 | ((k 1) (k 2)) ) ) 36 | (1 1 1 1 2 2 2 2) 37 | 38 | ;;; end of chap5e.tst 39 | -------------------------------------------------------------------------------- /src/chap5g.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap5g.tst,v 4.0 1995/07/10 06:51:32 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define zlurp (+ 2 3)) 19 | --- 20 | zlurp 21 | 5 22 | (set! zlurp 6) 23 | --- 24 | zlurp 25 | 6 26 | 27 | ((lambda (zixxy) 28 | (define zixxy (* 2 2)) ) 29 | 3 ) 30 | --- 31 | zixxy 32 | 4 33 | 34 | ;;; end of chap5g.tst 35 | -------------------------------------------------------------------------------- /src/chap6b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap6b.scm,v 4.0 1995/07/10 06:51:35 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Threaded interpreter. 19 | ;;; Dynamic creation of global variables as soon as there are seen. 20 | ;;; In fact they are not created at read-time but at compile-time and 21 | ;;; before evaluation-time. The problem is that at compile-time, we 22 | ;;; must compile (sic) so we must associate an index to any global 23 | ;;; variable so this index must be known by the compiler so the 24 | ;;; variable must be created by the compiler. 25 | 26 | (define (compute-kind r n) 27 | (or (local-variable? r 0 n) 28 | (global-variable? g.current n) 29 | (global-variable? g.init n) 30 | (adjoin-global-variable! n) ) ) 31 | 32 | ;;; Do not check if the global environment is large enough. 33 | ;;; The new variable is stored at the beginning of sg.current. 34 | 35 | (define (adjoin-global-variable! name) 36 | (let ((index (g.current-extend! name))) 37 | (vector-set! sg.current index undefined-value) 38 | (cdr (car g.current)) ) ) 39 | 40 | ;;; Preserve the current modifiable global environment (containing a, 41 | ;;; b, foo, fact, fib etc.) All tests will be compiled in that environment. 42 | 43 | (define original.g.current 44 | (let ((g g.current)) 45 | (lambda () g) ) ) 46 | 47 | ;;; Compile a program into a stand-alone program. It will initialize 48 | ;;; the global modifiable environment before starting evaluation. 49 | 50 | (define (stand-alone-producer e) 51 | (set! g.current (original.g.current)) 52 | (let* ((m (meaning e r.init)) 53 | (size (length g.current)) ) 54 | (lambda (sr k) 55 | (set! sg.current (make-vector size undefined-value)) 56 | (m sr k) ) ) ) 57 | 58 | ;;; Testing. 59 | ;;; We must skip the tests that presuppose a static non extensible 60 | ;;; global environment. Some of them appear in scheme-tests.scm. 61 | 62 | (define (test-scheme6b file) 63 | (suite-test 64 | file 65 | "Scheme? " 66 | "Scheme= " 67 | #t 68 | (lambda (read check error) 69 | (define (skip-read) 70 | (let ((e (read))) 71 | (if (member e *tests-to-skip*) 72 | (begin (read) ; skip the associated result 73 | (skip-read) ) 74 | e ) ) ) 75 | (set! wrong error) 76 | (set! static-wrong error) 77 | (lambda () 78 | ((stand-alone-producer (skip-read)) sr.init check) ) ) 79 | equal? ) ) 80 | 81 | (define *tests-to-skip* 82 | '( xyzzy 83 | (set! xyzzy 3) 84 | ((lambda (x y) xyzzy) 1 2) 85 | ) ) 86 | 87 | ;;; end of chap6b.scm 88 | -------------------------------------------------------------------------------- /src/chap6b.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap6b.tst,v 4.0 1995/07/10 06:51:36 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; testing that new variables are automatically created. 19 | 20 | pqoeur 21 | *** 22 | (begin (set! zld 3) 23 | zld ) 24 | 3 25 | (lambda () oiuerq 3) 26 | --- 27 | ((lambda (x) oeewfiuerq x) 3) 28 | *** 29 | 30 | ;;; end of chap6b.tst 31 | -------------------------------------------------------------------------------- /src/chap6dd.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap6dd.scm,v 4.0 1995/07/10 06:51:39 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Variant of chap6d.scm where activation frames are allocated before 19 | ;;; evaluation of arguments and where arguments are evaluated from 20 | ;;; left to right. 21 | 22 | ;;; Load before chap6d.scm 23 | 24 | (define (FROM-RIGHT-STORE-ARGUMENT m m* rank) 25 | (lambda () 26 | (let* ((v* (m*)) 27 | (v (m)) ) 28 | (set-activation-frame-argument! v* rank v) 29 | v* ) ) ) 30 | 31 | (define (FROM-RIGHT-CONS-ARGUMENT m m* arity) 32 | (lambda () 33 | (let* ((v* (m*)) 34 | (v (m)) ) 35 | (set-activation-frame-argument! 36 | v* arity (cons v (activation-frame-argument v* arity)) ) 37 | v* ) ) ) 38 | 39 | ;;; Retrofit 40 | 41 | (set! CONS-ARGUMENT FROM-RIGHT-CONS-ARGUMENT) 42 | (set! STORE-ARGUMENT FROM-RIGHT-STORE-ARGUMENT) 43 | 44 | ;;; Redefine a global variable 45 | 46 | (define (meaning e r tail?) 47 | (if (atom? e) 48 | (if (symbol? e) (meaning-reference e r tail?) 49 | (meaning-quotation e r tail?) ) 50 | (case (car e) 51 | ((quote) (meaning-quotation (cadr e) r tail?)) 52 | ((lambda) (meaning-abstraction (cadr e) (cddr e) r tail?)) 53 | ((if) (meaning-alternative (cadr e) (caddr e) (cadddr e) r tail?)) 54 | ((begin) (meaning-sequence (cdr e) r tail?)) 55 | ((set!) (meaning-assignment (cadr e) (caddr e) r tail?)) 56 | ((redefine) (meaning-redefine (cadr e))) 57 | (else (meaning-application (car e) (cdr e) r tail?)) ) ) ) 58 | 59 | (define (meaning-redefine n) 60 | (let ((kind1 (global-variable? g.init n))) 61 | (if kind1 62 | (let ((value (vector-ref sg.init (cdr kind1)))) 63 | (let ((kind2 (global-variable? g.current n))) 64 | (if kind2 65 | (static-wrong "Already redefined variable" n) 66 | (let ((index (g.current-extend! n))) 67 | (vector-set! sg.current index value) ) ) ) ) 68 | (static-wrong "No such variable to redefine" n) ) 69 | (lambda () 2001) ) ) 70 | 71 | ;;; For tests, it is necessary not to reset the global modifiable env. 72 | ;;; Not very clean but sufficient to test redefine. 73 | 74 | (define (stand-alone-producer e) 75 | ;;(set! g.current (original.g.current)) 76 | (let* ((m (meaning e r.init #t)) 77 | (size (length g.current)) 78 | (names (map (lambda (d) (symbol->string (car d))) 79 | (reverse g.current) )) ) 80 | (lambda () 81 | ;(set! sg.current (make-vector size undefined-value)) 82 | ;(set! sg.current.names (apply vector names)) 83 | (set! *env* sr.init) 84 | (m) ) ) ) 85 | 86 | ;;; end of chap6dd.scm 87 | -------------------------------------------------------------------------------- /src/chap6dd.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap6dd.tst,v 4.0 1995/07/10 06:51:40 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Tests for chap6dd.scm 19 | 20 | (redefine car) 21 | --- 22 | (set! car car) 23 | --- 24 | (car '(a b)) 25 | a 26 | ((lambda (old v) 27 | (begin (set! old car) 28 | (set! car cdr) 29 | (set! v (car '(a b))) 30 | (set! car old) 31 | v ) ) 32 | 'old 'v ) 33 | (b) 34 | 35 | ;;; testing errors 36 | (redefine car) 37 | *** 38 | (redefine foo) 39 | *** 40 | 41 | ;;; end of chap6dd.tst 42 | -------------------------------------------------------------------------------- /src/chap6g.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap6g.tst,v 4.0 1995/07/10 06:51:45 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; test that only explicitely defined variables are created. 19 | 20 | (define xfoo 3) 21 | --- 22 | (define xfoo (lambda () xbar)) 23 | *** 24 | (begin (define xfoo (lambda () xbar)) 25 | (define xbar 33) ) 26 | --- 27 | (begin (define xfoo (lambda () xbar)) 28 | (define xbar (lambda () xhux)) ) 29 | *** 30 | (begin (define xfoo (lambda () xbar)) 31 | (define xbar (lambda () (xhux))) ) 32 | *** 33 | -------------------------------------------------------------------------------- /src/chap6h.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap6h.scm,v 4.0 1995/07/10 06:51:46 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Improvement on chap6d.scm for niladic functions. 19 | 20 | (define (meaning-fix-abstraction n* e+ r tail?) 21 | (let ((arity (length n*))) 22 | (if (= arity 0) 23 | (let ((m+ (meaning-sequence e+ r #t))) 24 | (THUNK-CLOSURE m+) ) 25 | (let* ((r2 (r-extend* r n*)) 26 | (m+ (meaning-sequence e+ r2 #t)) ) 27 | (FIX-CLOSURE m+ arity) ) ) ) ) 28 | 29 | (define (THUNK-CLOSURE m+) 30 | (let ((arity+1 (+ 0 1))) 31 | (lambda () 32 | (define (the-function v* sr) 33 | (if (= (activation-frame-argument-length v*) arity+1) 34 | (begin (set! *env* sr) 35 | (m+) ) 36 | (wrong "Incorrect arity") ) ) 37 | (make-closure the-function *env*) ) ) ) 38 | 39 | ;;; end of chap6h.scm 40 | -------------------------------------------------------------------------------- /src/chap7i.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap7i.scm,v 4.1 1996/01/14 14:14:29 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Dynamic variables with shallow binding 19 | ;;; Just redefine find-dynamic-value, pop-dynamic-binding and 20 | ;;; push-dynamic-binding. 21 | 22 | (define (find-dynamic-value index) 23 | (let ((v (vector-ref *dynamics* index))) 24 | (if (eq? v undefined-value) 25 | (signal-exception #f (list "No such dynamic binding" index)) 26 | v ) ) ) 27 | 28 | (define (push-dynamic-binding index value) 29 | (stack-push (vector-ref *dynamics* index)) 30 | (stack-push index) 31 | (vector-set! *dynamics* index value) ) 32 | 33 | (define (pop-dynamic-binding) 34 | (let* ((index (stack-pop)) 35 | (old-value (stack-pop)) ) 36 | (vector-set! *dynamics* index old-value) ) ) 37 | 38 | (define *dynamics* (vector 1)) 39 | 40 | (define (run-machine pc code constants global-names dynamics) 41 | (define base-error-handler-primitive 42 | (make-primitive base-error-handler) ) 43 | (set! sg.current (make-vector (length global-names) undefined-value)) 44 | (set! sg.current.names global-names) 45 | (set! *constants* constants) 46 | (set! *dynamic-variables* dynamics) 47 | (set! *dynamics* (make-vector (+ 1 (length dynamics)) 48 | undefined-value )) ; \modified 49 | (set! *code* code) 50 | (set! *env* sr.init) 51 | (set! *stack-index* 0) 52 | (set! *val* 'anything) 53 | (set! *fun* 'anything) 54 | (set! *arg1* 'anything) 55 | (set! *arg2* 'anything) 56 | (push-dynamic-binding 0 (list base-error-handler-primitive)) 57 | (stack-push finish-pc) ; pc for FINISH 58 | (set! *pc* pc) 59 | (call/cc (lambda (exit) 60 | (set! *exit* exit) 61 | (run) )) ) 62 | 63 | (let ((native-run-machine run-machine)) 64 | (set! run-machine 65 | (lambda (pc code constants global-names dynamics) 66 | (when *debug* ; DEBUG 67 | (format #t "Code= ~A~%" (disassemble code)) ) 68 | (native-run-machine pc code constants global-names dynamics) ) ) ) 69 | 70 | ;;; end of chap7i.scm 71 | -------------------------------------------------------------------------------- /src/chap8.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8.tst,v 4.0 1995/07/10 06:51:58 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Testing programs and quotations 19 | 20 | (program? 'x) 21 | #t 22 | (program? 3) 23 | #t 24 | (program? "foo") 25 | #t 26 | (program? #\c) 27 | #t 28 | (program? #f) 29 | #t 30 | (program? #t) 31 | #t 32 | (program? car) 33 | #f 34 | (call/cc (lambda (k) (program? k))) 35 | #f 36 | (program? '(if 1 2 3)) 37 | #t 38 | (program? '(if)) 39 | #f 40 | (program? '(if 1)) 41 | #f 42 | (program? '(if . 1)) 43 | #f 44 | (program? '(if 1 2)) 45 | #f 46 | (program? '(if 1 2 . 3)) 47 | #f 48 | (program? '(if 1 2 3 . 4)) 49 | #f 50 | (program? '(if 1 2 3 4)) 51 | #f 52 | (program? '(begin)) 53 | #f 54 | (program? '(begin 1)) 55 | #t 56 | (program? '(begin 1 2 3 4 5)) 57 | #t 58 | (program? '(begin . 1)) 59 | #f 60 | (program? '(begin 1 . 2)) 61 | #f 62 | (program? '(set! 1 2)) 63 | #f 64 | (program? '(set! a 1)) 65 | #t 66 | (program? '(set! a 2 3)) 67 | #f 68 | (program? '(set! a . 1)) 69 | #f 70 | (program? '()) 71 | #f 72 | (program? '(1)) 73 | #t 74 | (program? '(1 . 2)) 75 | #f 76 | (program? '(1 2 3)) 77 | #t 78 | (program? '(1 2 3 . 4)) 79 | #f 80 | (program? '(lambda () 1)) 81 | #t 82 | (program? '(lambda () 1 . 2)) 83 | #f 84 | (program? '(lambda () 1 2 3 4)) 85 | #t 86 | (program? '(lambda ())) 87 | #f 88 | (program? '(lambda a 1)) 89 | #t 90 | (program? '(lambda (a b) a)) 91 | #t 92 | (program? '(lambda (a b c b) 2)) 93 | #f 94 | (program? '(lambda (a b c . a) 22)) 95 | #f 96 | (program? '(quote)) 97 | #f 98 | (program? '(quote . 1)) 99 | #f 100 | (program? '(quote 1 2)) 101 | #f 102 | (program? '(quote 1)) 103 | #t 104 | (program? (let* ((a '(quote 1)) 105 | (b (list a a)) ) 106 | b )) 107 | #t 108 | (program? (let* ((a '(quote 1)) 109 | (b (list a a)) ) 110 | (set-car! b b) 111 | b )) 112 | #f 113 | (program? (let* ((a* '(a b c))) 114 | (set-cdr! (cddr a*) a*) 115 | `(begin . ,a*) )) 116 | #f 117 | 118 | (quotation? 'a) 119 | #t 120 | (quotation? 3) 121 | #t 122 | (quotation? "foo") 123 | #t 124 | (quotation? #\newline) 125 | #t 126 | (quotation? #f) 127 | #t 128 | (quotation? #t) 129 | #t 130 | (call/cc quotation?) 131 | #f 132 | (quotation? quotation?) 133 | #f 134 | (quotation? '(a b c)) 135 | #t 136 | (quotation? '(a b . c)) 137 | #t 138 | (quotation? '#(a b)) 139 | #t 140 | (let* ((a '#(1 2 3)) 141 | (b (list a a)) ) 142 | (vector-set! a 1 b) 143 | (quotation? a) ) 144 | #f 145 | 146 | ;;; end of chap8.tst 147 | -------------------------------------------------------------------------------- /src/chap8a.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8a.tst,v 4.0 1995/07/10 06:52:00 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Tests on eval (in current lexical environment) 19 | 20 | (eval 'car) 21 | --- 22 | ((eval 'car) '(a b c)) 23 | a 24 | ((eval '(lambda (x) (list x x))) (+ 2 3)) 25 | (5 5) 26 | (eval 345) 27 | 345 28 | 29 | ;;; with side effects on the global mutable environment 30 | ;;; Foo and bar already exist 31 | (begin (set! foo 2) 32 | (eval '(set! foo 33)) 33 | foo ) 34 | 33 35 | (begin (set! bar 33) 36 | (set! foo 44) 37 | (eval '(set! bar (- foo bar))) 38 | bar ) 39 | 11 40 | 41 | ;;; More than one eval 42 | ((lambda (loop fact) 43 | (set! loop (lambda (i) 44 | (if (> i 0) 45 | (begin (display (eval (list fact fact 10))) 46 | (loop (- i 1)) ) 47 | 'done ) )) 48 | (loop 0) ) 49 | 'loop '(lambda (f n) (if (= n 0) 1 (* n (f f (- n 1))))) ) 50 | done 51 | 52 | ((eval '(lambda (x) (cons x x))) 53 | 33 ) 54 | (33 . 33) 55 | (((eval '(lambda (f) 56 | (lambda (x) (f x)) )) 57 | list ) 58 | 44 ) 59 | (44) 60 | 61 | ;;; Exercizing some errors. No test on syntax since interpreters of the 62 | ;;; book neglect this aspect. 63 | (eval car) 64 | *** 65 | ;;; remove this test since transcode-back cannot handle circular structures. 66 | ;(eval ((lambda (a) 67 | ; (set-car! (cdr (cdr a)) a) 68 | ; a ) 69 | ; (list 'if #f 2 3) )) 70 | ; *** 71 | 72 | ;;; examples in the book 73 | (begin (set! x 2) 74 | (set! z 1) 75 | (display 76 | (list ((lambda (x) (eval 'x)) 77 | 3 ) 78 | ((lambda (x y) (eval y)) 79 | 4 (list 'eval 'x) ) 80 | ((lambda (x y z) (eval y)) 81 | 5 (list 'eval 'z) 'x ) ) ) ) 82 | --- 83 | ;;; (3 4 5) if special form 84 | ;;; (2 2 1) if function 85 | 86 | 87 | " !!!!!!!!!!!! eval as a function will fail at the next one !!!!!!!!!!!!! " 88 | --- 89 | 90 | ;;; Using local lexical environment 91 | ((lambda (x) (eval 'x)) 92 | 22 ) 93 | 22 94 | ((lambda (x y) (eval y)) 95 | 3 'x ) 96 | 3 97 | ((lambda (x y) (eval y)) 98 | 4 (list 'eval 'x) ) 99 | 4 100 | ((lambda (x y z) (eval y)) 101 | 5 (list 'eval 'z) 'x ) 102 | 5 103 | 104 | ;;; Dynamic creation of global variables 105 | (eval '(begin (set! wrek 33) wrek)) 106 | 33 107 | 108 | ;;; end of chap8a.tst 109 | -------------------------------------------------------------------------------- /src/chap8b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8b.scm,v 4.3 2006/11/27 11:34:27 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Modification of chap4a.scm to introduce eval as a special form 19 | 20 | (define (evaluate e r s k) 21 | (if (atom? e) 22 | (if (symbol? e) (evaluate-variable e r s k) 23 | (evaluate-quote e r s k) ) 24 | (case (car e) 25 | ((quote) (evaluate-quote (cadr e) r s k)) 26 | ((if) (evaluate-if (cadr e) (caddr e) (cadddr e) r s k)) 27 | ((begin) (evaluate-begin (cdr e) r s k)) 28 | ((set!) (evaluate-set! (cadr e) (caddr e) r s k)) 29 | ((lambda) (evaluate-lambda (cadr e) (cddr e) r s k)) 30 | ((eval) (evaluate-eval (cadr e) r s k)) ; \modified 31 | (else (evaluate-application (car e) (cdr e) r s k)) ) ) ) 32 | 33 | (define (evaluate-eval e r s k) 34 | (evaluate e r s 35 | (lambda (v ss) 36 | (let ((ee (transcode-back v ss))) 37 | (if (program? ee) 38 | (evaluate ee r ss k) 39 | (wrong "Illegal program" ee) ) ) ) ) ) 40 | 41 | ;;; Create some additional locations 42 | 43 | (definitial bar 0) 44 | (definitial x 0) 45 | (definitial z 0) 46 | (definitial wrek 0) 47 | 48 | (defprimitive display 49 | (lambda (v* s k) 50 | (display (transcode-back (car v*) s)) 51 | (k (car v*) s) ) 52 | 1 ) 53 | 54 | ;;; end of chap8b.scm 55 | -------------------------------------------------------------------------------- /src/chap8b.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8b.tst,v 4.0 1995/07/10 06:52:02 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Eval with dynamic variables 19 | 20 | "Testing dynamic variables" 21 | --- 22 | (dynamic-let (a 1) 23 | (eval '(dynamic a)) ) 24 | 1 25 | (dynamic-let (a 1) 26 | (dynamic-let (b 2) 27 | (eval '(dynamic b)) ) ) 28 | 2 29 | ((lambda (f) 30 | (dynamic-let (a 33) 31 | ((eval 'f)) ) ) 32 | (lambda () (dynamic a)) ) 33 | 33 34 | 35 | ;;; end of chap8b.tst 36 | -------------------------------------------------------------------------------- /src/chap8c.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8c.scm,v 4.3 2006/11/24 18:41:11 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Modification of chap6d.scm to introduce eval as a special form 19 | 20 | (define (meaning e r tail?) 21 | (if (atom? e) 22 | (if (symbol? e) (meaning-reference e r tail?) 23 | (meaning-quotation e r tail?) ) 24 | (case (car e) 25 | ((quote) (meaning-quotation (cadr e) r tail?)) 26 | ((lambda) (meaning-abstraction (cadr e) (cddr e) r tail?)) 27 | ((if) (meaning-alternative (cadr e) (caddr e) (cadddr e) 28 | r tail? )) 29 | ((begin) (meaning-sequence (cdr e) r tail?)) 30 | ((set!) (meaning-assignment (cadr e) (caddr e) r tail?)) 31 | ((eval) (meaning-eval (cadr e) r tail?)) ; \modified 32 | (else (meaning-application (car e) (cdr e) 33 | r tail? )) ) ) ) 34 | 35 | (define (meaning-eval e r tail?) 36 | (let ((m (meaning e r #f))) 37 | (lambda () 38 | (let ((v (m))) 39 | (if (program? v) 40 | (let ((mm (meaning v r tail?))) 41 | (mm) ) 42 | (wrong "Illegal program" v) ) ) ) ) ) 43 | 44 | ;;; Add additional locations 45 | 46 | (defvariable wrek) 47 | (define original.g.current 48 | (let ((g g.current)) 49 | (lambda () g) ) ) 50 | 51 | ;;; end of chap8c.scm 52 | -------------------------------------------------------------------------------- /src/chap8d.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8d.scm,v 4.1 2006/11/24 18:41:05 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; variant of chap8c.scm for the bytecode compiler chap7g.scm 19 | 20 | (define (meaning e r tail?) 21 | (if (atom? e) 22 | (if (symbol? e) (meaning-reference e r tail?) 23 | (meaning-quotation e r tail?) ) 24 | (case (car e) 25 | ((quote) (meaning-quotation (cadr e) r tail?)) 26 | ((lambda) (meaning-abstraction (cadr e) (cddr e) r tail?)) 27 | ((if) (meaning-alternative (cadr e) (caddr e) (cadddr e) r tail?)) 28 | ((begin) (meaning-sequence (cdr e) r tail?)) 29 | ((set!) (meaning-assignment (cadr e) (caddr e) r tail?)) 30 | ((bind-exit) (meaning-bind-exit (caadr e) (cddr e) r tail?)) 31 | ((dynamic) (meaning-dynamic-reference (cadr e) r tail?)) 32 | ((dynamic-let) (meaning-dynamic-let (car (cadr e)) 33 | (cadr (cadr e)) 34 | (cddr e) r tail? )) 35 | ((monitor) (meaning-monitor (cadr e) (cddr e) r tail?)) 36 | ((eval) (meaning-eval (cadr e) r tail?)) 37 | (else (meaning-application (car e) (cdr e) r tail?)) ) ) ) 38 | 39 | (define (meaning-eval e r tail?) 40 | (let ((m (meaning e r #f))) 41 | (EVAL/CE m r) ) ) 42 | 43 | (define (EVAL/CE m r) 44 | (append (PRESERVE-ENV) (CONSTANT r) (PUSH-VALUE) 45 | m (COMPILE-RUN) (RESTORE-ENV) ) ) 46 | 47 | (define (COMPILE-RUN) (list 255)) 48 | 49 | (define (compile-and-run v r tail?) 50 | (unless tail? (stack-push *pc*)) 51 | (set! *pc* (compile-on-the-fly v r)) ) 52 | 53 | ;;; Compile program v within environment r, install resulting code and 54 | ;;; return its entry point. 55 | 56 | (define (compile-on-the-fly v r) 57 | (set! g.current '()) 58 | (for-each g.current-extend! sg.current.names) 59 | (set! *quotations* (vector->list *constants*)) 60 | (set! *dynamic-variables* *dynamic-variables*) 61 | (let ((code (apply vector (append (meaning v r #f) (RETURN))))) 62 | (set! sg.current.names (map car (reverse g.current))) 63 | (let ((v (make-vector (length sg.current.names) 64 | undefined-value ))) 65 | (_vector-copy! sg.current v 0 (vector-length sg.current)) 66 | (set! sg.current v) ) 67 | (set! *constants* (apply vector *quotations*)) 68 | (set! *dynamic-variables* *dynamic-variables*) 69 | (install-code! code) ) ) 70 | 71 | ;;; Exercice: Share the compilation. 72 | 73 | (define (prepare e) 74 | (eval/ce `(lambda () ,e)) ) 75 | 76 | ;;; Exercice: eval/at with eval/ce without clash. 77 | 78 | (define (eval/at e) 79 | (let ((g (gensym))) 80 | (eval/ce `(lambda (,g) (eval/ce ,g))) ) ) 81 | 82 | ;;; end of chap8d.scm 83 | -------------------------------------------------------------------------------- /src/chap8e.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8e.scm,v 4.0 1995/07/10 06:52:05 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (defprimitive eval 19 | (lambda (v) 20 | (if (program? v) 21 | (evaluate v env.global) 22 | (wrong "Illegal program" v) )) 23 | 1 ) 24 | 25 | ;;; end of chap8e.scm 26 | -------------------------------------------------------------------------------- /src/chap8f.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8f.scm,v 4.1 2006/11/24 18:40:55 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; eval as a function in the bytecode compiler 19 | 20 | (definitial eval 21 | (let* ((arity 1) 22 | (arity+1 (+ arity 1)) ) 23 | (make-primitive 24 | (lambda () 25 | (if (= arity+1 (activation-frame-argument-length *val*)) 26 | (let ((v (activation-frame-argument *val* 0))) 27 | (if (program? v) 28 | (compile-and-run v r.init #t) 29 | (signal-exception #t (list "Illegal program" v)) ) ) 30 | (signal-exception 31 | #t (list "Incorrect arity" 'eval) ) ) ) ) ) ) 32 | 33 | ;;; same as in chap8d.scm 34 | 35 | (define (compile-and-run v r tail?) 36 | (set! g.current '()) 37 | (for-each g.current-extend! sg.current.names) 38 | (set! *quotations* (vector->list *constants*)) 39 | (set! *dynamic-variables* *dynamic-variables*) 40 | (let ((code (apply vector (append (meaning v r #f) (RETURN))))) 41 | (set! sg.current.names (map car (reverse g.current))) 42 | (let ((v (make-vector (length sg.current.names) undefined-value))) 43 | (_vector-copy! sg.current v 0 (vector-length sg.current)) 44 | (set! sg.current v) ) 45 | (set! *constants* (apply vector *quotations*)) 46 | (set! *dynamic-variables* *dynamic-variables*) 47 | (unless tail? (stack-push *pc*)) 48 | (set! *pc* (install-code! code)) ) ) 49 | 50 | ;;; end of chap8f.scm 51 | -------------------------------------------------------------------------------- /src/chap8g.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8g.scm,v 4.0 1995/07/10 06:52:06 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Modification of chap1.scm. 19 | ;;; idempotent coding of functions. 20 | 21 | (define (invoke fn args) 22 | (if (procedure? fn) 23 | (apply fn args) 24 | (wrong "Not a function" fn) ) ) 25 | 26 | (define (make-function variables body env) 27 | (lambda values 28 | (eprogn body (extend env variables values)) ) ) 29 | 30 | (define-syntax defprimitive 31 | (syntax-rules () 32 | ((defprimitive name value arity) 33 | (definitial name 34 | (lambda values 35 | (if (= arity (length values)) 36 | (apply value values) 37 | (wrong "Incorrect arity" 38 | (list 'name values) ) ) ) ) ) ) ) 39 | 40 | (defprimitive cons cons 2) 41 | (defprimitive car car 1) 42 | (defprimitive cdr cdr 1) 43 | (defpredicate pair? pair? 1) 44 | (defpredicate symbol? symbol? 1) 45 | (defprimitive eq? eq? 2) ; cf. exercice \ref{exer-predicate} 46 | (defpredicate eq? eq? 2) ; cf. exercice \ref{exer-predicate} 47 | (defprimitive set-car! set-car! 2) 48 | (defprimitive set-cdr! set-cdr! 2) 49 | (defprimitive + + 2) 50 | (defprimitive - - 2) 51 | (defpredicate = = 2) 52 | (defprimitive < < 2) ; cf. exercice \ref{exer-predicate} 53 | (defpredicate < < 2) ; cf. exercice \ref{exer-predicate} 54 | (defpredicate > > 2) 55 | (defprimitive * * 2) 56 | (defpredicate <= <= 2) 57 | (defpredicate >= >= 2) 58 | (defprimitive remainder remainder 2) 59 | (defprimitive display display 1) 60 | 61 | (defprimitive call/cc 62 | (lambda (f) 63 | (call/cc (lambda (k) 64 | (f (lambda values 65 | (if (= (length values) 1) 66 | (k (car values)) 67 | (wrong "Incorrect arity" k) ) )) )) ) 68 | 1 ) 69 | 70 | (definitial apply 71 | (lambda values 72 | (if (>= (length values) 2) 73 | (let ((f (car values)) 74 | (args (let flat ((args (cdr values))) 75 | (if (null? (cdr args)) 76 | (car args) 77 | (cons (car args) (flat (cdr args))) ) )) ) 78 | (invoke f args) ) 79 | (wrong "Incorrect arity" 'apply) ) ) ) 80 | 81 | (definitial list list) 82 | 83 | (definitial eval 84 | (lambda values 85 | (if (= (length values) 1) 86 | (let ((v (car values))) 87 | (if (program? v) 88 | (evaluate v env.global) 89 | (wrong "Illegal program" v) ) ) 90 | (wrong "Incorrect arity" 'eval) ) ) ) 91 | 92 | ;;; end of chap8g.scm 93 | -------------------------------------------------------------------------------- /src/chap8j.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap8j.scm,v 4.1 1996/01/14 14:14:29 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; A reflective interpreter with non-systematically reified 19 | ;;; continuation and environment. These can be obtained through export 20 | ;;; and call/cc. Special forms are coded as fexprs. 21 | 22 | (define (meaning e r tail?) 23 | (if (atom? e) 24 | (if (symbol? e) (meaning-reference e r tail?) 25 | (meaning-quotation e r tail?) ) 26 | (case (car e) 27 | ((quote) (meaning-quotation (cadr e) r tail?)) 28 | ((lambda) (meaning-abstraction (cadr e) (cddr e) r tail?)) 29 | ((if) (meaning-alternative (cadr e) (caddr e) (cadddr e) r tail?)) 30 | ((begin) (meaning-sequence (cdr e) r tail?)) 31 | ((set!) (meaning-assignment (cadr e) (caddr e) r tail?)) 32 | ((bind-exit) (meaning-bind-exit (caadr e) (cddr e) r tail?)) 33 | ((dynamic) (meaning-dynamic-reference (cadr e) r tail?)) 34 | ((dynamic-let) (meaning-dynamic-let (car (cadr e)) 35 | (cadr (cadr e)) 36 | (cddr e) r tail? )) 37 | ((monitor) (meaning-monitor (cadr e) (cddr e) r tail?)) 38 | ((the-environment) (meaning-export '() r tail?)) ; \modified 39 | (else (meaning-application (car e) (cdr e) r tail?)) ) ) ) 40 | 41 | ;;; redefine these methods to hide details 42 | 43 | (define-method (show (e environment) . stream) 44 | (call-next-method) ) 45 | 46 | (define-method (show (e activation-frame) . stream) 47 | (call-next-method) ) 48 | 49 | ;;; (compile-file "si/reflisp.scm" "o/reflisp.so") 50 | ;;; (run-application 400 "o/reflisp.so") 51 | 52 | ;;; To know the length of the interpreter: (vector-length *code*) 53 | ;;; Actually 1270 bytes (with procedure->definition and others) 54 | 55 | ;;; end of chap8j.scm 56 | -------------------------------------------------------------------------------- /src/chap9a.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap9a.tst,v 4.0 1995/07/10 06:52:15 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; testing chap9a.scm 19 | ;;; If define-abbreviation is not defined, here is a simulation 20 | (define-pervasive-macro (define-abbreviation . parms) 21 | `(define-pervasive-macro . ,parms) ) 22 | --- 23 | 24 | (with-gensym (a b c) 25 | (list a b c) ) 26 | --- 27 | 28 | ;;; exercice 1 29 | (let ((i 0) 30 | (r '()) ) 31 | (repeat1 :while (begin (set! i (+ i 1)) (< i 10)) 32 | :unless (= 0 (modulo i 2)) 33 | :do (set! r (cons i r)) ) 34 | r ) 35 | (9 7 5 3 1) 36 | 37 | (pp (expand '(generate-vector-of-fix-makers 3))) 38 | --- 39 | 40 | (define-alias gg generate-vector-of-fix-makers) 41 | --- 42 | (pp (expand '(gg 3))) 43 | --- 44 | 45 | ;;; tests chap9b.tst 46 | (enumerate) 47 | --- ; prints 0 48 | (enumerate (display 'a)) 49 | --- ; prints 0a1 50 | (enumerate (display 'a) (display 'b)) 51 | --- ; prints 0a1b2 52 | (enumerate (display 'a) (display 'b) (display 'c)) 53 | --- ; prints 0a1b2c3 54 | (enumerate (display 'a) (display 'b) (display 'c) (display 'd)) 55 | --- ; prints 0a1b2c3d4 56 | 57 | (meroon-if #t 1 2) 58 | 1 59 | (meroon-if #f 1 2) 60 | 2 61 | (meroon-if '() 1 2) 62 | 1 63 | 64 | (define-inline (acons x y al) 65 | (cons (cons x y) al) ) 66 | --- 67 | (acons 'a 1 (acons 'b 2 '())) 68 | ((a . 1) (b . 2)) 69 | (apply acons 'a '1 '(())) 70 | ((a . 1)) 71 | 72 | ;;; end of chap9a.tst 73 | -------------------------------------------------------------------------------- /src/chap9b.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap9b.scm,v 4.0 1995/07/10 06:52:16 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (define-abbreviation (define-abbreviation call . body) 19 | `(install-macro! ',(car call) (lambda ,(cdr call) . ,body)) ) 20 | 21 | (define-abbreviation (define-meroonet-macro call . body) 22 | `(begin (define-abbreviation ,call . ,body) 23 | (eval '(define-abbreviation ,call . ,body)) ) ) 24 | 25 | (define-abbreviation (meroon-if condition consequent . alternant) 26 | `(if (let ((tmp ,condition)) 27 | (or tmp (null? tmp)) ) 28 | ,consequent . ,alternant ) ) 29 | 30 | (define-abbreviation (define-inline call . body) 31 | (let ((name (car call)) 32 | (variables (cdr call)) ) 33 | `(begin 34 | (define-abbreviation (,name . arguments) 35 | (cons (cons 'lambda (cons ',variables ',body)) 36 | arguments ) ) 37 | (define ,call (,name . ,variables)) ) ) ) 38 | 39 | (define-syntax enumerate 40 | (syntax-rules () 41 | ((enumerate) (display 0)) 42 | ((enumerate e1 e2 ...) 43 | (begin (display 0) (enumerate-aux e1 (e1) e2 ...) ) ) ) ) 44 | 45 | (define-syntax enumerate-aux 46 | (syntax-rules () 47 | ((enumerate-aux e1 len) (begin e1 (display (length 'len)))) 48 | ((enumerate-aux e1 len e2 e3 ...) 49 | (begin e1 (display (length 'len)) 50 | (enumerate-aux e2 (e2 . len) e3 ...) ) ) ) ) 51 | 52 | ;;; end of chap9b.scm 53 | -------------------------------------------------------------------------------- /src/chap9f.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap9f.scm,v 4.0 1995/07/10 06:52:22 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Only one world 19 | 20 | (define (make-macro-environment current-level) 21 | (let ((metalevel (delay current-level))) 22 | (list (make-Magic-Keyword 'eval-in-abbreviation-world 23 | (special-eval-in-abbreviation-world metalevel) ) 24 | (make-Magic-Keyword 'define-abbreviation 25 | (special-define-abbreviation metalevel)) 26 | (make-Magic-Keyword 'let-abbreviation 27 | (special-let-abbreviation metalevel)) 28 | (make-Magic-Keyword 'with-aliases 29 | (special-with-aliases metalevel) ) ) ) ) 30 | 31 | ;;; end of chap9f.scm 32 | -------------------------------------------------------------------------------- /src/chap9z.scm: -------------------------------------------------------------------------------- 1 | ;;; $Id: chap9z.scm,v 4.2 2006/11/25 17:01:28 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; Various excerpts for chapter on macros 19 | 20 | (define (prepare expression directives) 21 | (let ((macroexpand (generate-macroexpand directives))) 22 | (really-prepare (macroexpand expression)) ) ) 23 | 24 | (define (prepare expression) 25 | (really-prepare (macroexpand expression)) ) 26 | 27 | (define-abbreviation (while condition . body) ; \[\hfill\em{LOOP}\] 28 | `(if ,condition (begin (begin . ,body) 29 | (while ,condition . ,body) )) ) 30 | 31 | (define-abbreviation (incredible x) ; \[\hfill\em{BAD TASTE}\] 32 | (call/cc (lambda (k) `(quote (,k ,x)))) ) 33 | 34 | (define-abbreviation (define-immediate-abbreviation call . body) 35 | (let ((name (gensym))) 36 | `(begin (define ,name (lambda ,(cdr call) . ,body)) 37 | (define-abbreviation ,call (,name . ,(cdr call))) ) ) ) 38 | 39 | ;;; end of chap9z.scm 40 | -------------------------------------------------------------------------------- /src/showGC.s2c: -------------------------------------------------------------------------------- 1 | ;;; Show GC in Scheme->C 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | (set! after-collect 19 | (let ((gc-count 0)) 20 | (lambda (heap-size allocated-size full-gc-threshold) 21 | (set! gc-count (+ 1 gc-count)) 22 | (format stderr-port 23 | " [~A, %used=~A/~A]~%" 24 | gc-count 25 | allocated-size 26 | heap-size ) ) ) ) 27 | 28 | ;;; end of showGC.s2c 29 | -------------------------------------------------------------------------------- /src/syntax.tst: -------------------------------------------------------------------------------- 1 | ;;; $Id: syntax.tst,v 1.3 1994/08/25 17:30:31 queinnec Exp $ 2 | 3 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 4 | ;;; This file is derived from the files that accompany the book: 5 | ;;; LISP Implantation Semantique Programmation (InterEditions, France) 6 | ;;; or Lisp In Small Pieces (Cambridge University Press). 7 | ;;; By Christian Queinnec 8 | ;;; The original sources can be downloaded from the author's website at 9 | ;;; http://pagesperso-systeme.lip6.fr/Christian.Queinnec/WWW/LiSP.html 10 | ;;; This file may have been altered from the original in order to work with 11 | ;;; modern schemes. The latest copy of these altered sources can be found at 12 | ;;; https://github.com/appleby/Lisp-In-Small-Pieces 13 | ;;; If you want to report a bug in this program, open a GitHub Issue at the 14 | ;;; repo mentioned above. 15 | ;;; Check the README file before using this file. 16 | ;;;(((((((((((((((((((((((((((((((( L i S P )))))))))))))))))))))))))))))))) 17 | 18 | ;;; This is a little test for the port of syntax-caseV2.0. What is tested 19 | ;;; is that a compiled syntax-case linked into a Bigloo-based 20 | ;;; interpreter is correct. 21 | 22 | ;;; test on a predefined syntaxes 23 | 24 | (and) 25 | #t 26 | (and '1) 27 | 1 28 | (and 1 2 3) 29 | 3 30 | (and 1 2 #f 3) 31 | #f 32 | 33 | ;;; test on a new syntax 34 | 35 | (define-syntax funcall 36 | (syntax-rules () 37 | ((funcall function arguments ...) 38 | (function arguments ...) ) ) ) 39 | --- 40 | (let ((f (lambda (x) (funcall cons x x)))) 41 | (funcall f (+ 2 3)) ) 42 | (5 . 5) 43 | 44 | ;;; expand.ss seems to be false on a non-symbol as first argument of define. 45 | ;;; I patched expand.ss and rebuild expand.bb so it is good now. 46 | 47 | (begin (define a 33) a) 48 | 33 49 | (begin (define (a) 22) (a)) 50 | 22 51 | (begin (define (a . x) (cons x 2)) (a 0 1)) 52 | ((0 1) . 2) 53 | 54 | ;;; This seems to pose problems. In fact the problem was that 55 | ;;; chap*.scm contains calls to load (the Bigloo load) that does not 56 | ;;; call syntax-expand. So they are useless but "always keep tests!" 57 | 58 | (define env.global '()) 59 | --- 60 | (define-syntax definitial 61 | (syntax-rules () 62 | ((definitial name) 63 | (begin (set! env.global (cons (cons 'name 'void) env.global)) 64 | 'name ) ) 65 | ((definitial name value) 66 | (begin (set! env.global (cons (cons 'name value) env.global)) 67 | 'name ) ) ) ) 68 | --- 69 | (definitial t #t) 70 | --- 71 | env.global 72 | ((t . #t)) 73 | 74 | ;;; Testing define-abbreviation. 75 | 76 | (define-abbreviation (foo a b) 77 | `(quote (,a foo ,b)) ) 78 | --- 79 | (foo 2 3) 80 | (2 foo 3) 81 | (foo (+ 1 2) 3) 82 | ((+ 1 2) foo 3) 83 | 84 | ;;; test that when and unless are present. 85 | 86 | (when (pair? (cons 'a 'b)) 1 2) 87 | 2 88 | (when #f 1 2) 89 | --- 90 | (unless (pair? (cons 'a 'b)) 1 2) 91 | --- 92 | (unless #f 1 2 3) 93 | 3 94 | 95 | ;;; Some additional functions are required 96 | (atom? 'foo) 97 | #t 98 | (atom? (cons 1 2)) 99 | #f 100 | (get-internal-run-time) 101 | --- 102 | (number? (get-internal-run-time)) 103 | #t 104 | (iota 0 4) 105 | (0 1 2 3) 106 | (putprop 'foo 'bar 'hux) 107 | --- 108 | (getprop 'foo 'bar) 109 | hux 110 | 111 | " Successful end of tests. " 112 | --- 113 | 114 | ;;; end of syntax.tst 115 | --------------------------------------------------------------------------------