cyclone/tests/let-syntax.scm
Justin Ethier e0220ea62d Testing
2018-01-16 19:46:47 -05:00

175 lines
5.3 KiB
Scheme

(import (scheme base) (scheme write) (scheme cyclone pretty-print))
(write
((lambda (x) x) 1))
(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