cyclone/tests/let-syntax.scm

(import (scheme base) (scheme write) (scheme cyclone pretty-print))

(write
(let ((x 'outer))
  (let-syntax ((m (syntax-rules () ((m) x))))
    (let ((x 'inner))
      (m)))) ;; Should be outer
      )
;;;; Just testing, may want to remove this one once the recursive macro expansion works
;;;  (define-syntax my-or2 (syntax-rules ()
;;;            ((my-or2) #f)
;;;            ((my-or2 e) e)
;;;            ((my-or2 e1 e2 ...)
;;;             (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
;;;(write (my-or2 #t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;;  (define-syntax my-or (syntax-rules ()
;;;            ((my-or) #f)
;;;            ((my-or e) e)
;;;            ((my-or e1 e2 ...)
;;;             (let ((temp e1)) (if temp temp (my-or e2 ...))))))
;;;  (write
;;;  (let ((x #f) 
;;;        (y 7) 
;;;        (temp 8) 
;;;        (my-let odd?) 
;;;        (my-if even?))
;;;    (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;;;
;;;         (define-syntax foo (syntax-rules ()
;;;                 ((_ b)
;;;                  (bar a b))))
;;;          (define-syntax bar (syntax-rules ()                                                                                                                               ((_ c d)
;;;                  (cons c (let ((c 3))
;;;                            (list d c 'c))))))
;;;       (write
;;;       (let ((a 2))
;;;         (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
;;;; to be able to handle this macro in letrec-syntax form, though
;;#;(let-syntax
;;  ((my-or (syntax-rules ()
;;            ((my-or) #f)
;;            ((my-or e) e)
;;            ((my-or e1 e2 ...)
;;             (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
;;  (let ((x #f) 
;;        (y 7) 
;;        (temp 8) 
;;        (my-let odd?) 
;;        (my-if even?))
;;    (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;;
;;;; 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)
;;            ((my-or e1 e2 ...)
;;             (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
;;  (let ((x #f) 
;;        (y 7) 
;;        (temp 8) 
;;        (my-let odd?) 
;;        (my-if even?))
;;    (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;;)
;;
;;
;;;; From Chibi - isn't this a bug though?
;;;(write
;;;(let ()
;;;  (letrec-syntax ()
;;;    (define internal-def 'ok))
;;;  internal-def)
;;;)
;;
;;;; From Husk:
;;;;
;;; Examples from the source to R5RS pitfall 3.3
;;;; (assert/equal
;;;;   (let ((a 1))
;;;;      (letrec-syntax
;;;;          ((foo (syntax-rules ()
;;;;                  ((_ b)
;;;;                   (bar a b))))
;;;;           (bar (syntax-rules ()
;;;;                  ((_ c d)
;;;;                   (cons c (let ((c 3))
;;;;                             (list d c 'c)))))))
;;;;        (let ((a 2))
;;;;          (foo a))))
;;;;   '(1 2 3 a))
;;;; 
;;;; ; Examples from/based on pitfall 8.3                                                                                                         (assert/equal 1
;;;;   (let ((x 1))
;;;;     (let-syntax ((foo (syntax-rules () ((_) 2))))
;;;;       (define x (foo))
;;;;       3)
;;;;     x))
;;;; (assert/equal 1
;;;;   (let ((x 1))
;;;;     (letrec-syntax ((foo (syntax-rules () ((_) 2))))                                                                                               (define x (foo))
;;;;       3)
;;;;     x))
;;;; 
;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
;;;; (assert/equal
;;;;     (let ((unquote 'foo)) `(,'bar))
;;;;     '(,'bar))
;;
;;
;;#;(let ((a 1))
;;     (let-syntax
;;     ;;(letrec-syntax
;;         ((foo (syntax-rules ()
;;                 ((_ b)
;;                  (bar a b))))
;;          (bar (syntax-rules ()                                                                                                                               ((_ c d)
;;                  (cons c (let ((c 3))
;;                            (list d c 'c)))))))
;;       (let ((a 2))
;;         (foo a))))
;;
;;
;;(define-syntax my-let
;;  (syntax-rules
;;    ()
;;    ((my-let ((name val) ...) body1 body2 ...)
;;     ((lambda (name ...) body1 body2 ...) val ...))
;;    ((my-let tag ((name val) ...) body1 body2 ...)
;;     ((letrec ((tag (lambda (name ...) body1 body2 ...)))
;;        tag)
;;      val ...))))
;;(write
;;(my-let ((x 'outer))
;;  (let-syntax ((m (syntax-rules () ((m) x))))
;;    (my-let ((x 'inner))
;;      (m)))) ;; Should be outer
;;      )
;;
;;
;;;; (let-syntax ((given-that (syntax-rules ()
;;;; ((given-that test stmt1 stmt2 ...)
;;;; (if test
;;;; (begin stmt1
;;;; stmt2 ...))))))
;;;; (let ((if #t))
;;;; (given-that if (set! if 'now))
;;;; if)) ;; => now
;;
;;(write
;;(let ((x 'outer))
;;  (let-syntax ((m (syntax-rules () ((m) x))))
;;    (let ((x 'inner))
;;      (m)))) ;; Should be outer
;;      )
;;
;;;(write 
;;;(let ((x 'outer))
;;;  (define-syntax m ;; Testing this out, but let-syntax needs to work, too
;;;   (syntax-rules () ((m) x)))
;;;    (let ((x 'inner))
;;;      (m))) ;; Should be outer
;;;      )
;;;
;;;(write (m)) ;; Should be an error, of course