diff options
-rw-r--r-- | .gitignore | 7 | ||||
-rw-r--r-- | COPYING | 10 | ||||
-rw-r--r-- | Makefile | 13 | ||||
-rw-r--r-- | README.md | 14 | ||||
-rw-r--r-- | chicanery.egg | 14 | ||||
-rw-r--r-- | chicanery.extras.scm | 78 | ||||
-rw-r--r-- | chicanery.scm | 87 |
7 files changed, 223 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..07b8758 --- /dev/null +++ b/.gitignore | |||
@@ -0,0 +1,7 @@ | |||
1 | *.sh | ||
2 | *.import.* | ||
3 | *.inline | ||
4 | *.link | ||
5 | *.o | ||
6 | *.so | ||
7 | *.types \ No newline at end of file | ||
diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..ab3d3dc --- /dev/null +++ b/COPYING | |||
@@ -0,0 +1,10 @@ | |||
1 | Copyright (C) Case Duckworth under the terms of the | ||
2 | |||
3 | = = = = = = = = = = = = = GOD WILLING LICENSE v1.0 = = = = = = = = = = = = = = | ||
4 | |||
5 | Permission to use, distribute, modify, or otherwise interact with this software | ||
6 | is up to the good Lord, who in Their wisdom makes all things possible. I really | ||
7 | recommend you take it up with Them whether you should use this software for any reason, including incorporating this software into your project. | ||
8 | |||
9 | This software comes with no warranties from the copyright holder; I cannot speak | ||
10 | for God. | ||
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..38d0ce0 --- /dev/null +++ b/Makefile | |||
@@ -0,0 +1,13 @@ | |||
1 | # chicanery | ||
2 | ## this makefile exists only to ... make ... cleaning up easier, really. | ||
3 | |||
4 | .PHONY: build install clean | ||
5 | |||
6 | build: | ||
7 | chicken-install -n | ||
8 | |||
9 | install: | ||
10 | chicken-install | ||
11 | |||
12 | clean: | ||
13 | rm -f *.sh *.import.* *.inline *.link *.o *.so *.types | ||
diff --git a/README.md b/README.md new file mode 100644 index 0000000..1d5e86b --- /dev/null +++ b/README.md | |||
@@ -0,0 +1,14 @@ | |||
1 | # Chicanery: subtle, opinionated improvements to R7RS in CHICKEN | ||
2 | |||
3 | `chicanery` is my attempt at a prelude module for CHICKEN scheme. It imports and re-exports all `r7rs` modules, using `utf8` where possible, and it corrects a few (in my mind) rough spots in the language, to whit: | ||
4 | |||
5 | - `map`, `for-each`, and `append` are now generalized over lists, vectors, strings, and bytevectors (where appropriate). The list versions of these procedures have been named `list-map`, `list-for-each`, and `list-append` respectively. | ||
6 | - `ref` and `copy` have been defined as generalized functions over the above data types. | ||
7 | |||
8 | ## Todo | ||
9 | |||
10 | - Make sure `set!` works in, like, `(set! (ref 5 '(1 2 3 4 5)) 10)` | ||
11 | |||
12 | ## License | ||
13 | |||
14 | This software is licensed under the GWL, v. 1.0. See COPYING for details. | ||
diff --git a/chicanery.egg b/chicanery.egg new file mode 100644 index 0000000..4fddaec --- /dev/null +++ b/chicanery.egg | |||
@@ -0,0 +1,14 @@ | |||
1 | ;; chicanery -*- scheme -*- | ||
2 | |||
3 | ((synopsis "Subtly breaking scheme expectations.") | ||
4 | (author "Case Duckworth") | ||
5 | (version "0.1.0") | ||
6 | (license "God Willing License") | ||
7 | (category lang-exts) | ||
8 | (dependencies r7rs utf8) | ||
9 | (components | ||
10 | (extension chicanery | ||
11 | (source chicanery.scm) | ||
12 | (types-file) ; I don't know what this does ... | ||
13 | (inline-file) | ||
14 | (csc-options "-X" "r7rs" "-R" "r7rs")))) | ||
diff --git a/chicanery.extras.scm b/chicanery.extras.scm new file mode 100644 index 0000000..24cdff9 --- /dev/null +++ b/chicanery.extras.scm | |||
@@ -0,0 +1,78 @@ | |||
1 | ;;; chicanery extras --- extra stuff from ur old pal acdw | ||
2 | |||
3 | (export list-map list-for-each list-append) | ||
4 | |||
5 | ;; Generalized map, for-each, ... | ||
6 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work | ||
7 | ;; with any (default) datatype. TODO: generalize? | ||
8 | (define list-map map) | ||
9 | (define list-for-each for-each) | ||
10 | (define list-append append) | ||
11 | |||
12 | (define (map proc . collections) | ||
13 | (let ((first (car collections))) ; we only need to check the first one | ||
14 | (cond | ||
15 | ((list? first) | ||
16 | (apply list-map proc collections)) | ||
17 | ((vector? first) | ||
18 | (apply vector-map proc collections)) | ||
19 | ((string? first) | ||
20 | (apply string-map proc collections)) | ||
21 | (else (error "Bad datatype" first))))) | ||
22 | |||
23 | (define (for-each proc . collections) | ||
24 | (let ((first (car collections))) ; we only need to check the first one | ||
25 | (cond | ||
26 | ((list? first) | ||
27 | (apply list-for-each proc collections)) | ||
28 | ((vector? first) | ||
29 | (apply vector-for-each proc collections)) | ||
30 | ((string? first) | ||
31 | (apply string-for-each proc collections)) | ||
32 | (else (error "Bad datatype" first))))) | ||
33 | |||
34 | (define (append . collections) | ||
35 | (let ((first (car collections))) ; we only need to check the first one | ||
36 | (cond | ||
37 | ((list? first) | ||
38 | (apply list-append collections)) | ||
39 | ((vector? first) | ||
40 | (apply vector-append collections)) | ||
41 | ((string? first) | ||
42 | (apply string-append collections)) | ||
43 | ((bytevector? first) | ||
44 | (apply bytevector-append collections)) | ||
45 | (else (error "Bad datatype" first))))) | ||
46 | |||
47 | (export ref copy) | ||
48 | |||
49 | ;; Extended generic functions. | ||
50 | ;; These functions already have a list- version defined, but no non-prefixed | ||
51 | ;; one. So I'm fixing that. | ||
52 | (define (ref collection k) | ||
53 | (cond | ||
54 | ((list? collection) | ||
55 | (list-ref collection k)) | ||
56 | ((vector? collection) | ||
57 | (vector-ref collection k)) | ||
58 | ((string? collection) | ||
59 | (string-ref collection k)) | ||
60 | ((bytevector? collection) | ||
61 | (bytevector-u8-ref collection k)) | ||
62 | (else (error "Bad datatype" collection)))) | ||
63 | |||
64 | ;; I'm not going to generalize -copy! because I don't think it's a great idea, | ||
65 | ;; really. | ||
66 | (define (copy collection) | ||
67 | (cond | ||
68 | ((list? collection) | ||
69 | (list-copy collection)) | ||
70 | ((vector? collection) | ||
71 | (vector-copy collection)) | ||
72 | ((string? collection) | ||
73 | (string-copy collection)) | ||
74 | ((bytevector? collection) | ||
75 | (bytevector-copy collection)) | ||
76 | (else (error "Bad datatype" collection)))) | ||
77 | |||
78 | ;; TODO: look at set! semantics -- generalizable? | ||
diff --git a/chicanery.scm b/chicanery.scm new file mode 100644 index 0000000..a46cd91 --- /dev/null +++ b/chicanery.scm | |||
@@ -0,0 +1,87 @@ | |||
1 | ;;; chicanery --- subtly breaking scheme expectations | ||
2 | |||
3 | (import (r7rs)) | ||
4 | |||
5 | (define-library chicanery | ||
6 | ;; All the scheme stuff in one place | ||
7 | (import (scheme base)) | ||
8 | (import (scheme case-lambda)) | ||
9 | (import (scheme char)) | ||
10 | (import (scheme complex)) | ||
11 | (import (scheme cxr)) | ||
12 | (import (scheme eval)) | ||
13 | (import (scheme file)) | ||
14 | (import (scheme inexact)) | ||
15 | (import (scheme lazy)) | ||
16 | (import (scheme load)) | ||
17 | (import (scheme process-context)) | ||
18 | (import (scheme read)) | ||
19 | (import (scheme repl)) | ||
20 | (import (scheme time)) | ||
21 | (import (scheme write)) | ||
22 | (import (utf8)) | ||
23 | (export * + - / <= < >= = > abs and append apply assoc assq assv begin | ||
24 | binary-port? boolean? boolean=? bytevector bytevector-append | ||
25 | bytevector-copy bytevector-copy! bytevector-length bytevector-u8-ref | ||
26 | bytevector-u8-set! bytevector? car cdr caar cadr cdar cddr | ||
27 | call-with-current-continuation call/cc call-with-port call-with-values | ||
28 | case ceiling char-ready? char->integer integer->char char=? char<? | ||
29 | char>? char<=? char>=? char? close-input-port close-output-port | ||
30 | close-port complex? cond cond-expand cons current-input-port | ||
31 | current-output-port current-error-port define define-record-type | ||
32 | define-syntax define-values denominator numerator do dynamic-wind | ||
33 | eof-object eof-object? eq? eqv? equal? error error-object-irritants | ||
34 | error-object-message error-object? even? odd? exact inexact | ||
35 | exact-integer-sqrt exact-integer? exact? inexact? exp expt features | ||
36 | file-error? floor floor/ floor-quotient floor-remainder | ||
37 | flush-output-port for-each gcd lcm get-output-bytevector | ||
38 | get-output-string guard if import import-for-syntax include include-ci | ||
39 | input-port-open? output-port-open? input-port? output-port? integer? | ||
40 | lambda length let let* letrec letrec* let-values let*-values let-syntax | ||
41 | letrec-syntax list list-copy list-ref list-set! list-tail list? | ||
42 | list->vector make-bytevector make-list make-parameter make-string | ||
43 | make-vector map max min member memq memv modulo remainder negative? | ||
44 | positive? newline not null? number->string string->number number? | ||
45 | open-input-bytevector open-output-bytevector open-input-string | ||
46 | open-output-string or pair? parameterize peek-char peek-u8 port? | ||
47 | procedure? quasiquote quote quotient remainder raise raise-continuable | ||
48 | rational? rationalize read-bytevector read-bytevector! read-char | ||
49 | read-error? read-line read-string read-u8 real? reverse round set! | ||
50 | set-car! set-cdr! square string string->list list->string string->utf8 | ||
51 | utf8->string string->symbol symbol->string string->vector | ||
52 | string-append string-copy string-copy! string-fill! string-for-each | ||
53 | string-length string-map string-ref string-set! string=? string<? | ||
54 | string>? string<=? string>=? string? substring symbol=? symbol? | ||
55 | syntax-error syntax-rules textual-port? truncate truncate/ | ||
56 | truncate-quotient truncate-remainder u8-ready? unless #;unquote | ||
57 | #;unquote-splicing values vector vector-append vector-copy vector-copy! | ||
58 | vector-fill! vector-for-each vector-length vector-map vector-ref | ||
59 | vector-set! vector->list vector->string vector? when | ||
60 | with-exception-handler write-bytevector write-char write-string | ||
61 | write-u8 zero?) | ||
62 | (export case-lambda) | ||
63 | (export char-alphabetic? char-ci<=? char-ci<? char-ci=? char-ci>=? | ||
64 | char-ci>? char-downcase char-foldcase char-lower-case? char-numeric? | ||
65 | char-upcase char-upper-case? char-whitespace? digit-value string-ci<=? | ||
66 | string-ci<? string-ci=? string-ci>=? string-ci>? string-downcase | ||
67 | string-foldcase string-upcase) | ||
68 | (export angle imag-part magnitude make-polar make-rectangular real-part) | ||
69 | (export caaaar caaadr caaar caadar caaddr caadr cadaar cadadr cadar caddar | ||
70 | cadddr caddr cdaaar cdaadr cdaar cdadar cdaddr cdadr cddaar cddadr | ||
71 | cddar cdddar cddddr cdddr) | ||
72 | (export environment eval) | ||
73 | (export call-with-input-file call-with-output-file delete-file file-exists? | ||
74 | open-binary-input-file open-binary-output-file open-input-file | ||
75 | open-output-file with-input-from-file with-output-to-file) | ||
76 | (export acos asin atan cos exp finite? infinite? log nan? sin sqrt tan) | ||
77 | (export delay delay-force force make-promise promise?) | ||
78 | (export load) | ||
79 | (export command-line emergency-exit exit get-environment-variable | ||
80 | get-environment-variables) | ||
81 | (export read) | ||
82 | (export interaction-environment) | ||
83 | (export current-jiffy current-second jiffies-per-second) | ||
84 | (export display write write-shared write-simple) | ||
85 | |||
86 | (include "chicanery.extras.scm")) | ||
87 | |||