Skip to content

Commit 2921d03

Browse files
authored
Merge pull request #421 from yamacir-kit/library
2 parents 37073cc + 7b29898 commit 2921d03

40 files changed

+1048
-1221
lines changed

CMakeLists.txt

+1
Original file line numberDiff line numberDiff line change
@@ -177,6 +177,7 @@ check(identifier)
177177
check(internal-definition)
178178
check(let-syntax)
179179
check(letrec-syntax)
180+
check(library-declaration)
180181
check(numerical-operations)
181182
check(parameterize)
182183
check(r4rs)

README.md

+21-21
Original file line numberDiff line numberDiff line change
@@ -41,24 +41,24 @@ Subset of R7RS-small.
4141

4242
### SRFIs
4343

44-
| Number | Title | Library name | Note |
45-
|--------------------------------------------------------:|:---------------------------------------------------------|:------------------------------------------------------|:------------------|
46-
| [ 1](https://srfi.schemers.org/srfi-1/srfi-1.html) | List Library | [`(srfi 1)`](./basis/srfi-1.ss) | |
47-
| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 |
48-
| [ 8](https://srfi.schemers.org/srfi-8/srfi-8.html) | receive: Binding to multiple values | [`(srfi 8)`](./basis/srfi-8.ss) | |
49-
| [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html) | #, external form | | |
50-
| [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html) | Syntax for receiving multiple values | [`(srfi 11)`](./basis/srfi-11.ss) | R7RS 4.2.2 |
51-
| [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html) | Error reporting mechanism | [`(srfi 23)`](./basis/srfi-23.ss) | R7RS 6.11 |
52-
| [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html) | Nested Multi-line Comments | | R7RS 2.2 |
53-
| [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html) | Exception Handling for Programs | [`(srfi 34)`](./basis/srfi-34.ss) | R7RS 6.11 |
54-
| [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html) | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss) | R7RS 6.13.3 |
55-
| [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html) | Parameter objects | [`(srfi 39)`](./basis/srfi-39.ss) | R7RS 4.2.6 |
56-
| [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html) | Primitives for Expressing Iterative Lazy Algorithms | [`(srfi 45)`](./basis/srfi-45.ss) | R7RS 4.2.5 |
57-
| [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html) | S-expression comments | | R7RS 2.2 |
58-
| [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html) | Lightweight testing | [`(srfi 78)`](./basis/srfi-78.ss) | Except `check-ec` |
59-
| [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html) | => in case clauses | | R7RS 4.2.1 |
60-
| [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic `syntax-rules` template extensions | [`(srfi 149)`](./basis/srfi-149.ss) | R7RS 4.3.2 |
61-
| [211](https://srfi.schemers.org/srfi-211/srfi-211.html) | Scheme Macro Libraries | [`(srfi 211 explicit-renaming)`](./basis/srfi-211.ss) | |
44+
| Number | Title | Library name | Note |
45+
|--------------------------------------------------------:|:-------------------------------------------------------|:------------------------------------------------------|:------------------|
46+
| [ 1](https://srfi.schemers.org/srfi-1/srfi-1.html) | List Library | [`(srfi 1)`](./basis/srfi-1.ss) | |
47+
| [ 6](https://srfi.schemers.org/srfi-6/srfi-6.html) | Basic String Ports | [`(srfi 6)`](./basis/srfi-6.ss) | R7RS 6.13 |
48+
| [ 8](https://srfi.schemers.org/srfi-8/srfi-8.html) | receive: Binding to multiple values | [`(srfi 8)`](./basis/srfi-8.ss) | |
49+
| [ 10](https://srfi.schemers.org/srfi-10/srfi-10.html) | #, external form | | |
50+
| [ 11](https://srfi.schemers.org/srfi-11/srfi-11.html) | Syntax for receiving multiple values | [`(srfi 11)`](./basis/srfi-11.ss) | R7RS 4.2.2 |
51+
| [ 23](https://srfi.schemers.org/srfi-23/srfi-23.html) | Error reporting mechanism | [`(srfi 23)`](./basis/srfi-23.ss) | R7RS 6.11 |
52+
| [ 30](https://srfi.schemers.org/srfi-30/srfi-30.html) | Nested Multi-line Comments | | R7RS 2.2 |
53+
| [ 34](https://srfi.schemers.org/srfi-34/srfi-34.html) | Exception Handling for Programs | [`(srfi 34)`](./basis/srfi-34.ss) | R7RS 6.11 |
54+
| [ 38](https://srfi.schemers.org/srfi-38/srfi-38.html) | External Representation for Data With Shared Structure | [`(srfi 38)`](./basis/srfi-38.ss) | R7RS 6.13.3 |
55+
| [ 39](https://srfi.schemers.org/srfi-39/srfi-39.html) | Parameter objects | [`(srfi 39)`](./basis/srfi-39.ss) | R7RS 4.2.6 |
56+
| [ 45](https://srfi.schemers.org/srfi-45/srfi-45.html) | Primitives for Expressing Iterative Lazy Algorithms | [`(srfi 45)`](./basis/srfi-45.ss) | R7RS 4.2.5 |
57+
| [ 62](https://srfi.schemers.org/srfi-62/srfi-62.html) | S-expression comments | | R7RS 2.2 |
58+
| [ 78](https://srfi.schemers.org/srfi-78/srfi-78.html) | Lightweight testing | [`(srfi 78)`](./basis/srfi-78.ss) | Except `check-ec` |
59+
| [ 87](https://srfi.schemers.org/srfi-87/srfi-87.html) | => in case clauses | | R7RS 4.2.1 |
60+
| [149](https://srfi.schemers.org/srfi-149/srfi-149.html) | Basic syntax-rules template extensions | [`(srfi 149)`](./basis/srfi-149.ss) | R7RS 4.3.2 |
61+
| [211](https://srfi.schemers.org/srfi-211/srfi-211.html) | Scheme Macro Libraries | [`(srfi 211 explicit-renaming)`](./basis/srfi-211.ss) | |
6262

6363
## Requirements
6464

@@ -105,9 +105,9 @@ sudo rm -rf /usr/local/share/meevax
105105

106106
| Target Name | Description
107107
|:-------------------|:--
108-
| `all` (default) | Build shared-library `libmeevax.0.4.302.so` and executable `meevax`.
108+
| `all` (default) | Build shared-library `libmeevax.0.4.363.so` and executable `meevax`.
109109
| `test` | Test executable `meevax`.
110-
| `package` | Generate debian package `meevax_0.4.302_amd64.deb`.
110+
| `package` | Generate debian package `meevax_0.4.363_amd64.deb`.
111111
| `install` | Copy files into `/usr/local` __(1)__.
112112
| `install.deb` | `all` + `package` + `sudo apt install <meevax>.deb`
113113
| `safe-install.deb` | `all` + `test` + `package` + `sudo apt install <meevax>.deb`
@@ -122,7 +122,7 @@ __(1)__ Meevax installed by `make install` cannot be uninstalled by the system's
122122
## Usage
123123

124124
```
125-
Meevax Lisp System, version 0.4.302
125+
Meevax Lisp System, version 0.4.363
126126
127127
Usage: meevax [OPTION...] [FILE...]
128128

VERSION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
0.4.302
1+
0.4.363

basis/r4rs-essential.ss

+20-14
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,23 @@
11
(define-library (scheme r4rs essential)
22
(import (meevax character)
3-
(meevax control)
4-
(meevax environment)
3+
(meevax function)
4+
(rename (meevax environment)
5+
(load %load))
56
(rename (meevax comparator)
67
(identity=? eq?)
78
(normally=? eqv?))
8-
(meevax foreign-function)
99
(meevax list)
1010
(meevax number)
1111
(meevax pair)
1212
(meevax port)
13-
(meevax read)
13+
(rename (meevax read)
14+
(read %read))
1415
(meevax string)
1516
(meevax symbol)
1617
(meevax syntax)
1718
(meevax vector)
18-
(prefix (meevax write) %)
19+
(rename (meevax write)
20+
(write %write))
1921
(srfi 211 explicit-renaming))
2022

2123
(export quote lambda if set! cond case and or let letrec begin quasiquote
@@ -559,9 +561,17 @@
559561
result))
560562
(call-with-output-port (open-output-file path) f))
561563

562-
(define current-input-port standard-input-port) ; r7rs incompatible (current-input-port is standard input)
564+
(define current-input-port input-port)
563565

564-
(define current-output-port standard-output-port) ; r7rs incompatible (current-output-port is standard output)
566+
(define current-output-port output-port)
567+
568+
(define open-input-file open)
569+
570+
(define open-output-file open)
571+
572+
(define close-input-port close)
573+
574+
(define close-output-port close)
565575

566576
(define (read . port)
567577
(%read (if (pair? port)
@@ -588,17 +598,13 @@
588598
(car port)
589599
(current-output-port))))
590600

591-
(define (write-string string . xs) ; TODO REMOVE!
592-
(case (length xs)
593-
((0) (put-string string (current-output-port)))
594-
((1) (put-string string (car xs)))
595-
(else (put-string (apply string-copy string (cadr xs)) (car xs)))))
596-
597601
(define (display x . xs)
598602
(cond ((char? x)
599603
(apply write-char x xs))
600604
((string? x)
601-
(apply write-string x xs))
605+
(put-string x (if (pair? xs) ; NOTE: The procedure write-string is not defined in R4RS.
606+
(car xs)
607+
(current-output-port))))
602608
(else (apply write x xs))))
603609

604610
(define (newline . port)

basis/r4rs.ss

+4-3
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
(define-library (scheme r4rs)
22
(import (meevax inexact)
33
(only (meevax number) exact-integer? expt exact inexact ratio? ratio-numerator ratio-denominator)
4-
(only (meevax port) get-ready? standard-input-port standard-output-port)
4+
(only (meevax port) input-port output-port)
5+
(only (meevax read) get-ready?)
56
(only (meevax string) string-copy)
67
(only (meevax syntax) define-syntax)
78
(only (meevax vector) vector-fill!)
@@ -142,11 +143,11 @@
142143
(begin (string-set! s k c)
143144
(rec (- k 1)))))))
144145

145-
(define %current-input-port standard-input-port)
146+
(define %current-input-port (input-port))
146147

147148
(define (current-input-port) %current-input-port)
148149

149-
(define %current-output-port standard-output-port)
150+
(define %current-output-port (output-port))
150151

151152
(define (current-output-port) %current-output-port)
152153

basis/r5rs.ss

+1-2
Original file line numberDiff line numberDiff line change
@@ -46,8 +46,7 @@
4646
(apply emergency-exit normally?))))
4747

4848
(define-library (scheme r5rs)
49-
(import (only (meevax environment) environment)
50-
(only (meevax evaluate) eval)
49+
(import (only (meevax environment) environment eval)
5150
(only (meevax syntax) define-syntax let-syntax letrec-syntax)
5251
(except (scheme r4rs) call-with-current-continuation)
5352
(except (scheme r5rs continuation) exit)

basis/r7rs.ss

+28-18
Original file line numberDiff line numberDiff line change
@@ -3,12 +3,20 @@
33
(only (meevax number) exact-integer?)
44
(only (meevax vector) vector-append vector-copy vector-copy! string->vector)
55
(only (meevax port)
6-
binary-port? textual-port? port? input-port-open? output-port-open?
7-
standard-input-port standard-output-port standard-error-port
8-
eof-object get-ready? get-char get-char! put-char put-string
9-
%flush-output-port)
6+
binary-port?
7+
textual-port?
8+
port?
9+
input-port
10+
open?
11+
output-port
12+
flush
13+
error-port
14+
eof-object
15+
)
16+
(only (meevax read) get-char get-char! get-ready?)
1017
(only (meevax string) string-copy! vector->string)
1118
(only (meevax version) features)
19+
(only (meevax write) put-char put-string)
1220
(scheme r5rs)
1321
(srfi 6) ; Basic String Ports
1422
(srfi 11) ; Syntax for receiving multiple values
@@ -344,8 +352,12 @@
344352
(close-port port)
345353
result))
346354

355+
(define input-port-open? open?)
356+
357+
(define output-port-open? open?)
358+
347359
(define current-input-port
348-
(make-parameter (standard-input-port)
360+
(make-parameter (input-port)
349361
(lambda (x)
350362
(cond ((not (input-port? x))
351363
(error "current-input-port: not input-port" x))
@@ -354,7 +366,7 @@
354366
(else x)))))
355367

356368
(define current-output-port
357-
(make-parameter (standard-output-port)
369+
(make-parameter (output-port)
358370
(lambda (x)
359371
(cond ((not (output-port? x))
360372
(error "current-output-port: not output-port" x))
@@ -363,7 +375,7 @@
363375
(else x)))))
364376

365377
(define current-error-port
366-
(make-parameter (standard-error-port)
378+
(make-parameter (error-port)
367379
(lambda (x)
368380
(cond ((not (output-port? x))
369381
(error "current-error-port: not output-port" x))
@@ -400,15 +412,15 @@
400412
(case (length xs)
401413
((0) (put-string string (current-output-port)))
402414
((1) (put-string string (car xs)))
403-
(else (put-string (apply string-copy string (cadr xs)) (car xs)))))
415+
(else (put-string (apply string-copy string (cdr xs)) (car xs)))))
404416

405417
(define (newline . port)
406418
(apply write-char #\newline port))
407419

408420
(define (flush-output-port . port)
409-
(%flush-output-port (if (pair? port)
410-
(car port)
411-
(current-output-port))))
421+
(flush (if (pair? port)
422+
(car port)
423+
(current-output-port))))
412424
)
413425
)
414426

@@ -529,15 +541,12 @@
529541
(string-map char-foldcase x))))
530542

531543
(define-library (scheme eval)
532-
(import (only (meevax environment) environment)
533-
(only (meevax evaluate) eval))
544+
(import (only (meevax environment) environment eval))
534545
(export environment eval))
535546

536547
(define-library (scheme file)
537-
(import (only (meevax port) open-input-file open-output-file)
538-
(only (scheme r5rs) call-with-input-file call-with-output-file)
539-
(only (scheme base) define parameterize current-input-port current-output-port)
540-
)
548+
(import (only (scheme r5rs) call-with-input-file call-with-output-file open-input-file open-output-file)
549+
(only (scheme base) define parameterize current-input-port current-output-port))
541550
(export call-with-input-file
542551
call-with-output-file
543552
with-input-from-file
@@ -560,7 +569,8 @@
560569
)
561570

562571
(define-library (scheme read)
563-
(import (meevax read)
572+
(import (rename (meevax read)
573+
(read %read))
564574
(scheme base))
565575
(export read)
566576
(begin (define (read . x)

basis/srfi-34.ss

+2-2
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020

2121
(define-library (srfi 34)
2222
(import (only (meevax dynamic-environment) load-auxiliary store-auxiliary)
23-
(only (meevax error) throw)
23+
(only (meevax error) throw kernel-exception-handler-set!)
2424
(scheme r5rs))
2525

2626
(export with-exception-handler raise raise-continuable guard)
@@ -60,7 +60,7 @@
6060
(inner x)
6161
(throw x))))))
6262

63-
(declare-raise raise)
63+
(kernel-exception-handler-set! raise)
6464

6565
(define-syntax guard
6666
(syntax-rules ()

basis/srfi-6.ss

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
11
(define-library (srfi 6)
2-
(import (only (meevax port) open-input-string open-output-string get-output-string))
3-
(export open-input-string open-output-string get-output-string))
2+
(import (meevax port))
3+
(export (rename port->string get-output-string)
4+
(rename string->port open-input-string)
5+
(rename string->port open-output-string)))

0 commit comments

Comments
 (0)