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

WIP

Browse source
This commit is contained in:
Justin Ethier 2017-12-04 18:54:39 -05:00
parent a260474e7d
commit f561428d7e
1 changed files with 80 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

127
tests/when.scm
View file

@ -1,65 +1,88 @@
(import (scheme base) (scheme write)) (import (scheme base) (scheme write))
(define-syntax my-when ;(define-syntax my-when
(syntax-rules () ; (syntax-rules ()
((my-when test result1 result2 ...) ; ((my-when test result1 result2 ...)
(if test ; (if test
(begin result1 result2 ...))))) ; (begin result1 result2 ...)))))
;
(define-syntax my-when2 ;(define-syntax my-when2
(syntax-rules () ; (syntax-rules ()
((my-when test result1 result2 ...) ; ((my-when test result1 result2 ...)
(list result2 ...)))) ; (list result2 ...))))
;
;(write ;;(write
; (my-when2 #t 1)) ;; (my-when2 #t 1))
;
(define my-when2* ; (define my-when2*
(lambda (expr$28 rename$29 compare$30) ; (lambda (expr$28 rename$29 compare$30)
(car ((lambda (tmp$42) ; (car ((lambda (tmp$42)
(if tmp$42 ; (if tmp$42
tmp$42 ; tmp$42
(cons (error "no expansion for" expr$28) #f))) ; (cons (error "no expansion for" expr$28) #f)))
((lambda (v.1$36) ; ((lambda (v.1$36)
(if (pair? v.1$36) ; (if (pair? v.1$36)
((lambda (v.2$37) ; ((lambda (v.2$37)
((lambda (test) ; ((lambda (test)
((lambda (v.3$38) ; ((lambda (v.3$38)
(if (pair? v.3$38) ; (if (pair? v.3$38)
((lambda (v.4$39) ; ((lambda (v.4$39)
((lambda (result1) ; ((lambda (result1)
((lambda (v.5$40) ; ((lambda (v.5$40)
(if (list? v.5$40) ; (if (list? v.5$40)
((lambda (result2) ; ((lambda (result2)
(cons (cons-source ; (cons (cons-source
(rename$29 'list) ; (rename$29 'list)
(cons-source test '() '(test)) ; (cons-source test '() '(test))
'(list test)) ; '(list test))
#f)) ; #f))
v.5$40) ; v.5$40)
#f)) ; #f))
(cdr v.3$38))) ; (cdr v.3$38)))
v.4$39)) ; v.4$39))
(car v.3$38)) ; (car v.3$38))
#f)) ; #f))
(cdr v.1$36))) ; (cdr v.1$36)))
v.2$37)) ; v.2$37))
(car v.1$36)) ; (car v.1$36))
#f)) ; #f))
(cdr expr$28)))))) ; (cdr expr$28))))))
;; TODO: seems broken ;; TODO: seems broken
(define-syntax my-when4 ;(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 () (syntax-rules ()
((my-when test result1 result2 ...) ((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))
(write
(let-syntax (let-syntax
((second ((second
(syntax-rules () (syntax-rules ()
((second a b c) ((second a b c)
b)))) b))))
(second 33 44 55))))) (second 33 44 55)))
(write
(my-when4 't 1 2 3))
; (my-when2 ; (my-when2