artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

let.scm: cleanups.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-27 07:35:57 +02:00
parent 56fcde0966
commit af1b6dc88d
1 changed files with 10 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
let.mes
View file

@ -27,44 +27,20 @@
(set! ,label (lambda ,(map car bindings) ,@rest)) (set! ,label (lambda ,(map car bindings) ,@rest))
(,label ,@(map cadr bindings)))) (,label ,@(map cadr bindings))))
(define-macro (combined-let bindings-or-label . rest) (define-macro (let bindings-or-label . rest)
(display `(`,(cond (,(symbol? bindings-or-label)
`(,`(cond (list 'lambda '() (cons* 'named-let ,bindings-or-label ,(car rest) ,(cdr rest))))
(,(symbol? bindings-or-label)
(lambda () ,(cons* 'named-let bindings-or-label `(car ,rest) `(cdr ,rest))))
(#t (#t
(lambda () ,(cons* 'simple-let bindings-or-label rest)) (list 'lambda '() (cons* 'simple-let ,bindings-or-label ,rest))))))
))))
(newline)
`(,`(cond
(,(symbol? bindings-or-label)
(lambda () ,(cons* 'named-let bindings-or-label `(car ,rest) `(cdr ,rest))))
(#t
(lambda () ,(cons* 'simple-let bindings-or-label rest))
))))
(define (split-params bindings params)
(cond ((null? bindings) params)
(#t (split-params (cdr bindings)
(append params (cons (caar bindings) '()))))))
(define (split-values bindings values)
(cond ((null? bindings) values)
(#t (split-values (cdr bindings)
(append values (cdar bindings) '())))))
(define-macro (xsimple-let bindings rest) (define-macro (xsimple-let bindings rest)
`((lambda ,(split-params bindings '()) ,@rest) `(,`(lambda ,(map car bindings) ,@rest)
,@(split-values bindings '()))) ,@(map cadr bindings)))
(define-macro (xnamed-let label bindings rest) (define-macro (xnamed-let label bindings rest)
`((lambda (,label) `(simple-let ((,label *unspecified*))
(set! ,label (lambda ,(split-params bindings '()) ,@rest)) (set! ,label (lambda ,(map car bindings) ,@rest))
(,label ,@(split-values bindings '()))) (,label ,@(map cadr bindings))))
*unspecified*))
(define-macro (let bindings-or-label . rest) (define-macro (let bindings-or-label . rest)
`(cond (,(symbol? bindings-or-label) `(cond (,(symbol? bindings-or-label)