diff options
author | James LewisMoss <dres@debian.org> | 2001-07-27 23:45:29 -0400 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | f559c149c83da84d0b1c285f0298c84aec564af9 (patch) | |
tree | f1c91bcb9bb5e6dad87b643127c3f878d80d89ee /scmactst.scm | |
parent | c394920caedf3dac1981bb6b10eeb47fd6e4bb21 (diff) | |
parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
download | slib-f559c149c83da84d0b1c285f0298c84aec564af9.tar.gz slib-f559c149c83da84d0b1c285f0298c84aec564af9.zip |
Import Debian changes 2d2-1debian/2d2-1
slib (2d2-1) unstable; urgency=low
* New upstream version
* Revert back to free. Is now so.
slib (2d1-1) unstable; urgency=low
* New upstream version.
* Move to non-free. FSF pointed out license doesn't allow modified
versions to be distributed.
* Get a complete list of copyrights that apply to the source into
copyright file.
* Remove setup for guile 1.3.
* Remove postrm. Just calling install-info (lintian) Move install-info
call to prerm since doc-base doesn't do install-info.
slib (2c9-3) unstable; urgency=low
* Change info location to section "The Algorithmic Language Scheme" to
match up with where guile puts it's files.
* Postinst is running slibconfig now. (Closes: #75891)
slib (2c9-2) unstable; urgency=low
* Stop installing slibconfig (for guile).
* In postinst if /usr/sbin/slibconnfig exists call it (Close: #75843
#75891).
slib (2c9-1) unstable; urgency=low
* New upstream (Closes: #74760)
* replace string-index with strsrch:string-index in http-cgi.scm.
* Add doc-base support (Closes: #31163)
Diffstat (limited to 'scmactst.scm')
-rw-r--r-- | scmactst.scm | 160 |
1 files changed, 0 insertions, 160 deletions
diff --git a/scmactst.scm b/scmactst.scm deleted file mode 100644 index 3b71341..0000000 --- a/scmactst.scm +++ /dev/null @@ -1,160 +0,0 @@ -;;;"scmactst.scm" test syntactic closures macros -;;; From "sc-macro.doc", A Syntactic Closures Macro Facility by Chris Hanson - -(define errs '()) -(define test - (lambda (expect fun . args) - (write (cons fun args)) - (display " ==> ") - ((lambda (res) - (write res) - (newline) - (cond ((not (equal? expect res)) - (set! errs (cons (list res expect (cons fun args)) errs)) - (display " BUT EXPECTED ") - (write expect) - (newline) - #f) - (else #t))) - (if (procedure? fun) (apply fun args) (car args))))) - -(require 'syntactic-closures) - -(macro:expand - '(define-syntax push - (syntax-rules () - ((push item list) - (set! list (cons item list)))))) - -(test '(set! foo (cons bar foo)) 'push (macro:expand '(push bar foo))) - -(macro:expand - '(define-syntax push1 - (transformer - (lambda (exp env) - (let ((item - (make-syntactic-closure env '() (cadr exp))) - (list - (make-syntactic-closure env '() (caddr exp)))) - `(set! ,list (cons ,item ,list))))))) - -(test '(set! foo (cons bar foo)) 'push1 (macro:expand '(push1 bar foo))) - -(macro:expand - '(define-syntax loop - (transformer - (lambda (exp env) - (let ((body (cdr exp))) - `(call-with-current-continuation - (lambda (exit) - (let f () - ,@(map (lambda (exp) - (make-syntactic-closure env '(exit) - exp)) - body) - (f))))))))) - -(macro:expand - '(define-syntax let1 - (transformer - (lambda (exp env) - (let ((id (cadr exp)) - (init (caddr exp)) - (exp (cadddr exp))) - `((lambda (,id) - ,(make-syntactic-closure env (list id) exp)) - ,(make-syntactic-closure env '() init))))))) - -(test 93 'let1 (macro:eval '(let1 a 90 (+ a 3)))) - -(macro:expand - '(define-syntax loop-until - (syntax-rules - () - ((loop-until id init test return step) - (letrec ((loop - (lambda (id) - (if test return (loop step))))) - (loop init)))))) - -(test (macro:expand '(letrec ((loop (lambda (foo) (if #t 12 (loop 33))))) - (loop 3))) - 'loop - (macro:expand '(loop-until foo 3 #t 12 33))) - -(macro:expand - '(define-syntax loop-until1 - (transformer - (lambda (exp env) - (let ((id (cadr exp)) - (init (caddr exp)) - (test (cadddr exp)) - (return (cadddr (cdr exp))) - (step (cadddr (cddr exp))) - (close - (lambda (exp free) - (make-syntactic-closure env free exp)))) - `(letrec ((loop - ,(capture-syntactic-environment - (lambda (env) - `(lambda (,id) - (,(make-syntactic-closure env '() `if) - ,(close test (list id)) - ,(close return (list id)) - (,(make-syntactic-closure env '() - `loop) - ,(close step (list id))))))))) - (loop ,(close init '())))))))) - -(test (macro:expand '(letrec ((loop (lambda (foo) (if #t 12 (loop 33))))) - (loop 3))) - 'loop1 - (macro:expand '(loop-until1 foo 3 #t 12 33))) - -(test '#t 'identifier (identifier? 'a)) -;;; this needs to setup ENV. -;;;(test '#t 'identifier -;;; (identifier? (macro:expand (make-syntactic-closure env '() 'a)))) -(test #f 'identifier (identifier? "a")) -(test #f 'identifier (identifier? #\a)) -(test #f 'identifier (identifier? 97)) -(test #f 'identifier (identifier? #f)) -(test #f 'identifier (identifier? '(a))) -(test #f 'identifier (identifier? '#(a))) - -(test '(#t #f) - 'syntax - (macro:eval - '(let-syntax - ((foo - (transformer - (lambda (form env) - (capture-syntactic-environment - (lambda (transformer-env) - (identifier=? transformer-env 'x env 'x))))))) - (list (foo) - (let ((x 3)) - (foo)))))) - - -(test '(#f #t) - 'syntax - (macro:eval - '(let-syntax ((bar foo)) - (let-syntax - ((foo - (transformer - (lambda (form env) - (capture-syntactic-environment - (lambda (transformer-env) - (identifier=? transformer-env 'foo - env (cadr form)))))))) - (list (foo foo) - (foo bar)))))) - -(newline) -(cond ((null? errs) (display "Passed all tests")) - (else (display "errors were:") (newline) - (display "(got expected (call))") (newline) - (for-each (lambda (l) (write l) (newline)) errs))) -(newline) |