git @ Cat's Eye Technologies define-opaque / 1a829b9
Get passing arguments to the operations working. Chris Pressey 8 months ago
2 changed file(s) with 17 addition(s) and 8 deletion(s). Raw diff Collapse all Expand all
00 (define-syntax opaque-op
11 (syntax-rules ()
2 ((opaque-op (name args body))
3 body)))
2 ((opaque-op (name body) args)
3 (body args))))
44
55 (define-syntax opaque-ops
66 (syntax-rules ()
88 (begin
99 (display "Undefined operation ") (display target) (newline) #f))
1010 ((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 ...))))))
1212
1313 (define-syntax define-opaque-lousy
1414 (syntax-rules ()
0 ; usage: csi -q -b demo.scm
1
02 (load "define-opaque.scm")
13
24 (define-opaque-lousy stack make-stack (items)
35 (
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)
79 (let* ( (item (car items))
810 (new-items (cdr items)) )
911 (cons
1012 (make-stack new-items)
11 item)))
13 item))))
1214 )
1315 )
1416
1719 (result (stack 'pop '()))
1820 (stack2 (car result))
1921 (item (cdr result))
22 (stack3 (stack2 'push '(9)))
2023 )
2124 (display item)
2225 (newline)
23 (stack2 'pop '()))))
26 (display (stack2 'pop '()))
27 (newline)
28 (display (stack3 'pop '()))
29 (newline)
30 )))
31
32 (demo)