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

Relocated cond-expand to scheme/base

Browse source
This commit is contained in:
Justin Ethier 2015-08-21 01:55:39 -04:00
parent c46e311945
commit fcb25adfc3
2 changed files with 25 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
scheme/base.sld
View file

@ -90,6 +90,7 @@
begin
case
cond
cond-expand
when
quasiquote
)
@ -191,6 +192,28 @@
;((pair? exps) `(let (($_ ,(car exps)))
; ,(dummy-bind (cdr exps))))))
(dummy-bind (cdr exp)))))
(define-syntax cond-expand
(er-macro-transformer
;; Based on the cond-expand macro from Chibi scheme
(lambda (expr rename compare)
(define (check x)
(if (pair? x)
(case (car x)
((and) (every check (cdr x)))
((or) (any check (cdr x)))
((not) (not (check (cadr x))))
;((library) (eval `(find-module ',(cadr x)) (%meta-env)))
(else (error "cond-expand: bad feature" x)))
(memq x (features))))
(let expand ((ls (cdr expr)))
(cond ((null? ls)) ; (error "cond-expand: no expansions" expr)
((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))
((eq? 'else (caar ls)) ;(identifier->symbol (caar ls)))
(if (pair? (cdr ls))
(error "cond-expand: else in non-final position")
`(,(rename 'begin) ,@(cdar ls))))
((check (caar ls)) `(,(rename 'begin) ,@(cdar ls)))
(else (expand (cdr ls))))))))
(define-syntax cond
(er-macro-transformer
(lambda (expr rename compare)

30
scheme/cyclone/transforms.sld
View file

@ -131,35 +131,9 @@
;; Temporary work-around for pp not being implemented yet
(define pretty-print write)
;; Built-in macros
;; TODO: just a stub, real code would read (define-syntax)
;; from a lib file or such
;; Container for built-in macros
(define (get-macros) *defined-macros*)
(define *defined-macros*
(list
(cons 'cond-expand
;; Based on the cond-expand macro from Chibi scheme
(lambda (expr rename compare)
(define (check x)
(if (pair? x)
(case (car x)
((and) (every check (cdr x)))
((or) (any check (cdr x)))
((not) (not (check (cadr x))))
;((library) (eval `(find-module ',(cadr x)) (%meta-env)))
(else (error "cond-expand: bad feature" x)))
(memq x (features))))
(let expand ((ls (cdr expr)))
(cond ((null? ls)) ; (error "cond-expand: no expansions" expr)
((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))
((eq? 'else (caar ls)) ;(identifier->symbol (caar ls)))
(if (pair? (cdr ls))
(error "cond-expand: else in non-final position")
`(,(rename 'begin) ,@(cdar ls))))
((check (caar ls)) `(,(rename 'begin) ,@(cdar ls)))
(else (expand (cdr ls)))))))
))
(define *defined-macros* (list))
(define (built-in-syms)
'(call-with-values call/cc define))