From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 28 Mar 2018 00:17:55 +0000 (-0700)
Subject: Convert a bunch more macros to scons-rule.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~170
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4f161b544f82b88c8b030fecb5e30b591128a111;p=mit-scheme.git

Convert a bunch more macros to scons-rule.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 9f780f920..882fc8e92 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -385,7 +385,7 @@ USA.
 		       #t
 		       exprs))))
    system-global-environment))
-
+
 (define :case
   (spar-transformer->runtime
    (delay
@@ -636,47 +636,50 @@ USA.
 	     (else
 	      (ill-formed-syntax form)))))))
 
-(define-syntax :access
-  (er-macro-transformer
-   (lambda (form rename compare)
-     rename compare			;ignore
-     (cond ((syntax-match? '(identifier expression) (cdr form))
-	    `(,keyword:access ,@(cdr form)))
-	   ((syntax-match? '(identifier identifier + form) (cdr form))
-	    `(,keyword:access ,(cadr form) (,(car form) ,@(cddr form))))
-	   (else
-	    (ill-formed-syntax form))))))
-
-(define-syntax :circular-stream
-  (er-macro-transformer
-   (lambda (form rename compare)
-     compare				;ignore
-     (syntax-check '(_ 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)
-     compare				;ignore
-     (syntax-check '(_ expression expression) form)
-     `(,(rename 'CONS) ,(cadr form)
-		       (,(rename 'DELAY) ,(caddr form))))))
+(define :access
+  (spar-transformer->runtime
+   (delay
+     (scons-rule
+	 `((list (+ symbol))
+	   any)
+       (lambda (names expr)
+	 (fold-right (lambda (name expr)
+		       (scons-call keyword:access name expr))
+		     expr
+		     names))))
+   system-global-environment))
 
-(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 :cons-stream
+  (spar-transformer->runtime
+   (delay (scons-rule `(any any) scons-stream))
+   system-global-environment))
+
+(define :cons-stream*
+  (spar-transformer->runtime
+   (delay
+     (scons-rule `((list any (+ any)))
+       (lambda (exprs)
+	 (reduce-right scons-stream unspecific exprs))))
+   system-global-environment))
+
+(define (scons-stream expr1 expr2)
+  (scons-call (scons-close 'cons)
+	      expr1
+	      (scons-delay expr2)))
+
+(define :circular-stream
+  (spar-transformer->runtime
+   (delay
+     (scons-rule `((list (+ any)))
+       (lambda (exprs)
+	 (let ((self (new-identifier 'self)))
+	   (scons-letrec
+	       (list (list self
+			   (fold-right scons-stream
+				       self
+				       exprs)))
+	     self)))))
+   system-global-environment))
 
 (define-syntax :define-integrable
   (er-macro-transformer