Initial commit of initial work on R5RS `define-opaque` macro.
Chris Pressey
8 months ago
|
0 |
define-opaque
|
|
1 |
=============
|
|
2 |
|
|
3 |
This is an attempt to write a macro in R5RS Scheme that
|
|
4 |
defines opaque data structures. It is based on the third
|
|
5 |
example given in Information Hiding in Scheme][].
|
|
6 |
|
|
7 |
It is not intended to be suitable for production use. It
|
|
8 |
is, however, intended to properly hide the details of the
|
|
9 |
created data structure, by preventing access to it by any
|
|
10 |
means other than via the defined operations.
|
|
11 |
|
|
12 |
The macro is defined in
|
|
13 |
**[`src/define-opaque.scm`](src/define-opaque.scm)**.
|
|
14 |
|
|
15 |
The idea is that you'd just copy it into your project and
|
|
16 |
`(load "define-opaque.scm")` where you need it. For usage,
|
|
17 |
see the demo files also in [the `src` directory](src/).
|
|
18 |
|
|
19 |
This is an early version of the macro, and its name in
|
|
20 |
the source code is intended to indicate this fact.
|
|
21 |
If at some point it becomes more usable, I will update
|
|
22 |
its name.
|
|
23 |
|
|
24 |
[Information Hiding in Scheme]: https://github.com/cpressey/Information-Hiding-in-Scheme
|
|
0 |
(define-syntax opaque-op
|
|
1 |
(syntax-rules ()
|
|
2 |
((opaque-op (name args body))
|
|
3 |
body)))
|
|
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) (opaque-ops target args (rest ...))))))
|
|
12 |
|
|
13 |
(define-syntax define-opaque-lousy
|
|
14 |
(syntax-rules ()
|
|
15 |
((define-opaque-lousy 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 '(1 2 3)))))))
|
|
0 |
(load "define-opaque.scm")
|
|
1 |
|
|
2 |
(define-opaque-lousy stack make-stack (items)
|
|
3 |
(
|
|
4 |
(push (item)
|
|
5 |
(make-stack (cons item items)))
|
|
6 |
(pop ()
|
|
7 |
(let* ( (item (car items))
|
|
8 |
(new-items (cdr items)) )
|
|
9 |
(cons
|
|
10 |
(make-stack new-items)
|
|
11 |
item)))
|
|
12 |
)
|
|
13 |
)
|
|
14 |
|
|
15 |
(define demo (lambda ()
|
|
16 |
(let* (
|
|
17 |
(result (stack 'pop '()))
|
|
18 |
(stack2 (car result))
|
|
19 |
(item (cdr result))
|
|
20 |
)
|
|
21 |
(display item)
|
|
22 |
(newline)
|
|
23 |
(stack2 'pop '()))))
|