mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-16 17:27:33 +02:00
135 lines
3.7 KiB
Scheme
135 lines
3.7 KiB
Scheme
(import (scheme base) (scheme write) (scheme cyclone pretty-print))
|
|
|
|
;; 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))
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(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
|
|
|
|
#;(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)
|
|
(let odd?)
|
|
(if even?))
|
|
(my-or x (let temp) (if y) y))) ;; ==> 7
|
|
|
|
|
|
;; From Chibi
|
|
#;(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
|