Import Upstream version 2d2upstream/2d2

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)