From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Mon, 6 Jul 2015 20:01:55 +0000 (-0700)
Subject: Add CONS-STREAM* and CIRCULAR-STREAM macros.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~83
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9fea5f07af5465432262ee25c6df105b8b29614b;p=mit-scheme.git

Add CONS-STREAM* and CIRCULAR-STREAM macros.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index a99db4161..5e47f7115 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -571,6 +571,17 @@ USA.
 	   (else
 	    (ill-formed-syntax form))))))
 
+(define-syntax :circular-stream
+  (er-macro-transformer
+   (lambda (form rename compare)
+     compare				;ignore
+     (syntax-check '(KEYWORD EXPRESSION * EXPRESSION) form)
+     (let ((self (make-synthetic-identifier 'SELF)))
+       `(,(rename 'LETREC) ((,self (,(rename 'CONS-STREAM*)
+				    ,@(cdr form)
+				    ,self)))
+	 ,self)))))
+
 (define-syntax :cons-stream
   (er-macro-transformer
    (lambda (form rename compare)
@@ -578,6 +589,18 @@ USA.
      (syntax-check '(KEYWORD EXPRESSION EXPRESSION) form)
      `(,(rename 'CONS) ,(cadr form)
 		       (,(rename 'DELAY) ,(caddr form))))))
+
+(define-syntax :cons-stream*
+  (er-macro-transformer
+   (lambda (form rename compare)
+     compare				;ignore
+     (cond ((syntax-match? '(EXPRESSION EXPRESSION) (cdr form))
+	    `(,(rename 'CONS-STREAM) ,(cadr form) ,(caddr form)))
+	   ((syntax-match? '(EXPRESSION * EXPRESSION) (cdr form))
+	    `(,(rename 'CONS-STREAM) ,(cadr form)
+	      (,(rename 'CONS-STREAM*) ,@(cddr form))))
+	   (else
+	    (ill-formed-syntax form))))))
 
 (define-syntax :define-integrable
   (er-macro-transformer
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 656e729d4..03df60fe0 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4828,9 +4828,11 @@ USA.
 	  (assert :assert)
 	  (begin0 :begin0)
 	  (case :case)
+	  (circular-stream :circular-stream)
 	  (cond :cond)
 	  (cond-expand :cond-expand)
 	  (cons-stream :cons-stream)
+	  (cons-stream* :cons-stream*)
 	  (define :define)
 	  (define-integrable :define-integrable)
 	  (define-record-type :define-record-type)