conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

declare core syntaces individually separate from (scheme base)

This commit is contained in:
Yuichi Nishiwaki 2013-12-09 23:00:47 -08:00
parent 038020ff9f
commit 49c0330fb7
1 changed files with 203 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
piclib/built-in.scm
View File

@ -1,4 +1,6 @@
;;; hygienic macros ;;; hygienic macros
(define-library (picrin macro)
(import (scheme base))
(define (sc-macro-transformer f) (define (sc-macro-transformer f)
(lambda (expr use-env mac-env) (lambda (expr use-env mac-env)
@ -32,46 +34,28 @@
(walk (lambda (x) (if (symbol? x) (inject x) x)) expr)) (walk (lambda (x) (if (symbol? x) (inject x) x)) expr))
(make-syntactic-closure mac-env '() (f renamed inject compare)))) (make-syntactic-closure mac-env '() (f renamed inject compare))))
;;; Core syntaxes (export sc-macro-transformer
rsc-macro-transformer
er-macro-transformer
ir-macro-transformer))
(define (list . args) ;;; core syntaces
args) (define-library (picrin core-syntax)
(import (scheme base)
(picrin macro))
(define (caar p) (define (list . args) args)
(car (car p)))
(define (cadr p) (define (caar p) (car (car p)))
(car (cdr p))) (define (cadr p) (car (cdr p)))
(define (cdar p) (cdr (car p)))
(define (cddr p) (cdr (cdr p)))
(define (cdar p) (define (map f list)
(cdr (car p)))
(define (cddr p)
(cdr (cdr p)))
(define (any pred list)
(if (null? list) (if (null? list)
#f list
((lambda (it)
(if it
it
(any pred (cdr list))))
(pred (car list)))))
(define (map f list . lists)
(define (single-map f list)
(if (null? list)
'()
(cons (f (car list)) (cons (f (car list))
(map f (cdr list))))) (map f (cdr list)))))
(define (multiple-map f lists)
(if (any null? lists)
'()
(cons (apply f (single-map car lists))
(multiple-map f (single-map cdr lists)))))
(if (null? lists)
(single-map f list)
(multiple-map f (cons list lists))))
(define-macro (let bindings . body) (define-macro (let bindings . body)
(if (symbol? bindings) (if (symbol? bindings)
@ -188,6 +172,47 @@
(define-auxiliary-syntax unquote) (define-auxiliary-syntax unquote)
(define-auxiliary-syntax unquote-splicing) (define-auxiliary-syntax unquote-splicing)
(export let let* letrec letrec*
quasiquote unquote unquote-splicing
and or
cond else =>
do
when unless
_ ...))
(import (picrin macro)
(picrin core-syntax))
(define (list . args)
args)
(define (caar p)
(car (car p)))
(define (cadr p)
(car (cdr p)))
(define (cdar p)
(cdr (car p)))
(define (cddr p)
(cdr (cdr p)))
(define (append xs ys)
(if (null? xs)
ys
(cons (car xs)
(append (cdr xs) ys))))
(define (any pred list)
(if (null? list)
#f
((lambda (it)
(if it
it
(any pred (cdr list))))
(pred (car list)))))
(define (every pred list) (define (every pred list)
(if (null? list) (if (null? list)
#t #t
@ -383,7 +408,11 @@
(define-macro (define-char-transitive-predicate name op) (define-macro (define-char-transitive-predicate name op)
`(define (,name . cs) `(define (,name . cs)
(apply ,op (map char->integer cs)))) (letrec ((map (lambda (f list)
(if (null? list)
list
(cons (f (car list)) (map f (cdr list)))))))
(apply ,op (map char->integer cs)))))
(define-char-transitive-predicate char=? =) (define-char-transitive-predicate char=? =)
(define-char-transitive-predicate char<? <) (define-char-transitive-predicate char<? <)
@ -561,6 +590,21 @@
;;; 6.10 control features ;;; 6.10 control features
(define (map f list . lists)
(define (single-map f list)
(if (null? list)
'()
(cons (f (car list))
(map f (cdr list)))))
(define (multiple-map f lists)
(if (any null? lists)
'()
(cons (apply f (single-map car lists))
(multiple-map f (single-map cdr lists)))))
(if (null? lists)
(single-map f list)
(multiple-map f (cons list lists))))
(define (for-each f list . lists) (define (for-each f list . lists)
(define (single-for-each f list) (define (single-for-each f list)
(if (null? list) (if (null? list)