Get passing arguments to the operations working.
Chris Pressey
8 months ago
0 | 0 |
(define-syntax opaque-op
|
1 | 1 |
(syntax-rules ()
|
2 | |
((opaque-op (name args body))
|
3 | |
body)))
|
|
2 |
((opaque-op (name body) args)
|
|
3 |
(body args))))
|
4 | 4 |
|
5 | 5 |
(define-syntax opaque-ops
|
6 | 6 |
(syntax-rules ()
|
|
8 | 8 |
(begin
|
9 | 9 |
(display "Undefined operation ") (display target) (newline) #f))
|
10 | 10 |
((opaque-ops target args (op rest ...))
|
11 | |
(if (equal? (car 'op) target) (opaque-op op) (opaque-ops target args (rest ...))))))
|
|
11 |
(if (equal? (car 'op) target) (opaque-op op args) (opaque-ops target args (rest ...))))))
|
12 | 12 |
|
13 | 13 |
(define-syntax define-opaque-lousy
|
14 | 14 |
(syntax-rules ()
|
|
0 |
; usage: csi -q -b demo.scm
|
|
1 |
|
0 | 2 |
(load "define-opaque.scm")
|
1 | 3 |
|
2 | 4 |
(define-opaque-lousy stack make-stack (items)
|
3 | 5 |
(
|
4 | |
(push (item)
|
5 | |
(make-stack (cons item items)))
|
6 | |
(pop ()
|
|
6 |
(push (lambda (args)
|
|
7 |
(make-stack (cons (car args) items))))
|
|
8 |
(pop (lambda (args)
|
7 | 9 |
(let* ( (item (car items))
|
8 | 10 |
(new-items (cdr items)) )
|
9 | 11 |
(cons
|
10 | 12 |
(make-stack new-items)
|
11 | |
item)))
|
|
13 |
item))))
|
12 | 14 |
)
|
13 | 15 |
)
|
14 | 16 |
|
|
17 | 19 |
(result (stack 'pop '()))
|
18 | 20 |
(stack2 (car result))
|
19 | 21 |
(item (cdr result))
|
|
22 |
(stack3 (stack2 'push '(9)))
|
20 | 23 |
)
|
21 | 24 |
(display item)
|
22 | 25 |
(newline)
|
23 | |
(stack2 'pop '()))))
|
|
26 |
(display (stack2 'pop '()))
|
|
27 |
(newline)
|
|
28 |
(display (stack3 'pop '()))
|
|
29 |
(newline)
|
|
30 |
)))
|
|
31 |
|
|
32 |
(demo)
|