author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Wed, 16 Jan 2019 17:15:58 +0000 | |
changeset 438 | 1fe179d53161 |
parent 223 | 646d45b098aa |
permissions | -rw-r--r-- |
223
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
(define *debug-level* 0) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2 |
(define *debug-indent* 0) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
3 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
(define (external-representation o) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
(let ((p (open-output-string))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
(write o p) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
(get-output-string p))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
(define (fold-left/index fn acc lis) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
(let loop ((index 0) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
(lis lis) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
(acc acc)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
13 |
(if (null? lis) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
14 |
acc |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
(loop (+ index 1) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
(cdr lis) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
(fn index (car lis) acc))))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
19 |
(define (for-each/index fn lis) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
20 |
(let loop ((index 0) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
21 |
(lis lis)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
22 |
(unless (null? lis) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
23 |
(fn index (car lis)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
24 |
(loop (+ index 1) (cdr lis))))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
25 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
26 |
(define (describe-object o . pretty) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
27 |
(let ((description (map (lambda (entry) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
28 |
(let ((key (car entry)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
29 |
(val (cdr entry))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
30 |
(list (slot-name val) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
(slot-index val) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
(slot-delegating? val) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
(slot-kind val) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
(map (lambda (role) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
(list (role-positions role) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
(role-requirements role) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
37 |
(role-method role))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
38 |
(slot-roles val))))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
39 |
(hash-table->list (object-layout o))))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
40 |
(if (or (null? pretty) (car pretty)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
41 |
(pretty-print description)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
description)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
43 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
44 |
(define (send/previous-method/missing-handler previous-method missing-handler selector argv) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
(let* ((method (dispatch previous-method selector argv))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
46 |
(debug 2 --> 0 "Dispatching to method "method) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
47 |
(if method |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
(let ((code (get-slot method 'code))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
(if (procedure? code) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
50 |
(apply code method (vector->list argv)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
51 |
(metalevel-eval-method code method argv))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
52 |
(missing-handler argv)))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
53 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
54 |
(define (send/previous-method previous-method selector argv) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
55 |
(send/previous-method/missing-handler previous-method |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
56 |
(lambda (argv) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
57 |
(send/previous-method/missing-handler |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
58 |
#f |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
59 |
(lambda (inner-argv) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
60 |
(error "Dispatch failed" |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
61 |
`(send ,selector ,@(vector->list argv)))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
62 |
'notFoundOn: |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
63 |
(vector selector argv))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
64 |
selector |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
65 |
argv)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
66 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
67 |
(define (run-hooks! hooklist) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
68 |
(for-each (lambda (hook) (hook)) (reverse hooklist))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
69 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
70 |
(define (curry f . vs) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
71 |
(lambda rest |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
72 |
(apply f (append vs rest)))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
73 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
74 |
(define (non-*false*? x) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
75 |
(if (eq? x *false*) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
76 |
#f |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
77 |
x)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
78 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
79 |
(define (*false*? x) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
80 |
(eq? x *false*)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
81 |
|
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
82 |
(define (vector-fold fn seed v) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
83 |
(let ((len (vector-length v))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
84 |
(do ((i 0 (+ i 1)) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
85 |
(seed seed (fn (vector-ref v i) seed))) |
646d45b098aa
During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
86 |
((= i len) seed)))) |