mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-19 05:39:17 +02:00
103 lines
3 KiB
Scheme
103 lines
3 KiB
Scheme
(import (scheme base) (scheme write))
|
|
;(define-syntax my-when
|
|
; (syntax-rules ()
|
|
; ((my-when test result1 result2 ...)
|
|
; (if test
|
|
; (begin result1 result2 ...)))))
|
|
|
|
(define-syntax my-when2
|
|
(syntax-rules ()
|
|
((my-when test result1 result2 ...)
|
|
(list result2 ...))))
|
|
|
|
(write
|
|
(my-when2 #t 1))
|
|
;
|
|
; (define my-when2*
|
|
; (lambda (expr$28 rename$29 compare$30)
|
|
; (car ((lambda (tmp$42)
|
|
; (if tmp$42
|
|
; tmp$42
|
|
; (cons (error "no expansion for" expr$28) #f)))
|
|
; ((lambda (v.1$36)
|
|
; (if (pair? v.1$36)
|
|
; ((lambda (v.2$37)
|
|
; ((lambda (test)
|
|
; ((lambda (v.3$38)
|
|
; (if (pair? v.3$38)
|
|
; ((lambda (v.4$39)
|
|
; ((lambda (result1)
|
|
; ((lambda (v.5$40)
|
|
; (if (list? v.5$40)
|
|
; ((lambda (result2)
|
|
; (cons (cons-source
|
|
; (rename$29 'list)
|
|
; (cons-source test '() '(test))
|
|
; '(list test))
|
|
; #f))
|
|
; v.5$40)
|
|
; #f))
|
|
; (cdr v.3$38)))
|
|
; v.4$39))
|
|
; (car v.3$38))
|
|
; #f))
|
|
; (cdr v.1$36)))
|
|
; v.2$37))
|
|
; (car v.1$36))
|
|
; #f))
|
|
; (cdr expr$28))))))
|
|
|
|
|
|
;; TODO: seems broken
|
|
;(define-syntax my-when4
|
|
; (syntax-rules ()
|
|
; ((my-when test result1 result2 ...)
|
|
; (let-syntax
|
|
; ((second
|
|
; (syntax-rules ()
|
|
; ((second a b c)
|
|
; b))))
|
|
; (second 33 44 55)))))
|
|
;(write
|
|
; (my-when4 't 1 2 3))
|
|
|
|
;; The symbol?? macro from oleg:
|
|
;; http://okmij.org/ftp/Scheme/macros.html#macro-symbol-p
|
|
(define-syntax symbol??
|
|
(syntax-rules ()
|
|
((symbol?? (x . y) kt kf) kf) ; It's a pair, not a symbol
|
|
((symbol?? #(x ...) kt kf) kf) ; It's a vector, not a symbol
|
|
((symbol?? maybe-symbol kt kf)
|
|
(let-syntax
|
|
((test
|
|
(syntax-rules ()
|
|
((test maybe-symbol t f) t)
|
|
((test x t f) f))))
|
|
(test abracadabra kt kf)))))
|
|
(write (symbol?? a #t #f))
|
|
(write (symbol?? "a" #t #f))
|
|
|
|
(write
|
|
(let-syntax
|
|
((second
|
|
(syntax-rules ()
|
|
((second a b c)
|
|
b))))
|
|
(second 33 44 55)))
|
|
|
|
(write
|
|
(my-when2
|
|
't
|
|
1
|
|
(let-syntax
|
|
((my-when3
|
|
(syntax-rules ()
|
|
((my-when3 test result1 result2 ...)
|
|
(list result2 ...)))))
|
|
(my-when3 33 44 55))
|
|
2
|
|
3))
|
|
;(write
|
|
; (my-when2 '(my-when2 't 1 2 3) (lambda (a) a) (lambda X #f)))
|
|
;(write
|
|
; (my-when2 '(my-when2 "testing" 1) (lambda (a) a) (lambda X #f)))
|