Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-11 23:07:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Setup to use macro from test library

Browse source
This commit is contained in:
Justin Ethier 2015-08-14 01:49:34 -04:00
parent d228871f04
commit ca739ab9d0
1 changed files with 25 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
test2.scm
View file

@ -5,6 +5,7 @@
; ;
; ;
(import (scheme base) (import (scheme base)
(test-lib test)
(scheme eval) (scheme eval)
(scheme write)) (scheme write))
@ -17,36 +18,36 @@
; ;
; WTF is the macro unable to be evaluated when the same code works as part of *defined-macros*??? ; WTF is the macro unable to be evaluated when the same code works as part of *defined-macros*???
; ;
(define-syntax test ;(define-syntax test
(er-macro-transformer ; (er-macro-transformer
(lambda (expr rename compare) ; (lambda (expr rename compare)
(cond ((null? (cdr expr)) #t) ; (cond ((null? (cdr expr)) #t)
; (cond ((null? (cdr expr))) ;; (cond ((null? (cdr expr)))
((null? (cddr expr)) (cadr expr)) ; ((null? (cddr expr)) (cadr expr))
(else (list (rename 'if) (cadr expr) ; (else (list (rename 'if) (cadr expr)
(cons (rename 'and) (cddr expr)) ; (cons (rename 'and) (cddr expr))
#f)))))) ; #f))))))
;
(define-syntax or ;(define-syntax or
(er-macro-transformer ; (er-macro-transformer
(lambda (expr rename compare) ; (lambda (expr rename compare)
(cond ((null? (cdr expr)) #f) ; (cond ((null? (cdr expr)) #f)
((null? (cddr expr)) (cadr expr)) ; ((null? (cddr expr)) (cadr expr))
(else ; (else
(list (rename 'let) (list (list (rename 'tmp) (cadr expr))) ; (list (rename 'let) (list (list (rename 'tmp) (cadr expr)))
(list (rename 'if) (rename 'tmp) ; (list (rename 'if) (rename 'tmp)
(rename 'tmp) ; (rename 'tmp)
(cons (rename 'or) (cddr expr))))))))) ; (cons (rename 'or) (cddr expr)))))))))
(write (test 1 2 3)) (write (test 1 2 3))
(write (or 1 2 3 'or)) (write (my-or 1 2 3 'or))
(write (or #f 2 3 'or)) (write (my-or #f 2 3 'or))
;(test 'done) ;(test 'done)
'done 'done
(define x 1) (define x 1)
(write x) (write x)
(write (write
(eval 'or)) (eval 'my-or))
(write (write
(eval '(or 1 2 x))) (eval '(my-or 1 2 x)))