In version 0.2 you can supply default values for private fields.
Chris Pressey
1 year, 4 months ago
| 10 | 10 | means other than via the defined operations. |
| 11 | 11 | |
| 12 | 12 | The macro is defined in |
| 13 | **[`src/define-opaque-0.1.scm`](src/define-opaque-0.1.scm)**. | |
| 13 | **[`src/define-opaque-0.2.scm`](src/define-opaque-0.2.scm)**. | |
| 14 | 14 | |
| 15 | 15 | The idea is that you'd just copy it into your project and |
| 16 | 16 | `(load "define-opaque.scm")` where you need it. For usage, |
| 27 | 27 | (this name will be visible only to the operations) |
| 28 | 28 | * a list of names for the data items used internally |
| 29 | 29 | (these names will be visible only to the operations) |
| 30 | * a list of the values to be taken on by default by the | |
| 31 | internal names (must match length of previous list) | |
| 30 | 32 | * a list of operations. Each operation is a 2-element |
| 31 | 33 | list, consisting of its name, and a lambda expression |
| 32 | 34 | giving its implementation. |
| 38 | 40 | |
| 39 | 41 | Typically, the opaque data structure that results |
| 40 | 42 | is treated as a "protoype", and one defines an operation |
| 41 | called `new` that provides a way to initialize a new | |
| 42 | instance of the data structure based on some initialization | |
| 43 | parameters. | |
| 43 | called `new` (or similar) that provides a way to initialize | |
| 44 | a new instance of the data structure, possibly based on some | |
| 45 | given initialization parameters. | |
| 44 | 46 | |
| 45 | 47 | If the above description is unclear, the example programs |
| 46 | 48 | in [the `src` directory](src/) may help illuminate the |
| 47 | usage patterns. | |
| 49 | usage patterns: | |
| 48 | 50 | |
| 49 | ### TODO | |
| 50 | ||
| 51 | - [ ] is more than one private field supported? | |
| 52 | - [ ] support supplying initial values for private fields | |
| 51 | * [demo-stack.scm](src/demo-stack.scm) | |
| 52 | * [demo-stack-expanded.scm](src/demo-stack-expanded.scm) | |
| 53 | * [demo-proper-list.scm](src/demo-proper-list.scm) | |
| 53 | 54 | |
| 54 | 55 | [Information Hiding in Scheme]: https://codeberg.org/catseye/The-Dossier/src/branch/master/article/Information-Hiding-in-Scheme/ |
| 0 | (define-syntax opaque-op | |
| 1 | (syntax-rules () | |
| 2 | ((opaque-op (name body) args) | |
| 3 | (apply body args)))) | |
| 4 | ||
| 5 | (define-syntax opaque-ops | |
| 6 | (syntax-rules () | |
| 7 | ((opaque-ops target args ()) | |
| 8 | (begin | |
| 9 | (display "Undefined operation ") (display target) (newline) #f)) | |
| 10 | ((opaque-ops target args (op rest ...)) | |
| 11 | (if (equal? (car 'op) target) (opaque-op op args) (opaque-ops target args (rest ...)))))) | |
| 12 | ||
| 13 | (define-syntax define-opaque | |
| 14 | (syntax-rules () | |
| 15 | ((define-opaque name make-name privs ops) | |
| 16 | (define name | |
| 17 | (letrec | |
| 18 | ( | |
| 19 | (make-name (lambda privs | |
| 20 | (lambda (target . args) | |
| 21 | (opaque-ops target args ops)))) | |
| 22 | ) | |
| 23 | (make-name '())))))) |
| 0 | (define-syntax opaque-op | |
| 1 | (syntax-rules () | |
| 2 | ((opaque-op (name body) args) | |
| 3 | (apply body args)))) | |
| 4 | ||
| 5 | (define-syntax opaque-ops | |
| 6 | (syntax-rules () | |
| 7 | ((opaque-ops target args ()) | |
| 8 | (begin | |
| 9 | (display "Undefined operation ") (display target) (newline) #f)) | |
| 10 | ((opaque-ops target args (op rest ...)) | |
| 11 | (if (equal? (car 'op) target) (opaque-op op args) (opaque-ops target args (rest ...)))))) | |
| 12 | ||
| 13 | (define-syntax define-opaque | |
| 14 | (syntax-rules () | |
| 15 | ((define-opaque name make-name privs priv-defaults ops) | |
| 16 | (define name | |
| 17 | (letrec | |
| 18 | ( | |
| 19 | (make-name (lambda privs | |
| 20 | (lambda (target . args) | |
| 21 | (opaque-ops target args ops)))) | |
| 22 | ) | |
| 23 | (make-name . priv-defaults)))))) |
| 0 | ; usage: csi -q -b demo-proper-list.scm | |
| 1 | ||
| 2 | (load "define-opaque-0.2.scm") | |
| 3 | ||
| 4 | (define-opaque proper-list make-proper-list (selector value) ('nil 0) | |
| 5 | ( | |
| 6 | (proper-list? (lambda () | |
| 7 | #t)) | |
| 8 | (nil (lambda () | |
| 9 | (make-proper-list 'nil 0))) | |
| 10 | (cons (lambda (head-value tail-value) | |
| 11 | ; NB this is not hugely great, as it's a kind of duck-typing. | |
| 12 | (if (tail-value 'proper-list?) | |
| 13 | (make-proper-list 'cons (cons head-value tail-value)) | |
| 14 | (begin (display "Tail is not a proper list: " tail-value) #f)))) | |
| 15 | (repr (lambda () | |
| 16 | (cond | |
| 17 | ((equal? selector 'nil) | |
| 18 | '()) | |
| 19 | ((equal? selector 'cons) | |
| 20 | (let* ((head (car value)) (tail (cdr value))) | |
| 21 | (cons head (tail 'repr))))))) | |
| 22 | ) | |
| 23 | ) | |
| 24 | ||
| 25 | (define demo (lambda () | |
| 26 | (let* ( | |
| 27 | (list0 (proper-list 'cons 123 (proper-list 'cons 456 (proper-list 'nil)))) | |
| 28 | ) | |
| 29 | (display (list0 'repr)) (newline) | |
| 30 | ;(display (proper-list 'cons 123 456)) ; this will error! | |
| 31 | ))) | |
| 32 | ||
| 33 | (demo) |