Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

replace define-library-alias with define-library + alias-for

Browse source
This commit is contained in:
Alex Shinn 2020-06-04 23:55:37 +09:00
parent c245d6cee8
commit d42d4d5600
39 changed files with 141 additions and 153 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
.gitignore vendored
View file

@ -51,15 +51,23 @@ lib/chibi/stty.c
lib/chibi/system.c
lib/chibi/time.c
lib/chibi/win32/process-win32.c
lib/scheme/bytevector.c
lib/srfi/144/math.c
lib/srfi/160/uvprims.c
*.tgz
*.bz2
*.xz
*.html
*.img
*.err
*.fasl
*.txt
*.test
*.train
*.h5
!index.html
benchmarks/gabriel/times.tsv
examples/snow-fort
examples/synthcode
tests/snow/repo-cache
@ -73,3 +81,4 @@ tmp
js/chibi.*
build-lib/chibi/char-set/derived.scm
build-lib/chibi/char-set/width.scm

185
lib/meta-7.scm
View file

@ -229,101 +229,104 @@
(define define-library-transformer
(er-macro-transformer
(lambda (expr rename compare)
(let ((name (cadr expr))
(body (cddr expr))
(tmp (rename 'tmp))
(this-module (rename '*this-module*))
(_add-module! (rename 'add-module!))
(_make-module (rename 'make-module))
(_define (rename 'meta-define))
(_lambda (rename 'lambda))
(_let (rename 'let))
(_map (rename 'map))
(_if (rename 'if))
(_cond (rename 'cond))
(_set! (rename 'set!))
(_quote (rename 'quote))
(_and (rename 'and))
(_= (rename '=))
(_eq? (rename 'eq?))
(_pair? (rename 'pair?))
(_null? (rename 'null?))
(_reverse (rename 'reverse))
(_append (rename 'append))
(_assq (rename 'assq))
(_=> (rename '=>))
(_else (rename 'else))
(_length (rename 'length))
(_identifier->symbol (rename 'identifier->symbol))
(_error (rename 'error))
(_cons (rename 'cons))
(_car (rename 'car))
(_cdr (rename 'cdr))
(_caar (rename 'caar))
(_cadr (rename 'cadr))
(_cdar (rename 'cdar))
(_cddr (rename 'cddr)))
;; Check for suspicious defines.
(for-each
(lambda (x)
(if (and (pair? x) (memq (strip-syntactic-closures (car x))
'(define define-syntax)))
(warn "suspicious use of define in library declarations - did you forget to wrap it in begin?" x)))
(cdr expr))
;; Generate the library wrapper.
(set! *this-path*
(cons (string-concatenate
(module-name->strings (cdr (reverse name)) '()))
*this-path*))
`(,_let ((,tmp ,this-module))
(,_define (rewrite-export x)
(,_if (,_pair? x)
(,_if (,_and (,_= 3 (,_length x))
(,_eq? (,_quote rename)
(,_identifier->symbol (,_car x))))
(,_cons (,_car (,_cddr x)) (,_cadr x))
(,_error "invalid module export" x))
x))
(,_define (extract-exports)
(,_cond
((,_assq (,_quote export-all) ,this-module)
,_=> (,_lambda (x)
(,_if (,_pair? (,_cdr x))
(,_error "export-all takes no parameters" x))
#f))
(,_else
(,_let lp ((ls ,this-module) (res (,_quote ())))
(,_cond
((,_null? ls) res)
((,_and (,_pair? (,_car ls))
(,_eq? (,_quote export) (,_caar ls)))
(lp (,_cdr ls)
(,_append (,_map rewrite-export (,_cdar ls)) res)))
(,_else (lp (,_cdr ls) res)))))))
(,_set! ,this-module (,_quote ()))
,@body
(,_add-module! (,_quote ,name)
(,_make-module (extract-exports)
#f
(,_reverse ,this-module)))
(,_set! ,this-module ,tmp)
(,(rename 'pop-this-path)))))))
(cond
((find (lambda (x) (and (pair? x) (compare (car x) (rename 'alias-for))))
(cddr expr))
=> (lambda (alias)
(if (not (= 1 (length (cddr expr))))
(error "alias must be the only library declaration" expr))
;; we need to load the original module first, not just find it,
;; or else the includes would happen relative to the alias
(let ((name (cadr expr))
(orig (load-module (cadr alias))))
(if (not orig)
(error "couldn't find library to alias" (cadr alias))
`(,(rename 'add-module!) (,(rename 'quote) ,name)
(,(rename 'quote) ,orig))))))
(else
(let ((name (cadr expr))
(body (cddr expr))
(tmp (rename 'tmp))
(this-module (rename '*this-module*))
(_add-module! (rename 'add-module!))
(_make-module (rename 'make-module))
(_define (rename 'meta-define))
(_lambda (rename 'lambda))
(_let (rename 'let))
(_map (rename 'map))
(_if (rename 'if))
(_cond (rename 'cond))
(_set! (rename 'set!))
(_quote (rename 'quote))
(_and (rename 'and))
(_= (rename '=))
(_eq? (rename 'eq?))
(_pair? (rename 'pair?))
(_null? (rename 'null?))
(_reverse (rename 'reverse))
(_append (rename 'append))
(_assq (rename 'assq))
(_=> (rename '=>))
(_else (rename 'else))
(_length (rename 'length))
(_identifier->symbol (rename 'identifier->symbol))
(_error (rename 'error))
(_cons (rename 'cons))
(_car (rename 'car))
(_cdr (rename 'cdr))
(_caar (rename 'caar))
(_cadr (rename 'cadr))
(_cdar (rename 'cdar))
(_cddr (rename 'cddr)))
;; Check for suspicious defines.
(for-each
(lambda (x)
(if (and (pair? x) (memq (strip-syntactic-closures (car x))
'(define define-syntax)))
(warn "suspicious use of define in library declarations - did you forget to wrap it in begin?" x)))
(cdr expr))
;; Generate the library wrapper.
(set! *this-path*
(cons (string-concatenate
(module-name->strings (cdr (reverse name)) '()))
*this-path*))
`(,_let ((,tmp ,this-module))
(,_define (rewrite-export x)
(,_if (,_pair? x)
(,_if (,_and (,_= 3 (,_length x))
(,_eq? (,_quote rename)
(,_identifier->symbol (,_car x))))
(,_cons (,_car (,_cddr x)) (,_cadr x))
(,_error "invalid module export" x))
x))
(,_define (extract-exports)
(,_cond
((,_assq (,_quote export-all) ,this-module)
,_=> (,_lambda (x)
(,_if (,_pair? (,_cdr x))
(,_error "export-all takes no parameters" x))
#f))
(,_else
(,_let lp ((ls ,this-module) (res (,_quote ())))
(,_cond
((,_null? ls) res)
((,_and (,_pair? (,_car ls))
(,_eq? (,_quote export) (,_caar ls)))
(lp (,_cdr ls)
(,_append (,_map rewrite-export (,_cdar ls)) res)))
(,_else (lp (,_cdr ls) res)))))))
(,_set! ,this-module (,_quote ()))
,@body
(,_add-module! (,_quote ,name)
(,_make-module (extract-exports)
#f
(,_reverse ,this-module)))
(,_set! ,this-module ,tmp)
(,(rename 'pop-this-path)))))))))
(define-syntax define-library define-library-transformer)
(define-syntax module define-library-transformer)
(define-syntax define-library-alias
(er-macro-transformer
(lambda (expr rename compare)
;; we need to load the original module first, not just find it,
;; or else the includes would happen relative to the alias
(let ((name (cadr expr))
(orig (load-module (car (cddr expr)))))
(if (not orig)
(error "couldn't find library to alias" (car (cddr expr)))
`(,(rename 'add-module!) (,(rename 'quote) ,name)
(,(rename 'quote) ,orig)))))))
(define-syntax pop-this-path
(er-macro-transformer
(lambda (expr rename compare)

2
lib/scheme/bitwise.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme bitwise) (srfi 151))
(define-library (scheme bitwise) (alias-for (srfi 151)))

2
lib/scheme/box.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme box) (srfi 111))
(define-library (scheme box) (alias-for (srfi 111)))

2
lib/scheme/case-lambda.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme case-lambda) (srfi 16))
(define-library (scheme case-lambda) (alias-for (srfi 16)))

2
lib/scheme/charset.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme charset) (srfi 14))
(define-library (scheme charset) (alias-for (srfi 14)))

2
lib/scheme/comparator.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme comparator) (srfi 128))
(define-library (scheme comparator) (alias-for (srfi 128)))

2
lib/scheme/ephemeron.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme ephemeron) (srfi 124))
(define-library (scheme ephemeron) (alias-for (srfi 124)))

2
lib/scheme/fixnum.sld Normal file
View file

@ -0,0 +1,2 @@
(define-library (scheme fixnum) (alias-for (srfi 143)))

2
lib/scheme/flonum.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme flonum) (srfi 144))
(define-library (scheme flonum) (alias-for (srfi 144)))

2
lib/scheme/generator.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme generator) (srfi 121))
(define-library (scheme generator) (alias-for (srfi 121)))

2
lib/scheme/hash-table.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme hash-table) (srfi 125))
(define-library (scheme hash-table) (alias-for (srfi 125)))

2
lib/scheme/ideque.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme ideque) (srfi 134))
(define-library (scheme ideque) (alias-for (srfi 134)))

2
lib/scheme/ilist.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme ilist) (srfi 116))
(define-library (scheme ilist) (alias-for (srfi 116)))

2
lib/scheme/list-queue.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme list-queue) (srfi 117))
(define-library (scheme list-queue) (alias-for (srfi 117)))

2
lib/scheme/list.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme list) (srfi 1))
(define-library (scheme list) (alias-for (srfi 1)))

2
lib/scheme/lseq.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme lseq) (srfi 127))
(define-library (scheme lseq) (alias-for (srfi 127)))

2
lib/scheme/mapping.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme mapping) (srfi 146))
(define-library (scheme mapping) (alias-for (srfi 146)))

28
lib/scheme/mapping/hash.sld
View file

@ -1,28 +1,2 @@
(define-library (scheme mapping hash)
(import (srfi 146 hash))
(export
hashmap hashmap-unfold
hashmap? hashmap-contains? hashmap-empty? hashmap-disjoint?
hashmap-ref hashmap-ref/default hashmap-key-comparator
hashmap-adjoin hashmap-adjoin!
hashmap-set hashmap-set!
hashmap-replace hashmap-replace!
hashmap-delete hashmap-delete! hashmap-delete-all hashmap-delete-all!
hashmap-intern hashmap-intern!
hashmap-update hashmap-update! hashmap-update/default hashmap-update!/default
hashmap-pop hashmap-pop!
hashmap-search hashmap-search!
hashmap-size hashmap-find hashmap-count hashmap-any? hashmap-every?
hashmap-keys hashmap-values hashmap-entries
hashmap-map hashmap-map->list hashmap-for-each hashmap-fold
hashmap-filter hashmap-filter!
hashmap-remove hashmap-remove!
hashmap-partition hashmap-partition!
hashmap-copy hashmap->alist alist->hashmap alist->hashmap!
hashmap=? hashmap<? hashmap>? hashmap<=? hashmap>=?
hashmap-union hashmap-intersection hashmap-difference hashmap-xor
hashmap-union! hashmap-intersection! hashmap-difference! hashmap-xor!
make-hashmap-comparator
hashmap-comparator
comparator?))
(define-library (scheme mapping hash) (alias-for (srfi 146 hash)))

2
lib/scheme/regex.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme regex) (srfi 115))
(define-library (scheme regex) (alias-for (srfi 115)))

2
lib/scheme/set.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme set) (srfi 113))
(define-library (scheme set) (alias-for (srfi 113)))

2
lib/scheme/show.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme show) (srfi 166))
(define-library (scheme show) (alias-for (srfi 166)))

2
lib/scheme/sort.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme sort) (srfi 132))
(define-library (scheme sort) (alias-for (srfi 132)))

2
lib/scheme/stream.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme stream) (srfi 41))
(define-library (scheme stream) (alias-for (srfi 41)))

2
lib/scheme/text.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme text) (srfi 135))
(define-library (scheme text) (alias-for (srfi 135)))

2
lib/scheme/vector.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector) (srfi 133))
(define-library (scheme vector) (alias-for (srfi 133)))

2
lib/scheme/vector/base.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector base) (srfi 160 base))
(define-library (scheme vector base) (alias-for (srfi 160 base)))

2
lib/scheme/vector/c128.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector c128) (srfi 160 c128))
(define-library (scheme vector c128) (alias-for (srfi 160 c128)))

2
lib/scheme/vector/c64.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector c64) (srfi 160 c64))
(define-library (scheme vector c64) (alias-for (srfi 160 c64)))

2
lib/scheme/vector/f32.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector f32) (srfi 160 f32))
(define-library (scheme vector f32) (alias-for (srfi 160 f32)))

2
lib/scheme/vector/f64.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector f64) (srfi 160 f64))
(define-library (scheme vector f64) (alias-for (srfi 160 f64)))

2
lib/scheme/vector/s16.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector s16) (srfi 160 s16))
(define-library (scheme vector s16) (alias-for (srfi 160 s16)))

2
lib/scheme/vector/s32.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector s32) (srfi 160 s32))
(define-library (scheme vector s32) (alias-for (srfi 160 s32)))

2
lib/scheme/vector/s64.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector s64) (srfi 160 s64))
(define-library (scheme vector s64) (alias-for (srfi 160 s64)))

2
lib/scheme/vector/s8.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector s8) (srfi 160 s8))
(define-library (scheme vector s8) (alias-for (srfi 160 s8)))

2
lib/scheme/vector/u16.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector u16) (srfi 160 u16))
(define-library (scheme vector u16) (alias-for (srfi 160 u16)))

2
lib/scheme/vector/u32.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector u32) (srfi 160 u32))
(define-library (scheme vector u32) (alias-for (srfi 160 u32)))

2
lib/scheme/vector/u64.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector u64) (srfi 160 u64))
(define-library (scheme vector u64) (alias-for (srfi 160 u64)))

2
lib/scheme/vector/u8.sld
View file

@ -1,2 +1,2 @@
(define-library-alias (scheme vector u8) (srfi 160 u8))
(define-library (scheme vector u8) (alias-for (srfi 160 u8)))