From 71bdd86d9a626e576817f9a442c6c7095cb9e8ae Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 29 Jun 2015 21:33:30 -0400 Subject: [PATCH] Added case macro --- transforms.scm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/transforms.scm b/transforms.scm index 1ead30c5..342f4e26 100644 --- a/transforms.scm +++ b/transforms.scm @@ -105,6 +105,33 @@ (cons (rename 'begin) (cdr cl)) (cons (rename 'cond) (cddr expr)))))) (cadr expr))))) + (cons 'case + (lambda (expr rename compare) + (define (body exprs) + (cond + ((null? exprs) + (rename 'tmp)) + ((compare (rename '=>) (car exprs)) + `(,(cadr exprs) ,(rename 'tmp))) + (else + `(,(rename 'begin) ,@exprs)))) + (define (clause ls) + (cond + ((null? ls) #f) + ((compare (rename 'else) (caar ls)) + (body (cdar ls))) + ((and (pair? (car (car ls))) (null? (cdr (car (car ls))))) + `(,(rename 'if) (,(rename 'eqv?) ,(rename 'tmp) + (,(rename 'quote) ,(car (caar ls)))) + ,(body (cdar ls)) + ,(clause (cdr ls)))) + (else + `(,(rename 'if) (,(rename 'memv) ,(rename 'tmp) + (,(rename 'quote) ,(caar ls))) + ,(body (cdar ls)) + ,(clause (cdr ls)))))) + `(let ((,(rename 'tmp) ,(cadr expr))) + ,(clause (cddr expr))))) (cons 'cond-expand ;; Based on the cond-expand macro from Chibi scheme (lambda (expr rename compare)