about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2023-08-08 23:41:40 -0500
committerCase Duckworth2023-08-08 23:41:40 -0500
commitcd90c50267ad3cee1340d891759c5330af566e3d (patch)
tree15ef01ab91200d334243a7fed20d8686b9347ca9
parentRename scm to sld (diff)
downloadchicanery-cd90c50267ad3cee1340d891759c5330af566e3d.tar.gz
chicanery-cd90c50267ad3cee1340d891759c5330af566e3d.zip
Support multiple schemes
-rw-r--r--Makefile36
-rw-r--r--chicanery.extras.scm46
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 4NAME = chicanery
5 5
6build: 6default:
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:"
9install: 9 @sed -n 's/^\([^.].*\): *supported.*/- \1/p' Makefile
10 chicken-install
11 10
11.PHONY: clean
12clean: 12clean:
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
18supported:
19
20.PHONY: chicken
21chicken: supported chicanery.egg
22 csi -R chicanery
23
24.PHONY: guile
25guile: supported
26 echo '(import (chicanery))' > /tmp/chicanery.guile-bootstrap
27 guile -L . -l /tmp/chicanery.guile-bootstrap
28
29.PHONY: gambit
30gambit: supported chicanery\#.scm
31 gsi . -e '(import (chicanery))' -
32
33.PHONY: chibi
34chibi: 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)