Skip to content

Commit d348b91

Browse files
yamacir-kityamacir-kit
authored
Merge pull request #414 from yamacir-kit/cleanup
2 parents ab9adc0 + d2005b9 commit d348b91

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

54 files changed

+664
-479
lines changed

‎CMakeLists.txt

+10-1
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,18 @@ set(CMAKE_CXX_STANDARD_REQUIRED ON)
1919
set(CMAKE_POSITION_INDEPENDENT_CODE ON)
2020
set(CMAKE_VERBOSE_MAKEFILE OFF)
2121

22+
string(CONCAT UNSTABLE_OPTIMIZATION_OPTIONS # JOIN available if VERSION > 3.12
23+
# "-flto " # This optimization causes a SEGV when compiling with Clang 10.
24+
# "-fmerge-all-constants " # This optimization is very effective in reducing binary size, but non-standard to the C++ standard.
25+
# "-march=native " # This optimization causes "Illegal instruction" error (is Valgrind's bug) on CI.
26+
# "-mtune=native "
27+
)
28+
2229
set(CMAKE_CXX_FLAGS "-Wall -Wextra -Wpedantic -pipe")
2330
set(CMAKE_CXX_FLAGS_DEBUG "-Og -g")
2431
set(CMAKE_CXX_FLAGS_MINSIZEREL "-Os -DNDEBUG")
2532
set(CMAKE_CXX_FLAGS_RELWITHDEBINFO "-O2 -g -DNDEBUG")
26-
set(CMAKE_CXX_FLAGS_RELEASE "-O3 -DNDEBUG") # NOTE: -march=native causes "Illegal instruction" error (is Valgrind's bug) on CI.
33+
set(CMAKE_CXX_FLAGS_RELEASE "-O3 -DNDEBUG ${UNSTABLE_OPTIMIZATION_OPTIONS}")
2734

2835
set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR})
2936
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_BINDIR})
@@ -171,13 +178,15 @@ check(internal-definition)
171178
check(let-syntax)
172179
check(letrec-syntax)
173180
check(numerical-operations)
181+
check(parameterize)
174182
check(r4rs)
175183
check(r4rs-appendix)
176184
check(r5rs)
177185
check(r7rs)
178186
check(sicp-1)
179187
check(srfi-8)
180188
check(transformer)
189+
check(with-exception-handler)
181190

182191
file(GLOB ${PROJECT_NAME}_TEST_CXX ${CMAKE_CURRENT_SOURCE_DIR}/test/*.cpp)
183192
foreach(FILEPATH IN LISTS ${PROJECT_NAME}_TEST_CXX)

‎README.md

+3-3
Original file line numberDiff line numberDiff line change
@@ -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.232.so` and executable `meevax`.
108+
| `all` (default) | Build shared-library `libmeevax.0.4.278.so` and executable `meevax`.
109109
| `test` | Test executable `meevax`.
110-
| `package` | Generate debian package `meevax_0.4.232_amd64.deb`.
110+
| `package` | Generate debian package `meevax_0.4.278_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.232
125+
Meevax Lisp System, version 0.4.278
126126
127127
Usage: meevax [OPTION...] [FILE...]
128128

‎VERSION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
0.4.232
1+
0.4.278

‎basis/r4rs-essential.ss

+7-3
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22
(import (meevax character)
33
(meevax control)
44
(meevax environment)
5-
(meevax equivalence)
5+
(rename (meevax comparator)
6+
(identity=? eq?)
7+
(normally=? eqv?))
68
(meevax foreign-function)
79
(meevax list)
810
(meevax number)
@@ -11,8 +13,7 @@
1113
(meevax read)
1214
(meevax string)
1315
(meevax symbol)
14-
(rename (meevax syntax)
15-
(call-with-current-continuation! call-with-current-continuation))
16+
(meevax syntax)
1617
(meevax vector)
1718
(meevax write)
1819
(srfi 211 explicit-renaming))
@@ -541,6 +542,9 @@
541542
(begin (apply map f x xs)
542543
(if #f #f))))
543544

545+
(define (call-with-current-continuation f)
546+
(call-with-current-continuation! f))
547+
544548
(define (call-with-input-file path f) ; r7rs incompatible (values unsupported)
545549
(define (call-with-input-port port f)
546550
(let ((result (f port)))

‎basis/r5rs.ss

+22-13
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,48 @@
11
(define-library (scheme r5rs continuation)
22
(import (meevax context)
3-
(only (meevax syntax) define-syntax)
4-
(rename (scheme r4rs) (call-with-current-continuation r4rs:call/cc)))
3+
(only (meevax dynamic-environment) load-auxiliary store-auxiliary)
4+
(only (meevax syntax) define-syntax call-with-current-continuation!)
5+
(except (scheme r4rs) call-with-current-continuation))
56

67
(export call-with-current-continuation dynamic-wind exit)
78

8-
(begin (define %current-dynamic-extents '()) ; https://www.cs.hmc.edu/~fleck/envision/scheme48/meeting/node7.html
9+
; https://www.cs.hmc.edu/~fleck/envision/scheme48/meeting/node7.html
10+
11+
(begin (define (current-dynamic-extents)
12+
(load-auxiliary 0))
13+
14+
(define (install-dynamic-extents! extents)
15+
(store-auxiliary 0 extents))
916

1017
(define (dynamic-wind before thunk after)
1118
(before)
12-
(set! %current-dynamic-extents (cons (cons before after) %current-dynamic-extents))
19+
(install-dynamic-extents! (cons (cons before after)
20+
(current-dynamic-extents)))
1321
((lambda (result) ; TODO let-values
14-
(set! %current-dynamic-extents (cdr %current-dynamic-extents))
22+
(install-dynamic-extents! (cdr (current-dynamic-extents)))
1523
(after)
1624
result) ; TODO (apply values result)
1725
(thunk)))
1826

1927
(define (call-with-current-continuation procedure)
2028
(define (windup! from to)
21-
(set! %current-dynamic-extents from)
29+
(install-dynamic-extents! from)
2230
(cond ((eq? from to))
2331
((null? from) (windup! from (cdr to)) ((caar to)))
2432
((null? to) ((cdar from)) (windup! (cdr from) to))
2533
(else ((cdar from)) (windup! (cdr from) (cdr to)) ((caar to))))
26-
(set! %current-dynamic-extents to))
27-
(let ((current-dynamic-extents %current-dynamic-extents))
28-
(r4rs:call/cc (lambda (k1)
29-
(procedure (lambda (k2)
30-
(windup! %current-dynamic-extents current-dynamic-extents)
31-
(k1 k2)))))))
34+
(install-dynamic-extents! to))
35+
(let ((dynamic-extents (current-dynamic-extents)))
36+
(call-with-current-continuation!
37+
(lambda (continue)
38+
(procedure (lambda (x)
39+
(windup! (current-dynamic-extents) dynamic-extents)
40+
(continue x)))))))
3241

3342
(define (exit . normally?)
3443
(for-each (lambda (before/after)
3544
((cdr before/after)))
36-
%current-dynamic-extents)
45+
(current-dynamic-extents))
3746
(apply emergency-exit normally?))))
3847

3948
(define-library (scheme r5rs)

‎basis/r7rs.ss

+11-16
Original file line numberDiff line numberDiff line change
@@ -2,21 +2,11 @@
22
(import (only (meevax error) error? read-error? file-error?)
33
(only (meevax number) exact-integer?)
44
(only (meevax vector) vector-append vector-copy vector-copy! string->vector)
5-
(only (meevax port) binary-port?
6-
textual-port?
7-
port?
8-
input-port-open?
9-
output-port-open?
10-
standard-input-port
11-
standard-output-port
12-
standard-error-port
13-
eof-object
14-
get-ready?
15-
get-char
16-
get-char!
17-
put-char
18-
put-string
19-
%flush-output-port)
5+
(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)
2010
(only (meevax string) string-copy! vector->string)
2111
(only (meevax version) features)
2212
(scheme r5rs)
@@ -61,7 +51,7 @@
6151
syntax-rules
6252
_
6353
...
64-
; syntax-error
54+
syntax-error
6555
define
6656
; define-values
6757
define-syntax
@@ -286,6 +276,11 @@
286276
(cadr form))
287277
,@(cddr form)))))
288278

279+
(define-syntax syntax-error
280+
(er-macro-transformer
281+
(lambda (form rename compare)
282+
(apply error (cdr form)))))
283+
289284
(define (floor-quotient x y)
290285
(floor (/ x y)))
291286

‎basis/srfi-211.ss

+3-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,9 @@
1313
(export sc-macro-transformer rsc-macro-transformer make-syntactic-closure identifier?))
1414

1515
(define-library (srfi 211 explicit-renaming)
16-
(import (meevax equivalence)
16+
(import (rename (meevax comparator)
17+
(identity=? eq?)
18+
(normally=? eqv?))
1719
(meevax list)
1820
(meevax macro)
1921
(meevax pair)

‎basis/srfi-34.ss

+29-21
Original file line numberDiff line numberDiff line change
@@ -19,37 +19,48 @@
1919
; IN THE SOFTWARE.
2020

2121
(define-library (srfi 34)
22-
(import (only (meevax error) throw)
22+
(import (only (meevax dynamic-environment) load-auxiliary store-auxiliary)
23+
(only (meevax error) throw)
2324
(scheme r5rs))
2425

2526
(export with-exception-handler raise raise-continuable guard)
2627

27-
(begin (define %current-exception-handlers (list throw))
28+
(begin (define (current-exception-handlers)
29+
(load-auxiliary 2))
2830

29-
(define (%with-exception-handlers new-handlers thunk)
30-
(let ((old-handlers %current-exception-handlers))
31+
(define (install-exception-handlers! handlers)
32+
(store-auxiliary 2 handlers))
33+
34+
(define (with-exception-handlers new-handlers thunk)
35+
(let ((old-handlers (current-exception-handlers)))
3136
(dynamic-wind
32-
(lambda () (set! %current-exception-handlers new-handlers)) ; install
37+
(lambda () (install-exception-handlers! new-handlers)) ; install
3338
thunk
34-
(lambda () (set! %current-exception-handlers old-handlers))))) ; uninstall
39+
(lambda () (install-exception-handlers! old-handlers))))) ; uninstall
3540

3641
(define (with-exception-handler handler thunk)
37-
(%with-exception-handlers (cons handler %current-exception-handlers) thunk))
42+
(with-exception-handlers (cons handler (current-exception-handlers)) thunk))
3843

3944
(define (raise x)
40-
(let ((inner (car %current-exception-handlers))
41-
(outer (cdr %current-exception-handlers)))
42-
(%with-exception-handlers outer
45+
(let ((inner (car (current-exception-handlers)))
46+
(outer (cdr (current-exception-handlers))))
47+
(with-exception-handlers outer
4348
(lambda ()
44-
(inner x)
45-
(error "If the handler returns, a secondary exception is raised in the same dynamic environment as the handler")))))
49+
(if (procedure? inner)
50+
(inner x)
51+
(throw x))
52+
(throw x)))))
4653

4754
(define (raise-continuable x)
48-
(let ((inner (car %current-exception-handlers))
49-
(outer (cdr %current-exception-handlers)))
50-
(%with-exception-handlers outer
51-
(lambda ()
52-
(inner x)))))
55+
(let ((inner (car (current-exception-handlers)))
56+
(outer (cdr (current-exception-handlers))))
57+
(with-exception-handlers outer
58+
(lambda ()
59+
(if (procedure? inner)
60+
(inner x)
61+
(throw x))))))
62+
63+
(declare-raiser raise)
5364

5465
(define-syntax guard
5566
(syntax-rules ()
@@ -107,7 +118,4 @@
107118
clause1 clause2 ...)
108119
(if test
109120
(begin result1 result2 ...)
110-
(guard-aux reraise clause1 clause2 ...)))))
111-
112-
)
113-
)
121+
(guard-aux reraise clause1 clause2 ...)))))))

‎basis/srfi-39.ss

+32-45
Original file line numberDiff line numberDiff line change
@@ -19,61 +19,48 @@
1919
; SOFTWARE.
2020

2121
(define-library (srfi 39)
22-
(import (scheme r5rs)
22+
(import (only (meevax dynamic-environment) load-auxiliary store-auxiliary)
23+
(scheme r5rs)
2324
(srfi 211 explicit-renaming))
2425

2526
(export make-parameter parameterize)
2627

27-
(begin (define make-parameter
28-
(lambda (init . conv)
29-
(let ((converter (if (null? conv)
30-
(lambda (x) x)
31-
(car conv))))
32-
(let ((global-cell
33-
(cons #f (converter init))))
34-
(letrec ((parameter
35-
(lambda new-val
36-
(let ((cell (dynamic-lookup parameter global-cell)))
37-
(cond ((null? new-val)
38-
(cdr cell))
39-
((null? (cdr new-val))
40-
(set-cdr! cell (converter (car new-val))))
41-
(else ; this case is needed for parameterize
42-
(converter (car new-val))))))))
43-
(set-car! global-cell parameter)
44-
parameter)))))
28+
(begin (define (current-dynamic-bindings)
29+
(load-auxiliary 1))
4530

46-
(define dynamic-bind
47-
(lambda (parameters values body)
48-
(let* ((old-local
49-
(dynamic-env-local-get))
50-
(new-cells
51-
(map (lambda (parameter value)
52-
(cons parameter (parameter value #f)))
53-
parameters
54-
values))
55-
(new-local
56-
(append new-cells old-local)))
57-
(dynamic-wind
58-
(lambda () (dynamic-env-local-set! new-local))
59-
body
60-
(lambda () (dynamic-env-local-set! old-local))))))
31+
(define (install-dynamic-bindings! bindings)
32+
(store-auxiliary 1 bindings))
6133

62-
(define dynamic-lookup
63-
(lambda (parameter global-cell)
64-
(or (assq parameter (dynamic-env-local-get))
65-
global-cell)))
34+
(define (make-parameter init . converter)
35+
(let* ((convert (if (null? converter)
36+
(lambda (x) x)
37+
(car converter)))
38+
(default (cons #f (convert init))))
39+
(letrec ((parameter
40+
(lambda value
41+
(let ((cell (or (assq parameter (current-dynamic-bindings)) default)))
42+
(cond ((null? value)
43+
(cdr cell))
44+
((null? (cdr value))
45+
(set-cdr! cell (convert (car value))))
46+
(else ; Apply converter to value
47+
(convert (car value))))))))
48+
(set-car! default parameter)
49+
parameter)))
6650

67-
(define dynamic-env-local '())
68-
69-
(define (dynamic-env-local-get) dynamic-env-local)
70-
71-
(define (dynamic-env-local-set! new-env)
72-
(set! dynamic-env-local new-env))
51+
(define (dynamic-bind parameters values body)
52+
(let* ((outer (current-dynamic-bindings))
53+
(inner (map (lambda (parameter value)
54+
(cons parameter (parameter value 'apply-converter-to-value)))
55+
parameters
56+
values)))
57+
(dynamic-wind (lambda () (install-dynamic-bindings! (append inner outer)))
58+
body
59+
(lambda () (install-dynamic-bindings! outer)))))
7360

7461
(define-syntax parameterize
7562
(er-macro-transformer
7663
(lambda (form rename compare)
77-
`(,(rename 'dynamic-bind) (,(rename 'list) ,@(map car (cadr form)))
64+
`(,(rename 'dynamic-bind) (,(rename 'list) ,@(map car (cadr form)))
7865
(,(rename 'list) ,@(map cadr (cadr form)))
7966
(,(rename 'lambda) () ,@(cddr form))))))))

‎include/meevax/kernel/character.hpp

-2
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,6 @@
1717
#ifndef INCLUDED_MEEVAX_KERNEL_CHARACTER_HPP
1818
#define INCLUDED_MEEVAX_KERNEL_CHARACTER_HPP
1919

20-
#include <iostream>
21-
2220
#include <meevax/kernel/pair.hpp>
2321

2422
namespace meevax

0 commit comments

Comments
 (0)