diff options
author | Case Duckworth | 2023-08-08 23:41:40 -0500 |
---|---|---|
committer | Case Duckworth | 2023-08-08 23:41:40 -0500 |
commit | cd90c50267ad3cee1340d891759c5330af566e3d (patch) | |
tree | 15ef01ab91200d334243a7fed20d8686b9347ca9 | |
parent | Rename scm to sld (diff) | |
download | chicanery-cd90c50267ad3cee1340d891759c5330af566e3d.tar.gz chicanery-cd90c50267ad3cee1340d891759c5330af566e3d.zip |
Support multiple schemes
-rw-r--r-- | Makefile | 36 | ||||
-rw-r--r-- | chicanery.extras.scm | 46 |
2 files changed, 60 insertions, 22 deletions
diff --git a/Makefile b/Makefile index 38d0ce0..5c1c8b3 100644 --- a/Makefile +++ b/Makefile | |||
@@ -1,13 +1,35 @@ | |||
1 | # chicanery | 1 | # chicanery |
2 | ## this makefile exists only to ... make ... cleaning up easier, really. | 2 | ## this makefile exists only to ... make ... cleaning up easier, really. |
3 | 3 | ||
4 | .PHONY: build install clean | 4 | NAME = chicanery |
5 | 5 | ||
6 | build: | 6 | default: |
7 | chicken-install -n | 7 | @echo "CHICANERY: subtly breaking scheme expectations" |
8 | 8 | @echo "Use R7RS and all of R7RS. The following schemes are supported:" | |
9 | install: | 9 | @sed -n 's/^\([^.].*\): *supported.*/- \1/p' Makefile |
10 | chicken-install | ||
11 | 10 | ||
11 | .PHONY: clean | ||
12 | clean: | 12 | clean: |
13 | rm -f *.sh *.import.* *.inline *.link *.o *.so *.types | 13 | rm -f $(NAME) *.sh *.import.* *.inline *.link *.o* *.so *.types |
14 | |||
15 | # Scheme implementation demoes | ||
16 | |||
17 | .PHONY: supported | ||
18 | supported: | ||
19 | |||
20 | .PHONY: chicken | ||
21 | chicken: supported chicanery.egg | ||
22 | csi -R chicanery | ||
23 | |||
24 | .PHONY: guile | ||
25 | guile: supported | ||
26 | echo '(import (chicanery))' > /tmp/chicanery.guile-bootstrap | ||
27 | guile -L . -l /tmp/chicanery.guile-bootstrap | ||
28 | |||
29 | .PHONY: gambit | ||
30 | gambit: supported chicanery\#.scm | ||
31 | gsi . -e '(import (chicanery))' - | ||
32 | |||
33 | .PHONY: chibi | ||
34 | chibi: supported | ||
35 | chibi-scheme -I. -mchicanery | ||
diff --git a/chicanery.extras.scm b/chicanery.extras.scm index 27968df..bbd044f 100644 --- a/chicanery.extras.scm +++ b/chicanery.extras.scm | |||
@@ -1,15 +1,11 @@ | |||
1 | ;;; chicanery extras --- extra stuff from ur old pal acdw | 1 | ;;; chicanery extras --- extra stuff from ur old pal acdw |
2 | 2 | ||
3 | (export list-map | ||
4 | list-for-each | ||
5 | list-append) | ||
6 | |||
7 | ;;; Generalized map, for-each, ... | 3 | ;;; Generalized map, for-each, ... |
8 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work | 4 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work |
9 | ;; with any (default) datatype. TODO: generalize? | 5 | ;; with any (default) datatype. TODO: generalize? |
10 | (define list-map map) | 6 | (define list-map scheme/map) |
11 | (define list-for-each for-each) | 7 | (define list-for-each scheme/for-each) |
12 | (define list-append append) | 8 | (define list-append scheme/append) |
13 | 9 | ||
14 | (define (map proc . collections) | 10 | (define (map proc . collections) |
15 | (let ((first (car collections))) ; we only need to check the first one | 11 | (let ((first (car collections))) ; we only need to check the first one |
@@ -46,9 +42,6 @@ | |||
46 | (apply bytevector-append collections)) | 42 | (apply bytevector-append collections)) |
47 | (else (error "Bad datatype" first))))) | 43 | (else (error "Bad datatype" first))))) |
48 | 44 | ||
49 | (export ref | ||
50 | copy) | ||
51 | |||
52 | ;;; Extended generic functions. | 45 | ;;; Extended generic functions. |
53 | ;; These functions already have a list- version defined, but no non-prefixed | 46 | ;; These functions already have a list- version defined, but no non-prefixed |
54 | ;; one. So I'm fixing that. | 47 | ;; one. So I'm fixing that. |
@@ -78,13 +71,9 @@ | |||
78 | (bytevector-copy collection)) | 71 | (bytevector-copy collection)) |
79 | (else (error "Bad datatype" collection)))) | 72 | (else (error "Bad datatype" collection)))) |
80 | 73 | ||
81 | ;;; Functions that should be in scheme | 74 | ;;; Definitions that should be in scheme |
82 | ;; This sections should be as small as possible | 75 | ;; This sections should be as small as possible |
83 | 76 | ||
84 | (export atom? | ||
85 | read-port | ||
86 | read-port-chunk-size) | ||
87 | |||
88 | (define (atom? x) | 77 | (define (atom? x) |
89 | (not (pair? x))) | 78 | (not (pair? x))) |
90 | 79 | ||
@@ -113,3 +102,30 @@ | |||
113 | (case-lambda | 102 | (case-lambda |
114 | (() (%read-port (current-input-port))) | 103 | (() (%read-port (current-input-port))) |
115 | ((p) (%read-port p)))) | 104 | ((p) (%read-port p)))) |
105 | |||
106 | (define (defined? sym) | ||
107 | (call-with-current-continuation | ||
108 | (lambda (k) | ||
109 | (with-exception-handler | ||
110 | (lambda (e) (k #f)) | ||
111 | (lambda () | ||
112 | (eval sym (interaction-environment)) | ||
113 | #t))))) | ||
114 | |||
115 | (define (displayed x) | ||
116 | (call-with-port (open-output-string) | ||
117 | (lambda (port) | ||
118 | (display x port) | ||
119 | (get-output-string port)))) | ||
120 | |||
121 | (define (written x) | ||
122 | (call-with-port (open-output-string) | ||
123 | (lambda (port) | ||
124 | (write x port) | ||
125 | (get-output-string port)))) | ||
126 | |||
127 | (define (print x) | ||
128 | (display x) | ||
129 | (newline)) | ||
130 | |||
131 | (define ->string displayed) | ||