Added mtrace debugging

This commit is contained in:
Justin Ethier 2016-09-14 23:41:57 -04:00
parent 9e6fb14e7f
commit 1e922a1128

View file

@ -10,16 +10,32 @@
; (call-with-values (lambda () expr) ; (call-with-values (lambda () expr)
; (lambda params (let*-values rest . body)))))) ; (lambda params (let*-values rest . body))))))
;; From http://okmij.org/ftp/Scheme/macros.html
(define-syntax mtrace
(syntax-rules ()
((mtrace x)
(begin
(display "Trace: ") (write 'x) (newline)
x))))
(define-syntax my-let-values (define-syntax my-let-values
(syntax-rules () (syntax-rules ()
((my-let-values ("step") (binds ...) bind expr maps () () . body) ((my-let-values ("step") (binds ...) bind expr maps () () . body)
(mtrace
(let*-values (binds ... (bind expr)) (let maps . body))) (let*-values (binds ... (bind expr)) (let maps . body)))
)
((my-let-values ("step") (binds ...) bind old-expr maps () ((params expr) . rest) . body) ((my-let-values ("step") (binds ...) bind old-expr maps () ((params expr) . rest) . body)
(mtrace
(my-let-values ("step") (binds ... (bind old-expr)) () expr maps params rest . body)) (my-let-values ("step") (binds ... (bind old-expr)) () expr maps params rest . body))
)
((my-let-values ("step") binds (bind ...) expr (maps ...) (x . y) rest . body) ((my-let-values ("step") binds (bind ...) expr (maps ...) (x . y) rest . body)
(mtrace
(my-let-values ("step") binds (bind ... tmp) expr (maps ... (x tmp)) y rest . body)) (my-let-values ("step") binds (bind ... tmp) expr (maps ... (x tmp)) y rest . body))
)
((my-let-values ("step") binds (bind ...) expr (maps ...) x rest . body) ((my-let-values ("step") binds (bind ...) expr (maps ...) x rest . body)
(mtrace
(my-let-values ("step") binds (bind ... . tmp) expr (maps ... (x tmp)) () rest . body)) (my-let-values ("step") binds (bind ... . tmp) expr (maps ... (x tmp)) () rest . body))
)
; ((my-let-values ((params expr) . rest) . body) ; ((my-let-values ((params expr) . rest) . body)
; (my-let-values ("step") () () expr () params rest . body)) ; (my-let-values ("step") () () expr () params rest . body))
)) ))