Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +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 begin
case case
cond cond
cond-expand
when when
quasiquote quasiquote
) )
@ -191,6 +192,28 @@
;((pair? exps) `(let (($_ ,(car exps))) ;((pair? exps) `(let (($_ ,(car exps)))
; ,(dummy-bind (cdr exps)))))) ; ,(dummy-bind (cdr exps))))))
(dummy-bind (cdr exp))))) (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 (define-syntax cond
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)

30
scheme/cyclone/transforms.sld
View file

@ -131,35 +131,9 @@
;; Temporary work-around for pp not being implemented yet ;; Temporary work-around for pp not being implemented yet
(define pretty-print write) (define pretty-print write)
;; Built-in macros ;; Container for built-in macros
;; TODO: just a stub, real code would read (define-syntax)
;; from a lib file or such
(define (get-macros) *defined-macros*) (define (get-macros) *defined-macros*)
(define *defined-macros* (define *defined-macros* (list))
(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 (built-in-syms) (define (built-in-syms)
'(call-with-values call/cc define)) '(call-with-values call/cc define))