Partially-working version of letrec-syntax

scheme/eval.sld

@@ -468,13 +468,12 @@
 ;;(newline)
     (analyze cleaned a-env)))
 
-;; TODO: following is just a placeholder, does not work yet
 (define (analyze-letrec-syntax exp a-env)
-  (let* ((body-env a-env) ;;(env:extend-environment '() '() a-env))
+  (let* ((rename-env (env:extend-environment '() '() '()))
-         (expanded (expand exp body-env body-env))
+         (expanded (expand exp a-env rename-env))
-         (cleaned (macro:cleanup expanded body-env))
+         (cleaned (macro:cleanup expanded rename-env))
         )
-    (analyze cleaned body-env)))
+    (analyze cleaned a-env)))
 
 (define (analyze-syntax exp a-env)
   (let ((var (cadr exp)))
@@ -955,6 +954,28 @@
 ;(trace:error `(let-syntax ,new-local-macro-env))
        (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env 
        ))
+    ;; TODO: does not work yet:
+    ((letrec-syntax? exp)
+     (let* ((body (cons 'begin (cddr exp)))
+            (body-env (env:extend-environment '() '() env))
+            (bindings (cadr exp))
+            ;(new-local-macro-env (append bindings-as-macros local-env))
+           )
+       (for-each
+         (lambda (b)
+           (let* ((name (car b))
+                  (binding (cadr b))
+                  (binding-body (cadr binding))
+                  (macro-val
+                    (list 
+                      'macro
+                      (if (macro:syntax-rules? (env:lookup (car binding) body-env #f))
+                          (cadr (_expand binding body-env rename-env local-env))
+                          binding-body))))
+           (env:define-variable! name macro-val) body-env))
+         bindings)
+       (_expand body body-env rename-env local-env) ;;new-local-macro-env) ;; TODO: new-local-macro-env 
+       ))
     ((app? exp)
      (cond
        ((symbol? (car exp))

tests/let-syntax.scm

@@ -9,28 +9,28 @@
 ;(write (my-or2 #t))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  (define-syntax my-or (syntax-rules ()
+;  (define-syntax my-or (syntax-rules ()
-            ((my-or) #f)
+;            ((my-or) #f)
-            ((my-or e) e)
+;            ((my-or e) e)
-            ((my-or e1 e2 ...)
+;            ((my-or e1 e2 ...)
-             (let ((temp e1)) (if temp temp (my-or e2 ...))))))
+;             (let ((temp e1)) (if temp temp (my-or e2 ...))))))
-  (write
+;  (write
-  (let ((x #f) 
+;  (let ((x #f) 
-        (y 7) 
+;        (y 7) 
-        (temp 8) 
+;        (temp 8) 
-        (my-let odd?) 
+;        (my-let odd?) 
-        (my-if even?))
+;        (my-if even?))
-    (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
+;    (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
-
+;
-         (define-syntax foo (syntax-rules ()
+;         (define-syntax foo (syntax-rules ()
-                 ((_ b)
+;                 ((_ b)
-                  (bar a b))))
+;                  (bar a b))))
-          (define-syntax bar (syntax-rules ()                                                                                                                               ((_ c d)
+;          (define-syntax bar (syntax-rules ()                                                                                                                               ((_ c d)
-                  (cons c (let ((c 3))
+;                  (cons c (let ((c 3))
-                            (list d c 'c))))))
+;                            (list d c 'c))))))
-       (write
+;       (write
-       (let ((a 2))
+;       (let ((a 2))
-         (foo a)))
+;         (foo a)))
 
 ;; Chibi also fails with the same error when this is a let-synatx macro,
 ;; so it may be that Cyclone works just fine here! Obviously it needs
@@ -48,7 +48,10 @@
         (my-if even?))
     (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
 
-#;(letrec-syntax
+;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
+;; TODO: below does not work in eval - WTF?
+(write
+(letrec-syntax
   ((my-or (syntax-rules ()
             ((my-or) #f)
             ((my-or e) e)
@@ -57,16 +60,19 @@
   (let ((x #f) 
         (y 7) 
         (temp 8) 
-        (let odd?) 
+        (my-let odd?) 
-        (if even?))
+        (my-if even?))
-    (my-or x (let temp) (if y) y))) ;; ==> 7
+    (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
+)
 
 
-;; From Chibi
+;; From Chibi - isn't this a bug though?
-#;(let ()
+;(write
-  (letrec-syntax ()
+;(let ()
-    (define internal-def 'ok))
+;  (letrec-syntax ()
-  internal-def)
+;    (define internal-def 'ok))
+;  internal-def)
+;)
 
 ;; From Husk:
 ;;