├── distr
    ├── code2.pro.o
    ├── code.ch1.o
    ├── code.ch1
    ├── code1.pro.o
    ├── code.clu.o
    ├── ERRATA
    ├── TEST.INTERPS
    ├── code2.pro
    ├── code1.pro
    ├── code.lsp.o
    ├── code.refcnt.o
    ├── code.stack.o
    ├── code.ssgc.o
    ├── code.msgc.o
    ├── code.ssl.o
    ├── code.smt.o
    ├── code.apl
    ├── code.apl.o
    ├── code.sch.o
    ├── code.clu
    ├── code.ssl
    └── code.gc.lsp
├── C-distr
    ├── code2.pro.out
    ├── code.ch1.out
    ├── code.ch1
    ├── Makefile
    ├── code1.pro.out
    ├── code.clu.out
    ├── code2.pro
    ├── README
    ├── code1.pro
    ├── code.lsp.out
    ├── code.ssl.out
    ├── code.smt.out
    ├── code.apl
    ├── code.apl.out
    ├── code.sch.out
    ├── p2c
    │   └── p2c.h
    ├── code.clu
    └── code.ssl
├── README
├── index.html
└── errata.txt


/distr/code2.pro.o:
--------------------------------------------------------------------------------
 1 | -> -> -> -> 
 2 | -> 
 3 | -> -> 
 4 | -> 
 5 | -> 
 6 | -> -> 
 7 | -> 
 8 | -> 
 9 | -> 
10 | -> 
11 | -> 
12 | -> 
13 | -> 
14 | -> -> 
15 | -> > 
16 | -> -> 
17 | -> -> 
18 | -> > 
19 | -> -> > > > > 
20 | -> > > > > > > > 
21 | -> -> > 
22 | -> > 
23 | -> -> 
24 | -> > 
25 | -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> > 
26 | -> -> 
27 | -> > > > > > 
28 | -> -> > 
29 | -> > 
30 | -> > 
31 | -> 
32 | -> 
33 | -> > 
34 | (cons (move c a table) (cons (move a b table) (cons (move b table c) (cons (move a table b) nil))))
35 | Satisfied
36 | 
37 | -> > 
38 | (cons (move c a table) (cons (move a b table) (cons (move b table c) (cons (move a table b) nil))))
39 | Satisfied
40 | 
41 | -> 


--------------------------------------------------------------------------------
/C-distr/code2.pro.out:
--------------------------------------------------------------------------------
 1 | -> -> -> -> 
 2 | -> 
 3 | -> -> 
 4 | -> 
 5 | -> 
 6 | -> -> 
 7 | -> 
 8 | -> 
 9 | -> 
10 | -> 
11 | -> 
12 | -> 
13 | -> 
14 | -> -> 
15 | -> > 
16 | -> -> 
17 | -> -> 
18 | -> > 
19 | -> -> > > > > 
20 | -> > > > > > > > 
21 | -> -> > 
22 | -> > 
23 | -> -> 
24 | -> > 
25 | -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> > 
26 | -> -> 
27 | -> > > > > > 
28 | -> -> > 
29 | -> > 
30 | -> > 
31 | -> 
32 | -> 
33 | -> > 
34 | (cons (move c a table) (cons (move a b table) (cons (move b table c) (cons (move a table b) nil))))
35 | Satisfied
36 | 
37 | -> > 
38 | (cons (move c a table) (cons (move a b table) (cons (move b table c) (cons (move a table b) nil))))
39 | Satisfied
40 | 
41 | -> 


--------------------------------------------------------------------------------
/distr/code.ch1.o:
--------------------------------------------------------------------------------
 1 | -> 3
 2 | 
 3 | -> 3
 4 | 
 5 | -> 11
 6 | 
 7 | -> 11
 8 | 
 9 | -> 4
10 | 
11 | -> 4
12 | 
13 | -> 8
14 | 
15 | -> 8
16 | 
17 | -> 4
18 | 4
19 | 
20 | -> 4
21 | 
22 | -> 4
23 | 
24 | -> 5
25 | 
26 | -> 5
27 | 
28 | -> 4
29 | 5
30 | 20
31 | 
32 | -> 4
33 | 
34 | -> 5
35 | 
36 | -> 20
37 | 
38 | -> 5
39 | 
40 | -> 5
41 | 
42 | -> > 0
43 | 
44 | -> 0
45 | 
46 | -> 128
47 | 
48 | -> 128
49 | 
50 | -> +1
51 | -> 5
52 | 
53 | -> 5
54 | 
55 | -> double
56 | -> 8
57 | 
58 | -> 8
59 | 
60 | -> 128
61 | 
62 | -> 128
63 | 
64 | -> setx
65 | -> 129
66 | 
67 | -> 129
68 | 
69 | -> 128
70 | 
71 | -> 128
72 | 
73 | -> not
74 | -> <>
75 | -> mod
76 | -> > > > > > > > > gcd
77 | -> 3
78 | 
79 | -> 3
80 | 
81 | -> > gcd
82 | -> 3
83 | 
84 | -> 3
85 | 
86 | -> 


--------------------------------------------------------------------------------
/C-distr/code.ch1.out:
--------------------------------------------------------------------------------
 1 | -> 3
 2 | 
 3 | -> 3
 4 | 
 5 | -> 11
 6 | 
 7 | -> 11
 8 | 
 9 | -> 4
10 | 
11 | -> 4
12 | 
13 | -> 8
14 | 
15 | -> 8
16 | 
17 | -> 4
18 | 4
19 | 
20 | -> 4
21 | 
22 | -> 4
23 | 
24 | -> 5
25 | 
26 | -> 5
27 | 
28 | -> 4
29 | 5
30 | 20
31 | 
32 | -> 4
33 | 
34 | -> 5
35 | 
36 | -> 20
37 | 
38 | -> 5
39 | 
40 | -> 5
41 | 
42 | -> > 0
43 | 
44 | -> 0
45 | 
46 | -> 128
47 | 
48 | -> 128
49 | 
50 | -> +1
51 | -> 5
52 | 
53 | -> 5
54 | 
55 | -> double
56 | -> 8
57 | 
58 | -> 8
59 | 
60 | -> 128
61 | 
62 | -> 128
63 | 
64 | -> setx
65 | -> 129
66 | 
67 | -> 129
68 | 
69 | -> 128
70 | 
71 | -> 128
72 | 
73 | -> not
74 | -> <>
75 | -> mod
76 | -> > > > > > > > > gcd
77 | -> 3
78 | 
79 | -> 3
80 | 
81 | -> > gcd
82 | -> 3
83 | 
84 | -> 3
85 | 
86 | -> 


--------------------------------------------------------------------------------
/distr/code.ch1:
--------------------------------------------------------------------------------
 1 | 3
 2 | 3
 3 | (+ 4 7)
 4 | 11
 5 | (set x 4)
 6 | 4
 7 | (+ x x)
 8 | 8
 9 | (print x)
10 |   4
11 | 4
12 | (set y 5)
13 | 5
14 | (begin (print x) (print y) (* x y))
15 |   4
16 |   5
17 | 20
18 | (if (> y 0) 5 10)
19 | 5
20 | (while (> y 0)
21 |     (begin (set x (+ x x)) (set y (- y 1))))
22 | 0
23 | x
24 | 128
25 | (define +1 (x) (+ x 1))
26 | (+1 4)
27 | 5
28 | (define double (x) (+ x x))
29 | (double 4)
30 | 8
31 | x
32 | 128
33 | (define setx (x y) (begin (set x (+ x y)) x))
34 | (setx x 1)
35 | 129
36 | x
37 | 128
38 | (define not (boolval) (if boolval 0 1))
39 | (define <> (x y) (not (= x y)))
40 | (define mod (m n) (- m (* n (/ m n))))
41 | (define gcd (m n)
42 |       (begin
43 |           (set r (mod m n))
44 |           (while (<> r 0)
45 |                (begin
46 |                     (set m n)
47 |                     (set n r)
48 |                     (set r (mod m n))))
49 |           n))
50 | (gcd 6 15)
51 | 3
52 | (define gcd (m n)
53 |       (if (= n 0) m (gcd n (mod m n))))
54 | (gcd 6 15)
55 | 3
56 | quit
57 | 


--------------------------------------------------------------------------------
/C-distr/code.ch1:
--------------------------------------------------------------------------------
 1 | 3
 2 | 3
 3 | (+ 4 7)
 4 | 11
 5 | (set x 4)
 6 | 4
 7 | (+ x x)
 8 | 8
 9 | (print x)
10 |   4
11 | 4
12 | (set y 5)
13 | 5
14 | (begin (print x) (print y) (* x y))
15 |   4
16 |   5
17 | 20
18 | (if (> y 0) 5 10)
19 | 5
20 | (while (> y 0)
21 |     (begin (set x (+ x x)) (set y (- y 1))))
22 | 0
23 | x
24 | 128
25 | (define +1 (x) (+ x 1))
26 | (+1 4)
27 | 5
28 | (define double (x) (+ x x))
29 | (double 4)
30 | 8
31 | x
32 | 128
33 | (define setx (x y) (begin (set x (+ x y)) x))
34 | (setx x 1)
35 | 129
36 | x
37 | 128
38 | (define not (boolval) (if boolval 0 1))
39 | (define <> (x y) (not (= x y)))
40 | (define mod (m n) (- m (* n (/ m n))))
41 | (define gcd (m n)
42 |       (begin
43 |           (set r (mod m n))
44 |           (while (<> r 0)
45 |                (begin
46 |                     (set m n)
47 |                     (set n r)
48 |                     (set r (mod m n))))
49 |           n))
50 | (gcd 6 15)
51 | 3
52 | (define gcd (m n)
53 |       (if (= n 0) m (gcd n (mod m n))))
54 | (gcd 6 15)
55 | 3
56 | quit
57 | 


--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
 1 | The directory distr contains the code associated with the book
 2 | "Programming Languages: An Interpreter-based Approach," by Sam Kamin.
 3 | Please report problems to:
 4 | 
 5 | 	Sam Kamin			kamin@cs.uiuc.edu
 6 |         Computer Science Dept.		(217) 333-8069
 7 |         1304 W. Springfield
 8 |         Urbana, IL 61801
 9 | 
10 | The directory can be obtained either by copying the file distr.tar.Z,
11 | then uncompressing and de-tar'ing, or by copying the files directly
12 | out of the distr directory.  If copying the .Z file, be sure to set
13 | the "binary" flag.
14 | 
15 | The contents of the distr directory are fully explained in its
16 | README file.  That directory also includes a file ERRATA.  It lists all
17 | known substantive errors in the text.  (Further contributions are always
18 | welcome.)
19 | 
20 | The directory C-distr contains C versions of all of the interpreters
21 | except those from Chapter 10 (various versions of garbage-
22 | collection).  These were obtained automatically by using the
23 | Pascal-to-C translator p2c.  It is recommended that these be used
24 | only if a Pascal compiler is unavailable.  The contents of the
25 | C-distr directory are explained in its README file.
26 | 
27 | --
28 | Source:
29 | http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/impl/kamin/0.html
30 | 


--------------------------------------------------------------------------------
/C-distr/Makefile:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | CFLAGS	=-I.
 4 | LIBS	= p2c/p2clib.o
 5 | TARFILE	=/usr/ftp/pub/kamin-c.tar
 6 | 
 7 | GOALS	= chap1 lisp apl sasl scheme clu smalltalk prolog
 8 | 
 9 | goal:	$(GOALS)
10 | 	@echo done
11 | 
12 | clean:
13 | 	rm -f $(GOALS) *.o test.*.out p2c/*.o
14 | 
15 | tar:	clean
16 | 	tar crf $(TARFILE) .
17 | 	compress $(TARFILE)
18 | 
19 | p2c/p2clib.o: p2c/p2clib.c p2c/p2c.h
20 | 	$(CC) $(CFLAGS) -o p2c/p2clib.o -c p2c/p2clib.c
21 | 
22 | chap1: chap1.c $(LIBS)
23 | 	$(CC) $(CFLAGS) -o chap1 chap1.c $(LIBS)
24 | 	chap1 < code.ch1 > test.ch1.out
25 | 	diff -c test.ch1.out code.ch1.out
26 | 	rm -f test.*.out
27 | 
28 | lisp: lisp.c $(LIBS)
29 | 	$(CC) $(CFLAGS) -o lisp lisp.c $(LIBS)
30 | 	lisp < code.lsp > test.lsp.out
31 | 	diff -c test.lsp.out code.lsp.out
32 | 	rm -f test.*.out
33 | 
34 | apl: apl.c $(LIBS)
35 | 	$(CC) $(CFLAGS) -o apl apl.c $(LIBS)
36 | 	apl < code.apl > test.apl.out
37 | 	diff -c test.apl.out code.apl.out
38 | 	rm -f test.*.out
39 | 
40 | clu: clu.c $(LIBS)
41 | 	$(CC) $(CFLAGS) -o clu clu.c $(LIBS)
42 | 	clu < code.clu > test.clu.out
43 | 	diff -c test.clu.out code.clu.out
44 | 	rm -f test.*.out
45 | 
46 | scheme: scheme.c $(LIBS)
47 | 	$(CC) $(CFLAGS) -o scheme scheme.c $(LIBS)
48 | 	scheme < code.sch > test.sch.out
49 | 	diff -c test.sch.out code.sch.out
50 | 	rm -f test.*.out
51 | 
52 | smalltalk: smalltalk.c $(LIBS)
53 | 	$(CC) $(CFLAGS) -o smalltalk smalltalk.c $(LIBS)
54 | 	smalltalk < code.smt > test.smt.out
55 | 	diff -c test.smt.out code.smt.out
56 | 	rm -f test.*.out
57 | 
58 | sasl: sasl.c $(LIBS)
59 | 	$(CC) $(CFLAGS) -o sasl sasl.c $(LIBS)
60 | 	sasl < code.ssl > test.ssl.out
61 | 	diff -c test.ssl.out code.ssl.out
62 | 	rm -f test.*.out
63 | 
64 | prolog: prolog.c $(LIBS)
65 | 	$(CC) $(CFLAGS) -o prolog prolog.c $(LIBS)
66 | 	prolog < code1.pro > test.pro.out
67 | 	diff -c test.pro.out code1.pro.out
68 | 	prolog < code2.pro > test.pro.out
69 | 	diff -c test.pro.out code2.pro.out
70 | 	rm -f test.*.out
71 | 
72 | .p.c:
73 | 	p2c $*.p
74 | 


--------------------------------------------------------------------------------
/distr/code1.pro.o:
--------------------------------------------------------------------------------
  1 | -> -> 
  2 | -> 
  3 | -> 
  4 | -> 
  5 | -> 
  6 | -> 
  7 | -> -> > > > 
  8 | -> 
  9 | Satisfied
 10 | 
 11 | -> 
 12 | 
 13 | Satisfied
 14 | 
 15 | -> 
 16 | yellow blue red blue yellow blue
 17 | Satisfied
 18 | 
 19 | -> 
 20 | yellow blue red blue yellow blue
 21 | Satisfied
 22 | 
 23 | -> -> 
 24 | -> 
 25 | -> 
 26 | Satisfied
 27 | 
 28 | -> 
 29 | 
 30 | Satisfied
 31 | 
 32 | -> 
 33 | Not satisfied
 34 | 
 35 | -> 
 36 | Not satisfied
 37 | 
 38 | -> -> 
 39 | -> 
 40 | -> 
 41 | -> 
 42 | -> 
 43 | Satisfied
 44 | 
 45 | -> 
 46 | 
 47 | Satisfied
 48 | 
 49 | -> 
 50 | -> 
 51 | -> 
 52 | -> 
 53 | Satisfied
 54 | 
 55 | -> 
 56 | 
 57 | Satisfied
 58 | 
 59 | -> 
 60 | -> 
 61 | -> -> 
 62 | -> 
 63 | -> 
 64 | (cons 3 (cons 4 nil))
 65 | Satisfied
 66 | 
 67 | -> 
 68 | (cons 3 (cons 4 nil))
 69 | Satisfied
 70 | 
 71 | -> 
 72 | (cons 3 nil)
 73 | Satisfied
 74 | 
 75 | -> 
 76 | (cons 3 nil)
 77 | Satisfied
 78 | 
 79 | -> -> 
 80 | -> 
 81 | -> 
 82 | (cons 2 (cons 1 nil))
 83 | Satisfied
 84 | 
 85 | -> 
 86 | (cons 2 (cons 1 nil))
 87 | Satisfied
 88 | 
 89 | -> 
 90 | (cons 2 (cons 1 nil))
 91 | Satisfied
 92 | 
 93 | -> 
 94 | (cons 2 (cons 1 nil))
 95 | Satisfied
 96 | 
 97 | -> -> 
 98 | -> 
 99 | -> 
100 | (cons 3 nil)
101 | Satisfied
102 | 
103 | -> 
104 | (cons 3 nil)
105 | Satisfied
106 | 
107 | -> > 
108 | (cons 3 (cons 4 (cons 5 (cons 6 nil))))
109 | Satisfied
110 | 
111 | -> 
112 | (cons 3 (cons 4 (cons 5 (cons 6 nil))))
113 | Satisfied
114 | 
115 | -> > 
116 | (cons 5 nil)
117 | Satisfied
118 | 
119 | -> 
120 | (cons 5 nil)
121 | Satisfied
122 | 
123 | -> -> 
124 | -> 
125 | -> 
126 | -> 
127 | lima
128 | Satisfied
129 | 
130 | -> 
131 | lima
132 | Satisfied
133 | 
134 | -> -> 
135 | -> 
136 | -> 
137 | 15
138 | Satisfied
139 | 
140 | -> 
141 | 15
142 | Satisfied
143 | 
144 | -> 
145 | -> 
146 | -> 
147 | -> 
148 | -> 
149 | -> 
150 | -> -> 
151 | -> 
152 | -> 
153 | -> -> 
154 | -> > 
155 | -> -> 
156 | -> 
157 | (cons 2 (cons 3 (cons 4 nil)))
158 | Satisfied
159 | 
160 | -> 
161 | (cons 2 (cons 3 (cons 4 nil)))
162 | Satisfied
163 | 
164 | -> -> 
165 | -> 
166 | -> 
167 | -> -> 
168 | -> > > > > > 
169 | -> > 
170 | (cons 1 (cons 2 (cons 3 (cons 7 (cons 8 nil)))))
171 | Satisfied
172 | 
173 | -> 
174 | (cons 1 (cons 2 (cons 3 (cons 7 (cons 8 nil)))))
175 | Satisfied
176 | 
177 | -> -> 
178 | -> 
179 | -> 
180 | (cons 3 (cons 4 nil))
181 | Satisfied
182 | 
183 | -> 
184 | (cons 3 (cons 4 nil))
185 | Satisfied
186 | 
187 | -> 
188 | (diff (cons 3 (cons 4 Z1)) Z1)
189 | Satisfied
190 | 
191 | -> 
192 | (diff (cons 3 (cons 4 Z1)) Z1)
193 | Satisfied
194 | 
195 | -> 
196 | -> > 
197 | (diff (cons 3 (cons 4 Y)) Y)
198 | Satisfied
199 | 
200 | -> 
201 | (diff (cons 3 (cons 4 Y)) Y)
202 | Satisfied
203 | 
204 | -> 


--------------------------------------------------------------------------------
/C-distr/code1.pro.out:
--------------------------------------------------------------------------------
  1 | -> -> 
  2 | -> 
  3 | -> 
  4 | -> 
  5 | -> 
  6 | -> 
  7 | -> -> > > > 
  8 | -> 
  9 | Satisfied
 10 | 
 11 | -> 
 12 | 
 13 | Satisfied
 14 | 
 15 | -> 
 16 | yellow blue red blue yellow blue
 17 | Satisfied
 18 | 
 19 | -> 
 20 | yellow blue red blue yellow blue
 21 | Satisfied
 22 | 
 23 | -> -> 
 24 | -> 
 25 | -> 
 26 | Satisfied
 27 | 
 28 | -> 
 29 | 
 30 | Satisfied
 31 | 
 32 | -> 
 33 | Not satisfied
 34 | 
 35 | -> 
 36 | Not satisfied
 37 | 
 38 | -> -> 
 39 | -> 
 40 | -> 
 41 | -> 
 42 | -> 
 43 | Satisfied
 44 | 
 45 | -> 
 46 | 
 47 | Satisfied
 48 | 
 49 | -> 
 50 | -> 
 51 | -> 
 52 | -> 
 53 | Satisfied
 54 | 
 55 | -> 
 56 | 
 57 | Satisfied
 58 | 
 59 | -> 
 60 | -> 
 61 | -> -> 
 62 | -> 
 63 | -> 
 64 | (cons 3 (cons 4 nil))
 65 | Satisfied
 66 | 
 67 | -> 
 68 | (cons 3 (cons 4 nil))
 69 | Satisfied
 70 | 
 71 | -> 
 72 | (cons 3 nil)
 73 | Satisfied
 74 | 
 75 | -> 
 76 | (cons 3 nil)
 77 | Satisfied
 78 | 
 79 | -> -> 
 80 | -> 
 81 | -> 
 82 | (cons 2 (cons 1 nil))
 83 | Satisfied
 84 | 
 85 | -> 
 86 | (cons 2 (cons 1 nil))
 87 | Satisfied
 88 | 
 89 | -> 
 90 | (cons 2 (cons 1 nil))
 91 | Satisfied
 92 | 
 93 | -> 
 94 | (cons 2 (cons 1 nil))
 95 | Satisfied
 96 | 
 97 | -> -> 
 98 | -> 
 99 | -> 
100 | (cons 3 nil)
101 | Satisfied
102 | 
103 | -> 
104 | (cons 3 nil)
105 | Satisfied
106 | 
107 | -> > 
108 | (cons 3 (cons 4 (cons 5 (cons 6 nil))))
109 | Satisfied
110 | 
111 | -> 
112 | (cons 3 (cons 4 (cons 5 (cons 6 nil))))
113 | Satisfied
114 | 
115 | -> > 
116 | (cons 5 nil)
117 | Satisfied
118 | 
119 | -> 
120 | (cons 5 nil)
121 | Satisfied
122 | 
123 | -> -> 
124 | -> 
125 | -> 
126 | -> 
127 | lima
128 | Satisfied
129 | 
130 | -> 
131 | lima
132 | Satisfied
133 | 
134 | -> -> 
135 | -> 
136 | -> 
137 | 15
138 | Satisfied
139 | 
140 | -> 
141 | 15
142 | Satisfied
143 | 
144 | -> 
145 | -> 
146 | -> 
147 | -> 
148 | -> 
149 | -> 
150 | -> -> 
151 | -> 
152 | -> 
153 | -> -> 
154 | -> > 
155 | -> -> 
156 | -> 
157 | (cons 2 (cons 3 (cons 4 nil)))
158 | Satisfied
159 | 
160 | -> 
161 | (cons 2 (cons 3 (cons 4 nil)))
162 | Satisfied
163 | 
164 | -> -> 
165 | -> 
166 | -> 
167 | -> -> 
168 | -> > > > > > 
169 | -> > 
170 | (cons 1 (cons 2 (cons 3 (cons 7 (cons 8 nil)))))
171 | Satisfied
172 | 
173 | -> 
174 | (cons 1 (cons 2 (cons 3 (cons 7 (cons 8 nil)))))
175 | Satisfied
176 | 
177 | -> -> 
178 | -> 
179 | -> 
180 | (cons 3 (cons 4 nil))
181 | Satisfied
182 | 
183 | -> 
184 | (cons 3 (cons 4 nil))
185 | Satisfied
186 | 
187 | -> 
188 | (diff (cons 3 (cons 4 Z1)) Z1)
189 | Satisfied
190 | 
191 | -> 
192 | (diff (cons 3 (cons 4 Z1)) Z1)
193 | Satisfied
194 | 
195 | -> 
196 | -> > 
197 | (diff (cons 3 (cons 4 Y)) Y)
198 | Satisfied
199 | 
200 | -> 
201 | (diff (cons 3 (cons 4 Y)) Y)
202 | Satisfied
203 | 
204 | -> 


--------------------------------------------------------------------------------
/distr/code.clu.o:
--------------------------------------------------------------------------------
  1 | -> -> sqr
  2 | -> abs
  3 | -> +1
  4 | -> and
  5 | -> or
  6 | -> not
  7 | -> <>
  8 | -> >=
  9 | -> <=
 10 | -> mod
 11 | -> min
 12 | -> max
 13 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > new
 14 | abscissa
 15 | ordinate
 16 | reflect
 17 | rotate
 18 | compare
 19 | quadrant
 20 | sqrdist
 21 | Point
 22 | -> <userval>
 23 | 
 24 | -> -3
 25 | 
 26 | -> 4
 27 | 
 28 | -> 4
 29 | 
 30 | -> -3
 31 | 
 32 | -> -3
 33 | 
 34 | -> 3
 35 | 
 36 | -> -4
 37 | 
 38 | -> -4
 39 | 
 40 | -> 3
 41 | 
 42 | -> 3
 43 | 
 44 | -> <userval>
 45 | 
 46 | -> 1
 47 | 
 48 | -> 1
 49 | 
 50 | -> > > enclosed-area
 51 | -> 10
 52 | 
 53 | -> 10
 54 | 
 55 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > new
 56 | abscissa
 57 | ordinate
 58 | reflect
 59 | rotate
 60 | compare
 61 | quadrant
 62 | compute-quad
 63 | sqrdist
 64 | Point
 65 | -> <userval>
 66 | 
 67 | -> 2
 68 | 
 69 | -> 4
 70 | 
 71 | -> 4
 72 | 
 73 | -> -3
 74 | 
 75 | -> -3
 76 | 
 77 | -> 4
 78 | 
 79 | -> -4
 80 | 
 81 | -> -4
 82 | 
 83 | -> 3
 84 | 
 85 | -> 3
 86 | 
 87 | -> <userval>
 88 | 
 89 | -> 1
 90 | 
 91 | -> 1
 92 | 
 93 | -> > > enclosed-area
 94 | -> 10
 95 | 
 96 | -> 10
 97 | 
 98 | -> -> > > > > > > > > > > nil
 99 | null?
100 | cons
101 | car
102 | cdr
103 | rplaca
104 | rplacd
105 | List
106 | -> <userval>
107 | 
108 | -> <userval>
109 | 
110 | -> 1
111 | 
112 | -> 1
113 | 
114 | -> 1
115 | 
116 | -> 1
117 | 
118 | -> 2
119 | 
120 | -> 2
121 | 
122 | -> 3
123 | 
124 | -> 3
125 | 
126 | -> 3
127 | 
128 | -> 3
129 | 
130 | -> 3
131 | 
132 | -> > length
133 | -> 2
134 | 
135 | -> 2
136 | 
137 | -> 2
138 | 
139 | -> 2
140 | 
141 | -> -> > nth
142 | -> > changenth
143 | -> -> > > > > > > > > > > > > > > > new
144 | index
145 | assign
146 | zerolist
147 | out-of-bounds
148 | Array
149 | -> <userval>
150 | 
151 | -> 0
152 | 
153 | -> 0
154 | 
155 | -> 0
156 | 
157 | -> 1
158 | 4
159 | 9
160 | 16
161 | 25
162 | 36
163 | 49
164 | 64
165 | 81
166 | 100
167 | 0
168 | 
169 | -> -> > > > > > > fst
170 | snd
171 | mkPair
172 | Pair
173 | -> -> > > > > assoc
174 | -> -> > > > > > > > > > > > > > > > > > > > new
175 | index
176 | assign
177 | out-of-bounds
178 | SpArray
179 | -> <userval>
180 | 
181 | -> 0
182 | 
183 | -> 0
184 | 
185 | -> 0
186 | 
187 | -> 1
188 | 4
189 | 9
190 | 16
191 | 25
192 | 36
193 | 49
194 | 64
195 | 81
196 | 100
197 | 0
198 | 
199 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > create
200 | degree
201 | coeff
202 | zero?
203 | add
204 | minus
205 | sub
206 | mul
207 | prnt
208 | set-coeff
209 | remove-zeros
210 | Poly
211 | -> > > > > > > > > > diff
212 | -> <userval>
213 | 
214 | -> <userval>
215 | 
216 | -> <userval>
217 | 
218 | -> 10
219 | 1
220 | 3
221 | 0
222 | 0
223 | 
224 | -> 10
225 | 
226 | -> 1
227 | 
228 | -> 3
229 | 
230 | -> 0
231 | 
232 | -> 


--------------------------------------------------------------------------------
/index.html:
--------------------------------------------------------------------------------
 1 | <TITLE>Package: lang/lisp/impl/kamin/kamin/</TITLE>
 2 | <hr>
 3 | <b>CMU Artificial Intelligence Repository</b><br>
 4 | <tt><A HREF="/afs/cs.cmu.edu/project/ai-repository/ai/html/air.html"><IMG ALIGN=MIDDLE SRC="/afs/cs.cmu.edu/project/ai-repository/ai/html/gif/home.gif" ALT="Home"></A>  <A HREF="/afs/cs.cmu.edu/project/ai-repository/ai/html/rep_info.html"><IMG ALIGN=MIDDLE SRC="/afs/cs.cmu.edu/project/ai-repository/ai/html/gif/info.gif" ALT="INFO"></A>  <A HREF="/afs/cs.cmu.edu/project/ai-repository/ai/html/keys/keysform.html"><IMG ALIGN=MIDDLE SRC="/afs/cs.cmu.edu/project/ai-repository/ai/html/gif/search.gif" ALT="Search"></A>  <A HREF="/afs/cs.cmu.edu/project/ai-repository/ai/html/faqs/top.html"><IMG ALIGN=MIDDLE SRC="/afs/cs.cmu.edu/project/ai-repository/ai/html/gif/faqs.gif" ALT="FAQs"></A>  <A HREF="/afs/cs.cmu.edu/project/ai-repository/ai/0.html"><IMG ALIGN=MIDDLE SRC="/afs/cs.cmu.edu/project/ai-repository/ai/html/gif/top.gif" ALT="Repository Root"></A>  </tt>
 5 | <hr>
 6 | <H2>Kamin: Source for the interpreter's in Sam Kamin's book</H2>
 7 | <pre>
 8 | <A HREF="./">lang/lisp/impl/kamin/kamin/</A>
 9 | </pre>
10 | <listing>
11 | This directory contains the source code for the interpreters from
12 | Sam Kamin's book,
13 |    Samuel Kamin, "Programming Languages, An Interpreter-Based Approach", 
14 |    Addison-Wesley, Reading, Mass., 1990. ISBN 0-201-06824-9.
15 | The book discusses interpreters for Pascal, Lisp, APL, Scheme, SASL,
16 | CLU, Smalltalk and Prolog. The implementations center around a common
17 | core that remains unchanged from language to language.
18 | </listing>
19 | <pre>
20 | Origin:   
21 | 
22 |    <A HREF="ftp://a.cs.uiuc.edu/pub/kamin/kamin.distr/distr.tar.Z">a.cs.uiuc.edu:/pub/kamin/kamin.distr/distr.tar.Z</A>
23 | </pre>
24 | <hr>
25 | <listing>
26 | Version:      7-DEC-90
27 | 
28 | Requires:     PASCAL
29 | 
30 | Updated:      Wed Oct 12 22:36:01 1994
31 | 
32 | CD-ROM:       
33 | 
34 | Author(s):    Sam Kamin <kamin@cs.uiuc.edu>
35 |               Computer Science Dept.
36 |               1304 W. Springfield
37 |               Urbana, IL 61801
38 |               Tel: 217-333-8069
39 | 
40 | Keywords:
41 | 
42 |    Authors!Kamin, Interpreters!Lisp, Interpreters!Prolog, 
43 |    Interpreters!Scheme, Interpreters!Smalltalk, 
44 |    Lisp!Implementations, Pascal!Code, 
45 |    Programming Languages!Lisp, Programming Languages!Prolog, 
46 |    Programming Languages!Scheme, 
47 |    Programming Languages!Smalltalk, Prolog!Implementations, 
48 |    Scheme!Implementations, Smalltalk!Implementations
49 | 
50 | References:
51 | 
52 |    Samuel Kamin, "Programming Languages, An Interpreter-Based Approach",
53 |    Addison-Wesley, Reading, MA, 1990. ISBN 0-201-06824-9.
54 | 
55 | </listing><hr>
56 | <address>Last Web update on Mon Feb 13 10:32:06 1995 <br>
57 | <A HREF="/afs/cs.cmu.edu/project/ai-repository/ai/html/air.html">AI.Repository@cs.cmu.edu</A></address>
58 | 


--------------------------------------------------------------------------------
/C-distr/code.clu.out:
--------------------------------------------------------------------------------
  1 | -> -> sqr
  2 | -> abs
  3 | -> +1
  4 | -> and
  5 | -> or
  6 | -> not
  7 | -> <>
  8 | -> >=
  9 | -> <=
 10 | -> mod
 11 | -> min
 12 | -> max
 13 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > new
 14 | abscissa
 15 | ordinate
 16 | reflect
 17 | rotate
 18 | compare
 19 | quadrant
 20 | sqrdist
 21 | Point
 22 | -> <userval>
 23 | 
 24 | -> -3
 25 | 
 26 | -> 4
 27 | 
 28 | -> 4
 29 | 
 30 | -> -3
 31 | 
 32 | -> -3
 33 | 
 34 | -> 3
 35 | 
 36 | -> -4
 37 | 
 38 | -> -4
 39 | 
 40 | -> 3
 41 | 
 42 | -> 3
 43 | 
 44 | -> <userval>
 45 | 
 46 | -> 1
 47 | 
 48 | -> 1
 49 | 
 50 | -> > > enclosed-area
 51 | -> 10
 52 | 
 53 | -> 10
 54 | 
 55 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > new
 56 | abscissa
 57 | ordinate
 58 | reflect
 59 | rotate
 60 | compare
 61 | quadrant
 62 | compute-quad
 63 | sqrdist
 64 | Point
 65 | -> <userval>
 66 | 
 67 | -> 2
 68 | 
 69 | -> 4
 70 | 
 71 | -> 4
 72 | 
 73 | -> -3
 74 | 
 75 | -> -3
 76 | 
 77 | -> 4
 78 | 
 79 | -> -4
 80 | 
 81 | -> -4
 82 | 
 83 | -> 3
 84 | 
 85 | -> 3
 86 | 
 87 | -> <userval>
 88 | 
 89 | -> 1
 90 | 
 91 | -> 1
 92 | 
 93 | -> > > enclosed-area
 94 | -> 10
 95 | 
 96 | -> 10
 97 | 
 98 | -> -> > > > > > > > > > > nil
 99 | null?
100 | cons
101 | car
102 | cdr
103 | rplaca
104 | rplacd
105 | List
106 | -> <userval>
107 | 
108 | -> <userval>
109 | 
110 | -> 1
111 | 
112 | -> 1
113 | 
114 | -> 1
115 | 
116 | -> 1
117 | 
118 | -> 2
119 | 
120 | -> 2
121 | 
122 | -> 3
123 | 
124 | -> 3
125 | 
126 | -> 3
127 | 
128 | -> 3
129 | 
130 | -> 3
131 | 
132 | -> > length
133 | -> 2
134 | 
135 | -> 2
136 | 
137 | -> 2
138 | 
139 | -> 2
140 | 
141 | -> -> > nth
142 | -> > changenth
143 | -> -> > > > > > > > > > > > > > > > new
144 | index
145 | assign
146 | zerolist
147 | out-of-bounds
148 | Array
149 | -> <userval>
150 | 
151 | -> 0
152 | 
153 | -> 0
154 | 
155 | -> 0
156 | 
157 | -> 1
158 | 4
159 | 9
160 | 16
161 | 25
162 | 36
163 | 49
164 | 64
165 | 81
166 | 100
167 | 0
168 | 
169 | -> -> > > > > > > fst
170 | snd
171 | mkPair
172 | Pair
173 | -> -> > > > > assoc
174 | -> -> > > > > > > > > > > > > > > > > > > > new
175 | index
176 | assign
177 | out-of-bounds
178 | SpArray
179 | -> <userval>
180 | 
181 | -> 0
182 | 
183 | -> 0
184 | 
185 | -> 0
186 | 
187 | -> 1
188 | 4
189 | 9
190 | 16
191 | 25
192 | 36
193 | 49
194 | 64
195 | 81
196 | 100
197 | 0
198 | 
199 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > create
200 | degree
201 | coeff
202 | zero?
203 | add
204 | minus
205 | sub
206 | mul
207 | prnt
208 | set-coeff
209 | remove-zeros
210 | Poly
211 | -> > > > > > > > > > diff
212 | -> <userval>
213 | 
214 | -> <userval>
215 | 
216 | -> <userval>
217 | 
218 | -> 10
219 | 1
220 | 3
221 | 0
222 | 0
223 | 
224 | -> 10
225 | 
226 | -> 1
227 | 
228 | -> 3
229 | 
230 | -> 0
231 | 
232 | -> 


--------------------------------------------------------------------------------
/distr/ERRATA:
--------------------------------------------------------------------------------
 1 | These are errors in the first printing of "Programming Languages:
 2 | An Interpreter-based Approach," by Sam Kamin, Addison-Wesley, 1990.
 3 | Included are only the substantive errors, not simple typos or merely
 4 | aesthetic corrections.  Errors in the second printing (a subset of
 5 | those in first printing) are listed separately below.  (For reporting
 6 | a number of these typos, thanks to: Tim Budd, Chris Van Wyk.)
 7 | 
 8 | Errors in the table of contents and, especially, the index are too
 9 | numerous to list.  The main problem in the index is that page numbers in
10 | the appendices are almost all too high, by an average of two pages.
11 | 
12 | Read "->" as "should be changed to".  One case of this is `-> ""',
13 | which means "should be deleted".
14 | 
15 | p. vi, "Overview" section, l. 1: "?" -> "1979"
16 | p. 14, l. -11: "FUNDEF" -> "f: FUNDEF"
17 | p. 32, l. -5: "Coli" -> "coli"
18 | p. 59, "Further reading" section, last line: "Reingold [1988]" ->
19 |   "Reingold and Reingold [1988]"
20 | p. 62, l. 2: "The interpreter" -> "The new version of the meta-circular
21 |   interpreter"
22 | p. 62, l. 5: "programmed in Exercise 10" -> ""
23 | p. 68, l. 8: "vector V," -> "vector V, where \oplus is any primitive
24 |   dyadic operation,"
25 | p. 71, l. -5: remove one closing parenthesis at end of line
26 | p. 98, l. 10: "(page 15)" -> "(page 13)"
27 | p. 110, section 4.3, l. 1: "??" -> "C"
28 | p. 125, last line of text: "e2) e1)" -> "e2)) e1)"
29 | p. 126, line "(sum (f (car l)) (loop (cdr l))...)": delete three closing
30 |   parentheses
31 | p. 139, l. -14, -12, -10: on each line, second arrow show be star,
32 |   e.g. l. -10: -> (int \arrow bool) * int list \arrow bool
33 | p. 148, para. 2, l. 3: "Sethi [1988]" -> "Sethi [1989]"
34 | p. 149, l. -5: "(gcd 3 5)" -> "(gcd 9 11)"
35 | p. 156, l. 6: "(find-val pred (cdr ilis))))" -> "(find-val pred (cdr ilis)
36 |   (+1 100))))"
37 | p. 162, l. -3 (of text): "a_i" -> "x_i"
38 | p. 176, l. 11: "subsets" -> "gensubsets" (twice)
39 | p. 177, l. 13: "find" -> "find-val"
40 | p. 182, l. 3-6: "CADR" -> "CAR"
41 | p. 186, l. 9: "(f x y)" -> "e"
42 | p. 199, para. 2, l. -3: "In fact" -> "Furthermore, if we restore the
43 |   restriction that the path remain entirely within the first quadrant"
44 | p. 285, l. -15: "List" -> "SequenceableCollection"
45 | p. 311, l. -11: "(release-terminal THELAB self)" -> "(release-terminal
46 |              THELAB status)"
47 | p. 345, l. 6: "(from:to:by: n n+km k)" -> "(from:to:by: n n+km m)"
48 | p. 417, second box: "ALLOC 2,rv" -> "ALLOC 2"
49 | p. 550, l. -12: "ord(op)" -> "ord(op)+1"
50 | p. 563, l. -17: "ord(op)" -> "ord(op)+1"
51 | p. 616, middle: "[1988] R. Sethi" -> "[1989] R. Sethi"
52 | 
53 | Errors in second printing (that is, errors that weren't caught
54 | before the second printing).  This list is a subset of the list above:
55 | 
56 | p. 98:  l. 10: "page 15" -> "page 13"
57 |         lines -9, -8 use a notation for vector x that's only defined on p. 254
58 | p. 156: l. 6: "(find-val pred (cdr ilis))" ->
59 |                   "(find-val pred (cdr ilis) (+1 100))"
60 | p. 163: l. 9: "page 33" -> "page 31"
61 | p. 176, l. 11: "subsets" -> "gensubsets"
62 | p. 285, l. -15: "List" -> "SequenceableCollection"
63 | p. 311, l. -11: "(release-terminal THELAB self)" -> "(release-terminal
64 |              THELAB status)"
65 | 


--------------------------------------------------------------------------------
/errata.txt:
--------------------------------------------------------------------------------
 1 | These are errors in the first printing of "Programming Languages:
 2 | An Interpreter-based Approach," by Sam Kamin, Addison-Wesley, 1990.
 3 | Included are only the substantive errors, not simple typos or merely
 4 | aesthetic corrections.  Errors in the second printing (a subset of
 5 | those in first printing) are listed separately below.  (For reporting
 6 | a number of these typos, thanks to: Tim Budd, Chris Van Wyk.)
 7 | 
 8 | Errors in the table of contents and, especially, the index are too
 9 | numerous to list.  The main problem in the index is that page numbers in
10 | the appendices are almost all too high, by an average of two pages.
11 | 
12 | Read "->" as "should be changed to".  One case of this is `-> ""',
13 | which means "should be deleted".
14 | 
15 | p. vi, "Overview" section, l. 1: "?" -> "1979"
16 | p. 14, l. -11: "FUNDEF" -> "f: FUNDEF"
17 | p. 32, l. -5: "Coli" -> "coli"
18 | p. 59, "Further reading" section, last line: "Reingold [1988]" ->
19 |   "Reingold and Reingold [1988]"
20 | p. 62, l. 2: "The interpreter" -> "The new version of the meta-circular
21 |   interpreter"
22 | p. 62, l. 5: "programmed in Exercise 10" -> ""
23 | p. 68, l. 8: "vector V," -> "vector V, where \oplus is any primitive
24 |   dyadic operation,"
25 | p. 71, l. -5: remove one closing parenthesis at end of line
26 | p. 98, l. 10: "(page 15)" -> "(page 13)"
27 | p. 110, section 4.3, l. 1: "??" -> "C"
28 | p. 125, last line of text: "e2) e1)" -> "e2)) e1)"
29 | p. 126, line "(sum (f (car l)) (loop (cdr l))...)": delete three closing
30 |   parentheses
31 | p. 139, l. -14, -12, -10: on each line, second arrow show be star,
32 |   e.g. l. -10: -> (int \arrow bool) * int list \arrow bool
33 | p. 148, para. 2, l. 3: "Sethi [1988]" -> "Sethi [1989]"
34 | p. 149, l. -5: "(gcd 3 5)" -> "(gcd 9 11)"
35 | p. 156, l. 6: "(find-val pred (cdr ilis))))" -> "(find-val pred (cdr ilis)
36 |   (+1 100))))"
37 | p. 162, l. -3 (of text): "a_i" -> "x_i"
38 | p. 176, l. 11: "subsets" -> "gensubsets" (twice)
39 | p. 177, l. 13: "find" -> "find-val"
40 | p. 182, l. 3-6: "CADR" -> "CAR"
41 | p. 186, l. 9: "(f x y)" -> "e"
42 | p. 199, para. 2, l. -3: "In fact" -> "Furthermore, if we restore the
43 |   restriction that the path remain entirely within the first quadrant"
44 | p. 285, l. -15: "List" -> "SequenceableCollection"
45 | p. 311, l. -11: "(release-terminal THELAB self)" -> "(release-terminal
46 |              THELAB status)"
47 | p. 345, l. 6: "(from:to:by: n n+km k)" -> "(from:to:by: n n+km m)"
48 | p. 417, second box: "ALLOC 2,rv" -> "ALLOC 2"
49 | p. 550, l. -12: "ord(op)" -> "ord(op)+1"
50 | p. 563, l. -17: "ord(op)" -> "ord(op)+1"
51 | p. 616, middle: "[1988] R. Sethi" -> "[1989] R. Sethi"
52 | 
53 | Errors in second printing (that is, errors that weren't caught
54 | before the second printing).  This list is a subset of the list above:
55 | 
56 | p. 98:  l. 10: "page 15" -> "page 13"
57 |         lines -9, -8 use a notation for vector x that's only defined on p. 254
58 | p. 156: l. 6: "(find-val pred (cdr ilis))" ->
59 |                   "(find-val pred (cdr ilis) (+1 100))"
60 | p. 163: l. 9: "page 33" -> "page 31"
61 | p. 176, l. 11: "subsets" -> "gensubsets"
62 | p. 285, l. -15: "List" -> "SequenceableCollection"
63 | p. 311, l. -11: "(release-terminal THELAB self)" -> "(release-terminal
64 |              THELAB status)"
65 | 


--------------------------------------------------------------------------------
/distr/TEST.INTERPS:
--------------------------------------------------------------------------------
  1 | echo 'This file compiles all interpreters, saving binaries, and'
  2 | echo 'tests them by running them on files code.xxx (xxx the language name)'
  3 | echo 'and comparing the output to the files code.xxx.o.'
  4 | echo ''
  5 | echo 'The expected output from running this file is the list of messages:'
  6 | echo ''
  7 | echo 'Compiling CHAP1; binary is chap1'
  8 | echo 'Running CHAP1'
  9 | echo 'Compiling LISP; binary is lisp'
 10 | echo 'Running LISP'
 11 | echo ''
 12 | echo 'and so on.  If the output from any interpreter differs from'
 13 | echo 'what it should be, you will see the diff output following'
 14 | echo 'the "Running XXX" message'
 15 | echo ''
 16 | echo 'See the README file for more information'
 17 | echo ''
 18 | echo 'Compiling CHAP1; binary is chap1'
 19 | pc  chap1.p
 20 | mv a.out chap1
 21 | echo 'Running CHAP1'
 22 | ./chap1 < code.ch1  > chap1.out
 23 | diff code.ch1.o chap1.out
 24 | rm chap1.out
 25 | echo 'Compiling LISP; binary is lisp'
 26 | pc  lisp.p
 27 | mv a.out lisp
 28 | echo 'Running LISP'
 29 | ./lisp < code.lsp  > lisp.out
 30 | diff code.lsp.o lisp.out
 31 | rm lisp.out
 32 | echo 'Compiling APL; binary is apl'
 33 | pc  apl.p
 34 | mv a.out apl
 35 | echo 'Running APL'
 36 | ./apl < code.apl  > apl.out
 37 | diff code.apl.o apl.out
 38 | rm apl.out
 39 | echo 'Compiling SCHEME; binary is scheme'
 40 | pc  scheme.p
 41 | mv a.out scheme
 42 | echo 'Running SCHEME'
 43 | ./scheme < code.sch  > scheme.out
 44 | diff code.sch.o scheme.out
 45 | rm scheme.out
 46 | echo 'Compiling SASL; binary is sasl'
 47 | pc  sasl.p
 48 | mv a.out sasl
 49 | echo 'Running SASL'
 50 | ./sasl < code.ssl  > sasl.out
 51 | diff code.ssl.o sasl.out
 52 | rm sasl.out
 53 | echo 'Compiling CLU; binary is clu'
 54 | pc  clu.p
 55 | mv a.out clu
 56 | echo 'Running CLU'
 57 | ./clu < code.clu  > clu.out
 58 | diff code.clu.o clu.out
 59 | rm clu.out
 60 | echo 'Compiling SMALLTALK; binary is smalltalk'
 61 | pc  smalltalk.p
 62 | mv a.out smalltalk
 63 | echo 'Running SMALLTALK'
 64 | ./smalltalk < code.smt  > smalltalk.out
 65 | diff code.smt.o smalltalk.out
 66 | rm smalltalk.out
 67 | echo 'Compiling PROLOG; binary is prolog'
 68 | pc  prolog.p
 69 | mv a.out prolog
 70 | echo 'Running PROLOG - file 1'
 71 | ./prolog < code1.pro  > prolog1.out
 72 | diff code1.pro.o prolog1.out
 73 | rm prolog1.out
 74 | # echo 'Running PROLOG - file 2'
 75 | # ./prolog < code2.pro  > prolog2.out
 76 | # diff code2.pro.o prolog2.out
 77 | # rm prolog2.out
 78 | echo 'Compiling stacking version of LISP; binary is lisp-stack'
 79 | pc  lisp-stack.p
 80 | mv a.out lisp-stack
 81 | echo 'Running stacking version of LISP'
 82 | ./lisp-stack < code.gc.lsp  > lisp-stack.out
 83 | diff code.stack.o lisp-stack.out
 84 | rm lisp-stack.out
 85 | echo 'Compiling mark-scan version of LISP; binary is lisp-msgc'
 86 | pc  lisp-msgc.p
 87 | mv a.out lisp-msgc
 88 | echo 'Running mark-scan version of LISP'
 89 | ./lisp-msgc < code.gc.lsp  > lisp-msgc.out
 90 | diff code.msgc.o lisp-msgc.out
 91 | rm lisp-msgc.out
 92 | echo 'Compiling semi-space version of LISP; binary is lisp-ssgc'
 93 | pc  lisp-ssgc.p
 94 | mv a.out lisp-ssgc
 95 | echo 'Running semi-space version of LISP'
 96 | ./lisp-ssgc < code.gc.lsp  > lisp-ssgc.out
 97 | diff code.ssgc.o lisp-ssgc.out
 98 | rm lisp-ssgc.out
 99 | echo 'Compiling reference-counting version of LISP; binary is lisp-refcnt'
100 | pc  lisp-refcnt.p
101 | mv a.out lisp-refcnt
102 | echo 'Running reference-counting version of LISP'
103 | ./lisp-refcnt < code.gc.lsp  > lisp-refcnt.out
104 | diff code.refcnt.o lisp-refcnt.out
105 | rm lisp-refcnt.out
106 | 


--------------------------------------------------------------------------------
/C-distr/code2.pro:
--------------------------------------------------------------------------------
 1 | ; Section 8.4 - Note that two versions of transform are given.
 2 | ; This file can only be run if one of these is commented out.
 3 | ; Currently, the first, and less efficient, version is commented out.
 4 | (infer (member X (cons X L)))
 5 | (infer (member X (cons Y M)) from (member X M))
 6 | ;
 7 | (infer (block a))
 8 | (infer (block b))
 9 | (infer (block c))
10 | ;
11 | (infer (different a b))
12 | (infer (different a c))
13 | (infer (different b a))
14 | (infer (different b c))
15 | (infer (different c a))
16 | (infer (different c b))
17 | (infer (different X table) from (block X))
18 | (infer (different table Y) from (block Y))
19 | ;
20 | (infer (clear X nil))
21 | (infer (clear X (cons (on B Y) State))
22 |       from (different X Y) (clear X State))
23 | ;
24 | (infer (on X Y State) from (member (on X Y) State))
25 | ;
26 | (infer (update (move X Y Z) (cons (on X Y) S) (cons (on X Z) S)))
27 | (infer (update (move X Y Z) (cons (on U V) S1) (cons (on U V) S2))
28 |       from (different X U) (update (move X Y Z) S1 S2))
29 | ;
30 | (infer (legal-move (move B P1 table) State)
31 |       from
32 |              (on B P1 State)
33 |              (different P1 table)
34 |              (clear B State))
35 | (infer (legal-move (move B1 P B2) State)
36 |       from
37 |              (block B2)
38 |              (on B1 P State)
39 |              (different P B2)
40 |              (different B1 B2)
41 |              (clear B1 State)
42 |              (clear B2 State))
43 | ;
44 | (infer (different (cons (on A X) State1) (cons (on A Y) State2))
45 |       from (different X Y))
46 | (infer (different (cons (on A X) State1) (cons (on A X) State2))
47 |       from (different State1 State2))
48 | ;
49 | (infer (not-member X nil))
50 | (infer (not-member X (cons Y L))
51 |       from (different X Y) (not-member X L))
52 | ;
53 | ;(infer (transform State1 State2 Plan)
54 | ;      from (transform State1 State2 (cons State1 nil) Plan))
55 | ;;
56 | ;(infer (transform State State Visited nil))
57 | ;(infer (transform State1 State2 Visited (cons Move Moves))
58 | ;      from
59 | ;            (legal-move Move State1)
60 | ;             (update Move State1 State)
61 | ;             (not-member State Visited)
62 | ;             (transform State State2 (cons State Visited) Moves))
63 | ;;
64 | ;(infer (state1 (cons (on a b) (cons (on b table) (cons (on c a) nil)))))
65 | ;(infer (state2 (cons (on a b) (cons (on b c) (cons (on c table) nil)))))
66 | ;(infer? (state1 S1) (state2 S2) (transform S1 S2 Plan)
67 | ;              (print Plan))
68 | ;(infer? (print (cons (move c a table)
69 | ;   (cons (move a b table) (cons (move b table a)
70 | ;   (cons (move b a c) (cons (move a table b) nil)))))))
71 | ;
72 | (infer (transform State1 State2 Plan)
73 |       from (transform State1 State2 (cons State1 nil) Plan))
74 | ;
75 | (infer (transform State State Visited nil))
76 | (infer (transform State1 State2 Visited (cons Move Moves))
77 |       from
78 |              (choose-move Move State1 State2)
79 |              (update Move State1 State)
80 |              (not-member State Visited)
81 |              (transform State State2 (cons State Visited) Moves))
82 | ;
83 | (infer (choose-move Move State1 State2)
84 |       from (suggest Move State2) (legal-move Move State1))
85 | (infer (choose-move Move State1 State2)
86 |       from (legal-move Move State1))
87 | (infer (suggest (move X Y Z) State)
88 |       from (member (on X Z) State))
89 | (infer (state1 (cons (on a b) (cons (on b table) (cons (on c a) nil)))))
90 | (infer (state2 (cons (on a b) (cons (on b c) (cons (on c table) nil)))))
91 | (infer? (state1 S1) (state2 S2) (transform S1 S2 Plan)
92 |               (print Plan))
93 | (infer? (print (cons (move c a table) (cons (move a b table) (cons (move b table c)
94 |    (cons (move a table b) nil))))))
95 | quit
96 | 


--------------------------------------------------------------------------------
/distr/code2.pro:
--------------------------------------------------------------------------------
 1 | ; Section 8.4 - Note that two versions of transform are given.
 2 | ; This file can only be run if one of these is commented out.
 3 | ; Currently, the first, and less efficient, version is commented out.
 4 | (infer (member X (cons X L)))
 5 | (infer (member X (cons Y M)) from (member X M))
 6 | ;
 7 | (infer (block a))
 8 | (infer (block b))
 9 | (infer (block c))
10 | ;
11 | (infer (different a b))
12 | (infer (different a c))
13 | (infer (different b a))
14 | (infer (different b c))
15 | (infer (different c a))
16 | (infer (different c b))
17 | (infer (different X table) from (block X))
18 | (infer (different table Y) from (block Y))
19 | ;
20 | (infer (clear X nil))
21 | (infer (clear X (cons (on B Y) State))
22 |       from (different X Y) (clear X State))
23 | ;
24 | (infer (on X Y State) from (member (on X Y) State))
25 | ;
26 | (infer (update (move X Y Z) (cons (on X Y) S) (cons (on X Z) S)))
27 | (infer (update (move X Y Z) (cons (on U V) S1) (cons (on U V) S2))
28 |       from (different X U) (update (move X Y Z) S1 S2))
29 | ;
30 | (infer (legal-move (move B P1 table) State)
31 |       from
32 |              (on B P1 State)
33 |              (different P1 table)
34 |              (clear B State))
35 | (infer (legal-move (move B1 P B2) State)
36 |       from
37 |              (block B2)
38 |              (on B1 P State)
39 |              (different P B2)
40 |              (different B1 B2)
41 |              (clear B1 State)
42 |              (clear B2 State))
43 | ;
44 | (infer (different (cons (on A X) State1) (cons (on A Y) State2))
45 |       from (different X Y))
46 | (infer (different (cons (on A X) State1) (cons (on A X) State2))
47 |       from (different State1 State2))
48 | ;
49 | (infer (not-member X nil))
50 | (infer (not-member X (cons Y L))
51 |       from (different X Y) (not-member X L))
52 | ;
53 | ;(infer (transform State1 State2 Plan)
54 | ;      from (transform State1 State2 (cons State1 nil) Plan))
55 | ;;
56 | ;(infer (transform State State Visited nil))
57 | ;(infer (transform State1 State2 Visited (cons Move Moves))
58 | ;      from
59 | ;            (legal-move Move State1)
60 | ;             (update Move State1 State)
61 | ;             (not-member State Visited)
62 | ;             (transform State State2 (cons State Visited) Moves))
63 | ;;
64 | ;(infer (state1 (cons (on a b) (cons (on b table) (cons (on c a) nil)))))
65 | ;(infer (state2 (cons (on a b) (cons (on b c) (cons (on c table) nil)))))
66 | ;(infer? (state1 S1) (state2 S2) (transform S1 S2 Plan)
67 | ;              (print Plan))
68 | ;(infer? (print (cons (move c a table)
69 | ;   (cons (move a b table) (cons (move b table a)
70 | ;   (cons (move b a c) (cons (move a table b) nil)))))))
71 | ;
72 | (infer (transform State1 State2 Plan)
73 |       from (transform State1 State2 (cons State1 nil) Plan))
74 | ;
75 | (infer (transform State State Visited nil))
76 | (infer (transform State1 State2 Visited (cons Move Moves))
77 |       from
78 |              (choose-move Move State1 State2)
79 |              (update Move State1 State)
80 |              (not-member State Visited)
81 |              (transform State State2 (cons State Visited) Moves))
82 | ;
83 | (infer (choose-move Move State1 State2)
84 |       from (suggest Move State2) (legal-move Move State1))
85 | (infer (choose-move Move State1 State2)
86 |       from (legal-move Move State1))
87 | (infer (suggest (move X Y Z) State)
88 |       from (member (on X Z) State))
89 | (infer (state1 (cons (on a b) (cons (on b table) (cons (on c a) nil)))))
90 | (infer (state2 (cons (on a b) (cons (on b c) (cons (on c table) nil)))))
91 | (infer? (state1 S1) (state2 S2) (transform S1 S2 Plan)
92 |               (print Plan))
93 | (infer? (print (cons (move c a table) (cons (move a b table) (cons (move b table c)
94 |    (cons (move a table b) nil))))))
95 | quit
96 | 


--------------------------------------------------------------------------------
/C-distr/README:
--------------------------------------------------------------------------------
  1 | C versions of the language interpreters from "Programming Languages,
  2 | An Interpreter-based Approach," by Sam Kamin
  3 | ====================================================================
  4 | 
  5 | This directory contains C versions of the interpreters, produced
  6 | by the p2c translator from Cal Tech.  These versions were created, and
  7 | the makefile written, by Dirk Grunwald of Univ. of Colorado at
  8 | Boulder (thanks, Dirk!).  To compile and test the interpreters,
  9 | just say "make" in this directory.
 10 | 
 11 | The C versions of the interpreters were produced automatically
 12 | from the Pascal versions in the distr directory, using p2c, a Pascal-to-C
 13 | translator written by Dave Gillespie of Cal Tech.  (p2c can be
 14 | obtained by anonymous ftp from csvax.caltech.edu.)  The test
 15 | cases included here are identical to those in the distr directory,
 16 | and produce identical results.
 17 | 
 18 | Though p2c does a remarkably good job, these interpreters are not
 19 | hand-written, and are somewhat obscure in spots.  So they are
 20 | probably not appropriate for the "interpreter modification"
 21 | exercises.  For programming in the interpreted languages, on the
 22 | other hand, they are perfectly good.
 23 | 
 24 | The files in this directory are essentially the same as those in
 25 | the distr directory.  The interpreters have names xxx.c instead
 26 | of xxx.p, the file TEST.INTERPS is omitted (the Makefile takes its
 27 | place), and the README file is different.  Also, this directory
 28 | includes a subdirectory p2c containing files needed to compile the
 29 | C interpreters.  The biggest difference is the omission of the
 30 | files related to memory management (lisp.stack.p, lisp.ms-gc.p,
 31 | lisp.ss-gc.p, and lisp.refcnt.p, and their associated test files);
 32 | since these exist only for expository purposes (the language they
 33 | interpret is the same as that interpreted by lisp.c), and the C
 34 | versions of the code are not really readable (and are not explained
 35 | in the book), there seems no point in including them here.
 36 | 
 37 | Here is an explanation of the files containing the interpreters and
 38 | test cases:
 39 | 
 40 | 1. Interpreters (C source files):
 41 | 
 42 |      chap1.c - Chapter 1
 43 |      lisp.c - Lisp
 44 |      apl.c - APL
 45 |      scheme.c - Scheme
 46 |      sasl.c - SASL
 47 |      clu.c - CLU
 48 |      smalltalk.c - Smalltalk
 49 |      prolog.c - Prolog
 50 | 
 51 |    "make" will compile these files, leaving binaries called chap1,
 52 |    lisp, etc.
 53 | 
 54 | 2. Code files, including all code from chapters (plus some test cases
 55 |    not appearing in text).  Note that you may be unable to run these
 56 |    files as is due to memory limitations.  In that case, just split them
 57 |    up and run the pieces separately.  (The Prolog code is given in two
 58 |    pieces to avoid the problem of redefining predicates.)
 59 | 
 60 |      code.ch1 - Chapter 1
 61 |      code.lsp - Lisp
 62 |      code.apl - APL
 63 |      code.sch - Scheme
 64 |      code.ssl - SASL
 65 |      code.clu - CLU
 66 |      code.smt - Smalltalk
 67 |      code1.pro - Prolog, part 1
 68 |      code2.pro - Prolog, part 2
 69 |         
 70 | 3. Output of code files.  Use these to check that the interpreters
 71 |    are running correctly.
 72 | 
 73 |      code.ch1.out - output from running chap1.p on code.ch1
 74 |      code.lsp.out - output from running lisp.p on code.lsp
 75 |      code.apl.out - output from running apl.p on code.apl
 76 |      code.sch.out - output from running scheme.p on code.sch
 77 |      code.ssl.out - output from running sasl.p on code.ssl
 78 |      code.clu.out - output from running clu.p on code.clu
 79 |      code.smt.out - output from running smalltalk.p on code.smt
 80 |      code1.pro.out - output from running prolog.p on code1.pro
 81 |      code2.pro.out - output from running prolog.p on code2.pro
 82 | 
 83 |    "make" will use these files to test whether the interpreters are
 84 |    running correctly.  Aside from that, they have no particular use,
 85 |    as the book says what the correct value is for each expression.
 86 | 
 87 | PROBLEMS
 88 | 
 89 | The most likely source of problems when testing the interpreters is running
 90 | out of memory.  To alleviate the problem, I have made the following
 91 | adjustments:
 92 | 
 93 | 	code.lsp: The "quit" has been inserted before
 94 |                 line 414: "(r-e-p-loop '(", the first line of
 95 | 		an 86-line expression whose evaluation uses enormous
 96 | 		amounts of memory.
 97 | 
 98 | 	code.sch: Line 305: "(differentiate '(Dx (+ x c)))" has
 99 |                 been commented out.
100 | 
101 | 


--------------------------------------------------------------------------------
/C-distr/code1.pro:
--------------------------------------------------------------------------------
  1 | ; Section 8.1
  2 | (infer (different yellow blue))
  3 | (infer (different yellow red))
  4 | (infer (different blue yellow))
  5 | (infer (different blue red))
  6 | (infer (different red yellow))
  7 | (infer (different red blue))
  8 | ;
  9 | (infer (mapb-coloring A B C D E F)
 10 |      from (different A B) (different A C) (different A D) (different A F)
 11 |        (different B C) (different B E) (different C E) (different C D)
 12 |        (different D E) (different E F))
 13 | (infer?  (mapb-coloring A B C D E F))
 14 | (infer? (print))
 15 | (infer?  (mapb-coloring A B C D E F) (print A B C D E F))
 16 | (infer? (print yellow blue red blue yellow blue))
 17 | ;
 18 | (infer (member X (cons X L)))
 19 | (infer (member X (cons Y M)) from (member X M))
 20 | (infer?  (member 3 (cons 2 (cons 3 nil))))
 21 | (infer? (print))
 22 | (infer?  (member 3 (cons 2 (cons 4 nil))))
 23 | (infer? fail)
 24 | ; Section 8.2.2
 25 | (infer imokay from youreokay hesokay)
 26 | (infer youreokay from theyreokay)
 27 | (infer hesokay)
 28 | (infer theyreokay)
 29 | (infer?  imokay)
 30 | (infer? (print))
 31 | (infer hesnotokay from imnotokay)
 32 | (infer shesokay from hesnotokay)
 33 | (infer shesokay from theyreokay)
 34 | (infer?  shesokay)
 35 | (infer? (print))
 36 | (infer hesnotokay from shesokay)
 37 | (infer hesnotokay from imokay)
 38 | ; section 8.2.3
 39 | (infer (addtoend nil X (cons X nil)))
 40 | (infer (addtoend (cons Y L) X (cons Y M)) from (addtoend L X M))
 41 | (infer?  (addtoend (cons 3 nil) 4 L) (print L))
 42 | (infer? (print (cons 3 (cons 4 nil))))
 43 | (infer?  (addtoend L 4 (cons 3 (cons 4 nil))) (print L))
 44 | (infer? (print (cons 3 nil)))
 45 | ;
 46 | (infer (reverse nil nil))
 47 | (infer (reverse (cons X L) M) from (reverse L N) (addtoend N X M))
 48 | (infer?  (reverse (cons 1 (cons 2 nil)) L) (print L))
 49 | (infer? (print (cons 2 (cons 1 nil))))
 50 | (infer?  (reverse L (cons 1 (cons 2 nil))) (print L))
 51 | (infer? (print (cons 2 (cons 1 nil))))
 52 | ;
 53 | (infer (append nil L L))
 54 | (infer (append (cons X L) M (cons X N)) from (append L M N))
 55 | (infer? (append nil (cons 3 nil) L) (print L))
 56 | (infer? (print (cons 3 nil)))
 57 | (infer? (append (cons 3 (cons 4 nil)) (cons 5 (cons 6 nil)) L)
 58 |        (print L))
 59 | (infer? (print (cons 3 (cons 4 (cons 5 (cons 6 nil))))))
 60 | (infer? (append L (cons 6 (cons 7 nil)) (cons 5 (cons 6 (cons 7 nil))))
 61 |        (print L))
 62 | (infer? (print (cons 5 nil)))
 63 | ;
 64 | (infer (member X L) from (append L1 (cons X L2) L)).
 65 | (infer (lookup K A L) from (member (pair K A) L))
 66 | (infer (capitols (cons (pair chile santiago) (cons (pair peru lima) nil))))
 67 | (infer?  (capitols C) (lookup peru Capitol C) (print Capitol))
 68 | (infer? (print lima))
 69 | ;
 70 | (infer (mult 0 Y 0))
 71 | (infer (mult X Y Z) from (minus X 1 V) (mult V Y W) (plus W Y Z))
 72 | (infer?  (mult 3 5 X) (print X))
 73 | (infer? (print 15))
 74 | (infer (mult X Y Z) from (minus X 1 V) (plus W Y Z) (mult V Y W)).
 75 | (infer (fac 0 1))
 76 | (infer (fac N R) from (minus N 1 N1) (fac N1 R1) (mult R1 N R))
 77 | (infer (naive-sort L M) from (permutation L M) (ordered M)).
 78 | (infer (<= X X))
 79 | (infer (<= X Y) from (less X Y))
 80 | ;
 81 | (infer (ordered nil))
 82 | (infer (ordered (cons A nil)))
 83 | (infer (ordered (cons A (cons B L))) from (<= A B) (ordered (cons B L)))
 84 | ;
 85 | (infer (permutation nil nil))
 86 | (infer (permutation L (cons H T))
 87 |       from (append V (cons H U) L) (append V U W) (permutation W T))
 88 | ;
 89 | (infer (naive-sort L M) from (permutation L M) (ordered M)).
 90 | (infer?  (naive-sort (cons 4 (cons 2 (cons 3 nil))) L) (print L))
 91 | (infer? (print (cons 2 (cons 3 (cons 4 nil)))))
 92 | ;
 93 | (infer (partition H (cons A X) (cons A Y) Z) from (<= A H) (partition H X Y Z))
 94 | (infer (partition H (cons A X) Y (cons A Z)) from (less H A) (partition H X Y Z))
 95 | (infer (partition H nil nil nil))
 96 | ;
 97 | (infer (quicksort nil nil))
 98 | (infer (quicksort (cons H T) S)
 99 |       from
100 |       (partition H T A B)
101 |              (quicksort A A1)
102 |              (quicksort B B1)
103 |              (append A1 (cons H B1) S))
104 | (infer?  (quicksort (cons 8 (cons 2 (cons 3 (cons 7 (cons 1 nil))))) S)
105 |               (print S))
106 | (infer? (print (cons 1 (cons 2 (cons 3 (cons 7 (cons 8 nil)))))))
107 | ;
108 | (infer (simplify (diff X X) nil))
109 | (infer (simplify (diff (cons X Y) Z) (cons X W)) from (simplify (diff Y Z) W))
110 | (infer?  (simplify (diff (cons 3 (cons 4 X)) X) L) (print L))
111 | (infer? (print (cons 3 (cons 4 nil))))
112 | (infer?  (simplify L (cons 3 (cons 4 nil))) (print L))
113 | (infer? (print (diff (cons 3 (cons 4 Z1)) Z1)))
114 | (infer (diffappend (diff L X) (diff X Y) (diff L Y))).
115 | (infer?  (diffappend (diff (cons 3 X) X) (diff (cons 4 Y) Y) Z)
116 |         (print Z))
117 | (infer? (print (diff (cons 3 (cons 4 Y)) Y)))
118 | quit
119 | 


--------------------------------------------------------------------------------
/distr/code1.pro:
--------------------------------------------------------------------------------
  1 | ; Section 8.1
  2 | (infer (different yellow blue))
  3 | (infer (different yellow red))
  4 | (infer (different blue yellow))
  5 | (infer (different blue red))
  6 | (infer (different red yellow))
  7 | (infer (different red blue))
  8 | ;
  9 | (infer (mapb-coloring A B C D E F)
 10 |      from (different A B) (different A C) (different A D) (different A F)
 11 |        (different B C) (different B E) (different C E) (different C D)
 12 |        (different D E) (different E F))
 13 | (infer?  (mapb-coloring A B C D E F))
 14 | (infer? (print))
 15 | (infer?  (mapb-coloring A B C D E F) (print A B C D E F))
 16 | (infer? (print yellow blue red blue yellow blue))
 17 | ;
 18 | (infer (member X (cons X L)))
 19 | (infer (member X (cons Y M)) from (member X M))
 20 | (infer?  (member 3 (cons 2 (cons 3 nil))))
 21 | (infer? (print))
 22 | (infer?  (member 3 (cons 2 (cons 4 nil))))
 23 | (infer? fail)
 24 | ; Section 8.2.2
 25 | (infer imokay from youreokay hesokay)
 26 | (infer youreokay from theyreokay)
 27 | (infer hesokay)
 28 | (infer theyreokay)
 29 | (infer?  imokay)
 30 | (infer? (print))
 31 | (infer hesnotokay from imnotokay)
 32 | (infer shesokay from hesnotokay)
 33 | (infer shesokay from theyreokay)
 34 | (infer?  shesokay)
 35 | (infer? (print))
 36 | (infer hesnotokay from shesokay)
 37 | (infer hesnotokay from imokay)
 38 | ; section 8.2.3
 39 | (infer (addtoend nil X (cons X nil)))
 40 | (infer (addtoend (cons Y L) X (cons Y M)) from (addtoend L X M))
 41 | (infer?  (addtoend (cons 3 nil) 4 L) (print L))
 42 | (infer? (print (cons 3 (cons 4 nil))))
 43 | (infer?  (addtoend L 4 (cons 3 (cons 4 nil))) (print L))
 44 | (infer? (print (cons 3 nil)))
 45 | ;
 46 | (infer (reverse nil nil))
 47 | (infer (reverse (cons X L) M) from (reverse L N) (addtoend N X M))
 48 | (infer?  (reverse (cons 1 (cons 2 nil)) L) (print L))
 49 | (infer? (print (cons 2 (cons 1 nil))))
 50 | (infer?  (reverse L (cons 1 (cons 2 nil))) (print L))
 51 | (infer? (print (cons 2 (cons 1 nil))))
 52 | ;
 53 | (infer (append nil L L))
 54 | (infer (append (cons X L) M (cons X N)) from (append L M N))
 55 | (infer? (append nil (cons 3 nil) L) (print L))
 56 | (infer? (print (cons 3 nil)))
 57 | (infer? (append (cons 3 (cons 4 nil)) (cons 5 (cons 6 nil)) L)
 58 |        (print L))
 59 | (infer? (print (cons 3 (cons 4 (cons 5 (cons 6 nil))))))
 60 | (infer? (append L (cons 6 (cons 7 nil)) (cons 5 (cons 6 (cons 7 nil))))
 61 |        (print L))
 62 | (infer? (print (cons 5 nil)))
 63 | ;
 64 | (infer (member X L) from (append L1 (cons X L2) L)).
 65 | (infer (lookup K A L) from (member (pair K A) L))
 66 | (infer (capitols (cons (pair chile santiago) (cons (pair peru lima) nil))))
 67 | (infer?  (capitols C) (lookup peru Capitol C) (print Capitol))
 68 | (infer? (print lima))
 69 | ;
 70 | (infer (mult 0 Y 0))
 71 | (infer (mult X Y Z) from (minus X 1 V) (mult V Y W) (plus W Y Z))
 72 | (infer?  (mult 3 5 X) (print X))
 73 | (infer? (print 15))
 74 | (infer (mult X Y Z) from (minus X 1 V) (plus W Y Z) (mult V Y W)).
 75 | (infer (fac 0 1))
 76 | (infer (fac N R) from (minus N 1 N1) (fac N1 R1) (mult R1 N R))
 77 | (infer (naive-sort L M) from (permutation L M) (ordered M)).
 78 | (infer (<= X X))
 79 | (infer (<= X Y) from (less X Y))
 80 | ;
 81 | (infer (ordered nil))
 82 | (infer (ordered (cons A nil)))
 83 | (infer (ordered (cons A (cons B L))) from (<= A B) (ordered (cons B L)))
 84 | ;
 85 | (infer (permutation nil nil))
 86 | (infer (permutation L (cons H T))
 87 |       from (append V (cons H U) L) (append V U W) (permutation W T))
 88 | ;
 89 | (infer (naive-sort L M) from (permutation L M) (ordered M)).
 90 | (infer?  (naive-sort (cons 4 (cons 2 (cons 3 nil))) L) (print L))
 91 | (infer? (print (cons 2 (cons 3 (cons 4 nil)))))
 92 | ;
 93 | (infer (partition H (cons A X) (cons A Y) Z) from (<= A H) (partition H X Y Z))
 94 | (infer (partition H (cons A X) Y (cons A Z)) from (less H A) (partition H X Y Z))
 95 | (infer (partition H nil nil nil))
 96 | ;
 97 | (infer (quicksort nil nil))
 98 | (infer (quicksort (cons H T) S)
 99 |       from
100 |       (partition H T A B)
101 |              (quicksort A A1)
102 |              (quicksort B B1)
103 |              (append A1 (cons H B1) S))
104 | (infer?  (quicksort (cons 8 (cons 2 (cons 3 (cons 7 (cons 1 nil))))) S)
105 |               (print S))
106 | (infer? (print (cons 1 (cons 2 (cons 3 (cons 7 (cons 8 nil)))))))
107 | ;
108 | (infer (simplify (diff X X) nil))
109 | (infer (simplify (diff (cons X Y) Z) (cons X W)) from (simplify (diff Y Z) W))
110 | (infer?  (simplify (diff (cons 3 (cons 4 X)) X) L) (print L))
111 | (infer? (print (cons 3 (cons 4 nil))))
112 | (infer?  (simplify L (cons 3 (cons 4 nil))) (print L))
113 | (infer? (print (diff (cons 3 (cons 4 Z1)) Z1)))
114 | (infer (diffappend (diff L X) (diff X Y) (diff L Y))).
115 | (infer?  (diffappend (diff (cons 3 X) X) (diff (cons 4 Y) Y) Z)
116 |         (print Z))
117 | (infer? (print (diff (cons 3 (cons 4 Y)) Y)))
118 | quit
119 | 


--------------------------------------------------------------------------------
/distr/code.lsp.o:
--------------------------------------------------------------------------------
  1 | -> -> mod
  2 | -> +1
  3 | -> -> (a)
  4 | 
  5 | -> (a)
  6 | 
  7 | -> (a b)
  8 | 
  9 | -> (a b)
 10 | 
 11 | -> ((a) b)
 12 | 
 13 | -> ((a) b)
 14 | 
 15 | -> ((b (c d)))
 16 | 
 17 | -> ((b (c d)))
 18 | 
 19 | -> T
 20 | 
 21 | -> T
 22 | 
 23 | -> ()
 24 | 
 25 | -> ()
 26 | 
 27 | -> length
 28 | -> caar
 29 | -> cadr
 30 | -> cddr
 31 | -> caddr
 32 | -> cadar
 33 | -> cadddr
 34 | -> list1
 35 | -> list2
 36 | -> list3
 37 | -> ((a) b)
 38 | 
 39 | -> ((a) b)
 40 | 
 41 | -> or
 42 | -> atom?
 43 | -> > > > > > equal
 44 | -> ()
 45 | 
 46 | -> ()
 47 | 
 48 | -> T
 49 | 
 50 | -> T
 51 | 
 52 | -> ()
 53 | 
 54 | -> ()
 55 | 
 56 | -> and
 57 | -> not
 58 | -> divides
 59 | -> > interval-list
 60 | -> (3 4 5 6 7)
 61 | 
 62 | -> (3 4 5 6 7)
 63 | 
 64 | -> > > > > remove-multiples
 65 | -> (3 5 7)
 66 | 
 67 | -> (3 5 7)
 68 | 
 69 | -> > > sieve
 70 | -> primes<=
 71 | -> (2 3 5 7)
 72 | 
 73 | -> (2 3 5 7)
 74 | 
 75 | -> > > > insert
 76 | -> > > insertion-sort
 77 | -> (2 3 4 5 6 8)
 78 | 
 79 | -> (2 3 4 5 6 8)
 80 | 
 81 | -> > > > assoc
 82 | -> Thant
 83 | 
 84 | -> Thant
 85 | 
 86 | -> > > > > mkassoc
 87 | -> ((I Ching))
 88 | 
 89 | -> ((I Ching))
 90 | 
 91 | -> ((I Ching) (E coli))
 92 | 
 93 | -> ((I Ching) (E Coli))
 94 | 
 95 | -> ((I Magnin) (E coli))
 96 | 
 97 | -> ((I Magnin) (E coli))
 98 | 
 99 | -> Magnin
100 | 
101 | -> Magnin
102 | 
103 | -> ((apple ((texture crunchy))) (banana ((color yellow))))
104 | 
105 | -> > > getprop
106 | -> crunchy
107 | 
108 | -> crunchy
109 | 
110 | -> > > putprop
111 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
112 | 
113 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
114 | 
115 | -> red
116 | 
117 | -> red
118 | 
119 | -> hasprop?
120 | -> > > > > > gatherprop
121 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))) (lemon ((color yellow))))
122 | 
123 | -> ((apple ((texture crunchy) ... (lemon ((color yellow))))))
124 | 
125 | -> (banana lemon)
126 | 
127 | -> (banana lemon)
128 | 
129 | -> ()
130 | 
131 | -> ()
132 | 
133 | -> > addelt
134 | -> > > member?
135 | -> size
136 | -> > > > > union
137 | -> (3 a)
138 | 
139 | -> (3 a)
140 | 
141 | -> T
142 | 
143 | -> T
144 | 
145 | -> (a 2 3)
146 | 
147 | -> (a 2 3)
148 | 
149 | -> ((a b) 1)
150 | 
151 | -> ((a b) 1)
152 | 
153 | -> T
154 | 
155 | -> T
156 | 
157 | -> > > > sum
158 | -> > > > > > wrong-sum
159 | -> 10
160 | 
161 | -> 10
162 | 
163 | -> 16
164 | 
165 | -> 16
166 | 
167 | -> right-sum
168 | -> > > > > > right-sum-aux
169 | -> 10
170 | 
171 | -> 10
172 | 
173 | -> > > > > > pre-ord
174 | -> A
175 | B
176 | C
177 | D
178 | E
179 | F
180 | G
181 | H
182 | I
183 | I
184 | 
185 | -> (output is A B C D E F G H I)
186 | 
187 | -> -> ()
188 | 
189 | -> front
190 | -> rm-front
191 | -> > enqueue
192 | -> empty?
193 | -> -> level-ord
194 | -> > > > > > > > > > > > > level-ord*
195 | -> A
196 | B
197 | E
198 | C
199 | D
200 | F
201 | I
202 | G
203 | H
204 | ()
205 | 
206 | -> (output is A B E C D E F I G H)
207 | 
208 | -> -> > > > > inter
209 | -> > > > > > diff
210 | -> > > > UNION
211 | -> > > > INTER
212 | -> > > > DIFF
213 | -> > SELECT
214 | -> > > col-num
215 | -> > > > > include-rows
216 | -> > nth
217 | -> > PROJECT
218 | -> > > col-num*
219 | -> > > > include-cols*
220 | -> > > > include-cols
221 | -> > append
222 | -> > > > > > > > > > > > JOIN
223 | -> > > > > > > > > > > > > > > > > join-cols*
224 | -> > > > join-cols
225 | -> > > > > > > ((Victim Crime Criminal Location) (Phelps robbery Harrison London) (Drebber murder Hope London) (Sir-Charles murder Stapleton Devonshire) (Lady-Eva blackmail Milverton London) (Brunton murder Howells West-Sussex))
226 | 
227 | -> > > > > ((Victim Weapon Motive) (Drebber poison revenge) (Sir-Charles hound greed) (Brunton burial-alive passion))
228 | 
229 | -> > > > ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
230 | 
231 | -> ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
232 | 
233 | -> -> > > > > > eval
234 | -> > > > > apply-op
235 | -> 23
236 | 
237 | -> 23
238 | 
239 | -> 7
240 | 
241 | -> 7
242 | 
243 | -> 24
244 | 
245 | -> 24
246 | 
247 | -> > > > > > > eval
248 | -> 6
249 | 
250 | -> 6
251 | 
252 | -> > > > > > > > > > eval
253 | -> > > > > > > > > apply-binary-op
254 | -> > > > > > > apply-unary-op
255 | -> a
256 | 
257 | -> a
258 | 
259 | -> (3 9)
260 | 
261 | -> (3 9)
262 | 
263 | -> > > > > > > > > > > > > > > > > > eval
264 | -> userfun?
265 | -> > > > apply-userfun
266 | -> > > > evallist
267 | -> > > > mkassoc*
268 | -> ((double ((a) (+ a a))))
269 | 
270 | -> ((double ((a) (+ a a))))
271 | 
272 | -> 8
273 | 
274 | -> 8
275 | 
276 | -> > > ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
277 | 
278 | -> ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
279 | 
280 | -> 64
281 | 
282 | -> 64
283 | 
284 | -> r-e-p-loop
285 | -> > > > > > > r-e-p-loop*
286 | -> > > > process-def
287 | -> > > process-exp
288 | -> > > > > > (double 8 exp 64)
289 | 
290 | -> (double 8 exp 64)
291 | 
292 | -> 


--------------------------------------------------------------------------------
/C-distr/code.lsp.out:
--------------------------------------------------------------------------------
  1 | -> -> mod
  2 | -> +1
  3 | -> -> (a)
  4 | 
  5 | -> (a)
  6 | 
  7 | -> (a b)
  8 | 
  9 | -> (a b)
 10 | 
 11 | -> ((a) b)
 12 | 
 13 | -> ((a) b)
 14 | 
 15 | -> ((b (c d)))
 16 | 
 17 | -> ((b (c d)))
 18 | 
 19 | -> T
 20 | 
 21 | -> T
 22 | 
 23 | -> ()
 24 | 
 25 | -> ()
 26 | 
 27 | -> length
 28 | -> caar
 29 | -> cadr
 30 | -> cddr
 31 | -> caddr
 32 | -> cadar
 33 | -> cadddr
 34 | -> list1
 35 | -> list2
 36 | -> list3
 37 | -> ((a) b)
 38 | 
 39 | -> ((a) b)
 40 | 
 41 | -> or
 42 | -> atom?
 43 | -> > > > > > equal
 44 | -> ()
 45 | 
 46 | -> ()
 47 | 
 48 | -> T
 49 | 
 50 | -> T
 51 | 
 52 | -> ()
 53 | 
 54 | -> ()
 55 | 
 56 | -> and
 57 | -> not
 58 | -> divides
 59 | -> > interval-list
 60 | -> (3 4 5 6 7)
 61 | 
 62 | -> (3 4 5 6 7)
 63 | 
 64 | -> > > > > remove-multiples
 65 | -> (3 5 7)
 66 | 
 67 | -> (3 5 7)
 68 | 
 69 | -> > > sieve
 70 | -> primes<=
 71 | -> (2 3 5 7)
 72 | 
 73 | -> (2 3 5 7)
 74 | 
 75 | -> > > > insert
 76 | -> > > insertion-sort
 77 | -> (2 3 4 5 6 8)
 78 | 
 79 | -> (2 3 4 5 6 8)
 80 | 
 81 | -> > > > assoc
 82 | -> Thant
 83 | 
 84 | -> Thant
 85 | 
 86 | -> > > > > mkassoc
 87 | -> ((I Ching))
 88 | 
 89 | -> ((I Ching))
 90 | 
 91 | -> ((I Ching) (E coli))
 92 | 
 93 | -> ((I Ching) (E Coli))
 94 | 
 95 | -> ((I Magnin) (E coli))
 96 | 
 97 | -> ((I Magnin) (E coli))
 98 | 
 99 | -> Magnin
100 | 
101 | -> Magnin
102 | 
103 | -> ((apple ((texture crunchy))) (banana ((color yellow))))
104 | 
105 | -> > > getprop
106 | -> crunchy
107 | 
108 | -> crunchy
109 | 
110 | -> > > putprop
111 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
112 | 
113 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
114 | 
115 | -> red
116 | 
117 | -> red
118 | 
119 | -> hasprop?
120 | -> > > > > > gatherprop
121 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))) (lemon ((color yellow))))
122 | 
123 | -> ((apple ((texture crunchy) ... (lemon ((color yellow))))))
124 | 
125 | -> (banana lemon)
126 | 
127 | -> (banana lemon)
128 | 
129 | -> ()
130 | 
131 | -> ()
132 | 
133 | -> > addelt
134 | -> > > member?
135 | -> size
136 | -> > > > > union
137 | -> (3 a)
138 | 
139 | -> (3 a)
140 | 
141 | -> T
142 | 
143 | -> T
144 | 
145 | -> (a 2 3)
146 | 
147 | -> (a 2 3)
148 | 
149 | -> ((a b) 1)
150 | 
151 | -> ((a b) 1)
152 | 
153 | -> T
154 | 
155 | -> T
156 | 
157 | -> > > > sum
158 | -> > > > > > wrong-sum
159 | -> 10
160 | 
161 | -> 10
162 | 
163 | -> 16
164 | 
165 | -> 16
166 | 
167 | -> right-sum
168 | -> > > > > > right-sum-aux
169 | -> 10
170 | 
171 | -> 10
172 | 
173 | -> > > > > > pre-ord
174 | -> A
175 | B
176 | C
177 | D
178 | E
179 | F
180 | G
181 | H
182 | I
183 | I
184 | 
185 | -> (output is A B C D E F G H I)
186 | 
187 | -> -> ()
188 | 
189 | -> front
190 | -> rm-front
191 | -> > enqueue
192 | -> empty?
193 | -> -> level-ord
194 | -> > > > > > > > > > > > > level-ord*
195 | -> A
196 | B
197 | E
198 | C
199 | D
200 | F
201 | I
202 | G
203 | H
204 | ()
205 | 
206 | -> (output is A B E C D E F I G H)
207 | 
208 | -> -> > > > > inter
209 | -> > > > > > diff
210 | -> > > > UNION
211 | -> > > > INTER
212 | -> > > > DIFF
213 | -> > SELECT
214 | -> > > col-num
215 | -> > > > > include-rows
216 | -> > nth
217 | -> > PROJECT
218 | -> > > col-num*
219 | -> > > > include-cols*
220 | -> > > > include-cols
221 | -> > append
222 | -> > > > > > > > > > > > JOIN
223 | -> > > > > > > > > > > > > > > > > join-cols*
224 | -> > > > join-cols
225 | -> > > > > > > ((Victim Crime Criminal Location) (Phelps robbery Harrison London) (Drebber murder Hope London) (Sir-Charles murder Stapleton Devonshire) (Lady-Eva blackmail Milverton London) (Brunton murder Howells West-Sussex))
226 | 
227 | -> > > > > ((Victim Weapon Motive) (Drebber poison revenge) (Sir-Charles hound greed) (Brunton burial-alive passion))
228 | 
229 | -> > > > ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
230 | 
231 | -> ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
232 | 
233 | -> -> > > > > > eval
234 | -> > > > > apply-op
235 | -> 23
236 | 
237 | -> 23
238 | 
239 | -> 7
240 | 
241 | -> 7
242 | 
243 | -> 24
244 | 
245 | -> 24
246 | 
247 | -> > > > > > > eval
248 | -> 6
249 | 
250 | -> 6
251 | 
252 | -> > > > > > > > > > eval
253 | -> > > > > > > > > apply-binary-op
254 | -> > > > > > > apply-unary-op
255 | -> a
256 | 
257 | -> a
258 | 
259 | -> (3 9)
260 | 
261 | -> (3 9)
262 | 
263 | -> > > > > > > > > > > > > > > > > > eval
264 | -> userfun?
265 | -> > > > apply-userfun
266 | -> > > > evallist
267 | -> > > > mkassoc*
268 | -> ((double ((a) (+ a a))))
269 | 
270 | -> ((double ((a) (+ a a))))
271 | 
272 | -> 8
273 | 
274 | -> 8
275 | 
276 | -> > > ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
277 | 
278 | -> ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
279 | 
280 | -> 64
281 | 
282 | -> 64
283 | 
284 | -> r-e-p-loop
285 | -> > > > > > > r-e-p-loop*
286 | -> > > > process-def
287 | -> > > process-exp
288 | -> > > > > > (double 8 exp 64)
289 | 
290 | -> (double 8 exp 64)
291 | 
292 | -> 


--------------------------------------------------------------------------------
/distr/code.refcnt.o:
--------------------------------------------------------------------------------
  1 | -> -> mod
  2 | -> +1
  3 | -> -> (a)
  4 | 
  5 | -> (a)
  6 | 
  7 | -> (a b)
  8 | 
  9 | -> (a b)
 10 | 
 11 | -> ((a) b)
 12 | 
 13 | -> ((a) b)
 14 | 
 15 | -> ((b (c d)))
 16 | 
 17 | -> ((b (c d)))
 18 | 
 19 | -> T
 20 | 
 21 | -> T
 22 | 
 23 | -> ()
 24 | 
 25 | -> ()
 26 | 
 27 | -> length
 28 | -> caar
 29 | -> cadr
 30 | -> cddr
 31 | -> caddr
 32 | -> cadar
 33 | -> cadddr
 34 | -> list1
 35 | -> list2
 36 | -> list3
 37 | -> ((a) b)
 38 | 
 39 | -> ((a) b)
 40 | 
 41 | -> or
 42 | -> atom?
 43 | -> > > > > > equal
 44 | -> ()
 45 | 
 46 | -> ()
 47 | 
 48 | -> T
 49 | 
 50 | -> T
 51 | 
 52 | -> ()
 53 | 
 54 | -> ()
 55 | 
 56 | -> and
 57 | -> not
 58 | -> divides
 59 | -> > interval-list
 60 | -> (3 4 5 6 7)
 61 | 
 62 | -> (3 4 5 6 7)
 63 | 
 64 | -> > > > > remove-multiples
 65 | -> (3 5 7)
 66 | 
 67 | -> (3 5 7)
 68 | 
 69 | -> > > sieve
 70 | -> primes<=
 71 | -> (2 3 5 7)
 72 | 
 73 | -> (2 3 5 7)
 74 | 
 75 | -> > > > insert
 76 | -> > > insertion-sort
 77 | -> (2 3 4 5 6 8)
 78 | 
 79 | -> (2 3 4 5 6 8)
 80 | 
 81 | -> > > > assoc
 82 | -> Thant
 83 | 
 84 | -> Thant
 85 | 
 86 | -> > > > > mkassoc
 87 | -> ((I Ching))
 88 | 
 89 | -> ((I Ching))
 90 | 
 91 | -> ((I Ching) (E coli))
 92 | 
 93 | -> ((I Ching) (E Coli))
 94 | 
 95 | -> ((I Magnin) (E coli))
 96 | 
 97 | -> ((I Magnin) (E coli))
 98 | 
 99 | -> Magnin
100 | 
101 | -> Magnin
102 | 
103 | -> ((apple ((texture crunchy))) (banana ((color yellow))))
104 | 
105 | -> > > getprop
106 | -> crunchy
107 | 
108 | -> crunchy
109 | 
110 | -> > > putprop
111 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
112 | 
113 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
114 | 
115 | -> red
116 | 
117 | -> red
118 | 
119 | -> hasprop?
120 | -> > > > > > gatherprop
121 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))) (lemon ((color yellow))))
122 | 
123 | -> ((apple ((texture crunchy) ... (lemon ((color yellow))))))
124 | 
125 | -> (banana lemon)
126 | 
127 | -> (banana lemon)
128 | 
129 | -> ()
130 | 
131 | -> ()
132 | 
133 | -> > addelt
134 | -> > > member?
135 | -> size
136 | -> > > > > union
137 | -> (3 a)
138 | 
139 | -> (3 a)
140 | 
141 | -> T
142 | 
143 | -> T
144 | 
145 | -> (a 2 3)
146 | 
147 | -> (a 2 3)
148 | 
149 | -> ((a b) 1)
150 | 
151 | -> ((a b) 1)
152 | 
153 | -> T
154 | 
155 | -> T
156 | 
157 | -> > > > sum
158 | -> > > > > > wrong-sum
159 | -> 10
160 | 
161 | -> 10
162 | 
163 | -> 16
164 | 
165 | -> 16
166 | 
167 | -> right-sum
168 | -> > > > > > right-sum-aux
169 | -> 10
170 | 
171 | -> 10
172 | 
173 | -> > > > > > pre-ord
174 | -> A
175 | B
176 | C
177 | D
178 | E
179 | F
180 | G
181 | H
182 | I
183 | I
184 | 
185 | -> (output is A B C D E F G H I)
186 | 
187 | -> -> ()
188 | 
189 | -> front
190 | -> rm-front
191 | -> > enqueue
192 | -> empty?
193 | -> -> level-ord
194 | -> > > > > > > > > > > > > level-ord*
195 | -> A
196 | B
197 | E
198 | C
199 | D
200 | F
201 | I
202 | G
203 | H
204 | ()
205 | 
206 | -> (output is A B E C D E F I G H)
207 | 
208 | -> -> > > > > inter
209 | -> > > > > > diff
210 | -> > > > UNION
211 | -> > > > INTER
212 | -> > > > DIFF
213 | -> > SELECT
214 | -> > > col-num
215 | -> > > > > include-rows
216 | -> > nth
217 | -> > PROJECT
218 | -> > > col-num*
219 | -> > > > include-cols*
220 | -> > > > include-cols
221 | -> > append
222 | -> > > > > > > > > > > > JOIN
223 | -> > > > > > > > > > > > > > > > > join-cols*
224 | -> > > > join-cols
225 | -> > > > > > > ((Victim Crime Criminal Location) (Phelps robbery Harrison London) (Drebber murder Hope London) (Sir-Charles murder Stapleton Devonshire) (Lady-Eva blackmail Milverton London) (Brunton murder Howells West-Sussex))
226 | 
227 | -> > > > > ((Victim Weapon Motive) (Drebber poison revenge) (Sir-Charles hound greed) (Brunton burial-alive passion))
228 | 
229 | -> > > > ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
230 | 
231 | -> ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
232 | 
233 | -> -> > > > > > eval
234 | -> > > > > apply-op
235 | -> 23
236 | 
237 | -> 23
238 | 
239 | -> 7
240 | 
241 | -> 7
242 | 
243 | -> 24
244 | 
245 | -> 24
246 | 
247 | -> > > > > > > eval
248 | -> 6
249 | 
250 | -> 6
251 | 
252 | -> > > > > > > > > > eval
253 | -> > > > > > > > > apply-binary-op
254 | -> > > > > > > apply-unary-op
255 | -> a
256 | 
257 | -> a
258 | 
259 | -> (3 9)
260 | 
261 | -> (3 9)
262 | 
263 | -> > > > > > > > > > > > > > > > > > eval
264 | -> userfun?
265 | -> > > > apply-userfun
266 | -> > > > evallist
267 | -> > > > mkassoc*
268 | -> ((double ((a) (+ a a))))
269 | 
270 | -> ((double ((a) (+ a a))))
271 | 
272 | -> 8
273 | 
274 | -> 8
275 | 
276 | -> > > ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
277 | 
278 | -> ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
279 | 
280 | -> 64
281 | 
282 | -> 64
283 | 
284 | -> r-e-p-loop
285 | -> > > > > > > r-e-p-loop*
286 | -> > > > process-def
287 | -> > > process-exp
288 | -> > > > > > (double 8 exp 64)
289 | 
290 | -> (double 8 exp 64)
291 | 
292 | -> 


--------------------------------------------------------------------------------
/distr/code.stack.o:
--------------------------------------------------------------------------------
  1 | -> -> mod
  2 | -> +1
  3 | -> -> (a)
  4 | 
  5 | -> (a)
  6 | 
  7 | -> (a b)
  8 | 
  9 | -> (a b)
 10 | 
 11 | -> ((a) b)
 12 | 
 13 | -> ((a) b)
 14 | 
 15 | -> ((b (c d)))
 16 | 
 17 | -> ((b (c d)))
 18 | 
 19 | -> T
 20 | 
 21 | -> T
 22 | 
 23 | -> ()
 24 | 
 25 | -> ()
 26 | 
 27 | -> length
 28 | -> caar
 29 | -> cadr
 30 | -> cddr
 31 | -> caddr
 32 | -> cadar
 33 | -> cadddr
 34 | -> list1
 35 | -> list2
 36 | -> list3
 37 | -> ((a) b)
 38 | 
 39 | -> ((a) b)
 40 | 
 41 | -> or
 42 | -> atom?
 43 | -> > > > > > equal
 44 | -> ()
 45 | 
 46 | -> ()
 47 | 
 48 | -> T
 49 | 
 50 | -> T
 51 | 
 52 | -> ()
 53 | 
 54 | -> ()
 55 | 
 56 | -> and
 57 | -> not
 58 | -> divides
 59 | -> > interval-list
 60 | -> (3 4 5 6 7)
 61 | 
 62 | -> (3 4 5 6 7)
 63 | 
 64 | -> > > > > remove-multiples
 65 | -> (3 5 7)
 66 | 
 67 | -> (3 5 7)
 68 | 
 69 | -> > > sieve
 70 | -> primes<=
 71 | -> (2 3 5 7)
 72 | 
 73 | -> (2 3 5 7)
 74 | 
 75 | -> > > > insert
 76 | -> > > insertion-sort
 77 | -> (2 3 4 5 6 8)
 78 | 
 79 | -> (2 3 4 5 6 8)
 80 | 
 81 | -> > > > assoc
 82 | -> Thant
 83 | 
 84 | -> Thant
 85 | 
 86 | -> > > > > mkassoc
 87 | -> ((I Ching))
 88 | 
 89 | -> ((I Ching))
 90 | 
 91 | -> ((I Ching) (E coli))
 92 | 
 93 | -> ((I Ching) (E Coli))
 94 | 
 95 | -> ((I Magnin) (E coli))
 96 | 
 97 | -> ((I Magnin) (E coli))
 98 | 
 99 | -> Magnin
100 | 
101 | -> Magnin
102 | 
103 | -> ((apple ((texture crunchy))) (banana ((color yellow))))
104 | 
105 | -> > > getprop
106 | -> crunchy
107 | 
108 | -> crunchy
109 | 
110 | -> > > putprop
111 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
112 | 
113 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
114 | 
115 | -> red
116 | 
117 | -> red
118 | 
119 | -> hasprop?
120 | -> > > > > > gatherprop
121 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))) (lemon ((color yellow))))
122 | 
123 | -> ((apple ((texture crunchy) ... (lemon ((color yellow))))))
124 | 
125 | -> (banana lemon)
126 | 
127 | -> (banana lemon)
128 | 
129 | -> ()
130 | 
131 | -> ()
132 | 
133 | -> > addelt
134 | -> > > member?
135 | -> size
136 | -> > > > > union
137 | -> (3 a)
138 | 
139 | -> (3 a)
140 | 
141 | -> T
142 | 
143 | -> T
144 | 
145 | -> (a 2 3)
146 | 
147 | -> (a 2 3)
148 | 
149 | -> ((a b) 1)
150 | 
151 | -> ((a b) 1)
152 | 
153 | -> T
154 | 
155 | -> T
156 | 
157 | -> > > > sum
158 | -> > > > > > wrong-sum
159 | -> 10
160 | 
161 | -> 10
162 | 
163 | -> 16
164 | 
165 | -> 16
166 | 
167 | -> right-sum
168 | -> > > > > > right-sum-aux
169 | -> 10
170 | 
171 | -> 10
172 | 
173 | -> > > > > > pre-ord
174 | -> A
175 | B
176 | C
177 | D
178 | E
179 | F
180 | G
181 | H
182 | I
183 | I
184 | 
185 | -> (output is A B C D E F G H I)
186 | 
187 | -> -> ()
188 | 
189 | -> front
190 | -> rm-front
191 | -> > enqueue
192 | -> empty?
193 | -> -> level-ord
194 | -> > > > > > > > > > > > > level-ord*
195 | -> A
196 | B
197 | E
198 | C
199 | D
200 | F
201 | I
202 | G
203 | H
204 | ()
205 | 
206 | -> (output is A B E C D E F I G H)
207 | 
208 | -> -> > > > > inter
209 | -> > > > > > diff
210 | -> > > > UNION
211 | -> > > > INTER
212 | -> > > > DIFF
213 | -> > SELECT
214 | -> > > col-num
215 | -> > > > > include-rows
216 | -> > nth
217 | -> > PROJECT
218 | -> > > col-num*
219 | -> > > > include-cols*
220 | -> > > > include-cols
221 | -> > append
222 | -> > > > > > > > > > > > JOIN
223 | -> > > > > > > > > > > > > > > > > join-cols*
224 | -> > > > join-cols
225 | -> > > > > > > ((Victim Crime Criminal Location) (Phelps robbery Harrison London) (Drebber murder Hope London) (Sir-Charles murder Stapleton Devonshire) (Lady-Eva blackmail Milverton London) (Brunton murder Howells West-Sussex))
226 | 
227 | -> > > > > ((Victim Weapon Motive) (Drebber poison revenge) (Sir-Charles hound greed) (Brunton burial-alive passion))
228 | 
229 | -> > > > ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
230 | 
231 | -> ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
232 | 
233 | -> -> > > > > > eval
234 | -> > > > > apply-op
235 | -> 23
236 | 
237 | -> 23
238 | 
239 | -> 7
240 | 
241 | -> 7
242 | 
243 | -> 24
244 | 
245 | -> 24
246 | 
247 | -> > > > > > > eval
248 | -> 6
249 | 
250 | -> 6
251 | 
252 | -> > > > > > > > > > eval
253 | -> > > > > > > > > apply-binary-op
254 | -> > > > > > > apply-unary-op
255 | -> a
256 | 
257 | -> a
258 | 
259 | -> (3 9)
260 | 
261 | -> (3 9)
262 | 
263 | -> > > > > > > > > > > > > > > > > > eval
264 | -> userfun?
265 | -> > > > apply-userfun
266 | -> > > > evallist
267 | -> > > > mkassoc*
268 | -> ((double ((a) (+ a a))))
269 | 
270 | -> ((double ((a) (+ a a))))
271 | 
272 | -> 8
273 | 
274 | -> 8
275 | 
276 | -> > > ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
277 | 
278 | -> ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
279 | 
280 | -> 64
281 | 
282 | -> 64
283 | 
284 | -> r-e-p-loop
285 | -> > > > > > > r-e-p-loop*
286 | -> > > > process-def
287 | -> > > process-exp
288 | -> > > > > > (double 8 exp 64)
289 | 
290 | -> (double 8 exp 64)
291 | 
292 | -> 


--------------------------------------------------------------------------------
/distr/code.ssgc.o:
--------------------------------------------------------------------------------
  1 | -> -> mod
  2 | -> +1
  3 | -> -> (a)
  4 | 
  5 | -> (a)
  6 | 
  7 | -> (a b)
  8 | 
  9 | -> (a b)
 10 | 
 11 | -> ((a) b)
 12 | 
 13 | -> ((a) b)
 14 | 
 15 | -> ((b (c d)))
 16 | 
 17 | -> ((b (c d)))
 18 | 
 19 | -> T
 20 | 
 21 | -> T
 22 | 
 23 | -> ()
 24 | 
 25 | -> ()
 26 | 
 27 | -> length
 28 | -> caar
 29 | -> cadr
 30 | -> cddr
 31 | -> caddr
 32 | -> cadar
 33 | -> cadddr
 34 | -> list1
 35 | -> list2
 36 | -> list3
 37 | -> ((a) b)
 38 | 
 39 | -> ((a) b)
 40 | 
 41 | -> or
 42 | -> atom?
 43 | -> > > > > > equal
 44 | -> ()
 45 | 
 46 | -> ()
 47 | 
 48 | -> T
 49 | 
 50 | -> T
 51 | 
 52 | -> ()
 53 | 
 54 | -> ()
 55 | 
 56 | -> and
 57 | -> not
 58 | -> divides
 59 | -> > interval-list
 60 | -> (3 4 5 6 7)
 61 | 
 62 | -> (3 4 5 6 7)
 63 | 
 64 | -> > > > > remove-multiples
 65 | -> (3 5 7)
 66 | 
 67 | -> (3 5 7)
 68 | 
 69 | -> > > sieve
 70 | -> primes<=
 71 | -> (2 3 5 7)
 72 | 
 73 | -> (2 3 5 7)
 74 | 
 75 | -> > > > insert
 76 | -> > > insertion-sort
 77 | -> (2 3 4 5 6 8)
 78 | 
 79 | -> (2 3 4 5 6 8)
 80 | 
 81 | -> > > > assoc
 82 | -> Thant
 83 | 
 84 | -> Thant
 85 | 
 86 | -> > > > > mkassoc
 87 | -> ((I Ching))
 88 | 
 89 | -> ((I Ching))
 90 | 
 91 | -> ((I Ching) (E coli))
 92 | 
 93 | -> ((I Ching) (E Coli))
 94 | 
 95 | -> ((I Magnin) (E coli))
 96 | 
 97 | -> ((I Magnin) (E coli))
 98 | 
 99 | -> Magnin
100 | 
101 | -> Magnin
102 | 
103 | -> ((apple ((texture crunchy))) (banana ((color yellow))))
104 | 
105 | -> > > getprop
106 | -> crunchy
107 | 
108 | -> crunchy
109 | 
110 | -> > > putprop
111 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
112 | 
113 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
114 | 
115 | -> red
116 | 
117 | -> red
118 | 
119 | -> hasprop?
120 | -> > > > > > gatherprop
121 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))) (lemon ((color yellow))))
122 | 
123 | -> ((apple ((texture crunchy) ... (lemon ((color yellow))))))
124 | 
125 | -> Switching memories...recovered 435(87%) cells
126 | Called gc during parsing. Parse aborted; reenter input
127 | -> (banana lemon)
128 | 
129 | -> ()
130 | 
131 | -> ()
132 | 
133 | -> > addelt
134 | -> > > member?
135 | -> size
136 | -> > > > > union
137 | -> (3 a)
138 | 
139 | -> (3 a)
140 | 
141 | -> T
142 | 
143 | -> T
144 | 
145 | -> (a 2 3)
146 | 
147 | -> (a 2 3)
148 | 
149 | -> ((a b) 1)
150 | 
151 | -> ((a b) 1)
152 | 
153 | -> T
154 | 
155 | -> T
156 | 
157 | -> > > > sum
158 | -> > > > > > wrong-sum
159 | -> 10
160 | 
161 | -> 10
162 | 
163 | -> 16
164 | 
165 | -> 16
166 | 
167 | -> right-sum
168 | -> > > > > > right-sum-aux
169 | -> 10
170 | 
171 | -> 10
172 | 
173 | -> > > > > > pre-ord
174 | -> A
175 | B
176 | C
177 | D
178 | E
179 | F
180 | G
181 | H
182 | I
183 | I
184 | 
185 | -> (output is A B C D E F G H I)
186 | 
187 | -> -> ()
188 | 
189 | -> front
190 | -> rm-front
191 | -> > enqueue
192 | -> empty?
193 | -> -> level-ord
194 | -> > > > > > > > > > > > > level-ord*
195 | -> A
196 | B
197 | E
198 | C
199 | D
200 | F
201 | I
202 | G
203 | H
204 | ()
205 | 
206 | -> (output is A B E C D E F I G H)
207 | 
208 | -> -> > > > > inter
209 | -> > > > > > diff
210 | -> > > > UNION
211 | -> > > > INTER
212 | -> > > > DIFF
213 | -> > SELECT
214 | -> > > col-num
215 | -> > > > > include-rows
216 | -> > nth
217 | -> > PROJECT
218 | -> > > col-num*
219 | -> > > > include-cols*
220 | -> > > > include-cols
221 | -> > append
222 | -> > > > > > > > > > > > JOIN
223 | -> > > > > > > > > > > > > > > > > join-cols*
224 | -> > > > join-cols
225 | -> > > > > > > ((Victim Crime Criminal Location) (Phelps robbery Harrison London) (Drebber murder Hope London) (Sir-Charles murder Stapleton Devonshire) (Lady-Eva blackmail Milverton London) (Brunton murder Howells West-Sussex))
226 | 
227 | -> > > > > ((Victim Weapon Motive) (Drebber poison revenge) (Sir-Charles hound greed) (Brunton burial-alive passion))
228 | 
229 | -> > > > ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
230 | 
231 | -> ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
232 | 
233 | -> -> > > > > > eval
234 | -> > > > > apply-op
235 | -> Switching memories...recovered 283(57%) cells
236 | Called gc during parsing. Parse aborted; reenter input
237 | -> 23
238 | 
239 | -> 7
240 | 
241 | -> 7
242 | 
243 | -> 24
244 | 
245 | -> 24
246 | 
247 | -> > > > > > > eval
248 | -> 6
249 | 
250 | -> 6
251 | 
252 | -> > > > > > > > > > eval
253 | -> > > > > > > > > apply-binary-op
254 | -> > > > > > > apply-unary-op
255 | -> a
256 | 
257 | -> a
258 | 
259 | -> (3 9)
260 | 
261 | -> (3 9)
262 | 
263 | -> > > > > > > > > > > > > > > > > > eval
264 | -> userfun?
265 | -> > > > apply-userfun
266 | -> > > > evallist
267 | -> > > > mkassoc*
268 | -> ((double ((a) (+ a a))))
269 | 
270 | -> ((double ((a) (+ a a))))
271 | 
272 | -> 8
273 | 
274 | -> 8
275 | 
276 | -> > > ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
277 | 
278 | -> Switching memories...recovered 217(43%) cells
279 | Called gc during parsing. Parse aborted; reenter input
280 | -> 64
281 | 
282 | -> 64
283 | 
284 | -> r-e-p-loop
285 | -> > > > > > > r-e-p-loop*
286 | -> > > > process-def
287 | -> > > process-exp
288 | -> > > > > > Switching memories...recovered 100(20%) cells
289 | (double 8 exp 64)
290 | 
291 | -> (double 8 exp 64)
292 | 
293 | -> 


--------------------------------------------------------------------------------
/distr/code.msgc.o:
--------------------------------------------------------------------------------
  1 | -> -> mod
  2 | -> +1
  3 | -> -> (a)
  4 | 
  5 | -> (a)
  6 | 
  7 | -> (a b)
  8 | 
  9 | -> (a b)
 10 | 
 11 | -> ((a) b)
 12 | 
 13 | -> ((a) b)
 14 | 
 15 | -> ((b (c d)))
 16 | 
 17 | -> ((b (c d)))
 18 | 
 19 | -> T
 20 | 
 21 | -> T
 22 | 
 23 | -> ()
 24 | 
 25 | -> ()
 26 | 
 27 | -> length
 28 | -> caar
 29 | -> cadr
 30 | -> cddr
 31 | -> caddr
 32 | -> cadar
 33 | -> cadddr
 34 | -> list1
 35 | -> list2
 36 | -> list3
 37 | -> ((a) b)
 38 | 
 39 | -> ((a) b)
 40 | 
 41 | -> or
 42 | -> atom?
 43 | -> > > > > > equal
 44 | -> ()
 45 | 
 46 | -> ()
 47 | 
 48 | -> T
 49 | 
 50 | -> T
 51 | 
 52 | -> ()
 53 | 
 54 | -> ()
 55 | 
 56 | -> and
 57 | -> not
 58 | -> divides
 59 | -> > interval-list
 60 | -> (3 4 5 6 7)
 61 | 
 62 | -> (3 4 5 6 7)
 63 | 
 64 | -> > > > > remove-multiples
 65 | -> (3 5 7)
 66 | 
 67 | -> (3 5 7)
 68 | 
 69 | -> > > sieve
 70 | -> primes<=
 71 | -> (2 3 5 7)
 72 | 
 73 | -> (2 3 5 7)
 74 | 
 75 | -> > > > insert
 76 | -> > > insertion-sort
 77 | -> (2 3 4 5 6 8)
 78 | 
 79 | -> (2 3 4 5 6 8)
 80 | 
 81 | -> > > > assoc
 82 | -> Thant
 83 | 
 84 | -> Thant
 85 | 
 86 | -> > > > > mkassoc
 87 | -> ((I Ching))
 88 | 
 89 | -> ((I Ching))
 90 | 
 91 | -> ((I Ching) (E coli))
 92 | 
 93 | -> ((I Ching) (E Coli))
 94 | 
 95 | -> ((I Magnin) (E coli))
 96 | 
 97 | -> ((I Magnin) (E coli))
 98 | 
 99 | -> Magnin
100 | 
101 | -> Magnin
102 | 
103 | -> ((apple ((texture crunchy))) (banana ((color yellow))))
104 | 
105 | -> > > getprop
106 | -> crunchy
107 | 
108 | -> crunchy
109 | 
110 | -> > > putprop
111 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
112 | 
113 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))))
114 | 
115 | -> red
116 | 
117 | -> red
118 | 
119 | -> hasprop?
120 | -> > > > > > gatherprop
121 | -> ((apple ((texture crunchy) (color red))) (banana ((color yellow))) (lemon ((color yellow))))
122 | 
123 | -> ((apple ((texture crunchy) ... (lemon ((color yellow))))))
124 | 
125 | -> Garbage collection ...collected 435(87%) records
126 | Called gc during parsing. Parse aborted; reenter input
127 | -> (banana lemon)
128 | 
129 | -> ()
130 | 
131 | -> ()
132 | 
133 | -> > addelt
134 | -> > > member?
135 | -> size
136 | -> > > > > union
137 | -> (3 a)
138 | 
139 | -> (3 a)
140 | 
141 | -> T
142 | 
143 | -> T
144 | 
145 | -> (a 2 3)
146 | 
147 | -> (a 2 3)
148 | 
149 | -> ((a b) 1)
150 | 
151 | -> ((a b) 1)
152 | 
153 | -> T
154 | 
155 | -> T
156 | 
157 | -> > > > sum
158 | -> > > > > > wrong-sum
159 | -> 10
160 | 
161 | -> 10
162 | 
163 | -> 16
164 | 
165 | -> 16
166 | 
167 | -> right-sum
168 | -> > > > > > right-sum-aux
169 | -> 10
170 | 
171 | -> 10
172 | 
173 | -> > > > > > pre-ord
174 | -> A
175 | B
176 | C
177 | D
178 | E
179 | F
180 | G
181 | H
182 | I
183 | I
184 | 
185 | -> (output is A B C D E F G H I)
186 | 
187 | -> -> ()
188 | 
189 | -> front
190 | -> rm-front
191 | -> > enqueue
192 | -> empty?
193 | -> -> level-ord
194 | -> > > > > > > > > > > > > level-ord*
195 | -> A
196 | B
197 | E
198 | C
199 | D
200 | F
201 | I
202 | G
203 | H
204 | ()
205 | 
206 | -> (output is A B E C D E F I G H)
207 | 
208 | -> -> > > > > inter
209 | -> > > > > > diff
210 | -> > > > UNION
211 | -> > > > INTER
212 | -> > > > DIFF
213 | -> > SELECT
214 | -> > > col-num
215 | -> > > > > include-rows
216 | -> > nth
217 | -> > PROJECT
218 | -> > > col-num*
219 | -> > > > include-cols*
220 | -> > > > include-cols
221 | -> > append
222 | -> > > > > > > > > > > > JOIN
223 | -> > > > > > > > > > > > > > > > > join-cols*
224 | -> > > > join-cols
225 | -> > > > > > > ((Victim Crime Criminal Location) (Phelps robbery Harrison London) (Drebber murder Hope London) (Sir-Charles murder Stapleton Devonshire) (Lady-Eva blackmail Milverton London) (Brunton murder Howells West-Sussex))
226 | 
227 | -> > > > > ((Victim Weapon Motive) (Drebber poison revenge) (Sir-Charles hound greed) (Brunton burial-alive passion))
228 | 
229 | -> > > > ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
230 | 
231 | -> ((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
232 | 
233 | -> -> > > > > > eval
234 | -> > > > > apply-op
235 | -> Garbage collection ...collected 283(57%) records
236 | Called gc during parsing. Parse aborted; reenter input
237 | -> 23
238 | 
239 | -> 7
240 | 
241 | -> 7
242 | 
243 | -> 24
244 | 
245 | -> 24
246 | 
247 | -> > > > > > > eval
248 | -> 6
249 | 
250 | -> 6
251 | 
252 | -> > > > > > > > > > eval
253 | -> > > > > > > > > apply-binary-op
254 | -> > > > > > > apply-unary-op
255 | -> a
256 | 
257 | -> a
258 | 
259 | -> (3 9)
260 | 
261 | -> (3 9)
262 | 
263 | -> > > > > > > > > > > > > > > > > > eval
264 | -> userfun?
265 | -> > > > apply-userfun
266 | -> > > > evallist
267 | -> > > > mkassoc*
268 | -> ((double ((a) (+ a a))))
269 | 
270 | -> ((double ((a) (+ a a))))
271 | 
272 | -> 8
273 | 
274 | -> 8
275 | 
276 | -> > > ((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
277 | 
278 | -> Garbage collection ...collected 217(43%) records
279 | Called gc during parsing. Parse aborted; reenter input
280 | -> 64
281 | 
282 | -> 64
283 | 
284 | -> r-e-p-loop
285 | -> > > > > > > r-e-p-loop*
286 | -> > > > process-def
287 | -> > > process-exp
288 | -> > > > > > Garbage collection ...collected 100(20%) records
289 | (double 8 exp 64)
290 | 
291 | -> (double 8 exp 64)
292 | 
293 | -> 


--------------------------------------------------------------------------------
/distr/code.ssl.o:
--------------------------------------------------------------------------------
  1 | -> -> <closure>
  2 | 
  3 | -> > > <closure>
  4 | 
  5 | -> <closure>
  6 | 
  7 | -> <closure>
  8 | 
  9 | -> <closure>
 10 | 
 11 | -> <closure>
 12 | 
 13 | -> <closure>
 14 | 
 15 | -> <closure>
 16 | 
 17 | -> <closure>
 18 | 
 19 | -> <closure>
 20 | 
 21 | -> > > <closure>
 22 | 
 23 | -> <closure>
 24 | 
 25 | -> <closure>
 26 | 
 27 | -> <closure>
 28 | 
 29 | -> <closure>
 30 | 
 31 | -> <closure>
 32 | 
 33 | -> <closure>
 34 | 
 35 | -> <closure>
 36 | 
 37 | -> <closure>
 38 | 
 39 | -> <closure>
 40 | 
 41 | -> <closure>
 42 | 
 43 | -> > > > <closure>
 44 | 
 45 | -> > > > > <closure>
 46 | 
 47 | -> ()
 48 | 
 49 | -> <closure>
 50 | 
 51 | -> <closure>
 52 | 
 53 | -> > <closure>
 54 | 
 55 | -> <closure>
 56 | 
 57 | -> -> <closure>
 58 | 
 59 | -> > <closure>
 60 | 
 61 | -> > > > <closure>
 62 | 
 63 | -> > <closure>
 64 | 
 65 | -> 6
 66 | 
 67 | -> 6
 68 | 
 69 | -> > <closure>
 70 | 
 71 | -> 9
 72 | 
 73 | -> 9
 74 | 
 75 | -> -> <closure>
 76 | 
 77 | -> <closure>
 78 | 
 79 | -> 6
 80 | 
 81 | -> 6
 82 | 
 83 | -> -> (... ...)
 84 | 
 85 | -> (... ...)
 86 | 
 87 | -> 3
 88 | 
 89 | -> 3
 90 | 
 91 | -> 4
 92 | 
 93 | -> 4
 94 | 
 95 | -> (3 4 ...)
 96 | 
 97 | -> (3 4 ...)
 98 | 
 99 | -> ()
100 | 
101 | -> ()
102 | 
103 | -> (3 4)
104 | 
105 | -> (3 4)
106 | 
107 | -> > <closure>
108 | 
109 | -> (... ...)
110 | 
111 | -> (... ...)
112 | 
113 | -> 0
114 | 
115 | -> 0
116 | 
117 | -> 1
118 | 
119 | -> 1
120 | 
121 | -> (0 1 ...)
122 | 
123 | -> (0 1 ...)
124 | 
125 | -> > > > <closure>
126 | 
127 | -> (... ...)
128 | 
129 | -> (... ...)
130 | 
131 | -> T
132 | 
133 | -> T
134 | 
135 | -> (3 4)
136 | 
137 | -> (3 4)
138 | 
139 | -> > > > <closure>
140 | 
141 | -> (... ...)
142 | 
143 | -> (... ...)
144 | 
145 | -> T
146 | 
147 | -> T
148 | 
149 | -> (0 1 2 3 4)
150 | 
151 | -> (0 1 2 3 4)
152 | 
153 | -> <closure>
154 | 
155 | -> <closure>
156 | 
157 | -> <closure>
158 | 
159 | -> > <closure>
160 | 
161 | -> > <closure>
162 | 
163 | -> > > <closure>
164 | 
165 | -> 10
166 | 
167 | -> 10
168 | 
169 | -> <closure>
170 | 
171 | -> > <closure>
172 | 
173 | -> 5
174 | 
175 | -> 5
176 | 
177 | -> > > > > <closure>
178 | 
179 | -> > > <closure>
180 | 
181 | -> <closure>
182 | 
183 | -> (... ...)
184 | 
185 | -> <closure>
186 | 
187 | -> (... ...)
188 | 
189 | -> T
190 | 
191 | -> (2 3 5 7 11)
192 | 
193 | -> -> <closure>
194 | 
195 | -> > > <closure>
196 | 
197 | -> > <closure>
198 | 
199 | -> <closure>
200 | 
201 | -> 6
202 | 
203 | -> 6
204 | 
205 | -> -> <closure>
206 | 
207 | -> > > > <closure>
208 | 
209 | -> <closure>
210 | 
211 | -> > <closure>
212 | 
213 | -> > <closure>
214 | 
215 | -> > > > <closure>
216 | 
217 | -> > <closure>
218 | 
219 | -> > > > <closure>
220 | 
221 | -> (... ...)
222 | 
223 | -> T
224 | 
225 | -> (Permutations of a b c)
226 | 
227 | -> ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
228 | 
229 | -> <closure>
230 | 
231 | -> (2 ...)
232 | 
233 | -> T
234 | 
235 | -> (2 1 3 4)
236 | 
237 | -> (2 1 3 4)
238 | 
239 | -> -> (... ...)
240 | 
241 | -> (... ...)
242 | 
243 | -> > > <closure>
244 | 
245 | -> (... ...)
246 | 
247 | -> (... ...)
248 | 
249 | -> (... ...)
250 | 
251 | -> 6
252 | 
253 | -> 6
254 | 
255 | -> -> > > > > > > > > <closure>
256 | 
257 | -> > <closure>
258 | 
259 | -> > > <closure>
260 | 
261 | -> > > > <closure>
262 | 
263 | -> <closure>
264 | 
265 | -> <closure>
266 | 
267 | -> > > > > <closure>
268 | 
269 | -> > > > <closure>
270 | 
271 | -> Unsatisfiable
272 | 
273 | -> -> > <closure>
274 | 
275 | -> > > > <closure>
276 | 
277 | -> ((2 2) (0 1) (3 0))
278 | 
279 | -> ((2 2) (0 1) (3 0))
280 | 
281 | -> (... ...)
282 | 
283 | -> <closure>
284 | 
285 | -> <closure>
286 | 
287 | -> > > > <closure>
288 | 
289 | -> > > > <closure>
290 | 
291 | -> > > > <closure>
292 | 
293 | -> -> > <closure>
294 | 
295 | -> -> > <closure>
296 | 
297 | -> > > > > > <closure>
298 | 
299 | -> > > > <closure>
300 | 
301 | -> T
302 | 
303 | -> T
304 | 
305 | -> ()
306 | 
307 | -> ()
308 | 
309 | -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> <closure>
310 | 
311 | -> <closure>
312 | 
313 | -> <closure>
314 | 
315 | -> a
316 | 
317 | -> a
318 | 
319 | -> <closure>
320 | 
321 | -> <closure>
322 | 
323 | -> 24
324 | 
325 | -> 24
326 | 
327 | -> <closure>
328 | 
329 | -> <closure>
330 | 
331 | -> <closure>
332 | 
333 | -> <closure>
334 | 
335 | -> <closure>
336 | 
337 | -> <closure>
338 | 
339 | -> <closure>
340 | 
341 | -> 3
342 | 
343 | -> 3
344 | 
345 | -> <closure>
346 | 
347 | -> > <closure>
348 | 
349 | -> 15
350 | 
351 | -> 15
352 | 
353 | -> <closure>
354 | 
355 | -> <closure>
356 | 
357 | -> <closure>
358 | 
359 | -> <closure>
360 | 
361 | -> 2
362 | 
363 | -> 2
364 | 
365 | -> <closure>
366 | 
367 | -> <closure>
368 | 
369 | -> <closure>
370 | 
371 | -> 3
372 | 
373 | -> 3
374 | 
375 | -> <closure>
376 | 
377 | -> <closure>
378 | 
379 | -> 6
380 | 
381 | -> 6
382 | 
383 | -> <closure>
384 | 
385 | -> <closure>
386 | 
387 | -> <closure>
388 | 
389 | -> <closure>
390 | 
391 | -> <closure>
392 | 
393 | -> 4
394 | 
395 | -> 4
396 | 
397 | -> <closure>
398 | 
399 | -> <closure>
400 | 
401 | -> > <closure>
402 | 
403 | -> <closure>
404 | 
405 | -> <closure>
406 | 
407 | -> > <closure>
408 | 
409 | -> yes
410 | 
411 | -> yes
412 | 
413 | -> no
414 | 
415 | -> no
416 | 
417 | -> > <closure>
418 | 
419 | -> 24
420 | 
421 | -> 24
422 | 
423 | -> > <closure>
424 | 
425 | -> <closure>
426 | 
427 | -> 24
428 | 
429 | -> 24
430 | 
431 | -> <closure>
432 | 
433 | -> <closure>
434 | 
435 | -> <closure>
436 | 
437 | -> 1
438 | 
439 | -> 1
440 | 
441 | -> > > <closure>
442 | 
443 | -> 24
444 | 
445 | -> 24
446 | 
447 | -> 


--------------------------------------------------------------------------------
/C-distr/code.ssl.out:
--------------------------------------------------------------------------------
  1 | -> -> <closure>
  2 | 
  3 | -> > > <closure>
  4 | 
  5 | -> <closure>
  6 | 
  7 | -> <closure>
  8 | 
  9 | -> <closure>
 10 | 
 11 | -> <closure>
 12 | 
 13 | -> <closure>
 14 | 
 15 | -> <closure>
 16 | 
 17 | -> <closure>
 18 | 
 19 | -> <closure>
 20 | 
 21 | -> > > <closure>
 22 | 
 23 | -> <closure>
 24 | 
 25 | -> <closure>
 26 | 
 27 | -> <closure>
 28 | 
 29 | -> <closure>
 30 | 
 31 | -> <closure>
 32 | 
 33 | -> <closure>
 34 | 
 35 | -> <closure>
 36 | 
 37 | -> <closure>
 38 | 
 39 | -> <closure>
 40 | 
 41 | -> <closure>
 42 | 
 43 | -> > > > <closure>
 44 | 
 45 | -> > > > > <closure>
 46 | 
 47 | -> ()
 48 | 
 49 | -> <closure>
 50 | 
 51 | -> <closure>
 52 | 
 53 | -> > <closure>
 54 | 
 55 | -> <closure>
 56 | 
 57 | -> -> <closure>
 58 | 
 59 | -> > <closure>
 60 | 
 61 | -> > > > <closure>
 62 | 
 63 | -> > <closure>
 64 | 
 65 | -> 6
 66 | 
 67 | -> 6
 68 | 
 69 | -> > <closure>
 70 | 
 71 | -> 9
 72 | 
 73 | -> 9
 74 | 
 75 | -> -> <closure>
 76 | 
 77 | -> <closure>
 78 | 
 79 | -> 6
 80 | 
 81 | -> 6
 82 | 
 83 | -> -> (... ...)
 84 | 
 85 | -> (... ...)
 86 | 
 87 | -> 3
 88 | 
 89 | -> 3
 90 | 
 91 | -> 4
 92 | 
 93 | -> 4
 94 | 
 95 | -> (3 4 ...)
 96 | 
 97 | -> (3 4 ...)
 98 | 
 99 | -> ()
100 | 
101 | -> ()
102 | 
103 | -> (3 4)
104 | 
105 | -> (3 4)
106 | 
107 | -> > <closure>
108 | 
109 | -> (... ...)
110 | 
111 | -> (... ...)
112 | 
113 | -> 0
114 | 
115 | -> 0
116 | 
117 | -> 1
118 | 
119 | -> 1
120 | 
121 | -> (0 1 ...)
122 | 
123 | -> (0 1 ...)
124 | 
125 | -> > > > <closure>
126 | 
127 | -> (... ...)
128 | 
129 | -> (... ...)
130 | 
131 | -> T
132 | 
133 | -> T
134 | 
135 | -> (3 4)
136 | 
137 | -> (3 4)
138 | 
139 | -> > > > <closure>
140 | 
141 | -> (... ...)
142 | 
143 | -> (... ...)
144 | 
145 | -> T
146 | 
147 | -> T
148 | 
149 | -> (0 1 2 3 4)
150 | 
151 | -> (0 1 2 3 4)
152 | 
153 | -> <closure>
154 | 
155 | -> <closure>
156 | 
157 | -> <closure>
158 | 
159 | -> > <closure>
160 | 
161 | -> > <closure>
162 | 
163 | -> > > <closure>
164 | 
165 | -> 10
166 | 
167 | -> 10
168 | 
169 | -> <closure>
170 | 
171 | -> > <closure>
172 | 
173 | -> 5
174 | 
175 | -> 5
176 | 
177 | -> > > > > <closure>
178 | 
179 | -> > > <closure>
180 | 
181 | -> <closure>
182 | 
183 | -> (... ...)
184 | 
185 | -> <closure>
186 | 
187 | -> (... ...)
188 | 
189 | -> T
190 | 
191 | -> (2 3 5 7 11)
192 | 
193 | -> -> <closure>
194 | 
195 | -> > > <closure>
196 | 
197 | -> > <closure>
198 | 
199 | -> <closure>
200 | 
201 | -> 6
202 | 
203 | -> 6
204 | 
205 | -> -> <closure>
206 | 
207 | -> > > > <closure>
208 | 
209 | -> <closure>
210 | 
211 | -> > <closure>
212 | 
213 | -> > <closure>
214 | 
215 | -> > > > <closure>
216 | 
217 | -> > <closure>
218 | 
219 | -> > > > <closure>
220 | 
221 | -> (... ...)
222 | 
223 | -> T
224 | 
225 | -> (Permutations of a b c)
226 | 
227 | -> ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
228 | 
229 | -> <closure>
230 | 
231 | -> (2 ...)
232 | 
233 | -> T
234 | 
235 | -> (2 1 3 4)
236 | 
237 | -> (2 1 3 4)
238 | 
239 | -> -> (... ...)
240 | 
241 | -> (... ...)
242 | 
243 | -> > > <closure>
244 | 
245 | -> (... ...)
246 | 
247 | -> (... ...)
248 | 
249 | -> (... ...)
250 | 
251 | -> 6
252 | 
253 | -> 6
254 | 
255 | -> -> > > > > > > > > <closure>
256 | 
257 | -> > <closure>
258 | 
259 | -> > > <closure>
260 | 
261 | -> > > > <closure>
262 | 
263 | -> <closure>
264 | 
265 | -> <closure>
266 | 
267 | -> > > > > <closure>
268 | 
269 | -> > > > <closure>
270 | 
271 | -> Unsatisfiable
272 | 
273 | -> -> > <closure>
274 | 
275 | -> > > > <closure>
276 | 
277 | -> ((2 2) (0 1) (3 0))
278 | 
279 | -> ((2 2) (0 1) (3 0))
280 | 
281 | -> (... ...)
282 | 
283 | -> <closure>
284 | 
285 | -> <closure>
286 | 
287 | -> > > > <closure>
288 | 
289 | -> > > > <closure>
290 | 
291 | -> > > > <closure>
292 | 
293 | -> -> > <closure>
294 | 
295 | -> -> > <closure>
296 | 
297 | -> > > > > > <closure>
298 | 
299 | -> > > > <closure>
300 | 
301 | -> T
302 | 
303 | -> T
304 | 
305 | -> ()
306 | 
307 | -> ()
308 | 
309 | -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> <closure>
310 | 
311 | -> <closure>
312 | 
313 | -> <closure>
314 | 
315 | -> a
316 | 
317 | -> a
318 | 
319 | -> <closure>
320 | 
321 | -> <closure>
322 | 
323 | -> 24
324 | 
325 | -> 24
326 | 
327 | -> <closure>
328 | 
329 | -> <closure>
330 | 
331 | -> <closure>
332 | 
333 | -> <closure>
334 | 
335 | -> <closure>
336 | 
337 | -> <closure>
338 | 
339 | -> <closure>
340 | 
341 | -> 3
342 | 
343 | -> 3
344 | 
345 | -> <closure>
346 | 
347 | -> > <closure>
348 | 
349 | -> 15
350 | 
351 | -> 15
352 | 
353 | -> <closure>
354 | 
355 | -> <closure>
356 | 
357 | -> <closure>
358 | 
359 | -> <closure>
360 | 
361 | -> 2
362 | 
363 | -> 2
364 | 
365 | -> <closure>
366 | 
367 | -> <closure>
368 | 
369 | -> <closure>
370 | 
371 | -> 3
372 | 
373 | -> 3
374 | 
375 | -> <closure>
376 | 
377 | -> <closure>
378 | 
379 | -> 6
380 | 
381 | -> 6
382 | 
383 | -> <closure>
384 | 
385 | -> <closure>
386 | 
387 | -> <closure>
388 | 
389 | -> <closure>
390 | 
391 | -> <closure>
392 | 
393 | -> 4
394 | 
395 | -> 4
396 | 
397 | -> <closure>
398 | 
399 | -> <closure>
400 | 
401 | -> > <closure>
402 | 
403 | -> <closure>
404 | 
405 | -> <closure>
406 | 
407 | -> > <closure>
408 | 
409 | -> yes
410 | 
411 | -> yes
412 | 
413 | -> no
414 | 
415 | -> no
416 | 
417 | -> > <closure>
418 | 
419 | -> 24
420 | 
421 | -> 24
422 | 
423 | -> > <closure>
424 | 
425 | -> <closure>
426 | 
427 | -> 24
428 | 
429 | -> 24
430 | 
431 | -> <closure>
432 | 
433 | -> <closure>
434 | 
435 | -> <closure>
436 | 
437 | -> 1
438 | 
439 | -> 1
440 | 
441 | -> > > <closure>
442 | 
443 | -> 24
444 | 
445 | -> 24
446 | 
447 | -> 


--------------------------------------------------------------------------------
/distr/code.smt.o:
--------------------------------------------------------------------------------
  1 | -> -> +1
  2 | -> or
  3 | -> and
  4 | -> not
  5 | -> <>
  6 | -> <=
  7 | -> divides
  8 | -> mod
  9 | -> > > gcd
 10 | -> abs
 11 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > initFinancialHistory
 12 | receive:from:
 13 | spend:for:
 14 | cashOnHand
 15 | totalReceivedFrom:
 16 | totalSpentFor:
 17 | FinancialHistory
 18 | -> > mkFinancialHistory
 19 | -> -> > > > > > > > > > > > > > > > initDeductibleHistory
 20 | spend:Deduct:
 21 | spend:for:deduct:
 22 | totalDeductions
 23 | DeductibleHistory
 24 | -> > mkDeductibleHistory
 25 | -> -> -> 0
 26 | 
 27 | -> 1
 28 | 
 29 | -> isNil
 30 | -> notNil
 31 | -> > > > > > > > > > > > > > > > > > > > > > > > > first
 32 | next
 33 | add:
 34 | size
 35 | isEmpty
 36 | includes:
 37 | Collection
 38 | -> > > > > > > > initSet
 39 | first
 40 | next
 41 | add:
 42 | Set
 43 | -> mkSet
 44 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > at:put:
 45 | currentKey
 46 | at:
 47 | includesKey:
 48 | indexOf:
 49 | KeyedCollection
 50 | -> -> > > > > > > > initAssociation
 51 | fst
 52 | snd
 53 | fst:
 54 | snd:
 55 | Association
 56 | -> -> mkAssociation
 57 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initDictionary
 58 | currentKey
 59 | first
 60 | next
 61 | at:put:
 62 | associationAt:
 63 | Dictionary
 64 | -> mkDictionary
 65 | -> -> > > > > > > > > > > > > > > firstKey
 66 | lastKey
 67 | last
 68 | at:
 69 | SequenceableCollection
 70 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > car
 71 | cdr
 72 | initList
 73 | add:
 74 | car:
 75 | cdr:
 76 | first
 77 | next
 78 | firstKey
 79 | lastKey
 80 | currentKey
 81 | at:put:
 82 | removeFirst
 83 | zerolist
 84 | List
 85 | -> mkList
 86 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > initArray
 87 | size
 88 | firstKey
 89 | lastKey
 90 | currentKey
 91 | first
 92 | next
 93 | at:put:
 94 | Array
 95 | -> mkArray
 96 | -> -> <userval>
 97 | 
 98 | -> 950
 99 | 
100 | -> 1150
101 | 
102 | -> 1150
103 | 
104 | -> 1150
105 | 
106 | -> 1050
107 | 
108 | -> 1050
109 | 
110 | -> 1050
111 | 
112 | -> <userval>
113 | 
114 | -> 950
115 | 
116 | -> 1150
117 | 
118 | -> 1150
119 | 
120 | -> 1150
121 | 
122 | -> 0
123 | 
124 | -> 0
125 | 
126 | -> 100
127 | 
128 | -> 1050
129 | 
130 | -> 1050
131 | 
132 | -> 100
133 | 
134 | -> 100
135 | 
136 | -> 150
137 | 
138 | -> 950
139 | 
140 | -> 950
141 | 
142 | -> 150
143 | 
144 | -> 150
145 | 
146 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > +
147 | negate
148 | *
149 | recip
150 | =
151 | <
152 | zero
153 | one
154 | print
155 | -
156 | /
157 | >
158 | +1
159 | sub1
160 | isZero
161 | isNegative
162 | abs
163 | sqr
164 | sqrt
165 | Number
166 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initFraction
167 | setFraction
168 | x
169 | y
170 | +
171 | negate
172 | *
173 | recip
174 | =
175 | <
176 | zero
177 | one
178 | print
179 | div-reduce
180 | sign-reduce
181 | Fraction
182 | -> mkFraction
183 | -> <userval>
184 | 
185 | -> <userval>
186 | 
187 | -> <userval>
188 | 
189 | -> 3437249
190 | 833049
191 | 833049
192 | 
193 | -> 3437249
194 | 
195 | -> 833049
196 | 
197 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initFloat
198 | mant
199 | exp
200 | +
201 | negate
202 | *
203 | recip
204 | zero
205 | one
206 | =
207 | <
208 | print
209 | isZero
210 | isNegative
211 | powerof10
212 | normalize
213 | Float
214 | -> mkFloat
215 | -> <userval>
216 | 
217 | -> <userval>
218 | 
219 | -> 4125
220 | -3
221 | -3
222 | 
223 | -> 4125
224 | 
225 | -> -3
226 | 
227 | -> -> > > > > > > > > > > > initialize
228 | report
229 | run
230 | Simulation
231 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > initLabSimulation
232 | initialize
233 | report
234 | LabSimulation
235 | -> mkLabSimulation
236 | -> > > > > > > > > > > > initLab
237 | terminals-free?
238 | pick-terminal
239 | release-terminal
240 | Lab
241 | -> mkLab
242 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > car
243 | cdr
244 | initList
245 | newEmptyCollection
246 | add:
247 | car:
248 | cdr:
249 | first
250 | next
251 | firstKey
252 | lastKey
253 | currentKey
254 | at:put:
255 | removeFirst
256 | zerolist
257 | List
258 | -> -> > > > > > > initQueue
259 | newEmptyCollection
260 | enqueue:
261 | Queue
262 | -> mkQueue
263 | -> > > > > > > > > > > > > initEventQueue
264 | scheduleEvent
265 | doNextEvent
266 | EventQueue
267 | -> mkEventQueue
268 | -> > > > > > > > > initPriorityQueue
269 | newEmptyCollection
270 | insert:
271 | PriorityQueue
272 | -> mkPriorityQueue
273 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initStudent
274 | takeAction
275 | arrive
276 | leaveTerminal
277 | grabTerminal
278 | scheduleLeaveTerminal
279 | scheduleNewArrival
280 | Student
281 | -> -> > > > > > initWaitTimeList
282 | next
283 | WaitTimeList
284 | -> mkWaitTimeList
285 | -> -> > > > > initServiceTimeList
286 | next
287 | ServiceTimeList
288 | -> mkServiceTimeList
289 | -> <userval>
290 | 
291 | -> simulation-done
292 | students-finishing
293 | 20
294 | left-on-queue
295 | 0
296 | Total-time-wasted:
297 | 18900
298 | Average-time-wasted:
299 | 945
300 | 945
301 | 
302 | -> simulation-done
303 | 
304 | -> students-finishing
305 | 
306 | -> 20
307 | 
308 | -> left-on-queue
309 | 
310 | -> 0
311 | 
312 | -> Total-time-wasted:
313 | 
314 | -> 18900
315 | 
316 | -> Average-time-wasted:
317 | 
318 | -> 945
319 | 
320 | -> -> > > > > initWaitTimeList
321 | next
322 | WaitTimeList
323 | -> mkWaitTimeList
324 | -> -> > > > > > > > initServiceTimeList
325 | next
326 | ServiceTimeList
327 | -> mkServiceTimeList
328 | -> <userval>
329 | 
330 | -> simulation-done
331 | students-finishing
332 | 30
333 | left-on-queue
334 | 8
335 | Total-time-wasted:
336 | 3090
337 | Average-time-wasted:
338 | 103
339 | 103
340 | 
341 | -> simulation-done
342 | 
343 | -> students-finishing
344 | 
345 | -> 30
346 | 
347 | -> left-on-queue
348 | 
349 | -> 8
350 | 
351 | -> Total-time-wasted:
352 | 
353 | -> 3090
354 | 
355 | -> Average-time-wasted:
356 | 
357 | -> 103
358 | 
359 | -> 


--------------------------------------------------------------------------------
/C-distr/code.smt.out:
--------------------------------------------------------------------------------
  1 | -> -> +1
  2 | -> or
  3 | -> and
  4 | -> not
  5 | -> <>
  6 | -> <=
  7 | -> divides
  8 | -> mod
  9 | -> > > gcd
 10 | -> abs
 11 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > initFinancialHistory
 12 | receive:from:
 13 | spend:for:
 14 | cashOnHand
 15 | totalReceivedFrom:
 16 | totalSpentFor:
 17 | FinancialHistory
 18 | -> > mkFinancialHistory
 19 | -> -> > > > > > > > > > > > > > > > initDeductibleHistory
 20 | spend:Deduct:
 21 | spend:for:deduct:
 22 | totalDeductions
 23 | DeductibleHistory
 24 | -> > mkDeductibleHistory
 25 | -> -> -> 0
 26 | 
 27 | -> 1
 28 | 
 29 | -> isNil
 30 | -> notNil
 31 | -> > > > > > > > > > > > > > > > > > > > > > > > > first
 32 | next
 33 | add:
 34 | size
 35 | isEmpty
 36 | includes:
 37 | Collection
 38 | -> > > > > > > > initSet
 39 | first
 40 | next
 41 | add:
 42 | Set
 43 | -> mkSet
 44 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > at:put:
 45 | currentKey
 46 | at:
 47 | includesKey:
 48 | indexOf:
 49 | KeyedCollection
 50 | -> -> > > > > > > > initAssociation
 51 | fst
 52 | snd
 53 | fst:
 54 | snd:
 55 | Association
 56 | -> -> mkAssociation
 57 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initDictionary
 58 | currentKey
 59 | first
 60 | next
 61 | at:put:
 62 | associationAt:
 63 | Dictionary
 64 | -> mkDictionary
 65 | -> -> > > > > > > > > > > > > > > firstKey
 66 | lastKey
 67 | last
 68 | at:
 69 | SequenceableCollection
 70 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > car
 71 | cdr
 72 | initList
 73 | add:
 74 | car:
 75 | cdr:
 76 | first
 77 | next
 78 | firstKey
 79 | lastKey
 80 | currentKey
 81 | at:put:
 82 | removeFirst
 83 | zerolist
 84 | List
 85 | -> mkList
 86 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > initArray
 87 | size
 88 | firstKey
 89 | lastKey
 90 | currentKey
 91 | first
 92 | next
 93 | at:put:
 94 | Array
 95 | -> mkArray
 96 | -> -> <userval>
 97 | 
 98 | -> 950
 99 | 
100 | -> 1150
101 | 
102 | -> 1150
103 | 
104 | -> 1150
105 | 
106 | -> 1050
107 | 
108 | -> 1050
109 | 
110 | -> 1050
111 | 
112 | -> <userval>
113 | 
114 | -> 950
115 | 
116 | -> 1150
117 | 
118 | -> 1150
119 | 
120 | -> 1150
121 | 
122 | -> 0
123 | 
124 | -> 0
125 | 
126 | -> 100
127 | 
128 | -> 1050
129 | 
130 | -> 1050
131 | 
132 | -> 100
133 | 
134 | -> 100
135 | 
136 | -> 150
137 | 
138 | -> 950
139 | 
140 | -> 950
141 | 
142 | -> 150
143 | 
144 | -> 150
145 | 
146 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > +
147 | negate
148 | *
149 | recip
150 | =
151 | <
152 | zero
153 | one
154 | print
155 | -
156 | /
157 | >
158 | +1
159 | sub1
160 | isZero
161 | isNegative
162 | abs
163 | sqr
164 | sqrt
165 | Number
166 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initFraction
167 | setFraction
168 | x
169 | y
170 | +
171 | negate
172 | *
173 | recip
174 | =
175 | <
176 | zero
177 | one
178 | print
179 | div-reduce
180 | sign-reduce
181 | Fraction
182 | -> mkFraction
183 | -> <userval>
184 | 
185 | -> <userval>
186 | 
187 | -> <userval>
188 | 
189 | -> 3437249
190 | 833049
191 | 833049
192 | 
193 | -> 3437249
194 | 
195 | -> 833049
196 | 
197 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initFloat
198 | mant
199 | exp
200 | +
201 | negate
202 | *
203 | recip
204 | zero
205 | one
206 | =
207 | <
208 | print
209 | isZero
210 | isNegative
211 | powerof10
212 | normalize
213 | Float
214 | -> mkFloat
215 | -> <userval>
216 | 
217 | -> <userval>
218 | 
219 | -> 4125
220 | -3
221 | -3
222 | 
223 | -> 4125
224 | 
225 | -> -3
226 | 
227 | -> -> > > > > > > > > > > > initialize
228 | report
229 | run
230 | Simulation
231 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > initLabSimulation
232 | initialize
233 | report
234 | LabSimulation
235 | -> mkLabSimulation
236 | -> > > > > > > > > > > > initLab
237 | terminals-free?
238 | pick-terminal
239 | release-terminal
240 | Lab
241 | -> mkLab
242 | -> -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > car
243 | cdr
244 | initList
245 | newEmptyCollection
246 | add:
247 | car:
248 | cdr:
249 | first
250 | next
251 | firstKey
252 | lastKey
253 | currentKey
254 | at:put:
255 | removeFirst
256 | zerolist
257 | List
258 | -> -> > > > > > > initQueue
259 | newEmptyCollection
260 | enqueue:
261 | Queue
262 | -> mkQueue
263 | -> > > > > > > > > > > > > initEventQueue
264 | scheduleEvent
265 | doNextEvent
266 | EventQueue
267 | -> mkEventQueue
268 | -> > > > > > > > > initPriorityQueue
269 | newEmptyCollection
270 | insert:
271 | PriorityQueue
272 | -> mkPriorityQueue
273 | -> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > initStudent
274 | takeAction
275 | arrive
276 | leaveTerminal
277 | grabTerminal
278 | scheduleLeaveTerminal
279 | scheduleNewArrival
280 | Student
281 | -> -> > > > > > initWaitTimeList
282 | next
283 | WaitTimeList
284 | -> mkWaitTimeList
285 | -> -> > > > > initServiceTimeList
286 | next
287 | ServiceTimeList
288 | -> mkServiceTimeList
289 | -> <userval>
290 | 
291 | -> simulation-done
292 | students-finishing
293 | 20
294 | left-on-queue
295 | 0
296 | Total-time-wasted:
297 | 18900
298 | Average-time-wasted:
299 | 945
300 | 945
301 | 
302 | -> simulation-done
303 | 
304 | -> students-finishing
305 | 
306 | -> 20
307 | 
308 | -> left-on-queue
309 | 
310 | -> 0
311 | 
312 | -> Total-time-wasted:
313 | 
314 | -> 18900
315 | 
316 | -> Average-time-wasted:
317 | 
318 | -> 945
319 | 
320 | -> -> > > > > initWaitTimeList
321 | next
322 | WaitTimeList
323 | -> mkWaitTimeList
324 | -> -> > > > > > > > initServiceTimeList
325 | next
326 | ServiceTimeList
327 | -> mkServiceTimeList
328 | -> <userval>
329 | 
330 | -> simulation-done
331 | students-finishing
332 | 30
333 | left-on-queue
334 | 8
335 | Total-time-wasted:
336 | 3090
337 | Average-time-wasted:
338 | 103
339 | 103
340 | 
341 | -> simulation-done
342 | 
343 | -> students-finishing
344 | 
345 | -> 30
346 | 
347 | -> left-on-queue
348 | 
349 | -> 8
350 | 
351 | -> Total-time-wasted:
352 | 
353 | -> 3090
354 | 
355 | -> Average-time-wasted:
356 | 
357 | -> 103
358 | 
359 | -> 


--------------------------------------------------------------------------------
/C-distr/code.apl:
--------------------------------------------------------------------------------
  1 | ; From chapter 1
  2 | (define +1 (x) (+ x 1))
  3 | (define <= (x y) (or (< x y) (= x y)))
  4 | ; Section 3.1,3
  5 | (define fac (n) (*/ (indx n)))
  6 | (fac 4)
  7 | 24
  8 | (define avg (v) (/ (+/ v) (shape v)))
  9 | (avg '(2 4 6))
 10 | 4
 11 | (define neg (v) (- 0 v))
 12 | (neg '(3 -5 -8))
 13 | '(-3 5 8)
 14 | (define min (v1 v2) (neg (max (neg v1) (neg v2))))
 15 | (min 4 8)
 16 | 4
 17 | (min '(2 4 6 8) '(5 3 7 4))
 18 | '(2 3 6 4)
 19 | (define min/ (v) (neg (max/ (neg v))))
 20 | (min/ '(5 3 7 4))
 21 | 3
 22 | (define mod (m n) (- m (* n (/ m n))))
 23 | (mod '(2 5 8 11) '(1 2 3 4))
 24 | '(0 1 2 3)
 25 | (mod 10 '(2 5 8 11))
 26 | '(0 0 2 10)
 27 | (define even? (n) (= (mod n 2) 0))
 28 | (even? '(1 2 3 4 5))
 29 | '(0 1 0 1 0)
 30 | (define even-sum (v) (+/ (compress (even? v) v)))
 31 | (even-sum '(1 2 3 4 5))
 32 | 6
 33 | (define not= (x y) (if (= x y) 0 1))
 34 | (not= 3 5)
 35 | 1
 36 | (not= '(1 3 5) '(1 4 8))
 37 | 0
 38 | (define not (x) (- 1 x))
 39 | (define <> (x y) (not (= x y)))
 40 | (<> '(1 3 5) '(1 4 8))
 41 | '(0 1 1)
 42 | (define reverse (a)
 43 |         (begin
 44 |          (set size ([] (shape a) 1))
 45 |                  ([] a (+1 (- size (indx size))))))
 46 | (set m (restruct '(4 4) '(1 1 0 0 0)))
 47 |    '(1   1   0   0)
 48 |    '(0   1   1   0)
 49 |    '(0   0   1   1)
 50 |    '(0   0   0   1)
 51 | (reverse m)
 52 |    '(0   0   0   1)
 53 |    '(0   0   1   1)
 54 |    '(0   1   1   0)
 55 |    '(1   1   0   0)
 56 | (define reverse (a)
 57 |            ([] a (+1 (- (set size ([] (shape a) 1)) (indx size))))))
 58 | (reverse m)
 59 |    '(0   0   0   1)
 60 |    '(0   0   1   1)
 61 |    '(0   1   1   0)
 62 |    '(1   1   0   0)
 63 | (define signum (x) (+ (* (< x 0) -1)(> x 0)))
 64 | (define abs (x) (* x (signum x)))
 65 | (define find (x v) ([] (compress (= x v) (indx (shape v))) 1))
 66 | (find 3 '(1 4 7 3 9 2))
 67 | 4
 68 | (define find-closest (x v)
 69 |       (begin
 70 |            (set absdiffs (abs (- v x)))
 71 |            (find (min/ absdiffs) absdiffs)))
 72 | (find-closest 10 '(8 11 4 13 7))
 73 | 2
 74 | (define sqr (x) (* x x))
 75 | (define variance (v) (/ (+/ (sqr (- v (avg v)))) (shape v)))
 76 | (variance '(5 10 15 20))
 77 | 31
 78 | (define binom (n)
 79 |      (begin (set l '(1))
 80 |               (print l)
 81 |               (while (< (shape l) n)
 82 |                     (begin
 83 |                           (set l (+ (cat 0 l)(cat l 0)))
 84 |                           (print l)))))
 85 | (define prime (n)
 86 |         (and/ (<> 0 (mod n (+1 (indx (- n 2)))))))
 87 | (define dropend (v) ([] v (indx (- (shape v) 1))))
 88 | (define +\ (v)
 89 |          (if (= (shape v) 0) v
 90 |                (cat (+\ (dropend v)) (+/ v))))
 91 | (+\ '(1 3 5 7))
 92 | '(1   4   9   16)
 93 | (define assign (v i x)
 94 |       (cat ([] v (indx (- i 1)))
 95 |            (cat x ([] v (+ i (indx (- (shape v) i)))))))
 96 | (assign '(1 2 3 4 5) 3 6)
 97 | '(1 2 6 4 5)
 98 | (define drop1 (v) ([] v (+1 (indx (- (shape v) 1)))))
 99 | (define vecassign (v i x)
100 |       (if (= (shape i) 0) v
101 |              (vecassign (assign v ([] i 1)([] x 1))
102 |                        (drop1 i) (drop1 x))))
103 | (vecassign '(10 20 30 40 50) '(3 5 1) '(7 9 11))
104 | '(11 20 7 40 9)
105 | (define fillzeros (v)
106 |        (vecassign (restruct (+/ (+ v 1)) 0)
107 |                     (+\ (+ v 1))
108 |                     (restruct (shape v) 1)))
109 | (fillzeros '(2 0 3 1))
110 | '(0 0 1 1 0 0 0 1 0 1)
111 | (define mod-outer-prod (v1 v2)
112 |          (mod (trans (restruct (cat (shape v2)(shape v1)) v1))
113 |              (restruct (cat (shape v1) (shape v2)) v2)))
114 | (mod-outer-prod (indx 4) (indx 7))
115 | '(0 1 1 1 1 1 1)
116 | '(0 0 2 2 2 2 2)
117 | '(0 1 0 3 3 3 3)
118 | '(0 0 1 0 4 4 4)
119 | (define primes<= (n)
120 |     (compress (= 2 (+/ (= 0 (mod-outer-prod (set s (indx n)) s))))
121 |               s))
122 | (primes<= 7)
123 | '(2 3 5 7)
124 | ; Section 3.3??
125 | (define dup-cols (v n)
126 |     (trans (restruct (cat n (shape v)) v)))
127 | (define dup-rows (v n)
128 |     ([] (restruct (cat 1 (shape v)) v) (restruct n 1)))
129 | (define freqvec (scores lo hi)
130 |      (begin
131 |           (set width (+ (- hi lo) 1))
132 |           (+/ (trans (= 
133 |                 (dup-cols scores width)
134 |                 (dup-rows (+ (indx width) (- lo 1)) (shape scores))))))))
135 | (define cumfreqvec (freqs) (+\ freqs))
136 | (define range (scores) (cat (min/ scores) (max/ scores)))
137 | (define mode (freqs lo) (+ (find (max/ freqs) freqs) (- lo 1)))
138 | (define median (cumfreqs lo)
139 |            (+ (- lo 1) (find-closest (max/ cumfreqs) (* 2 cumfreqs))))
140 | (define addelt (e i v)
141 |     (cat ([] v (indx (- i 1)))
142 |          (cat e ([] v (+ (indx (- (+1 (shape v)) i)) (- i 1))))))
143 | (define addrow (v i m)
144 |     ([] (restruct (+ '(1 0) (shape m)) (cat v m))
145 |           (addelt 1 i (+1 (indx ([] (shape m) 1))))))
146 | (define addcol (v i m)
147 |     (trans (addrow v i (trans m))))
148 | (define histo (freqs lo hi)
149 |     (begin
150 |          (set width (+1 (- hi lo)))
151 |          (set length (max/ freqs))
152 |          (set hist
153 |              (<=   (restruct (cat width length) (indx length))
154 |                  (dup-cols freqs length)))
155 |          (addcol (- (indx width) (- 1 lo)) 1 hist)))
156 | (define graph (freqs lo)
157 |    (begin
158 |        (set length (max/ freqs))
159 |        (set lines (restruct (cat (+ length 1) length)
160 |                                   (cat (restruct length 0) 1)))
161 |        (set thegraph (reverse (trans ([] lines (+ freqs 1)))))
162 |        (addrow (- (indx (shape freqs)) (- 1 lo)) (+ length 1) thegraph)))
163 | (set SCORES '(-2 1 -1 0 0 2 1 1))
164 | (set FREQS (freqvec SCORES -2 2))
165 | '(1 1 2 3 1)
166 | (set CUMFREQS (cumfreqvec FREQS))
167 | '(1 2 4 7 8)
168 | (range SCORES)
169 | '(-2 2)
170 | (mode FREQS -2)
171 | 1 
172 | (median CUMFREQS -2)
173 | 0 
174 | (histo FREQS -2 2)
175 | '(-2 1 0 0)
176 | '(-1 1 0 0)
177 | '(0 1 1 0)
178 | '(1 1 1 1)
179 | '(2 1 0 0)
180 | (graph FREQS -2)
181 | '(0 0 0 1 0)
182 | '(0 0 1 0 0)
183 | '(1 1 0 0 1)
184 | '(-2 -1 0 1 2)
185 | (graph CUMFREQS -2)
186 | '(0 0 0 0 1)
187 | '(0 0 0 1 0)
188 | '(0 0 0 0 0)
189 | '(0 0 0 0 0)
190 | '(0 0 1 0 0)
191 | '(0 0 0 0 0)
192 | '(0 1 0 0 0)
193 | '(1 0 0 0 0)
194 | '(-2 -1 0 1 2)
195 | quit
196 | 


--------------------------------------------------------------------------------
/distr/code.apl:
--------------------------------------------------------------------------------
  1 | ; From chapter 1
  2 | (define +1 (x) (+ x 1))
  3 | (define <= (x y) (or (< x y) (= x y)))
  4 | ; Section 3.1,3
  5 | (define fac (n) (*/ (indx n)))
  6 | (fac 4)
  7 | 24
  8 | (define avg (v) (/ (+/ v) (shape v)))
  9 | (avg '(2 4 6))
 10 | 4
 11 | (define neg (v) (- 0 v))
 12 | (neg '(3 -5 -8))
 13 | '(-3 5 8)
 14 | (define min (v1 v2) (neg (max (neg v1) (neg v2))))
 15 | (min 4 8)
 16 | 4
 17 | (min '(2 4 6 8) '(5 3 7 4))
 18 | '(2 3 6 4)
 19 | (define min/ (v) (neg (max/ (neg v))))
 20 | (min/ '(5 3 7 4))
 21 | 3
 22 | (define mod (m n) (- m (* n (/ m n))))
 23 | (mod '(2 5 8 11) '(1 2 3 4))
 24 | '(0 1 2 3)
 25 | (mod 10 '(2 5 8 11))
 26 | '(0 0 2 10)
 27 | (define even? (n) (= (mod n 2) 0))
 28 | (even? '(1 2 3 4 5))
 29 | '(0 1 0 1 0)
 30 | (define even-sum (v) (+/ (compress (even? v) v)))
 31 | (even-sum '(1 2 3 4 5))
 32 | 6
 33 | (define not= (x y) (if (= x y) 0 1))
 34 | (not= 3 5)
 35 | 1
 36 | (not= '(1 3 5) '(1 4 8))
 37 | 0
 38 | (define not (x) (- 1 x))
 39 | (define <> (x y) (not (= x y)))
 40 | (<> '(1 3 5) '(1 4 8))
 41 | '(0 1 1)
 42 | (define reverse (a)
 43 |         (begin
 44 |          (set size ([] (shape a) 1))
 45 |                  ([] a (+1 (- size (indx size))))))
 46 | (set m (restruct '(4 4) '(1 1 0 0 0)))
 47 |    '(1   1   0   0)
 48 |    '(0   1   1   0)
 49 |    '(0   0   1   1)
 50 |    '(0   0   0   1)
 51 | (reverse m)
 52 |    '(0   0   0   1)
 53 |    '(0   0   1   1)
 54 |    '(0   1   1   0)
 55 |    '(1   1   0   0)
 56 | (define reverse (a)
 57 |            ([] a (+1 (- (set size ([] (shape a) 1)) (indx size))))))
 58 | (reverse m)
 59 |    '(0   0   0   1)
 60 |    '(0   0   1   1)
 61 |    '(0   1   1   0)
 62 |    '(1   1   0   0)
 63 | (define signum (x) (+ (* (< x 0) -1)(> x 0)))
 64 | (define abs (x) (* x (signum x)))
 65 | (define find (x v) ([] (compress (= x v) (indx (shape v))) 1))
 66 | (find 3 '(1 4 7 3 9 2))
 67 | 4
 68 | (define find-closest (x v)
 69 |       (begin
 70 |            (set absdiffs (abs (- v x)))
 71 |            (find (min/ absdiffs) absdiffs)))
 72 | (find-closest 10 '(8 11 4 13 7))
 73 | 2
 74 | (define sqr (x) (* x x))
 75 | (define variance (v) (/ (+/ (sqr (- v (avg v)))) (shape v)))
 76 | (variance '(5 10 15 20))
 77 | 31
 78 | (define binom (n)
 79 |      (begin (set l '(1))
 80 |               (print l)
 81 |               (while (< (shape l) n)
 82 |                     (begin
 83 |                           (set l (+ (cat 0 l)(cat l 0)))
 84 |                           (print l)))))
 85 | (define prime (n)
 86 |         (and/ (<> 0 (mod n (+1 (indx (- n 2)))))))
 87 | (define dropend (v) ([] v (indx (- (shape v) 1))))
 88 | (define +\ (v)
 89 |          (if (= (shape v) 0) v
 90 |                (cat (+\ (dropend v)) (+/ v))))
 91 | (+\ '(1 3 5 7))
 92 | '(1   4   9   16)
 93 | (define assign (v i x)
 94 |       (cat ([] v (indx (- i 1)))
 95 |            (cat x ([] v (+ i (indx (- (shape v) i)))))))
 96 | (assign '(1 2 3 4 5) 3 6)
 97 | '(1 2 6 4 5)
 98 | (define drop1 (v) ([] v (+1 (indx (- (shape v) 1)))))
 99 | (define vecassign (v i x)
100 |       (if (= (shape i) 0) v
101 |              (vecassign (assign v ([] i 1)([] x 1))
102 |                        (drop1 i) (drop1 x))))
103 | (vecassign '(10 20 30 40 50) '(3 5 1) '(7 9 11))
104 | '(11 20 7 40 9)
105 | (define fillzeros (v)
106 |        (vecassign (restruct (+/ (+ v 1)) 0)
107 |                     (+\ (+ v 1))
108 |                     (restruct (shape v) 1)))
109 | (fillzeros '(2 0 3 1))
110 | '(0 0 1 1 0 0 0 1 0 1)
111 | (define mod-outer-prod (v1 v2)
112 |          (mod (trans (restruct (cat (shape v2)(shape v1)) v1))
113 |              (restruct (cat (shape v1) (shape v2)) v2)))
114 | (mod-outer-prod (indx 4) (indx 7))
115 | '(0 1 1 1 1 1 1)
116 | '(0 0 2 2 2 2 2)
117 | '(0 1 0 3 3 3 3)
118 | '(0 0 1 0 4 4 4)
119 | (define primes<= (n)
120 |     (compress (= 2 (+/ (= 0 (mod-outer-prod (set s (indx n)) s))))
121 |               s))
122 | (primes<= 7)
123 | '(2 3 5 7)
124 | ; Section 3.3??
125 | (define dup-cols (v n)
126 |     (trans (restruct (cat n (shape v)) v)))
127 | (define dup-rows (v n)
128 |     ([] (restruct (cat 1 (shape v)) v) (restruct n 1)))
129 | (define freqvec (scores lo hi)
130 |      (begin
131 |           (set width (+ (- hi lo) 1))
132 |           (+/ (trans (= 
133 |                 (dup-cols scores width)
134 |                 (dup-rows (+ (indx width) (- lo 1)) (shape scores))))))))
135 | (define cumfreqvec (freqs) (+\ freqs))
136 | (define range (scores) (cat (min/ scores) (max/ scores)))
137 | (define mode (freqs lo) (+ (find (max/ freqs) freqs) (- lo 1)))
138 | (define median (cumfreqs lo)
139 |            (+ (- lo 1) (find-closest (max/ cumfreqs) (* 2 cumfreqs))))
140 | (define addelt (e i v)
141 |     (cat ([] v (indx (- i 1)))
142 |          (cat e ([] v (+ (indx (- (+1 (shape v)) i)) (- i 1))))))
143 | (define addrow (v i m)
144 |     ([] (restruct (+ '(1 0) (shape m)) (cat v m))
145 |           (addelt 1 i (+1 (indx ([] (shape m) 1))))))
146 | (define addcol (v i m)
147 |     (trans (addrow v i (trans m))))
148 | (define histo (freqs lo hi)
149 |     (begin
150 |          (set width (+1 (- hi lo)))
151 |          (set length (max/ freqs))
152 |          (set hist
153 |              (<=   (restruct (cat width length) (indx length))
154 |                  (dup-cols freqs length)))
155 |          (addcol (- (indx width) (- 1 lo)) 1 hist)))
156 | (define graph (freqs lo)
157 |    (begin
158 |        (set length (max/ freqs))
159 |        (set lines (restruct (cat (+ length 1) length)
160 |                                   (cat (restruct length 0) 1)))
161 |        (set thegraph (reverse (trans ([] lines (+ freqs 1)))))
162 |        (addrow (- (indx (shape freqs)) (- 1 lo)) (+ length 1) thegraph)))
163 | (set SCORES '(-2 1 -1 0 0 2 1 1))
164 | (set FREQS (freqvec SCORES -2 2))
165 | '(1 1 2 3 1)
166 | (set CUMFREQS (cumfreqvec FREQS))
167 | '(1 2 4 7 8)
168 | (range SCORES)
169 | '(-2 2)
170 | (mode FREQS -2)
171 | 1 
172 | (median CUMFREQS -2)
173 | 0 
174 | (histo FREQS -2 2)
175 | '(-2 1 0 0)
176 | '(-1 1 0 0)
177 | '(0 1 1 0)
178 | '(1 1 1 1)
179 | '(2 1 0 0)
180 | (graph FREQS -2)
181 | '(0 0 0 1 0)
182 | '(0 0 1 0 0)
183 | '(1 1 0 0 1)
184 | '(-2 -1 0 1 2)
185 | (graph CUMFREQS -2)
186 | '(0 0 0 0 1)
187 | '(0 0 0 1 0)
188 | '(0 0 0 0 0)
189 | '(0 0 0 0 0)
190 | '(0 0 1 0 0)
191 | '(0 0 0 0 0)
192 | '(0 1 0 0 0)
193 | '(1 0 0 0 0)
194 | '(-2 -1 0 1 2)
195 | quit
196 | 


--------------------------------------------------------------------------------
/C-distr/code.apl.out:
--------------------------------------------------------------------------------
  1 | -> -> +1
  2 | -> <=
  3 | -> -> fac
  4 | ->     24 
  5 | 
  6 | 
  7 | ->     24 
  8 | 
  9 | 
 10 | -> avg
 11 | ->      4 
 12 | 
 13 | 
 14 | ->      4 
 15 | 
 16 | 
 17 | -> neg
 18 | ->     -3      5      8 
 19 | 
 20 | 
 21 | ->     -3      5      8 
 22 | 
 23 | 
 24 | -> min
 25 | ->      4 
 26 | 
 27 | 
 28 | ->      4 
 29 | 
 30 | 
 31 | ->      2      3      6      4 
 32 | 
 33 | 
 34 | ->      2      3      6      4 
 35 | 
 36 | 
 37 | -> min/
 38 | ->      3 
 39 | 
 40 | 
 41 | ->      3 
 42 | 
 43 | 
 44 | -> mod
 45 | ->      0      1      2      3 
 46 | 
 47 | 
 48 | ->      0      1      2      3 
 49 | 
 50 | 
 51 | ->      0      0      2     10 
 52 | 
 53 | 
 54 | ->      0      0      2     10 
 55 | 
 56 | 
 57 | -> even?
 58 | ->      0      1      0      1      0 
 59 | 
 60 | 
 61 | ->      0      1      0      1      0 
 62 | 
 63 | 
 64 | -> even-sum
 65 | ->      6 
 66 | 
 67 | 
 68 | ->      6 
 69 | 
 70 | 
 71 | -> not=
 72 | ->      1 
 73 | 
 74 | 
 75 | ->      1 
 76 | 
 77 | 
 78 | ->      0 
 79 | 
 80 | 
 81 | ->      0 
 82 | 
 83 | 
 84 | -> not
 85 | -> <>
 86 | ->      0      1      1 
 87 | 
 88 | 
 89 | ->      0      1      1 
 90 | 
 91 | 
 92 | -> > > > reverse
 93 | ->      1      1      0      0 
 94 |      0      1      1      0 
 95 |      0      0      1      1 
 96 |      0      0      0      1 
 97 | 
 98 | 
 99 | ->      1      1      0      0 
100 | 
101 | 
102 | ->      0      1      1      0 
103 | 
104 | 
105 | ->      0      0      1      1 
106 | 
107 | 
108 | ->      0      0      0      1 
109 | 
110 | 
111 | ->      0      0      0      1 
112 |      0      0      1      1 
113 |      0      1      1      0 
114 |      1      1      0      0 
115 | 
116 | 
117 | ->      0      0      0      1 
118 | 
119 | 
120 | ->      0      0      1      1 
121 | 
122 | 
123 | ->      0      1      1      0 
124 | 
125 | 
126 | ->      1      1      0      0 
127 | 
128 | 
129 | -> > reverse
130 | ->      0      0      0      1 
131 |      0      0      1      1 
132 |      0      1      1      0 
133 |      1      1      0      0 
134 | 
135 | 
136 | ->      0      0      0      1 
137 | 
138 | 
139 | ->      0      0      1      1 
140 | 
141 | 
142 | ->      0      1      1      0 
143 | 
144 | 
145 | ->      1      1      0      0 
146 | 
147 | 
148 | -> signum
149 | -> abs
150 | -> find
151 | ->      4 
152 | 
153 | 
154 | ->      4 
155 | 
156 | 
157 | -> > > > find-closest
158 | ->      2 
159 | 
160 | 
161 | ->      2 
162 | 
163 | 
164 | -> sqr
165 | -> variance
166 | ->     31 
167 | 
168 | 
169 | ->     31 
170 | 
171 | 
172 | -> > > > > > > binom
173 | -> > prime
174 | -> dropend
175 | -> > > +\
176 | ->      1      4      9     16 
177 | 
178 | 
179 | ->      1      4      9     16 
180 | 
181 | 
182 | -> > > assign
183 | ->      1      2      6      4      5 
184 | 
185 | 
186 | ->      1      2      6      4      5 
187 | 
188 | 
189 | -> drop1
190 | -> > > > vecassign
191 | ->     11     20      7     40      9 
192 | 
193 | 
194 | ->     11     20      7     40      9 
195 | 
196 | 
197 | -> > > > fillzeros
198 | ->      0      0      1      1      0      0      0      1      0      1 
199 | 
200 | 
201 | ->      0      0      1      1      0      0      0      1      0      1 
202 | 
203 | 
204 | -> > > mod-outer-prod
205 | ->      0      1      1      1      1      1      1 
206 |      0      0      2      2      2      2      2 
207 |      0      1      0      3      3      3      3 
208 |      0      0      1      0      4      4      4 
209 | 
210 | 
211 | ->      0      1      1      1      1      1      1 
212 | 
213 | 
214 | ->      0      0      2      2      2      2      2 
215 | 
216 | 
217 | ->      0      1      0      3      3      3      3 
218 | 
219 | 
220 | ->      0      0      1      0      4      4      4 
221 | 
222 | 
223 | -> > > primes<=
224 | ->      2      3      5      7 
225 | 
226 | 
227 | ->      2      3      5      7 
228 | 
229 | 
230 | -> -> > dup-cols
231 | -> > dup-rows
232 | -> > > > > > freqvec
233 | -> cumfreqvec
234 | -> range
235 | -> mode
236 | -> > median
237 | -> > > addelt
238 | -> > > addrow
239 | -> > addcol
240 | -> > > > > > > > histo
241 | -> > > > > > > graph
242 | ->     -2      1     -1      0      0      2      1      1 
243 | 
244 | 
245 | ->      1      1      2      3      1 
246 | 
247 | 
248 | ->      1      1      2      3      1 
249 | 
250 | 
251 | ->      1      2      4      7      8 
252 | 
253 | 
254 | ->      1      2      4      7      8 
255 | 
256 | 
257 | ->     -2      2 
258 | 
259 | 
260 | ->     -2      2 
261 | 
262 | 
263 | ->      1 
264 | 
265 | 
266 | ->      1 
267 | 
268 | 
269 | ->      0 
270 | 
271 | 
272 | ->      0 
273 | 
274 | 
275 | ->     -2      1      0      0 
276 |     -1      1      0      0 
277 |      0      1      1      0 
278 |      1      1      1      1 
279 |      2      1      0      0 
280 | 
281 | 
282 | ->     -2      1      0      0 
283 | 
284 | 
285 | ->     -1      1      0      0 
286 | 
287 | 
288 | ->      0      1      1      0 
289 | 
290 | 
291 | ->      1      1      1      1 
292 | 
293 | 
294 | ->      2      1      0      0 
295 | 
296 | 
297 | ->      0      0      0      1      0 
298 |      0      0      1      0      0 
299 |      1      1      0      0      1 
300 |     -2     -1      0      1      2 
301 | 
302 | 
303 | ->      0      0      0      1      0 
304 | 
305 | 
306 | ->      0      0      1      0      0 
307 | 
308 | 
309 | ->      1      1      0      0      1 
310 | 
311 | 
312 | ->     -2     -1      0      1      2 
313 | 
314 | 
315 | ->      0      0      0      0      1 
316 |      0      0      0      1      0 
317 |      0      0      0      0      0 
318 |      0      0      0      0      0 
319 |      0      0      1      0      0 
320 |      0      0      0      0      0 
321 |      0      1      0      0      0 
322 |      1      0      0      0      0 
323 |     -2     -1      0      1      2 
324 | 
325 | 
326 | ->      0      0      0      0      1 
327 | 
328 | 
329 | ->      0      0      0      1      0 
330 | 
331 | 
332 | ->      0      0      0      0      0 
333 | 
334 | 
335 | ->      0      0      0      0      0 
336 | 
337 | 
338 | ->      0      0      1      0      0 
339 | 
340 | 
341 | ->      0      0      0      0      0 
342 | 
343 | 
344 | ->      0      1      0      0      0 
345 | 
346 | 
347 | ->      1      0      0      0      0 
348 | 
349 | 
350 | ->     -2     -1      0      1      2 
351 | 
352 | 
353 | -> 


--------------------------------------------------------------------------------
/distr/code.apl.o:
--------------------------------------------------------------------------------
  1 | -> -> +1
  2 | -> <=
  3 | -> -> fac
  4 | ->     24 
  5 | 
  6 | 
  7 | ->     24 
  8 | 
  9 | 
 10 | -> avg
 11 | ->      4 
 12 | 
 13 | 
 14 | ->      4 
 15 | 
 16 | 
 17 | -> neg
 18 | ->     -3      5      8 
 19 | 
 20 | 
 21 | ->     -3      5      8 
 22 | 
 23 | 
 24 | -> min
 25 | ->      4 
 26 | 
 27 | 
 28 | ->      4 
 29 | 
 30 | 
 31 | ->      2      3      6      4 
 32 | 
 33 | 
 34 | ->      2      3      6      4 
 35 | 
 36 | 
 37 | -> min/
 38 | ->      3 
 39 | 
 40 | 
 41 | ->      3 
 42 | 
 43 | 
 44 | -> mod
 45 | ->      0      1      2      3 
 46 | 
 47 | 
 48 | ->      0      1      2      3 
 49 | 
 50 | 
 51 | ->      0      0      2     10 
 52 | 
 53 | 
 54 | ->      0      0      2     10 
 55 | 
 56 | 
 57 | -> even?
 58 | ->      0      1      0      1      0 
 59 | 
 60 | 
 61 | ->      0      1      0      1      0 
 62 | 
 63 | 
 64 | -> even-sum
 65 | ->      6 
 66 | 
 67 | 
 68 | ->      6 
 69 | 
 70 | 
 71 | -> not=
 72 | ->      1 
 73 | 
 74 | 
 75 | ->      1 
 76 | 
 77 | 
 78 | ->      0 
 79 | 
 80 | 
 81 | ->      0 
 82 | 
 83 | 
 84 | -> not
 85 | -> <>
 86 | ->      0      1      1 
 87 | 
 88 | 
 89 | ->      0      1      1 
 90 | 
 91 | 
 92 | -> > > > reverse
 93 | ->      1      1      0      0 
 94 |      0      1      1      0 
 95 |      0      0      1      1 
 96 |      0      0      0      1 
 97 | 
 98 | 
 99 | ->      1      1      0      0 
100 | 
101 | 
102 | ->      0      1      1      0 
103 | 
104 | 
105 | ->      0      0      1      1 
106 | 
107 | 
108 | ->      0      0      0      1 
109 | 
110 | 
111 | ->      0      0      0      1 
112 |      0      0      1      1 
113 |      0      1      1      0 
114 |      1      1      0      0 
115 | 
116 | 
117 | ->      0      0      0      1 
118 | 
119 | 
120 | ->      0      0      1      1 
121 | 
122 | 
123 | ->      0      1      1      0 
124 | 
125 | 
126 | ->      1      1      0      0 
127 | 
128 | 
129 | -> > reverse
130 | ->      0      0      0      1 
131 |      0      0      1      1 
132 |      0      1      1      0 
133 |      1      1      0      0 
134 | 
135 | 
136 | ->      0      0      0      1 
137 | 
138 | 
139 | ->      0      0      1      1 
140 | 
141 | 
142 | ->      0      1      1      0 
143 | 
144 | 
145 | ->      1      1      0      0 
146 | 
147 | 
148 | -> signum
149 | -> abs
150 | -> find
151 | ->      4 
152 | 
153 | 
154 | ->      4 
155 | 
156 | 
157 | -> > > > find-closest
158 | ->      2 
159 | 
160 | 
161 | ->      2 
162 | 
163 | 
164 | -> sqr
165 | -> variance
166 | ->     31 
167 | 
168 | 
169 | ->     31 
170 | 
171 | 
172 | -> > > > > > > binom
173 | -> > prime
174 | -> dropend
175 | -> > > +\
176 | ->      1      4      9     16 
177 | 
178 | 
179 | ->      1      4      9     16 
180 | 
181 | 
182 | -> > > assign
183 | ->      1      2      6      4      5 
184 | 
185 | 
186 | ->      1      2      6      4      5 
187 | 
188 | 
189 | -> drop1
190 | -> > > > vecassign
191 | ->     11     20      7     40      9 
192 | 
193 | 
194 | ->     11     20      7     40      9 
195 | 
196 | 
197 | -> > > > fillzeros
198 | ->      0      0      1      1      0      0      0      1      0      1 
199 | 
200 | 
201 | ->      0      0      1      1      0      0      0      1      0      1 
202 | 
203 | 
204 | -> > > mod-outer-prod
205 | ->      0      1      1      1      1      1      1 
206 |      0      0      2      2      2      2      2 
207 |      0      1      0      3      3      3      3 
208 |      0      0      1      0      4      4      4 
209 | 
210 | 
211 | ->      0      1      1      1      1      1      1 
212 | 
213 | 
214 | ->      0      0      2      2      2      2      2 
215 | 
216 | 
217 | ->      0      1      0      3      3      3      3 
218 | 
219 | 
220 | ->      0      0      1      0      4      4      4 
221 | 
222 | 
223 | -> > > primes<=
224 | ->      2      3      5      7 
225 | 
226 | 
227 | ->      2      3      5      7 
228 | 
229 | 
230 | -> -> > dup-cols
231 | -> > dup-rows
232 | -> > > > > > freqvec
233 | -> cumfreqvec
234 | -> range
235 | -> mode
236 | -> > median
237 | -> > > addelt
238 | -> > > addrow
239 | -> > addcol
240 | -> > > > > > > > histo
241 | -> > > > > > > graph
242 | ->     -2      1     -1      0      0      2      1      1 
243 | 
244 | 
245 | ->      1      1      2      3      1 
246 | 
247 | 
248 | ->      1      1      2      3      1 
249 | 
250 | 
251 | ->      1      2      4      7      8 
252 | 
253 | 
254 | ->      1      2      4      7      8 
255 | 
256 | 
257 | ->     -2      2 
258 | 
259 | 
260 | ->     -2      2 
261 | 
262 | 
263 | ->      1 
264 | 
265 | 
266 | ->      1 
267 | 
268 | 
269 | ->      0 
270 | 
271 | 
272 | ->      0 
273 | 
274 | 
275 | ->     -2      1      0      0 
276 |     -1      1      0      0 
277 |      0      1      1      0 
278 |      1      1      1      1 
279 |      2      1      0      0 
280 | 
281 | 
282 | ->     -2      1      0      0 
283 | 
284 | 
285 | ->     -1      1      0      0 
286 | 
287 | 
288 | ->      0      1      1      0 
289 | 
290 | 
291 | ->      1      1      1      1 
292 | 
293 | 
294 | ->      2      1      0      0 
295 | 
296 | 
297 | ->      0      0      0      1      0 
298 |      0      0      1      0      0 
299 |      1      1      0      0      1 
300 |     -2     -1      0      1      2 
301 | 
302 | 
303 | ->      0      0      0      1      0 
304 | 
305 | 
306 | ->      0      0      1      0      0 
307 | 
308 | 
309 | ->      1      1      0      0      1 
310 | 
311 | 
312 | ->     -2     -1      0      1      2 
313 | 
314 | 
315 | ->      0      0      0      0      1 
316 |      0      0      0      1      0 
317 |      0      0      0      0      0 
318 |      0      0      0      0      0 
319 |      0      0      1      0      0 
320 |      0      0      0      0      0 
321 |      0      1      0      0      0 
322 |      1      0      0      0      0 
323 |     -2     -1      0      1      2 
324 | 
325 | 
326 | ->      0      0      0      0      1 
327 | 
328 | 
329 | ->      0      0      0      1      0 
330 | 
331 | 
332 | ->      0      0      0      0      0 
333 | 
334 | 
335 | ->      0      0      0      0      0 
336 | 
337 | 
338 | ->      0      0      1      0      0 
339 | 
340 | 
341 | ->      0      0      0      0      0 
342 | 
343 | 
344 | ->      0      1      0      0      0 
345 | 
346 | 
347 | ->      1      0      0      0      0 
348 | 
349 | 
350 | ->     -2     -1      0      1      2 
351 | 
352 | 
353 | -> 


--------------------------------------------------------------------------------
/C-distr/code.sch.out:
--------------------------------------------------------------------------------
  1 | -> -> <closure>
  2 | 
  3 | -> <closure>
  4 | 
  5 | -> <closure>
  6 | 
  7 | -> > <closure>
  8 | 
  9 | -> <closure>
 10 | 
 11 | -> <closure>
 12 | 
 13 | -> <closure>
 14 | 
 15 | -> > > > > > <closure>
 16 | 
 17 | -> <closure>
 18 | 
 19 | -> <closure>
 20 | 
 21 | -> <closure>
 22 | 
 23 | -> <closure>
 24 | 
 25 | -> > > > <closure>
 26 | 
 27 | -> <closure>
 28 | 
 29 | -> > <closure>
 30 | 
 31 | -> > > > > <closure>
 32 | 
 33 | -> > > > <closure>
 34 | 
 35 | -> <closure>
 36 | 
 37 | -> -> > <closure>
 38 | 
 39 | -> (5 7)
 40 | 
 41 | -> (5 7)
 42 | 
 43 | -> > > > <closure>
 44 | 
 45 | -> ((2 9) (4 5))
 46 | 
 47 | -> ((2 9) (4 5))
 48 | 
 49 | -> <closure>
 50 | 
 51 | -> <closure>
 52 | 
 53 | -> 5
 54 | 
 55 | -> 5
 56 | 
 57 | -> -> > > <closure>
 58 | 
 59 | -> (T () () ())
 60 | 
 61 | -> (T () () ())
 62 | 
 63 | -> (4 5 6)
 64 | 
 65 | -> (4 5 6)
 66 | 
 67 | -> <closure>
 68 | 
 69 | -> (4 5 6)
 70 | 
 71 | -> (4 5 6)
 72 | 
 73 | -> <closure>
 74 | 
 75 | -> 7
 76 | 
 77 | -> 7
 78 | 
 79 | -> <closure>
 80 | 
 81 | -> <closure>
 82 | 
 83 | -> (4 5 6)
 84 | 
 85 | -> (4 5 6)
 86 | 
 87 | -> <closure>
 88 | 
 89 | -> ((3 4) (5 6))
 90 | 
 91 | -> ((3 4) (5 6))
 92 | 
 93 | -> > > <closure>
 94 | 
 95 | -> <closure>
 96 | 
 97 | -> 30
 98 | 
 99 | -> 30
100 | 
101 | -> <closure>
102 | 
103 | -> <closure>
104 | 
105 | -> 10
106 | 
107 | -> 10
108 | 
109 | -> <closure>
110 | 
111 | -> 24
112 | 
113 | -> 24
114 | 
115 | -> <closure>
116 | 
117 | -> (3 4 5)
118 | 
119 | -> (3 4 5)
120 | 
121 | -> <closure>
122 | 
123 | -> > > > <closure>
124 | 
125 | -> > > > > <closure>
126 | 
127 | -> <closure>
128 | 
129 | -> > <closure>
130 | 
131 | -> <closure>
132 | 
133 | -> ((95 2170) (85 1005))
134 | 
135 | -> ((95 2170) (85 1005))
136 | 
137 | -> ((85 1005) (85 2170))
138 | 
139 | -> ((85 1005) (85 2170))
140 | 
141 | -> <closure>
142 | 
143 | -> ((85 1005) (95 2170))
144 | 
145 | -> ((85 1005) (95 2170))
146 | 
147 | -> > <closure>
148 | 
149 | -> > <closure>
150 | 
151 | -> > <closure>
152 | 
153 | -> <closure>
154 | 
155 | -> > ((Reddy 2170 95 92) (Kaplan 1005 85 87))
156 | 
157 | -> ((Reddy 2170 95 92) (Kaplan 1005 85 87))
158 | 
159 | -> <closure>
160 | 
161 | -> > <closure>
162 | 
163 | -> > > <closure>
164 | 
165 | -> <closure>
166 | 
167 | -> > ((Kaplan 1005 85 87) (Reddy 2170 95 92))
168 | 
169 | -> ((Kaplan 1005 85 87) (Reddy 2170 95 92))
170 | 
171 | -> > > <closure>
172 | 
173 | -> ()
174 | 
175 | -> <closure>
176 | 
177 | -> <closure>
178 | 
179 | -> <closure>
180 | 
181 | -> (a b)
182 | 
183 | -> (a b)
184 | 
185 | -> T
186 | 
187 | -> T
188 | 
189 | -> ()
190 | 
191 | -> ()
192 | 
193 | -> (b c)
194 | 
195 | -> (b c)
196 | 
197 | -> (c a b)
198 | 
199 | -> (c a b)
200 | 
201 | -> > > > > <closure>
202 | 
203 | -> > <closure>
204 | 
205 | -> > ()
206 | 
207 | -> ()
208 | 
209 | -> > T
210 | 
211 | -> T
212 | 
213 | -> > <closure>
214 | 
215 | -> > <closure>
216 | 
217 | -> <closure>
218 | 
219 | -> > <closure>
220 | 
221 | -> > <closure>
222 | 
223 | -> > > > > > > <closure>
224 | 
225 | -> (() <closure> <closure>)
226 | 
227 | -> ()
228 | 
229 | -> <closure>
230 | 
231 | -> <closure>
232 | 
233 | -> > > > <closure>
234 | 
235 | -> 1
236 | 
237 | -> 1
238 | 
239 | -> > > <closure>
240 | 
241 | -> > > > <closure>
242 | 
243 | -> 1
244 | 
245 | -> 1
246 | 
247 | -> <closure>
248 | 
249 | -> > > > > <closure>
250 | 
251 | -> 1
252 | 
253 | -> 1
254 | 
255 | -> <closure>
256 | 
257 | -> > > > > > > <closure>
258 | 
259 | -> 1
260 | 
261 | -> 1
262 | 
263 | -> <closure>
264 | 
265 | -> > <closure>
266 | 
267 | -> <closure>
268 | 
269 | -> <closure>
270 | 
271 | -> 14
272 | 
273 | -> 14
274 | 
275 | -> 131
276 | 
277 | -> 131
278 | 
279 | -> -> -> > > > <closure>
280 | 
281 | -> <closure>
282 | 
283 | -> -> <closure>
284 | 
285 | -> <closure>
286 | 
287 | -> <closure>
288 | 
289 | -> > > > > > > > > > > > <closure>
290 | 
291 | -> > > > > > > > <closure>
292 | 
293 | -> > > > > > > <closure>
294 | 
295 | -> > > > > > > <closure>
296 | 
297 | -> > > > > > > > > > <closure>
298 | 
299 | -> > > > > > > > > > > > <closure>
300 | 
301 | -> > <closure>
302 | 
303 | -> <closure>
304 | 
305 | -> > > <closure>
306 | 
307 | -> > <closure>
308 | 
309 | -> > > > > > <closure>
310 | 
311 | -> > <closure>
312 | 
313 | -> > > > > > > (((Dx x) 1) ((Dx c) 0) ((Dx (+ X Y)) (+ (Dx X) (Dx Y))) ((Dx (- X Y)) (- (Dx X) (Dx Y))) ((Dx (* X Y)) (+ (* Y (Dx X)) (* X (Dx Y)))) ((Dx (/ X Y)) (/ (- (* Y (Dx X)) (* X (Dx Y))) (* Y Y))))
314 | 
315 | -> <closure>
316 | 
317 | -> -> -> -> <closure>
318 | 
319 | -> <closure>
320 | 
321 | -> <closure>
322 | 
323 | -> <closure>
324 | 
325 | -> > > > > > > > > > <closure>
326 | 
327 | -> > > > <closure>
328 | 
329 | -> > > > <closure>
330 | 
331 | -> > > <closure>
332 | 
333 | -> > > > <closure>
334 | 
335 | -> <closure>
336 | 
337 | -> <closure>
338 | 
339 | -> > > > > > > > > > > > > > > > > ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)))
340 | 
341 | -> > > > > > > > > <closure>
342 | 
343 | -> > > > > > > > > <closure>
344 | 
345 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (double (closure (lambda (a) (+ a a)) ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?))))))
346 | 
347 | -> > ((+ (primop +)) (- (primop -)) ... (double (closure (lambda (a) (+ a a)) ...)))
348 | 
349 | -> 8
350 | 
351 | -> 8
352 | 
353 | -> -> > > > > > > > > > <closure>
354 | 
355 | -> > > > <closure>
356 | 
357 | -> > > <closure>
358 | 
359 | -> <closure>
360 | 
361 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10))
362 | 
363 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))))
364 | 
365 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))) (g (lambda (s) (f (+ s 11)))))
366 | 
367 | -> 21
368 | 
369 | -> 21
370 | 
371 | -> > ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))) (g (lambda (s) (f (+ s 11)))) (add (lambda (x) (lambda (y) (+ x y)))))
372 | 
373 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))) (g (lambda (s) (f (+ s 11)))) (add (lambda (x) (lambda (y) (+ x y)))) (add1 (lambda (y) (+ x y))))
374 | 
375 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (add1 x))) (g (lambda (s) (f (+ s 11)))) (add (lambda (x) (lambda (y) (+ x y)))) (add1 (lambda (y) (+ x y))))
376 | 
377 | -> 10
378 | 
379 | -> 10
380 | 
381 | -> 


--------------------------------------------------------------------------------
/distr/code.sch.o:
--------------------------------------------------------------------------------
  1 | -> -> <closure>
  2 | 
  3 | -> <closure>
  4 | 
  5 | -> <closure>
  6 | 
  7 | -> > <closure>
  8 | 
  9 | -> <closure>
 10 | 
 11 | -> <closure>
 12 | 
 13 | -> <closure>
 14 | 
 15 | -> > > > > > <closure>
 16 | 
 17 | -> <closure>
 18 | 
 19 | -> <closure>
 20 | 
 21 | -> <closure>
 22 | 
 23 | -> <closure>
 24 | 
 25 | -> > > > <closure>
 26 | 
 27 | -> <closure>
 28 | 
 29 | -> > <closure>
 30 | 
 31 | -> > > > > <closure>
 32 | 
 33 | -> > > > <closure>
 34 | 
 35 | -> <closure>
 36 | 
 37 | -> -> > <closure>
 38 | 
 39 | -> (5 7)
 40 | 
 41 | -> (5 7)
 42 | 
 43 | -> > > > <closure>
 44 | 
 45 | -> ((2 9) (4 5))
 46 | 
 47 | -> ((2 9) (4 5))
 48 | 
 49 | -> <closure>
 50 | 
 51 | -> <closure>
 52 | 
 53 | -> 5
 54 | 
 55 | -> 5
 56 | 
 57 | -> -> > > <closure>
 58 | 
 59 | -> (T () () ())
 60 | 
 61 | -> (T () () ())
 62 | 
 63 | -> (4 5 6)
 64 | 
 65 | -> (4 5 6)
 66 | 
 67 | -> <closure>
 68 | 
 69 | -> (4 5 6)
 70 | 
 71 | -> (4 5 6)
 72 | 
 73 | -> <closure>
 74 | 
 75 | -> 7
 76 | 
 77 | -> 7
 78 | 
 79 | -> <closure>
 80 | 
 81 | -> <closure>
 82 | 
 83 | -> (4 5 6)
 84 | 
 85 | -> (4 5 6)
 86 | 
 87 | -> <closure>
 88 | 
 89 | -> ((3 4) (5 6))
 90 | 
 91 | -> ((3 4) (5 6))
 92 | 
 93 | -> > > <closure>
 94 | 
 95 | -> <closure>
 96 | 
 97 | -> 30
 98 | 
 99 | -> 30
100 | 
101 | -> <closure>
102 | 
103 | -> <closure>
104 | 
105 | -> 10
106 | 
107 | -> 10
108 | 
109 | -> <closure>
110 | 
111 | -> 24
112 | 
113 | -> 24
114 | 
115 | -> <closure>
116 | 
117 | -> (3 4 5)
118 | 
119 | -> (3 4 5)
120 | 
121 | -> <closure>
122 | 
123 | -> > > > <closure>
124 | 
125 | -> > > > > <closure>
126 | 
127 | -> <closure>
128 | 
129 | -> > <closure>
130 | 
131 | -> <closure>
132 | 
133 | -> ((95 2170) (85 1005))
134 | 
135 | -> ((95 2170) (85 1005))
136 | 
137 | -> ((85 1005) (85 2170))
138 | 
139 | -> ((85 1005) (85 2170))
140 | 
141 | -> <closure>
142 | 
143 | -> ((85 1005) (95 2170))
144 | 
145 | -> ((85 1005) (95 2170))
146 | 
147 | -> > <closure>
148 | 
149 | -> > <closure>
150 | 
151 | -> > <closure>
152 | 
153 | -> <closure>
154 | 
155 | -> > ((Reddy 2170 95 92) (Kaplan 1005 85 87))
156 | 
157 | -> ((Reddy 2170 95 92) (Kaplan 1005 85 87))
158 | 
159 | -> <closure>
160 | 
161 | -> > <closure>
162 | 
163 | -> > > <closure>
164 | 
165 | -> <closure>
166 | 
167 | -> > ((Kaplan 1005 85 87) (Reddy 2170 95 92))
168 | 
169 | -> ((Kaplan 1005 85 87) (Reddy 2170 95 92))
170 | 
171 | -> > > <closure>
172 | 
173 | -> ()
174 | 
175 | -> <closure>
176 | 
177 | -> <closure>
178 | 
179 | -> <closure>
180 | 
181 | -> (a b)
182 | 
183 | -> (a b)
184 | 
185 | -> T
186 | 
187 | -> T
188 | 
189 | -> ()
190 | 
191 | -> ()
192 | 
193 | -> (b c)
194 | 
195 | -> (b c)
196 | 
197 | -> (c a b)
198 | 
199 | -> (c a b)
200 | 
201 | -> > > > > <closure>
202 | 
203 | -> > <closure>
204 | 
205 | -> > ()
206 | 
207 | -> ()
208 | 
209 | -> > T
210 | 
211 | -> T
212 | 
213 | -> > <closure>
214 | 
215 | -> > <closure>
216 | 
217 | -> <closure>
218 | 
219 | -> > <closure>
220 | 
221 | -> > <closure>
222 | 
223 | -> > > > > > > <closure>
224 | 
225 | -> (() <closure> <closure>)
226 | 
227 | -> ()
228 | 
229 | -> <closure>
230 | 
231 | -> <closure>
232 | 
233 | -> > > > <closure>
234 | 
235 | -> 1
236 | 
237 | -> 1
238 | 
239 | -> > > <closure>
240 | 
241 | -> > > > <closure>
242 | 
243 | -> 1
244 | 
245 | -> 1
246 | 
247 | -> <closure>
248 | 
249 | -> > > > > <closure>
250 | 
251 | -> 1
252 | 
253 | -> 1
254 | 
255 | -> <closure>
256 | 
257 | -> > > > > > > <closure>
258 | 
259 | -> 1
260 | 
261 | -> 1
262 | 
263 | -> <closure>
264 | 
265 | -> > <closure>
266 | 
267 | -> <closure>
268 | 
269 | -> <closure>
270 | 
271 | -> 14
272 | 
273 | -> 14
274 | 
275 | -> 131
276 | 
277 | -> 131
278 | 
279 | -> -> -> > > > <closure>
280 | 
281 | -> <closure>
282 | 
283 | -> -> <closure>
284 | 
285 | -> <closure>
286 | 
287 | -> <closure>
288 | 
289 | -> > > > > > > > > > > > <closure>
290 | 
291 | -> > > > > > > > <closure>
292 | 
293 | -> > > > > > > <closure>
294 | 
295 | -> > > > > > > <closure>
296 | 
297 | -> > > > > > > > > > <closure>
298 | 
299 | -> > > > > > > > > > > > <closure>
300 | 
301 | -> > <closure>
302 | 
303 | -> <closure>
304 | 
305 | -> > > <closure>
306 | 
307 | -> > <closure>
308 | 
309 | -> > > > > > <closure>
310 | 
311 | -> > <closure>
312 | 
313 | -> > > > > > > (((Dx x) 1) ((Dx c) 0) ((Dx (+ X Y)) (+ (Dx X) (Dx Y))) ((Dx (- X Y)) (- (Dx X) (Dx Y))) ((Dx (* X Y)) (+ (* Y (Dx X)) (* X (Dx Y)))) ((Dx (/ X Y)) (/ (- (* Y (Dx X)) (* X (Dx Y))) (* Y Y))))
314 | 
315 | -> <closure>
316 | 
317 | -> -> -> -> <closure>
318 | 
319 | -> <closure>
320 | 
321 | -> <closure>
322 | 
323 | -> <closure>
324 | 
325 | -> > > > > > > > > > <closure>
326 | 
327 | -> > > > <closure>
328 | 
329 | -> > > > <closure>
330 | 
331 | -> > > <closure>
332 | 
333 | -> > > > <closure>
334 | 
335 | -> <closure>
336 | 
337 | -> <closure>
338 | 
339 | -> > > > > > > > > > > > > > > > > ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)))
340 | 
341 | -> > > > > > > > > <closure>
342 | 
343 | -> > > > > > > > > <closure>
344 | 
345 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (double (closure (lambda (a) (+ a a)) ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?))))))
346 | 
347 | -> > ((+ (primop +)) (- (primop -)) ... (double (closure (lambda (a) (+ a a)) ...)))
348 | 
349 | -> 8
350 | 
351 | -> 8
352 | 
353 | -> -> > > > > > > > > > <closure>
354 | 
355 | -> > > > <closure>
356 | 
357 | -> > > <closure>
358 | 
359 | -> <closure>
360 | 
361 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10))
362 | 
363 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))))
364 | 
365 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))) (g (lambda (s) (f (+ s 11)))))
366 | 
367 | -> 21
368 | 
369 | -> 21
370 | 
371 | -> > ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))) (g (lambda (s) (f (+ s 11)))) (add (lambda (x) (lambda (y) (+ x y)))))
372 | 
373 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (+ x s))) (g (lambda (s) (f (+ s 11)))) (add (lambda (x) (lambda (y) (+ x y)))) (add1 (lambda (y) (+ x y))))
374 | 
375 | -> ((+ (primop +)) (- (primop -)) (cons (primop cons)) (* (primop *)) (/ (primop /)) (< (primop <)) (> (primop >)) (= (primop =)) (cdr (primop cdr)) (car (primop car)) (number? (primop number?)) (list? (primop list?)) (symbol? (primop symbol?)) (null? (primop null?)) (closure? (primop closure?)) (primop? (primop primop?)) (s 10) (f (lambda (x) (add1 x))) (g (lambda (s) (f (+ s 11)))) (add (lambda (x) (lambda (y) (+ x y)))) (add1 (lambda (y) (+ x y))))
376 | 
377 | -> 10
378 | 
379 | -> 10
380 | 
381 | -> 


--------------------------------------------------------------------------------
/C-distr/p2c/p2c.h:
--------------------------------------------------------------------------------
  1 | #ifndef P2C_H
  2 | #define P2C_H
  3 | 
  4 | 
  5 | /* Header file for code generated by "p2c", the Pascal-to-C translator */
  6 | 
  7 | /* "p2c"  Copyright (C) 1989 Dave Gillespie.
  8 |  * This file may be copied, modified, etc. in any way.  It is not restricted
  9 |  * by the licence agreement accompanying p2c itself.
 10 |  */
 11 | 
 12 | 
 13 | #include <stdio.h>
 14 | 
 15 | 
 16 | #ifdef FILE       /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
 17 | # define BSD 1	  /*  (a convenient, but horrible kludge!) */
 18 | #endif
 19 | 
 20 | 
 21 | #ifdef __STDC__
 22 | # include <stddef.h>
 23 | # include <stdlib.h>
 24 | # define HAS_STDLIB
 25 | # define __CAT__(a,b)a##b
 26 | #else
 27 | # ifndef BSD
 28 | #  include <memory.h>
 29 | # endif
 30 | # include <sys/types.h>
 31 | # define __ID__(a)a
 32 | # define __CAT__(a,b)__ID__(a)b
 33 | #endif
 34 | 
 35 | 
 36 | #ifdef BSD
 37 | # include <strings.h>
 38 | # define memcpy(a,b,n) (bcopy(b,a,n),a)
 39 | # define memcmp(a,b,n) bcmp(a,b,n)
 40 | # define strchr(s,c) index(s,c)
 41 | # define strrchr(s,c) rindex(s,c)
 42 | #else
 43 | # include <string.h>
 44 | #endif
 45 | 
 46 | #include <ctype.h>
 47 | #include <math.h>
 48 | #include <setjmp.h>
 49 | 
 50 | 
 51 | typedef struct __p2c_jmp_buf {
 52 |     struct __p2c_jmp_buf *next;
 53 |     jmp_buf jbuf;
 54 | } __p2c_jmp_buf;
 55 | 
 56 | 
 57 | /* Warning: The following will not work if setjmp is used simultaneously.
 58 |    This also violates the ANSI restriction about using vars after longjmp,
 59 |    but a typical implementation of longjmp will get it right anyway. */
 60 | 
 61 | #ifndef FAKE_TRY
 62 | # define TRY(x)         do { __p2c_jmp_buf __try_jb;  \
 63 | 			     __try_jb.next = __top_jb;  \
 64 | 			     if (!setjmp((__top_jb = &__try_jb)->jbuf)) {
 65 | # define RECOVER(x)	__top_jb = __try_jb.next; } else {
 66 | # define RECOVER2(x,L)  __top_jb = __try_jb.next; } else {  \
 67 | 			     if (0) { L: __top_jb = __try_jb.next; }
 68 | # define ENDTRY(x)      } } while (0) 
 69 | #else
 70 | # define TRY(x)         if (1) {
 71 | # define RECOVER(x)     } else do {
 72 | # define RECOVER2(x,L)  } else do { L:
 73 | # define ENDTRY(x)      } while (0)
 74 | #endif
 75 | 
 76 | 
 77 | 
 78 | /* The following definitions work only on twos-complement machines */
 79 | #ifndef SHORT_MAX
 80 | # define SHORT_MAX  (((unsigned short) -1) >> 1)
 81 | # define SHORT_MIN  (~SHORT_MAX)
 82 | #endif
 83 | 
 84 | #ifndef INT_MAX
 85 | # define INT_MAX    (((unsigned int) -1) >> 1)
 86 | # define INT_MIN    (~INT_MAX)
 87 | #endif
 88 | 
 89 | #ifndef LONG_MAX
 90 | # define LONG_MAX   (((unsigned long) -1) >> 1)
 91 | # define LONG_MIN   (~LONG_MAX)
 92 | #endif
 93 | 
 94 | #ifndef SEEK_SET
 95 | # define SEEK_SET   0
 96 | # define SEEK_CUR   1
 97 | # define SEEK_END   2
 98 | #endif
 99 | 
100 | #ifndef EXIT_SUCCESS
101 | # define EXIT_SUCCESS  0
102 | # define EXIT_FAILURE  1
103 | #endif
104 | 
105 | 
106 | #define SETBITS  32
107 | 
108 | 
109 | #ifdef __STDC__
110 | # define Signed     signed
111 | # define Const      const
112 | # define Volatile   volatile
113 | # define Void       void      /* Void f() = procedure */
114 | # define PP(x)      x         /* function prototype */
115 | # define PV()       (void)    /* null function prototype */
116 | typedef void *Anyptr;
117 | #else
118 | # define Signed
119 | # define Const
120 | # define Volatile
121 | # define Void       void
122 | # define PP(x)      ()
123 | # define PV()       ()
124 | typedef char *Anyptr;
125 | #endif
126 | 
127 | #ifdef __GNUC__
128 | # define Inline     inline
129 | #else
130 | # define Inline
131 | #endif
132 | 
133 | #define Register    register  /* Register variables */
134 | #define Static      static    /* Private global funcs and vars */
135 | #define Local       static    /* Nested functions */
136 | #define Char        char      /* Characters (not bytes) */
137 | 
138 | 
139 | typedef Signed   char schar;
140 | typedef unsigned char uchar;
141 | typedef unsigned char boolean;
142 | 
143 | #ifndef true
144 | # define true    1
145 | # define false   0
146 | #endif
147 | 
148 | 
149 | typedef struct {
150 |     Anyptr proc, link;
151 | } _PROCEDURE;
152 | 
153 | #define _FNSIZE  120
154 | 
155 | 
156 | extern Void    PASCAL_MAIN  PP( (int, Char **) );
157 | extern Char    **P_argv;
158 | extern int     P_argc;
159 | extern short   P_escapecode;
160 | extern int     P_ioresult;
161 | extern __p2c_jmp_buf *__top_jb;
162 | 
163 | 
164 | #if 0   /* use this if you have Ansi C but non-prototyped header files */
165 | extern Char    *strcat      PP( (Char *, Const Char *) );
166 | extern Char    *strchr      PP( (Const Char *, int) );
167 | extern int      strcmp      PP( (Const Char *, Const Char *) );
168 | extern Char    *strcpy      PP( (Char *, Const Char *) );
169 | extern size_t   strlen      PP( (Const Char *) );
170 | extern Char    *strncat     PP( (Char *, Const Char *, size_t) );
171 | extern int      strncmp     PP( (Const Char *, Const Char *, size_t) );
172 | extern Char    *strncpy     PP( (Char *, Const Char *, size_t) );
173 | extern Char    *strrchr     PP( (Const Char *, int) );
174 | 
175 | extern Anyptr   memchr      PP( (Const Anyptr, int, size_t) );
176 | extern Anyptr   memmove     PP( (Anyptr, Const Anyptr, size_t) );
177 | extern Anyptr   memset      PP( (Anyptr, int, size_t) );
178 | #ifndef memcpy
179 | extern Anyptr   memcpy      PP( (Anyptr, Const Anyptr, size_t) );
180 | extern int      memcmp      PP( (Const Anyptr, Const Anyptr, size_t) );
181 | #endif
182 | 
183 | extern int      atoi        PP( (Const Char *) );
184 | extern double   atof        PP( (Const Char *) );
185 | extern long     atol        PP( (Const Char *) );
186 | extern double   strtod      PP( (Const Char *, Char **) );
187 | extern long     strtol      PP( (Const Char *, Char **, int) );
188 | #endif
189 | 
190 | #ifndef HAS_STDLIB
191 | extern Anyptr   malloc      PP( (size_t) );
192 | extern Void     free        PP( (Anyptr) );
193 | #endif
194 | 
195 | extern int      _OutMem     PV();
196 | extern int      _CaseCheck  PV();
197 | extern int      _NilCheck   PV();
198 | extern int	_Escape     PP( (int) );
199 | extern int	_EscIO      PP( (int) );
200 | 
201 | extern long     ipow        PP( (long, long) );
202 | extern Char    *strsub      PP( (Char *, Char *, int, int) );
203 | extern Char    *strltrim    PP( (Char *) );
204 | extern Char    *strrtrim    PP( (Char *) );
205 | extern Char    *strrpt      PP( (Char *, Char *, int) );
206 | extern Char    *strpad      PP( (Char *, Char *, int, int) );
207 | extern int      strpos2     PP( (Char *, Char *, int) );
208 | extern long     memavail    PV();
209 | extern int      P_peek      PP( (FILE *) );
210 | extern int      P_eof       PP( (FILE *) );
211 | extern int      P_eoln      PP( (FILE *) );
212 | extern long     P_maxpos    PP( (FILE *) );
213 | extern long    *P_setunion  PP( (long *, long *, long *) );
214 | extern long    *P_setint    PP( (long *, long *, long *) );
215 | extern long    *P_setdiff   PP( (long *, long *, long *) );
216 | extern long    *P_setxor    PP( (long *, long *, long *) );
217 | extern int      P_inset     PP( (unsigned, long *) );
218 | extern int      P_setequal  PP( (long *, long *) );
219 | extern int      P_subset    PP( (long *, long *) );
220 | extern long    *P_addset    PP( (long *, unsigned) );
221 | extern long    *P_addsetr   PP( (long *, unsigned, unsigned) );
222 | extern long    *P_remset    PP( (long *, unsigned) );
223 | extern long    *P_setcpy    PP( (long *, long *) );
224 | extern long    *P_expset    PP( (long *, long) );
225 | extern long     P_packset   PP( (long *) );
226 | 
227 | 
228 | /* I/O error handling */
229 | #define _CHKIO(cond,ior,val,def)  ((cond) ? P_ioresult=0,(val)  \
230 | 					  : P_ioresult=(ior),(def))
231 | #define _SETIO(cond,ior)          (P_ioresult = (cond) ? 0 : (ior))
232 | 
233 | /* Following defines are suitable for the HP Pascal operating system */
234 | #define FileNotFound     10
235 | #define FileNotOpen      13
236 | #define FileWriteError   38
237 | #define BadInputFormat   14
238 | #define EndOfFile        30
239 | 
240 | /* File buffers */
241 | #define FILEBUF(f,sc,type) sc int __CAT__(f,_BFLAGS);   \
242 | 			   sc type __CAT__(f,_BUFFER);
243 | 
244 | #define RESETBUF(f,type)   (__CAT__(f,_BFLAGS) = 1)
245 | #define SETUPBUF(f,type)   (__CAT__(f,_BFLAGS) = 0)
246 | 
247 | #define GETFBUF(f,type)    (*((__CAT__(f,_BFLAGS) == 1 &&   \
248 | 			       ((__CAT__(f,_BFLAGS) = 2),   \
249 | 				fread(&__CAT__(f,_BUFFER),  \
250 | 				      sizeof(type),1,(f)))),\
251 | 			      &__CAT__(f,_BUFFER)))
252 | 
253 | #define PUTFBUF(f,type,v)  (GETFBUF(f,type) = (v))
254 | 
255 | #define GET(f,type)        (__CAT__(f,_BFLAGS) == 1 ?   \
256 | 			    fread(&__CAT__(f,_BUFFER),sizeof(type),1,(f)) :  \
257 | 			    (__CAT__(f,_BFLAGS) = 1))
258 | 
259 | #define PUT(f,type)        (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)),  \
260 | 			    (__CAT__(f,_BFLAGS) = 0))
261 | 
262 | 
263 | /* Memory allocation */
264 | #ifdef __GCC__
265 | # define Malloc(n)  (malloc(n) ?: (Anyptr)_OutMem())
266 | #else
267 | extern Anyptr __MallocTemp__;
268 | # define Malloc(n)  ((__MallocTemp__ = malloc(n)) ? __MallocTemp__ : (Anyptr)_OutMem())
269 | #endif
270 | #define Free(p)     (free((Anyptr)(p)), (p)=NULL)
271 | 
272 | /* sign extension */
273 | #define SEXT(x,n)   ((x) | -(((x) & (1L<<((n)-1))) << 1))
274 | 
275 | /* packed arrays */   /* BEWARE: these are untested! */
276 | #define P_getbits_UB(a,i,n,L)   ((int)((a)[(i)>>(L)-(n)] >>   \
277 | 				       (((~(i))&((1<<(L)-(n))-1)) << (n)) &  \
278 | 				       (1<<(1<<(n)))-1))
279 | 
280 | #define P_getbits_SB(a,i,n,L)   ((int)((a)[(i)>>(L)-(n)] <<   \
281 | 				       (16 - ((((~(i))&((1<<(L)-(n))-1))+1) <<\
282 | 					      (n)) >> (16-(1<<(n))))))
283 | 
284 | #define P_putbits_UB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |=   \
285 | 				 (x) << (((~(i))&((1<<(L)-(n))-1)) << (n)))
286 | 
287 | #define P_putbits_SB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |=   \
288 | 				 ((x) & (1<<(1<<(n)))-1) <<   \
289 | 				 (((~(i))&((1<<(L)-(n))-1)) << (n)))
290 | 
291 | #define P_clrbits_B(a,i,n,L)    ((a)[(i)>>(L)-(n)] &=   \
292 | 				 ~( (1<<(1<<(n)))-1 <<   \
293 | 				   (((~(i))&((1<<(L)-(n))-1)) << (n))) )
294 | 
295 | /* small packed arrays */
296 | #define P_getbits_US(v,i,n)     ((int)((v) >> (~(i) << (n)) & (1<<(1<<(n)))-1))
297 | #define P_getbits_SS(v,i,n)     ((int)((long)(v) << (32 - (((~(i))+1) << (n))) >> (32-(1<<(n)))))
298 | #define P_putbits_US(v,i,x,n)   ((v) |= (x) << (~(i) << (n)))
299 | #define P_putbits_SS(v,i,x,n)   ((v) |= ((x) & (1<<(1<<(n)))-1) << (~(i) << (n)))
300 | #define P_clrbits_S(v,i,n)      ((v) &= ~( (1<<(1<<(n)))-1 << (~(i) << (n)) ))
301 | 
302 | 
303 | 
304 | /* Fix toupper/tolower on Suns and other stupid BSD systems */
305 | #ifdef toupper
306 | # undef toupper
307 | # undef tolower
308 | # define toupper(c)   my_toupper(c)
309 | # define tolower(c)   my_tolower(c)
310 | # define _toupper(c)  ((c)-'a'+'A')
311 | # define _tolower(c)  ((c)-'A'+'a')
312 | #endif
313 | 
314 | 
315 | 
316 | #endif    /* P2C_H */
317 | 
318 | 
319 | 
320 | /* End. */
321 | 
322 | 
323 | 


--------------------------------------------------------------------------------
/distr/code.clu:
--------------------------------------------------------------------------------
  1 | ; From Chapter 1
  2 | (define sqr (x) (* x x))
  3 | (define abs (x) (if (< x 0) (- 0 x) x))
  4 | (define +1 (x) (+ x 1))
  5 | (define and (x y) (if x y x))
  6 | (define or (x y) (if x x y))
  7 | (define not (x) (if x 0 1))
  8 | (define <> (x y) (not (= x y)))
  9 | (define >= (x y) (or (> x y) (= x y)))
 10 | (define <= (x y) (or (< x y) (= x y)))
 11 | (define mod (m n) (- m (* n (/ m n))))
 12 | (define min (x y) (if (< x y) x y))
 13 | (define max (x y) (if (> x y) x y))
 14 | ; Section 6.1
 15 | (cluster Point
 16 |     ; Export: new, abscissa, ordinate, reflect, rotate, compare, quadrant
 17 |     (rep x-coord y-coord)
 18 |     (define new (x y) (Point x y))
 19 |     (define abscissa (p) (x-coord p))
 20 |     (define ordinate (p) (y-coord p))
 21 |     (define reflect (p)
 22 |          (begin
 23 |                (set-x-coord p (- 0 (x-coord p)))
 24 |                (set-y-coord p (- 0 (y-coord p)))))
 25 |     (define rotate (p)
 26 |          (begin
 27 |                (set temp (x-coord p))
 28 |                (set-x-coord p (y-coord p))
 29 |                (set-y-coord p (- 0 temp))))
 30 |     (define compare (p1 p2)
 31 |          (< (sqrdist p1) (sqrdist p2)))
 32 |     (define quadrant (p)
 33 |          (if (>= (x-coord p) 0)
 34 |               (if (>= (y-coord p) 0) 1 2)
 35 |               (if (< (y-coord p) 0) 3 4)))
 36 |     ; sqrdist is not exported
 37 |     (define sqrdist (p)
 38 |          (+ (sqr (x-coord p)) (sqr (y-coord p))))
 39 | )
 40 | (set p1 (Point$new 3 4))
 41 | (Point$rotate p1)
 42 | (Point$abscissa p1)
 43 | 4
 44 | (Point$ordinate p1)
 45 | -3
 46 | (Point$reflect p1)
 47 | (Point$abscissa p1)
 48 | -4
 49 | (Point$ordinate p1)
 50 | 3
 51 | (set p2 (Point$new 1 5))
 52 | (Point$compare p1 p2)
 53 | 1
 54 | (define enclosed-area (p1 p2)
 55 |       (abs (* (- (Point$abscissa p1) (Point$abscissa p2))
 56 |         (- (Point$ordinate p1) (Point$ordinate p2)))))
 57 | (enclosed-area p1 p2)
 58 | 10
 59 | (cluster Point
 60 |     ; Export: new, abscissa, ordinate, reflect, rotate, compare, quadrant
 61 |     (rep x-mag y-mag quad)
 62 |     (define new (x y) (Point (abs x) (abs y) (compute-quad x y)))
 63 |     (define abscissa (p)
 64 |          (if (> (quad p) 2) (- 0 (x-mag p)) (x-mag p)))
 65 |     (define ordinate (p)
 66 |          (if (or (= (quad p) 2) (= (quad p) 3))
 67 |               (- 0 (y-mag p))
 68 |               (y-mag p)))
 69 |     (define reflect (p)
 70 |          (set-quad p (+1 (mod (+1 (quad p)) 4))))
 71 |     (define rotate (p)
 72 |          (begin
 73 |                (set temp (x-mag p))
 74 |                (set-x-mag p (y-mag p))
 75 |                (set-y-mag p temp)
 76 |                (set-quad p (+1 (mod (quad p) 4)))))
 77 |     (define compare (p1 p2)
 78 |          (< (sqrdist p1) (sqrdist p2)))
 79 |     (define quadrant (p) (quad p))
 80 |     ; compute-quad, sqrdist are not exported
 81 |     (define compute-quad (x y)
 82 |          (if (>= x 0)
 83 |               (if (>= y 0) 1 2)
 84 |               (if (< y 0) 3 4)))
 85 |     (define sqrdist (p)
 86 |          (+ (sqr (x-mag p)) (sqr (y-mag p))))
 87 | )
 88 | (set p1 (Point$new 3 4))
 89 | (Point$rotate p1)
 90 | (Point$abscissa p1)
 91 | 4
 92 | (Point$ordinate p1)
 93 | -3
 94 | (Point$reflect p1)
 95 | (Point$abscissa p1)
 96 | -4
 97 | (Point$ordinate p1)
 98 | 3
 99 | (set p2 (Point$new 1 5))
100 | (Point$compare p1 p2)
101 | 1
102 | (define enclosed-area (p1 p2)
103 |       (abs (* (- (Point$abscissa p1) (Point$abscissa p2))
104 |         (- (Point$ordinate p1) (Point$ordinate p2)))))
105 | (enclosed-area p1 p2)
106 | 10
107 | ; Section 6.2.3
108 | (cluster List
109 |     ; Exports: nil, null?, cons, car, cdr, rplaca, rplacd
110 |     (rep type a d)
111 |     (define nil () (List 0 0 0))
112 |     (define null? (l) (= (type l) 0))
113 |     (define cons (item l) (List 1 item l))
114 |     (define car (l) (a l))
115 |     (define cdr (l) (d l))
116 |     (define rplaca (l a) (set-a l a))
117 |     (define rplacd (l d) (set-d l d))
118 | )
119 | (set x (List$cons 1 (List$cons 2 (List$nil)))) ; x is 1,2
120 | (set y x) ; y is 1,2
121 | (List$car x)
122 | 1
123 | (List$car y)
124 | 1
125 | (List$car (List$cdr x))
126 | 2
127 | (List$rplaca y 3) ; y is 3,2, and so is x
128 | (List$car x)
129 | 3
130 | (List$car y)
131 | 3
132 | (define length (l)
133 |     (if (List$null? l) 0 (+1 (length (List$cdr l)))))
134 | (length x)
135 | 2
136 | (length y)
137 | 2
138 | ;
139 | (define nth (n l)
140 |       (if (= n 0) (List$car l) (nth (- n 1) (List$cdr l))))
141 | (define changenth (n x l)
142 |       (if (= n 0) (List$rplaca l x) (changenth (- n 1) x (List$cdr l)))))
143 | ;
144 | (cluster Array
145 |       ; Exports: new, index, assign
146 |       ; Indexing is from base, array has length size,
147 |       ; and elements are in list elts.
148 |       (rep base size elts)
149 |       (define new (b s) (Array b s (zerolist s)))
150 |       (define index (A i)
151 |             (if (out-of-bounds A i) 0 (nth (- i (base A)) (elts A))))
152 |       (define assign (A i x)
153 |             (if (out-of-bounds A i) A (changenth (- i (base A)) x (elts A))))
154 |       ; zerolist, out-of-bounds not exported
155 |       (define zerolist (n)
156 |             (if (= n 0) (List$nil) (List$cons 0 (zerolist (- n 1)))))
157 |       (define out-of-bounds (A i)
158 |             (or (< i (base A)) (> i (- (+ (base A) (size A)) 1))))
159 | )
160 | (set A (Array$new 1 10))
161 | (set i 0)
162 | (while (< i 10) (begin (set i (+ i 1)) (Array$assign A i (* i i))))
163 | (set i 0)
164 | (while (< i 10) (begin (set i (+ i 1)) (print (Array$index A i))))
165 | ;
166 | (cluster Pair
167 |     ; Exports: fst, snd, mkPair
168 |     (rep f s)
169 |     (define fst (p) (f p))
170 |     (define snd (p) (s p))
171 |     (define mkPair (x y) (Pair x y))
172 | )
173 | ;
174 | (define assoc (i l)
175 |        (if (List$null? l) l
176 |             (if (= (Pair$fst (List$car l)) i)
177 |                  l
178 |                  (assoc i (List$cdr l)))))
179 | ;
180 | (cluster SpArray
181 |     ; Exports: new, index, assign
182 |     (rep base size elts)
183 |     (define new (b s) (SpArray b s (List$nil)))
184 |     (define index (A i)
185 |            (begin
186 |                (set found (assoc i (elts A)))
187 |                (if (List$null? found) 0 (Pair$snd (List$car found)))))
188 |     (define assign (A i x)
189 |          (if (out-of-bounds A i) A
190 |              (begin
191 |                  (set found (assoc i (elts A)))
192 |                  (if (List$null? found)
193 |                      (set-elts A (List$cons (Pair$mkPair i x) (elts A)))
194 |                      (List$rplaca found (Pair$mkPair i x)))
195 |                  A)))
196 |     ; out-of-bounds not exported
197 |     (define out-of-bounds (A i)
198 |           (or (< i (base A)) (> i (- (+ (base A) (size A)) 1))))
199 | )
200 | (set A (SpArray$new 1 10))
201 | (set i 0)
202 | (while (< i 10) (begin (set i (+ i 1)) (SpArray$assign A i (* i i))))
203 | (set i 0)
204 | (while (< i 10) (begin (set i (+ i 1)) (print (SpArray$index A i))))
205 | ; Section 6.4
206 | (cluster Poly
207 |     ; Export: create, degree, coeff, zero?, add, minus, sub, mul, prnt
208 |     (rep coeffs lo hi)
209 |     (define create (c n)
210 |         (begin
211 |              (set A (Array$new 0 20))
212 |              (Array$assign A n c)
213 |              (Poly A n n)))
214 |     (define degree (p) (hi p))
215 |     (define coeff (p n)
216 |         (if (or (< n (lo p)) (> n (hi p))) 0 (Array$index (coeffs p) n)))
217 |     (define zero? (p) (= 0 (coeff p (lo p))))
218 |     (define add (p q)
219 |         (begin
220 |              (set result (create 0 0))
221 |              (set-lo result (min (lo p) (lo q)))
222 |              (set-hi result (max (hi p) (hi q)))
223 |              (set i (lo result))
224 |              (while (<= i (hi result))
225 |                  (begin
226 |                       (set-coeff result i (+ (coeff p i) (coeff q i)))
227 |                       (set i (+1 i))))
228 |              (remove-zeros result)
229 |              result))
230 |     (define minus (p)
231 |         (begin
232 |              (set result (create 0 0))
233 |              (set-lo result (lo p))
234 |              (set-hi result (hi p))
235 |              (set i (lo p))
236 |              (while (<= i (hi p))
237 |                  (begin
238 |                       (set-coeff result i (- 0 (coeff p i)))
239 |                       (set i (+1 i))))
240 |                result))
241 |     (define sub (p q)
242 |         (add p (minus q)))
243 |     (define mul (p q)
244 |         (begin
245 |              (set result (create 0 0))
246 |              (if (> (+ (hi p) (hi q)) 19) result ; error!
247 |                  (if (or (zero? p) (zero? q)) result
248 |                     (begin
249 |                          (set-lo result (+ (lo p) (lo q)))
250 |                          (set-hi result (+ (hi p) (hi q)))
251 |                          (set p-hi (hi p))
252 |                          (set q-hi (hi q))
253 |                          (set q-lo (lo q))
254 |                          (set i (lo p))
255 |                          (while (<= i p-hi)
256 |                               (begin
257 |                                    (set j q-lo)
258 |                                    (while (<= j q-hi)
259 |                                              (begin
260 |                                     (set-coeff result (+ i j)
261 |                                           (+ (coeff result (+ i j))
262 |                                          (* (coeff p i) (coeff q j))))
263 |                                       (set j (+1 j))))
264 |                                  (set i (+1 i))))
265 |                          result)))))
266 |     (define prnt (p)
267 |      (if (zero? p) (begin (print 0) (print 0))
268 |        (begin
269 |          (set expon (hi p))
270 |          (while (>= expon (lo p))
271 |            (if (= (coeff p expon) 0)
272 |              (set expon (- expon 1))
273 |              (begin (print (coeff p expon)) (print expon)
274 |                     (set expon (- expon 1))))))))
275 |   ; set-coeff, remove-zeros not exported
276 |     (define set-coeff (p n c)
277 |           (Array$assign (coeffs p) n c))
278 |     (define remove-zeros (p) ; (lo p) is too low, and/or (hi p) too high
279 |         (begin
280 |              (while (and (= 0 (coeff p (lo p))) (<= (lo p) (hi p)))
281 |                   (set-lo p (+1 (lo p))))
282 |              (if (> (lo p) (hi p)) ; p a zero polynomial
283 |                   (begin (set-lo p 0) (set-hi p 0))
284 |                   (while (= 0 (coeff p (hi p)))
285 |                           (set-hi p (- (hi p) 1))))))
286 | )
287 | (define diff (p)
288 |     (begin
289 |         (set n 1)
290 |         (set pdx (Poly$create 0 0))
291 |         (while (<= n (Poly$degree p))
292 |             (begin
293 |                 (set pdx (Poly$add pdx
294 |                        (Poly$create (* n (Poly$coeff p n)) (- n 1))))
295 |                 (set n (+1 n))))
296 |         pdx))
297 | (set p (Poly$create 5 2))
298 | (set q (Poly$create 3 1))
299 | (set r (Poly$add p q))
300 | (Poly$prnt (diff r))
301 | 10
302 | 1
303 | 3
304 | 0
305 | quit
306 | 


--------------------------------------------------------------------------------
/C-distr/code.clu:
--------------------------------------------------------------------------------
  1 | ; From Chapter 1
  2 | (define sqr (x) (* x x))
  3 | (define abs (x) (if (< x 0) (- 0 x) x))
  4 | (define +1 (x) (+ x 1))
  5 | (define and (x y) (if x y x))
  6 | (define or (x y) (if x x y))
  7 | (define not (x) (if x 0 1))
  8 | (define <> (x y) (not (= x y)))
  9 | (define >= (x y) (or (> x y) (= x y)))
 10 | (define <= (x y) (or (< x y) (= x y)))
 11 | (define mod (m n) (- m (* n (/ m n))))
 12 | (define min (x y) (if (< x y) x y))
 13 | (define max (x y) (if (> x y) x y))
 14 | ; Section 6.1
 15 | (cluster Point
 16 |     ; Export: new, abscissa, ordinate, reflect, rotate, compare, quadrant
 17 |     (rep x-coord y-coord)
 18 |     (define new (x y) (Point x y))
 19 |     (define abscissa (p) (x-coord p))
 20 |     (define ordinate (p) (y-coord p))
 21 |     (define reflect (p)
 22 |          (begin
 23 |                (set-x-coord p (- 0 (x-coord p)))
 24 |                (set-y-coord p (- 0 (y-coord p)))))
 25 |     (define rotate (p)
 26 |          (begin
 27 |                (set temp (x-coord p))
 28 |                (set-x-coord p (y-coord p))
 29 |                (set-y-coord p (- 0 temp))))
 30 |     (define compare (p1 p2)
 31 |          (< (sqrdist p1) (sqrdist p2)))
 32 |     (define quadrant (p)
 33 |          (if (>= (x-coord p) 0)
 34 |               (if (>= (y-coord p) 0) 1 2)
 35 |               (if (< (y-coord p) 0) 3 4)))
 36 |     ; sqrdist is not exported
 37 |     (define sqrdist (p)
 38 |          (+ (sqr (x-coord p)) (sqr (y-coord p))))
 39 | )
 40 | (set p1 (Point$new 3 4))
 41 | (Point$rotate p1)
 42 | (Point$abscissa p1)
 43 | 4
 44 | (Point$ordinate p1)
 45 | -3
 46 | (Point$reflect p1)
 47 | (Point$abscissa p1)
 48 | -4
 49 | (Point$ordinate p1)
 50 | 3
 51 | (set p2 (Point$new 1 5))
 52 | (Point$compare p1 p2)
 53 | 1
 54 | (define enclosed-area (p1 p2)
 55 |       (abs (* (- (Point$abscissa p1) (Point$abscissa p2))
 56 |         (- (Point$ordinate p1) (Point$ordinate p2)))))
 57 | (enclosed-area p1 p2)
 58 | 10
 59 | (cluster Point
 60 |     ; Export: new, abscissa, ordinate, reflect, rotate, compare, quadrant
 61 |     (rep x-mag y-mag quad)
 62 |     (define new (x y) (Point (abs x) (abs y) (compute-quad x y)))
 63 |     (define abscissa (p)
 64 |          (if (> (quad p) 2) (- 0 (x-mag p)) (x-mag p)))
 65 |     (define ordinate (p)
 66 |          (if (or (= (quad p) 2) (= (quad p) 3))
 67 |               (- 0 (y-mag p))
 68 |               (y-mag p)))
 69 |     (define reflect (p)
 70 |          (set-quad p (+1 (mod (+1 (quad p)) 4))))
 71 |     (define rotate (p)
 72 |          (begin
 73 |                (set temp (x-mag p))
 74 |                (set-x-mag p (y-mag p))
 75 |                (set-y-mag p temp)
 76 |                (set-quad p (+1 (mod (quad p) 4)))))
 77 |     (define compare (p1 p2)
 78 |          (< (sqrdist p1) (sqrdist p2)))
 79 |     (define quadrant (p) (quad p))
 80 |     ; compute-quad, sqrdist are not exported
 81 |     (define compute-quad (x y)
 82 |          (if (>= x 0)
 83 |               (if (>= y 0) 1 2)
 84 |               (if (< y 0) 3 4)))
 85 |     (define sqrdist (p)
 86 |          (+ (sqr (x-mag p)) (sqr (y-mag p))))
 87 | )
 88 | (set p1 (Point$new 3 4))
 89 | (Point$rotate p1)
 90 | (Point$abscissa p1)
 91 | 4
 92 | (Point$ordinate p1)
 93 | -3
 94 | (Point$reflect p1)
 95 | (Point$abscissa p1)
 96 | -4
 97 | (Point$ordinate p1)
 98 | 3
 99 | (set p2 (Point$new 1 5))
100 | (Point$compare p1 p2)
101 | 1
102 | (define enclosed-area (p1 p2)
103 |       (abs (* (- (Point$abscissa p1) (Point$abscissa p2))
104 |         (- (Point$ordinate p1) (Point$ordinate p2)))))
105 | (enclosed-area p1 p2)
106 | 10
107 | ; Section 6.2.3
108 | (cluster List
109 |     ; Exports: nil, null?, cons, car, cdr, rplaca, rplacd
110 |     (rep type a d)
111 |     (define nil () (List 0 0 0))
112 |     (define null? (l) (= (type l) 0))
113 |     (define cons (item l) (List 1 item l))
114 |     (define car (l) (a l))
115 |     (define cdr (l) (d l))
116 |     (define rplaca (l a) (set-a l a))
117 |     (define rplacd (l d) (set-d l d))
118 | )
119 | (set x (List$cons 1 (List$cons 2 (List$nil)))) ; x is 1,2
120 | (set y x) ; y is 1,2
121 | (List$car x)
122 | 1
123 | (List$car y)
124 | 1
125 | (List$car (List$cdr x))
126 | 2
127 | (List$rplaca y 3) ; y is 3,2, and so is x
128 | (List$car x)
129 | 3
130 | (List$car y)
131 | 3
132 | (define length (l)
133 |     (if (List$null? l) 0 (+1 (length (List$cdr l)))))
134 | (length x)
135 | 2
136 | (length y)
137 | 2
138 | ;
139 | (define nth (n l)
140 |       (if (= n 0) (List$car l) (nth (- n 1) (List$cdr l))))
141 | (define changenth (n x l)
142 |       (if (= n 0) (List$rplaca l x) (changenth (- n 1) x (List$cdr l)))))
143 | ;
144 | (cluster Array
145 |       ; Exports: new, index, assign
146 |       ; Indexing is from base, array has length size,
147 |       ; and elements are in list elts.
148 |       (rep base size elts)
149 |       (define new (b s) (Array b s (zerolist s)))
150 |       (define index (A i)
151 |             (if (out-of-bounds A i) 0 (nth (- i (base A)) (elts A))))
152 |       (define assign (A i x)
153 |             (if (out-of-bounds A i) A (changenth (- i (base A)) x (elts A))))
154 |       ; zerolist, out-of-bounds not exported
155 |       (define zerolist (n)
156 |             (if (= n 0) (List$nil) (List$cons 0 (zerolist (- n 1)))))
157 |       (define out-of-bounds (A i)
158 |             (or (< i (base A)) (> i (- (+ (base A) (size A)) 1))))
159 | )
160 | (set A (Array$new 1 10))
161 | (set i 0)
162 | (while (< i 10) (begin (set i (+ i 1)) (Array$assign A i (* i i))))
163 | (set i 0)
164 | (while (< i 10) (begin (set i (+ i 1)) (print (Array$index A i))))
165 | ;
166 | (cluster Pair
167 |     ; Exports: fst, snd, mkPair
168 |     (rep f s)
169 |     (define fst (p) (f p))
170 |     (define snd (p) (s p))
171 |     (define mkPair (x y) (Pair x y))
172 | )
173 | ;
174 | (define assoc (i l)
175 |        (if (List$null? l) l
176 |             (if (= (Pair$fst (List$car l)) i)
177 |                  l
178 |                  (assoc i (List$cdr l)))))
179 | ;
180 | (cluster SpArray
181 |     ; Exports: new, index, assign
182 |     (rep base size elts)
183 |     (define new (b s) (SpArray b s (List$nil)))
184 |     (define index (A i)
185 |            (begin
186 |                (set found (assoc i (elts A)))
187 |                (if (List$null? found) 0 (Pair$snd (List$car found)))))
188 |     (define assign (A i x)
189 |          (if (out-of-bounds A i) A
190 |              (begin
191 |                  (set found (assoc i (elts A)))
192 |                  (if (List$null? found)
193 |                      (set-elts A (List$cons (Pair$mkPair i x) (elts A)))
194 |                      (List$rplaca found (Pair$mkPair i x)))
195 |                  A)))
196 |     ; out-of-bounds not exported
197 |     (define out-of-bounds (A i)
198 |           (or (< i (base A)) (> i (- (+ (base A) (size A)) 1))))
199 | )
200 | (set A (SpArray$new 1 10))
201 | (set i 0)
202 | (while (< i 10) (begin (set i (+ i 1)) (SpArray$assign A i (* i i))))
203 | (set i 0)
204 | (while (< i 10) (begin (set i (+ i 1)) (print (SpArray$index A i))))
205 | ; Section 6.4
206 | (cluster Poly
207 |     ; Export: create, degree, coeff, zero?, add, minus, sub, mul, prnt
208 |     (rep coeffs lo hi)
209 |     (define create (c n)
210 |         (begin
211 |              (set A (Array$new 0 20))
212 |              (Array$assign A n c)
213 |              (Poly A n n)))
214 |     (define degree (p) (hi p))
215 |     (define coeff (p n)
216 |         (if (or (< n (lo p)) (> n (hi p))) 0 (Array$index (coeffs p) n)))
217 |     (define zero? (p) (= 0 (coeff p (lo p))))
218 |     (define add (p q)
219 |         (begin
220 |              (set result (create 0 0))
221 |              (set-lo result (min (lo p) (lo q)))
222 |              (set-hi result (max (hi p) (hi q)))
223 |              (set i (lo result))
224 |              (while (<= i (hi result))
225 |                  (begin
226 |                       (set-coeff result i (+ (coeff p i) (coeff q i)))
227 |                       (set i (+1 i))))
228 |              (remove-zeros result)
229 |              result))
230 |     (define minus (p)
231 |         (begin
232 |              (set result (create 0 0))
233 |              (set-lo result (lo p))
234 |              (set-hi result (hi p))
235 |              (set i (lo p))
236 |              (while (<= i (hi p))
237 |                  (begin
238 |                       (set-coeff result i (- 0 (coeff p i)))
239 |                       (set i (+1 i))))
240 |                result))
241 |     (define sub (p q)
242 |         (add p (minus q)))
243 |     (define mul (p q)
244 |         (begin
245 |              (set result (create 0 0))
246 |              (if (> (+ (hi p) (hi q)) 19) result ; error!
247 |                  (if (or (zero? p) (zero? q)) result
248 |                     (begin
249 |                          (set-lo result (+ (lo p) (lo q)))
250 |                          (set-hi result (+ (hi p) (hi q)))
251 |                          (set p-hi (hi p))
252 |                          (set q-hi (hi q))
253 |                          (set q-lo (lo q))
254 |                          (set i (lo p))
255 |                          (while (<= i p-hi)
256 |                               (begin
257 |                                    (set j q-lo)
258 |                                    (while (<= j q-hi)
259 |                                              (begin
260 |                                     (set-coeff result (+ i j)
261 |                                           (+ (coeff result (+ i j))
262 |                                          (* (coeff p i) (coeff q j))))
263 |                                       (set j (+1 j))))
264 |                                  (set i (+1 i))))
265 |                          result)))))
266 |     (define prnt (p)
267 |      (if (zero? p) (begin (print 0) (print 0))
268 |        (begin
269 |          (set expon (hi p))
270 |          (while (>= expon (lo p))
271 |            (if (= (coeff p expon) 0)
272 |              (set expon (- expon 1))
273 |              (begin (print (coeff p expon)) (print expon)
274 |                     (set expon (- expon 1))))))))
275 |   ; set-coeff, remove-zeros not exported
276 |     (define set-coeff (p n c)
277 |           (Array$assign (coeffs p) n c))
278 |     (define remove-zeros (p) ; (lo p) is too low, and/or (hi p) too high
279 |         (begin
280 |              (while (and (= 0 (coeff p (lo p))) (<= (lo p) (hi p)))
281 |                   (set-lo p (+1 (lo p))))
282 |              (if (> (lo p) (hi p)) ; p a zero polynomial
283 |                   (begin (set-lo p 0) (set-hi p 0))
284 |                   (while (= 0 (coeff p (hi p)))
285 |                           (set-hi p (- (hi p) 1))))))
286 | )
287 | (define diff (p)
288 |     (begin
289 |         (set n 1)
290 |         (set pdx (Poly$create 0 0))
291 |         (while (<= n (Poly$degree p))
292 |             (begin
293 |                 (set pdx (Poly$add pdx
294 |                        (Poly$create (* n (Poly$coeff p n)) (- n 1))))
295 |                 (set n (+1 n))))
296 |         pdx))
297 | (set p (Poly$create 5 2))
298 | (set q (Poly$create 3 1))
299 | (set r (Poly$add p q))
300 | (Poly$prnt (diff r))
301 | 10
302 | 1
303 | 3
304 | 0
305 | quit
306 | 


--------------------------------------------------------------------------------
/distr/code.ssl:
--------------------------------------------------------------------------------
  1 | ; From previous chapters (esp. Scheme and Lisp)
  2 | (set +1 (lambda (x) (+ x 1)))
  3 | (set mapcar (lambda (f l)
  4 |      (if (null? l) '()
  5 |       (cons (f (car l)) (mapcar f (cdr l)))))))
  6 | (set sqr (lambda (x) (* x x)))
  7 | (set cadr (lambda (x) (car (cdr x))))
  8 | (set cddr (lambda (x) (cdr (cdr x))))
  9 | (set cadddr (lambda (x) (car (cdr (cdr (cdr x))))))
 10 | (set abs (lambda (x) (if (< x 0) (- 0 x) x)))
 11 | (set mod (lambda (m n) (- m (* n (/ m n)))))
 12 | (set divides (lambda (m n) (= (mod n m) 0)))
 13 | (set length (lambda (l) (if (null? l) 0 (+1 (length (cdr l))))))
 14 | (set append (lambda (x y)
 15 |    (if (null? x) y
 16 |       (cons (car x) (append (cdr x) y)))))
 17 | (set list1 (lambda (x) (cons x '())))
 18 | (set list2 (lambda (x y) (cons x (cons y '()))))
 19 | (set not (lambda (x) (if x '() 'T)))
 20 | (set or (lambda (x y) (if x x y)))
 21 | (set and (lambda (x y) (if x y x)))
 22 | (set cadr (lambda (x) (car (cdr x))))
 23 | (set caddr (lambda (x) (car (cdr (cdr x)))))
 24 | (set curry (lambda (f) (lambda (x) (lambda (y) (f x y)))))
 25 | (set id (lambda (x) x))
 26 | (set compose (lambda (f g) (lambda (x) (g (f x)))))
 27 | (set member? (lambda (x l)
 28 |    (if (null? l) '()
 29 |      (if (= x (car l)) 'T
 30 |         (member? x (cdr l))))))
 31 | (set union (lambda (s1 s2)
 32 |      (if (null? s1) s2
 33 |          (if (member? (car s1) s2)
 34 |                 (union (cdr s1) s2)
 35 |              (cons (car s1) (union (cdr s1) s2))))))
 36 | (set empty-queue '())
 37 | (set front (lambda (q) (car q)))
 38 | (set rm-front (lambda (q) (cdr q)))
 39 | (set enqueue (lambda (t q)
 40 |    (if (null? q) (list1 t) (cons (car q) (enqueue t (cdr q))))))
 41 | (set empty? (lambda (q) (null? q)))
 42 | ; Section 5.0
 43 | (set pred (lambda (x) (> x 5)))
 44 | (set fun-srch-for (lambda (n)
 45 |      (find-val pred (interval 1 n) (+1 n))))
 46 | (set find-val (lambda (pred lis failure-value)
 47 |      (if (null? lis) failure-value
 48 |          (if (pred (car lis)) (car lis)
 49 |              (find-val pred (cdr lis) failure-value)))))
 50 | (set interval (lambda (i j)
 51 |    (if (> i j) '() (cons i (interval (+1 i) j)))))
 52 | (fun-srch-for 10)
 53 | 6
 54 | (set fun-srch-for-sqr (lambda (n)
 55 |      (find-val pred (mapcar sqr (interval 1 n)) (sqr (+1 n)))))
 56 | (fun-srch-for-sqr 10)
 57 | 9
 58 | ; Section 5.1
 59 | (set fun-srch-while (lambda () (find-val pred (ints-from 1) '())))
 60 | (set ints-from (lambda (i) (cons i (ints-from (+1 i)))))
 61 | (fun-srch-while)
 62 | 6
 63 | ; Section 5.2.3
 64 | (set x (mapcar +1 '(2 3)))
 65 | '(... ...)
 66 | (car x)
 67 | 3
 68 | (cadr x)
 69 | 4
 70 | x
 71 | '(3 4 ...)
 72 | (cddr x)
 73 | '()
 74 | x
 75 | '(3 4)
 76 | (set ints-from (lambda (i)
 77 |         (cons i (ints-from (+1 i)))))
 78 | (set ints (ints-from 0))
 79 | '(... ...)
 80 | (car ints)
 81 | 0
 82 | (cadr ints)
 83 | 1
 84 | ints
 85 | '(0 1 ...)
 86 | (set force (lambda (x)
 87 |    (if (list? x)  ; apply list? to every component
 88 |      (if (force (car x)) (force (cdr x)) '())
 89 |      'T)))
 90 | (set x (mapcar +1 '(2 3)))
 91 | '(... ...)
 92 | (force x)
 93 | 'T
 94 | x
 95 | '(3 4)
 96 | (set first-n (lambda (n l)
 97 |    (if (null? l) '()
 98 |      (if (= n 0) '()
 99 |        (cons (car l) (first-n (- n 1) (cdr l)))))))
100 | (set ints5 (first-n 5 ints))
101 | '(... ...)
102 | (force ints5)
103 | 'T
104 | ints5
105 | '(0 1 2 3 4)
106 | (set next (lambda (n xi) (/ (+ xi (/ n xi)) 2)))
107 | (set xlist (lambda (xi n) (cons xi (xlist (next n xi) n))))
108 | (set mk-xlist (lambda (n) (xlist 1 n)))
109 | (set abs-conv (lambda (epsilon)
110 |    (lambda (l) (< (abs (- (cadr l) (car l))) epsilon))))
111 | (set abs-sqrt (lambda (n)
112 |    (find-list (abs-conv 3) cadr (mk-xlist n))))
113 | (set find-list (lambda (pred extract l)
114 |    (if (null? l) '() (if (pred l) (extract l)
115 |      (find-list pred extract (cdr l))))))
116 | (abs-sqrt 100)
117 | 10
118 | (set next (lambda (n xi) (/ (+ xi (/ n (* xi xi))) 2)))
119 | (set abs-cbrt (lambda (n)
120 |      (find-list (abs-conv 2) cadr (mk-xlist n))))
121 | (abs-cbrt 100)
122 | 5
123 | (set remove-multiples (lambda (n l)
124 |    (if (null? l) '()
125 |      (if (divides n (car l))
126 |         (remove-multiples n (cdr l))
127 |         (cons (car l) (remove-multiples n (cdr l)))))))
128 | (set sieve (lambda (l) (if (null? l) '()
129 |         (cons (car l)
130 |               (sieve (remove-multiples (car l) (cdr l)))))))
131 | (set primes<= (lambda (n) (sieve (interval 2 n))))
132 | (set primes (sieve (ints-from 2)))
133 | (set first-n-primes (lambda (n) (first-n n primes)))
134 | (set p (first-n-primes 5))
135 | (force p)
136 | p
137 | ;
138 | (set next-int +1)
139 | (set repeat-until (lambda (init next pred)
140 |    (if (pred init) init
141 |      (repeat-until (next init) next pred))))
142 | (set new-fun-srch-while (lambda ()
143 |    (repeat-until 1 next-int pred)))
144 | (set pred (lambda (x) (> x 5)))
145 | (new-fun-srch-while)
146 | 6
147 | ;
148 | (set find-atom (lambda (s) (find-val pred (flatten s) '())))
149 | (set flatten (lambda (x)
150 |      (if (null? x) '()
151 |           (if (atom? x) (list1 x)
152 |               (append (flatten (car x)) (flatten (cdr x)))))))
153 | (set samefringe (lambda (x y) (equal (flatten x) (flatten y))))
154 | (set find-perm (lambda (l)
155 |     (find-val pred (permutations l) '())))
156 | (set append* (lambda (l)
157 |     (if (null? l) '() (append (car l) (append* (cdr l))))))
158 | (set filter (lambda (pred l)
159 |     (if (null? l) '()
160 |      (if (pred (car l)) (cons (car l) (filter pred (cdr l)))
161 |        (filter pred (cdr l))))))
162 | (set remove (lambda (item l)
163 |      (filter (lambda (x) (not (= x item))) l)))
164 | (set permutations (lambda (l)
165 |   (if (= (length l) 1) (list1 l)
166 |      (append* (mapcar (lambda (x) (mapcar (lambda (z) (cons x z))
167 |                                   (permutations (remove x l)))) l)))))
168 | (set p (permutations '(a b c)))
169 | (force p)
170 | '(Permutations of a b c)
171 | p
172 | (set pred (lambda (perm) (= (car perm) 2)))
173 | (set p (find-perm '(1 2 3 4)))
174 | (force p)
175 | p
176 | '(2 1 3 4)
177 | ;
178 | (set ints (cons 0 (mapcar +1 ints)))
179 | (set powersof2 (cons 1 (mapcar double powersof2)))
180 | (set mapcar2 (lambda (f l1 l2)
181 |         (cons (f (car l1) (car l2))
182 |                 (mapcar2 f (cdr l1) (cdr l2)))))
183 | (set posints (cdr ints))
184 | (set X (cons x0 (mapcar2 f X posints)))
185 | (set facs (cons 1 (mapcar2 * facs posints)))
186 | (cadddr facs)
187 | 6
188 | ; Section 5.4
189 | (set evalBoolexp (lambda (e a)
190 |      (if (symbol? e) (isTrue? e a)
191 |        (if (= (car e) 'not)
192 |                (not (evalBoolexp (cadr e) a))
193 |           (if (= (car e) 'or)
194 |                 (or (evalBoolexp (cadr e) a)
195 |                       (evalBoolexp (caddr e) a))
196 |               (and (evalBoolexp (cadr e) a)
197 |                       (evalBoolexp (caddr e) a)))))))
198 | (set mapaddx (lambda (x l) ; add x to each list in l, then append to l
199 |      (append l (mapcar (lambda (y) (cons x y)) l))))
200 | (set gensubsets (lambda (l) ; create a list containing all sub-sets of l
201 |      (if (null? (cdr l)) (list2 l '())
202 |          (mapaddx (car l) (gensubsets (cdr l))))))
203 | (set variables (lambda (e) ; All variables occurring in e
204 |      (if (symbol? e) (cons e '())
205 |           (if (= (car e) 'not) (variables (cadr e))
206 |                (union (variables (cadr e)) (variables (caddr e)))))))
207 | (set assignments (lambda (e) (gensubsets (variables e))))
208 | (set isTrue? member?)
209 | (set findTruth (lambda (e alist)
210 |      ; Find if any assignment on alist satisfies e
211 |      (if (null? alist) '() ; No assignments left to try
212 |           (if (evalBoolexp e (car alist)) 'T
213 |                (findTruth e (cdr alist))))))
214 | (set SAT (lambda (e)
215 |      (if (findTruth e (assignments e))
216 |           'Satisfiable
217 |           'Unsatisfiable)))
218 | (SAT '(not (or p (and (or (not p) q) (or (not p) (not q))))))
219 | ; Section 5.5
220 | (set add-points (lambda (p q)
221 |     (list2 (+ (car p) (car q)) (+ (cadr p) (cadr q)))))
222 | (set gen-paths (lambda (p points)
223 |     (cons p
224 |      (mapcar (lambda (r) (gen-paths r points))
225 |                    (mapcar (lambda (q) (add-points q p)) points)))))
226 | (set P '((2 2)(0 1)(3 0)))
227 | '((2 2)(0 1)(3 0))
228 | (set PATHS (gen-paths '(0 0) P))
229 | (set == (lambda (p q) (and (= (car p) (car q)) (= (cadr p) (cadr q)))))
230 | (set << (lambda (p q) (or (< (car p) (car q)) (< (cadr p) (cadr q)))))
231 | (set dfs (lambda (t pred term)
232 |      (if (pred (car t)) 'T  ; success
233 |           (if (term (car t)) '()  ; failure on this branch
234 |                (dfs* (cdr t) pred term)))))
235 | (set dfs* (lambda (l pred term)
236 |      (if (null? l) '() ; failure
237 |           (if (dfs (car l) pred term) 'T
238 |                (dfs* (cdr l) pred term)))))
239 | (set reaches-dfs (lambda (p0 paths)
240 |      (dfs paths
241 |             (lambda (q) (== p0 q))
242 |             (lambda (q) (<< p0 q)))))
243 | ;
244 | (set enqueue* (lambda (q items)
245 |      (if (null? items) q (enqueue* (enqueue (car items) q) (cdr items)))))
246 | ;
247 | (set bfs (lambda (t pred term)
248 |      (bfs-queue (enqueue t empty-queue) pred term)))
249 | (set bfs-queue (lambda (q pred term)
250 |      (if (empty? q) '()
251 |        (if (pred (car (front q))) 'T
252 |         (if (term (car (front q))) (bfs-queue (rm-front q) pred term)
253 |          (bfs-queue (enqueue* (rm-front q) (cdr (front q)))
254 |                     pred term))))))
255 | (set reaches-bfs (lambda (p0 paths)
256 |      (bfs paths
257 |             (lambda (q) (== p0 q))
258 |             (lambda (q) (<< p0 q)))))
259 | (reaches-dfs '(4 6) PATHS)
260 | 'T
261 | (reaches-bfs '(4 3) PATHS)
262 | '()
263 | ; Section 5.7
264 | ;; The following is SCHEME code!!
265 | ;(set find-val (lambda (pred str failure-value)
266 | ;   (if (empty-stream? str) failure-value
267 | ;     (if (pred (head str)) (head str)
268 | ;       (find-val pred (tail str) failure-value)))))
269 | ;(set if2 (lambda (pred x y) (if (pred x) x y)))
270 | ;(set find-val (lambda (pred str failure-value)
271 | ;   (if (empty-stream? str) failure-value
272 | ;     (if2 pred (head str)
273 | ;       (find-val pred (tail str) failure-value)))))
274 | ;(set ones (cons 1 (lambda () ones)))
275 | ;(1 <closure>)
276 | ;(car ((cdr ones)))
277 | ;1
278 | ;(set flatten (lambda (l)
279 | ;     (if (null? l) '()
280 | ;         (if (atom? l) (list2 l (lambda () '()))
281 | ;             (append-str (flatten (car l))
282 | ;                         (lambda () (flatten (cdr l))))))))
283 | ;(set append-str (lambda (s1 s2)
284 | ;     (if (null? s1) (s2)
285 | ;          (list2 (car s1) (lambda () (append-str ((cadr s1)) s2))))))
286 | ;(set find-str (lambda (pred s)
287 | ;     (if (null? s) '()
288 | ;          (if (pred (car s)) (car s)
289 | ;               (find-str pred ((cadr s)))))))
290 | ;(set find-atom (lambda (pred l)
291 | ;      (find-str pred (flatten l))))
292 | ; Back to SASL
293 | ; Section 5.8
294 | (set TRUE (lambda (t f) t))
295 | (set FALSE (lambda (t f) f))
296 | (set IF (lambda (c t f) (c t f)))
297 | (IF TRUE 'a 'b)
298 | 'a
299 | (set EQ (lambda (x y) (if (= x y) TRUE FALSE)))
300 | (set fac (lambda (x) (IF (EQ x 0) 1 (* x (fac (- x 1))))))
301 | (fac 4)
302 | 24
303 | (set AND (lambda (x y) (IF x y x)))
304 | (set CONS (lambda (a d) (lambda (f) (f a d FALSE))))
305 | (set NIL (lambda (f) (f NIL NIL TRUE)))
306 | (set CAR (lambda (l) (l (lambda (car cdr null?) car))))
307 | (set CDR (lambda (l) (l (lambda (car cdr null?) cdr))))
308 | (set NULL? (lambda (l) (l (lambda (car cdr null?) null?))))
309 | (set CADR (lambda (x) (CAR (CDR x))))
310 | (CADR (CONS 'abc (CONS 3 NIL)))
311 | 3
312 | (set l1 (CONS 4 (CONS 5 (CONS 6 NIL))))
313 | (set +/ (lambda (l)
314 |        (IF (NULL? l) 0 (+ (CAR l) (+/ (CDR l))))))
315 | (+/ l1)
316 | 15
317 | (set ZERO (lambda (f) (lambda (x) x)))
318 | (set ONE (lambda (f) (lambda (x) (f x))))
319 | (set TWO (lambda (f) (lambda (x) (f (f x)))))
320 | (set print-int (lambda (n) ((n +1) 0)))
321 | (print-int TWO)
322 | 2
323 | (set +ONE (lambda (n) (lambda (g) (compose g (n g)))))
324 | (set PLUS (lambda (m n) (lambda (g) (compose (m g) (n g)))))
325 | (set THREE (PLUS ONE TWO))
326 | (print-int THREE)
327 | 3
328 | (set MULT (lambda (m n) (compose m n)))
329 | (set SIX (MULT THREE TWO))
330 | (print-int SIX)
331 | 6
332 | (set LIST2 (lambda (x y) (CONS x (CONS y NIL))))
333 | (set STEP (lambda (m-a) (LIST2 (CADR m-a) (+ONE (CADR m-a))))),
334 | (set -ONE (lambda (n) (CAR ((n STEP) (LIST2 ZERO ZERO)))))
335 | (set SUB (lambda (m n) ((n -ONE) m)))
336 | (set FOUR (SUB SIX TWO))
337 | (print-int FOUR)
338 | 4
339 | (set GT (lambda (m n) (NOT (=ZERO? (SUB m n)))))
340 | (set GE (lambda (m n) (=ZERO? (SUB n m))))
341 | (set EQUAL (lambda (m n)
342 |    (AND (=ZERO? (SUB m n)) (=ZERO? (SUB n m)))))
343 | (set uncurry (lambda (f) (lambda (x y) ((f x) y))))
344 | (set F (curry FALSE))
345 | (set =ZERO? (lambda (n)
346 |      (uncurry (lambda (y) ((n F) (lambda (x) y))))))
347 | (IF (=ZERO? ZERO) 'yes 'no)
348 | 'yes
349 | (IF (=ZERO? FOUR) 'yes 'no)
350 | 'no
351 | (set fac (lambda (n)
352 |      (IF (EQUAL n ZERO) ONE (MULT n (fac (SUB n ONE))))))
353 | (print-int (fac FOUR))
354 | 24
355 | (set FAC-STEP (lambda (x-y)
356 |      (LIST2 (-ONE (CAR x-y)) (MULT (CAR x-y) (CADR x-y)))))
357 | (set FAC (lambda (n) (CADR ((n FAC-STEP) (LIST2 n ONE)))))
358 | (print-int (FAC FOUR))
359 | 24
360 | (set W (lambda (F) (lambda (f) (F (f f)))))
361 | (set Y (lambda (F) ((W F) (W F))))
362 | (set ONES (Y (lambda (ones) (CONS ONE ones))))
363 | (print-int (CAR (CDR (CDR ONES))))
364 | 1
365 | (set FAC (Y (lambda (fac)
366 |      (lambda (n)
367 |           (IF (EQUAL n ZERO) ONE (MULT n (fac (SUB n ONE))))))))
368 | (print-int (FAC FOUR))
369 | 24
370 | quit
371 | 


--------------------------------------------------------------------------------
/C-distr/code.ssl:
--------------------------------------------------------------------------------
  1 | ; From previous chapters (esp. Scheme and Lisp)
  2 | (set +1 (lambda (x) (+ x 1)))
  3 | (set mapcar (lambda (f l)
  4 |      (if (null? l) '()
  5 |       (cons (f (car l)) (mapcar f (cdr l)))))))
  6 | (set sqr (lambda (x) (* x x)))
  7 | (set cadr (lambda (x) (car (cdr x))))
  8 | (set cddr (lambda (x) (cdr (cdr x))))
  9 | (set cadddr (lambda (x) (car (cdr (cdr (cdr x))))))
 10 | (set abs (lambda (x) (if (< x 0) (- 0 x) x)))
 11 | (set mod (lambda (m n) (- m (* n (/ m n)))))
 12 | (set divides (lambda (m n) (= (mod n m) 0)))
 13 | (set length (lambda (l) (if (null? l) 0 (+1 (length (cdr l))))))
 14 | (set append (lambda (x y)
 15 |    (if (null? x) y
 16 |       (cons (car x) (append (cdr x) y)))))
 17 | (set list1 (lambda (x) (cons x '())))
 18 | (set list2 (lambda (x y) (cons x (cons y '()))))
 19 | (set not (lambda (x) (if x '() 'T)))
 20 | (set or (lambda (x y) (if x x y)))
 21 | (set and (lambda (x y) (if x y x)))
 22 | (set cadr (lambda (x) (car (cdr x))))
 23 | (set caddr (lambda (x) (car (cdr (cdr x)))))
 24 | (set curry (lambda (f) (lambda (x) (lambda (y) (f x y)))))
 25 | (set id (lambda (x) x))
 26 | (set compose (lambda (f g) (lambda (x) (g (f x)))))
 27 | (set member? (lambda (x l)
 28 |    (if (null? l) '()
 29 |      (if (= x (car l)) 'T
 30 |         (member? x (cdr l))))))
 31 | (set union (lambda (s1 s2)
 32 |      (if (null? s1) s2
 33 |          (if (member? (car s1) s2)
 34 |                 (union (cdr s1) s2)
 35 |              (cons (car s1) (union (cdr s1) s2))))))
 36 | (set empty-queue '())
 37 | (set front (lambda (q) (car q)))
 38 | (set rm-front (lambda (q) (cdr q)))
 39 | (set enqueue (lambda (t q)
 40 |    (if (null? q) (list1 t) (cons (car q) (enqueue t (cdr q))))))
 41 | (set empty? (lambda (q) (null? q)))
 42 | ; Section 5.0
 43 | (set pred (lambda (x) (> x 5)))
 44 | (set fun-srch-for (lambda (n)
 45 |      (find-val pred (interval 1 n) (+1 n))))
 46 | (set find-val (lambda (pred lis failure-value)
 47 |      (if (null? lis) failure-value
 48 |          (if (pred (car lis)) (car lis)
 49 |              (find-val pred (cdr lis) failure-value)))))
 50 | (set interval (lambda (i j)
 51 |    (if (> i j) '() (cons i (interval (+1 i) j)))))
 52 | (fun-srch-for 10)
 53 | 6
 54 | (set fun-srch-for-sqr (lambda (n)
 55 |      (find-val pred (mapcar sqr (interval 1 n)) (sqr (+1 n)))))
 56 | (fun-srch-for-sqr 10)
 57 | 9
 58 | ; Section 5.1
 59 | (set fun-srch-while (lambda () (find-val pred (ints-from 1) '())))
 60 | (set ints-from (lambda (i) (cons i (ints-from (+1 i)))))
 61 | (fun-srch-while)
 62 | 6
 63 | ; Section 5.2.3
 64 | (set x (mapcar +1 '(2 3)))
 65 | '(... ...)
 66 | (car x)
 67 | 3
 68 | (cadr x)
 69 | 4
 70 | x
 71 | '(3 4 ...)
 72 | (cddr x)
 73 | '()
 74 | x
 75 | '(3 4)
 76 | (set ints-from (lambda (i)
 77 |         (cons i (ints-from (+1 i)))))
 78 | (set ints (ints-from 0))
 79 | '(... ...)
 80 | (car ints)
 81 | 0
 82 | (cadr ints)
 83 | 1
 84 | ints
 85 | '(0 1 ...)
 86 | (set force (lambda (x)
 87 |    (if (list? x)  ; apply list? to every component
 88 |      (if (force (car x)) (force (cdr x)) '())
 89 |      'T)))
 90 | (set x (mapcar +1 '(2 3)))
 91 | '(... ...)
 92 | (force x)
 93 | 'T
 94 | x
 95 | '(3 4)
 96 | (set first-n (lambda (n l)
 97 |    (if (null? l) '()
 98 |      (if (= n 0) '()
 99 |        (cons (car l) (first-n (- n 1) (cdr l)))))))
100 | (set ints5 (first-n 5 ints))
101 | '(... ...)
102 | (force ints5)
103 | 'T
104 | ints5
105 | '(0 1 2 3 4)
106 | (set next (lambda (n xi) (/ (+ xi (/ n xi)) 2)))
107 | (set xlist (lambda (xi n) (cons xi (xlist (next n xi) n))))
108 | (set mk-xlist (lambda (n) (xlist 1 n)))
109 | (set abs-conv (lambda (epsilon)
110 |    (lambda (l) (< (abs (- (cadr l) (car l))) epsilon))))
111 | (set abs-sqrt (lambda (n)
112 |    (find-list (abs-conv 3) cadr (mk-xlist n))))
113 | (set find-list (lambda (pred extract l)
114 |    (if (null? l) '() (if (pred l) (extract l)
115 |      (find-list pred extract (cdr l))))))
116 | (abs-sqrt 100)
117 | 10
118 | (set next (lambda (n xi) (/ (+ xi (/ n (* xi xi))) 2)))
119 | (set abs-cbrt (lambda (n)
120 |      (find-list (abs-conv 2) cadr (mk-xlist n))))
121 | (abs-cbrt 100)
122 | 5
123 | (set remove-multiples (lambda (n l)
124 |    (if (null? l) '()
125 |      (if (divides n (car l))
126 |         (remove-multiples n (cdr l))
127 |         (cons (car l) (remove-multiples n (cdr l)))))))
128 | (set sieve (lambda (l) (if (null? l) '()
129 |         (cons (car l)
130 |               (sieve (remove-multiples (car l) (cdr l)))))))
131 | (set primes<= (lambda (n) (sieve (interval 2 n))))
132 | (set primes (sieve (ints-from 2)))
133 | (set first-n-primes (lambda (n) (first-n n primes)))
134 | (set p (first-n-primes 5))
135 | (force p)
136 | p
137 | ;
138 | (set next-int +1)
139 | (set repeat-until (lambda (init next pred)
140 |    (if (pred init) init
141 |      (repeat-until (next init) next pred))))
142 | (set new-fun-srch-while (lambda ()
143 |    (repeat-until 1 next-int pred)))
144 | (set pred (lambda (x) (> x 5)))
145 | (new-fun-srch-while)
146 | 6
147 | ;
148 | (set find-atom (lambda (s) (find-val pred (flatten s) '())))
149 | (set flatten (lambda (x)
150 |      (if (null? x) '()
151 |           (if (atom? x) (list1 x)
152 |               (append (flatten (car x)) (flatten (cdr x)))))))
153 | (set samefringe (lambda (x y) (equal (flatten x) (flatten y))))
154 | (set find-perm (lambda (l)
155 |     (find-val pred (permutations l) '())))
156 | (set append* (lambda (l)
157 |     (if (null? l) '() (append (car l) (append* (cdr l))))))
158 | (set filter (lambda (pred l)
159 |     (if (null? l) '()
160 |      (if (pred (car l)) (cons (car l) (filter pred (cdr l)))
161 |        (filter pred (cdr l))))))
162 | (set remove (lambda (item l)
163 |      (filter (lambda (x) (not (= x item))) l)))
164 | (set permutations (lambda (l)
165 |   (if (= (length l) 1) (list1 l)
166 |      (append* (mapcar (lambda (x) (mapcar (lambda (z) (cons x z))
167 |                                   (permutations (remove x l)))) l)))))
168 | (set p (permutations '(a b c)))
169 | (force p)
170 | '(Permutations of a b c)
171 | p
172 | (set pred (lambda (perm) (= (car perm) 2)))
173 | (set p (find-perm '(1 2 3 4)))
174 | (force p)
175 | p
176 | '(2 1 3 4)
177 | ;
178 | (set ints (cons 0 (mapcar +1 ints)))
179 | (set powersof2 (cons 1 (mapcar double powersof2)))
180 | (set mapcar2 (lambda (f l1 l2)
181 |         (cons (f (car l1) (car l2))
182 |                 (mapcar2 f (cdr l1) (cdr l2)))))
183 | (set posints (cdr ints))
184 | (set X (cons x0 (mapcar2 f X posints)))
185 | (set facs (cons 1 (mapcar2 * facs posints)))
186 | (cadddr facs)
187 | 6
188 | ; Section 5.4
189 | (set evalBoolexp (lambda (e a)
190 |      (if (symbol? e) (isTrue? e a)
191 |        (if (= (car e) 'not)
192 |                (not (evalBoolexp (cadr e) a))
193 |           (if (= (car e) 'or)
194 |                 (or (evalBoolexp (cadr e) a)
195 |                       (evalBoolexp (caddr e) a))
196 |               (and (evalBoolexp (cadr e) a)
197 |                       (evalBoolexp (caddr e) a)))))))
198 | (set mapaddx (lambda (x l) ; add x to each list in l, then append to l
199 |      (append l (mapcar (lambda (y) (cons x y)) l))))
200 | (set gensubsets (lambda (l) ; create a list containing all sub-sets of l
201 |      (if (null? (cdr l)) (list2 l '())
202 |          (mapaddx (car l) (gensubsets (cdr l))))))
203 | (set variables (lambda (e) ; All variables occurring in e
204 |      (if (symbol? e) (cons e '())
205 |           (if (= (car e) 'not) (variables (cadr e))
206 |                (union (variables (cadr e)) (variables (caddr e)))))))
207 | (set assignments (lambda (e) (gensubsets (variables e))))
208 | (set isTrue? member?)
209 | (set findTruth (lambda (e alist)
210 |      ; Find if any assignment on alist satisfies e
211 |      (if (null? alist) '() ; No assignments left to try
212 |           (if (evalBoolexp e (car alist)) 'T
213 |                (findTruth e (cdr alist))))))
214 | (set SAT (lambda (e)
215 |      (if (findTruth e (assignments e))
216 |           'Satisfiable
217 |           'Unsatisfiable)))
218 | (SAT '(not (or p (and (or (not p) q) (or (not p) (not q))))))
219 | ; Section 5.5
220 | (set add-points (lambda (p q)
221 |     (list2 (+ (car p) (car q)) (+ (cadr p) (cadr q)))))
222 | (set gen-paths (lambda (p points)
223 |     (cons p
224 |      (mapcar (lambda (r) (gen-paths r points))
225 |                    (mapcar (lambda (q) (add-points q p)) points)))))
226 | (set P '((2 2)(0 1)(3 0)))
227 | '((2 2)(0 1)(3 0))
228 | (set PATHS (gen-paths '(0 0) P))
229 | (set == (lambda (p q) (and (= (car p) (car q)) (= (cadr p) (cadr q)))))
230 | (set << (lambda (p q) (or (< (car p) (car q)) (< (cadr p) (cadr q)))))
231 | (set dfs (lambda (t pred term)
232 |      (if (pred (car t)) 'T  ; success
233 |           (if (term (car t)) '()  ; failure on this branch
234 |                (dfs* (cdr t) pred term)))))
235 | (set dfs* (lambda (l pred term)
236 |      (if (null? l) '() ; failure
237 |           (if (dfs (car l) pred term) 'T
238 |                (dfs* (cdr l) pred term)))))
239 | (set reaches-dfs (lambda (p0 paths)
240 |      (dfs paths
241 |             (lambda (q) (== p0 q))
242 |             (lambda (q) (<< p0 q)))))
243 | ;
244 | (set enqueue* (lambda (q items)
245 |      (if (null? items) q (enqueue* (enqueue (car items) q) (cdr items)))))
246 | ;
247 | (set bfs (lambda (t pred term)
248 |      (bfs-queue (enqueue t empty-queue) pred term)))
249 | (set bfs-queue (lambda (q pred term)
250 |      (if (empty? q) '()
251 |        (if (pred (car (front q))) 'T
252 |         (if (term (car (front q))) (bfs-queue (rm-front q) pred term)
253 |          (bfs-queue (enqueue* (rm-front q) (cdr (front q)))
254 |                     pred term))))))
255 | (set reaches-bfs (lambda (p0 paths)
256 |      (bfs paths
257 |             (lambda (q) (== p0 q))
258 |             (lambda (q) (<< p0 q)))))
259 | (reaches-dfs '(4 6) PATHS)
260 | 'T
261 | (reaches-bfs '(4 3) PATHS)
262 | '()
263 | ; Section 5.7
264 | ;; The following is SCHEME code!!
265 | ;(set find-val (lambda (pred str failure-value)
266 | ;   (if (empty-stream? str) failure-value
267 | ;     (if (pred (head str)) (head str)
268 | ;       (find-val pred (tail str) failure-value)))))
269 | ;(set if2 (lambda (pred x y) (if (pred x) x y)))
270 | ;(set find-val (lambda (pred str failure-value)
271 | ;   (if (empty-stream? str) failure-value
272 | ;     (if2 pred (head str)
273 | ;       (find-val pred (tail str) failure-value)))))
274 | ;(set ones (cons 1 (lambda () ones)))
275 | ;(1 <closure>)
276 | ;(car ((cdr ones)))
277 | ;1
278 | ;(set flatten (lambda (l)
279 | ;     (if (null? l) '()
280 | ;         (if (atom? l) (list2 l (lambda () '()))
281 | ;             (append-str (flatten (car l))
282 | ;                         (lambda () (flatten (cdr l))))))))
283 | ;(set append-str (lambda (s1 s2)
284 | ;     (if (null? s1) (s2)
285 | ;          (list2 (car s1) (lambda () (append-str ((cadr s1)) s2))))))
286 | ;(set find-str (lambda (pred s)
287 | ;     (if (null? s) '()
288 | ;          (if (pred (car s)) (car s)
289 | ;               (find-str pred ((cadr s)))))))
290 | ;(set find-atom (lambda (pred l)
291 | ;      (find-str pred (flatten l))))
292 | ; Back to SASL
293 | ; Section 5.8
294 | (set TRUE (lambda (t f) t))
295 | (set FALSE (lambda (t f) f))
296 | (set IF (lambda (c t f) (c t f)))
297 | (IF TRUE 'a 'b)
298 | 'a
299 | (set EQ (lambda (x y) (if (= x y) TRUE FALSE)))
300 | (set fac (lambda (x) (IF (EQ x 0) 1 (* x (fac (- x 1))))))
301 | (fac 4)
302 | 24
303 | (set AND (lambda (x y) (IF x y x)))
304 | (set CONS (lambda (a d) (lambda (f) (f a d FALSE))))
305 | (set NIL (lambda (f) (f NIL NIL TRUE)))
306 | (set CAR (lambda (l) (l (lambda (car cdr null?) car))))
307 | (set CDR (lambda (l) (l (lambda (car cdr null?) cdr))))
308 | (set NULL? (lambda (l) (l (lambda (car cdr null?) null?))))
309 | (set CADR (lambda (x) (CAR (CDR x))))
310 | (CADR (CONS 'abc (CONS 3 NIL)))
311 | 3
312 | (set l1 (CONS 4 (CONS 5 (CONS 6 NIL))))
313 | (set +/ (lambda (l)
314 |        (IF (NULL? l) 0 (+ (CAR l) (+/ (CDR l))))))
315 | (+/ l1)
316 | 15
317 | (set ZERO (lambda (f) (lambda (x) x)))
318 | (set ONE (lambda (f) (lambda (x) (f x))))
319 | (set TWO (lambda (f) (lambda (x) (f (f x)))))
320 | (set print-int (lambda (n) ((n +1) 0)))
321 | (print-int TWO)
322 | 2
323 | (set +ONE (lambda (n) (lambda (g) (compose g (n g)))))
324 | (set PLUS (lambda (m n) (lambda (g) (compose (m g) (n g)))))
325 | (set THREE (PLUS ONE TWO))
326 | (print-int THREE)
327 | 3
328 | (set MULT (lambda (m n) (compose m n)))
329 | (set SIX (MULT THREE TWO))
330 | (print-int SIX)
331 | 6
332 | (set LIST2 (lambda (x y) (CONS x (CONS y NIL))))
333 | (set STEP (lambda (m-a) (LIST2 (CADR m-a) (+ONE (CADR m-a))))),
334 | (set -ONE (lambda (n) (CAR ((n STEP) (LIST2 ZERO ZERO)))))
335 | (set SUB (lambda (m n) ((n -ONE) m)))
336 | (set FOUR (SUB SIX TWO))
337 | (print-int FOUR)
338 | 4
339 | (set GT (lambda (m n) (NOT (=ZERO? (SUB m n)))))
340 | (set GE (lambda (m n) (=ZERO? (SUB n m))))
341 | (set EQUAL (lambda (m n)
342 |    (AND (=ZERO? (SUB m n)) (=ZERO? (SUB n m)))))
343 | (set uncurry (lambda (f) (lambda (x y) ((f x) y))))
344 | (set F (curry FALSE))
345 | (set =ZERO? (lambda (n)
346 |      (uncurry (lambda (y) ((n F) (lambda (x) y))))))
347 | (IF (=ZERO? ZERO) 'yes 'no)
348 | 'yes
349 | (IF (=ZERO? FOUR) 'yes 'no)
350 | 'no
351 | (set fac (lambda (n)
352 |      (IF (EQUAL n ZERO) ONE (MULT n (fac (SUB n ONE))))))
353 | (print-int (fac FOUR))
354 | 24
355 | (set FAC-STEP (lambda (x-y)
356 |      (LIST2 (-ONE (CAR x-y)) (MULT (CAR x-y) (CADR x-y)))))
357 | (set FAC (lambda (n) (CADR ((n FAC-STEP) (LIST2 n ONE)))))
358 | (print-int (FAC FOUR))
359 | 24
360 | (set W (lambda (F) (lambda (f) (F (f f)))))
361 | (set Y (lambda (F) ((W F) (W F))))
362 | (set ONES (Y (lambda (ones) (CONS ONE ones))))
363 | (print-int (CAR (CDR (CDR ONES))))
364 | 1
365 | (set FAC (Y (lambda (fac)
366 |      (lambda (n)
367 |           (IF (EQUAL n ZERO) ONE (MULT n (fac (SUB n ONE))))))))
368 | (print-int (FAC FOUR))
369 | 24
370 | quit
371 | 


--------------------------------------------------------------------------------
/distr/code.gc.lsp:
--------------------------------------------------------------------------------
  1 | ; From chapter 1
  2 | (define mod (m n) (- m (* n (/ m n))))
  3 | (define +1 (x) (+ x 1))
  4 | ; Section 2.1.3
  5 | (cons 'a '())
  6 | '(a)
  7 | (cons 'a '(b))
  8 | '(a b)
  9 | (cons '(a) '(b))
 10 | '((a) b)
 11 | (cdr '(a (b (c d))))
 12 | '((b (c d)))
 13 | (null? '())
 14 | 'T
 15 | (null? '(()))
 16 | '()
 17 | (define length (l) (if (null? l) 0 (+1 (length (cdr l)))))
 18 | (define caar (l) (car (car l)))
 19 | (define cadr (l) (car (cdr l)))
 20 | (define cddr (l) (cdr (cdr l)))
 21 | (define caddr (l) (car (cdr (cdr l))))
 22 | (define cadar (l) (car (cdr (car l))))
 23 | (define cadddr (exp) (car (cdr (cdr (cdr exp)))))
 24 | (define list1 (x) (cons x '()))
 25 | (define list2 (x y) (cons x (cons y '())))
 26 | (define list3 (x y z) (cons x (cons y (cons z '()))))
 27 | (list2 (list1 'a) 'b)
 28 | '((a) b)
 29 | (define or (x y) (if x x y))
 30 | (define atom? (x) (or (null? x) (or (number? x) (symbol? x))))
 31 | (define equal (l1 l2)
 32 |       (if (atom? l1) (= l1 l2)
 33 |           (if (atom? l2) '()
 34 |               (if (equal (car l1) (car l2))
 35 |                    (equal (cdr l1) (cdr l2))
 36 |                    '()))))
 37 | (equal 'a 'b)
 38 | '()
 39 | (equal '(a (1 3) c) '(a (1 3) c))
 40 | 'T
 41 | (equal '(a (1 3) d) '(a (1 3) c))
 42 | '()
 43 | (define and (x y) (if x y x)).
 44 | (define not (x) (if x '() 'T)).
 45 | (define divides (m n) (= (mod n m) 0))
 46 | (define  interval-list (m n)
 47 |      (if (> m n) '() (cons m (interval-list (+1 m) n))))
 48 | (interval-list 3 7)
 49 | '(3 4 5 6 7)
 50 | (define remove-multiples (n l)
 51 |        (if (null? l) '()
 52 |        (if  (divides n (car l))
 53 |                           (remove-multiples n (cdr l))
 54 |              (cons (car l) (remove-multiples n (cdr l))))))
 55 | (remove-multiples 2 '(2 3 4 5 6 7))
 56 | '(3 5 7)
 57 | (define sieve (l)
 58 |      (if (null? l) '()
 59 |           (cons (car l) (sieve (remove-multiples (car l) (cdr l))))))
 60 | (define primes<= (n) (sieve (interval-list 2 n)))
 61 | (primes<= 10)
 62 | '(2 3 5 7)
 63 | (define insert (x l)
 64 |      (if (null? l) (list1 x)
 65 |       (if (< x (car l))  (cons x l)
 66 |          (cons (car l)(insert x (cdr l))))))
 67 | (define insertion-sort (l)
 68 |    (if (null? l) '()
 69 |     (insert (car l) (insertion-sort (cdr l)))))
 70 | (insertion-sort '(4 3 2 6 8 5))
 71 | '(2 3 4 5 6 8)
 72 |  (define assoc (x alist) 
 73 |      (if (null? alist) '()
 74 |          (if  (= x (caar alist)) (cadar alist)
 75 |              (assoc x (cdr alist)))))
 76 | (assoc 'U '((E coli)(I Ching)(U Thant)))
 77 | 'Thant
 78 | (define mkassoc (x y alist)
 79 |      (if (null? alist)
 80 |           (list1 (list2 x y))
 81 |          (if  (= x (caar alist)) (cons (list2 x y) (cdr alist))
 82 |            (cons (car alist) (mkassoc x y (cdr alist))))))
 83 | (set al (mkassoc 'I 'Ching '()))
 84 | '((I Ching))
 85 | (set al (mkassoc 'E 'coli al))
 86 | '((I Ching)(E Coli))
 87 | (set al (mkassoc 'I 'Magnin al))
 88 | '((I Magnin)(E coli))
 89 | (assoc 'I al)
 90 | 'Magnin
 91 | (set fruits '((apple ((texture crunchy)))(banana ((color yellow)))))
 92 | (define getprop (x p plist)
 93 |      ; find property p of individual x in plist
 94 |      (assoc p (assoc x plist)))
 95 | (getprop 'apple 'texture fruits)
 96 | 'crunchy
 97 | (define putprop (x p y plist)
 98 |      ; give individual x value y for property p
 99 |         (mkassoc x (mkassoc p y (assoc x plist)) plist))
100 | (set fruits (putprop 'apple 'color 'red fruits))
101 | '((apple ((texture crunchy)(color red)))(banana ((color yellow)))))
102 | (getprop 'apple 'color fruits)
103 | 'red
104 | (define hasprop? (p y alist) (= (assoc p alist) y))
105 |  (define  gatherprop (p y plist)
106 |      ; get all individuals having value y for property p
107 |         (if  (null? plist) '()
108 |               (if  (hasprop? p y (cadar plist))
109 |                     (cons (caar plist) (gatherprop p y (cdr plist)))
110 |                     (gatherprop p y (cdr plist)))))
111 | (set fruits (putprop 'lemon 'color 'yellow fruits))
112 | '((apple ((texture crunchy) ... (lemon ((color yellow))))))
113 | (gatherprop 'color 'yellow fruits)
114 | '(banana lemon)
115 | (set nullset '())
116 | '()
117 | (define addelt (x s)
118 |    (if (member? x s) s (cons x s)))
119 | (define member? (x s)
120 |      (if (null? s) '()
121 |          (if (equal x (car s)) 'T (member? x (cdr s)))))
122 | (define size (s) (length s))
123 | (define union (s1 s2)
124 |      (if (null? s1) s2
125 |          (if (member? (car s1) s2)
126 |                 (union (cdr s1) s2)
127 |              (cons (car s1) (union (cdr s1) s2)))))
128 | (set s (addelt 3 (addelt 'a nullset)))
129 | '(3 a)
130 | (member? 'a s)
131 | 'T
132 | (union s (addelt 2 (addelt 3 nullset)))
133 | '(a 2 3)
134 | (set t (addelt '(a b) (addelt 1 nullset)))
135 | '((a b) 1)
136 | (member? '(a b) t)
137 | 'T
138 | (define sum (l)
139 |    (if (null? l) 0
140 |      (if (number? l) l
141 |        (+ (sum (car l)) (sum (cdr l))))))
142 | (define wrong-sum (l)
143 |    (if (null? l) 0
144 |      (if (number? l) l
145 |        (begin
146 |          (set tmp (wrong-sum (car l)))
147 |          (+ (wrong-sum (cdr l)) tmp)))))
148 | (sum '(1 2 3 4))
149 | 10
150 | (wrong-sum '(1 2 3 4))
151 | 16
152 | (define right-sum (l) (right-sum-aux l 0))
153 | (define right-sum-aux (l tmp)
154 |     (if (null? l) 0
155 |        (if (number? l) l
156 |           (begin
157 |              (set tmp (right-sum (car l)))
158 |              (+ (right-sum (cdr l)) tmp)))))
159 | (right-sum '(1 2 3 4))
160 | 10
161 | (define pre-ord (tree)
162 |      (if (atom? tree) (print tree)
163 |          (begin
164 |              (print (car tree))
165 |              (pre-ord (cadr tree))
166 |              (pre-ord (caddr tree)))))
167 | (pre-ord '(A (B C D) (E (F G H) I)))
168 | '(output is A B C D E F G H I)
169 | ; Queue operations
170 | (set empty-queue '())
171 | (define front (q) (car q))
172 | (define rm-front (q) (cdr q))
173 | (define enqueue (t q)
174 |    (if (null? q) (list1 t) (cons (car q) (enqueue t (cdr q)))))
175 | (define empty? (q) (null? q))
176 | ; Level-order traversal
177 | (define level-ord (tree) (level-ord* (enqueue tree empty-queue)))
178 | (define level-ord* (node-q)
179 |    (if (empty? node-q) '()
180 |      (begin
181 |        (set this-node (front node-q))
182 |        (if (atom? this-node)
183 |                  (begin
184 |                       (print this-node)
185 |                       (level-ord* (rm-front node-q)))
186 |          (begin
187 |            (print (car this-node))
188 |            (level-ord*
189 |              (enqueue (caddr this-node)
190 |                (enqueue (cadr this-node) (rm-front node-q)))))))))
191 | (level-ord '(A (B C D) (E (F G H) I)))
192 | '(output is A B E C D E F I G H)
193 | ; Section 2.3
194 | (define inter (s1 s2)
195 |      (if (null? s1) s1
196 |           (if (member? (car s1) s2)
197 |                (cons (car s1) (inter (cdr s1) s2))
198 |                (inter (cdr s1) s2))))
199 | (define diff (s1 s2)
200 |      (if (null? s1) s1
201 |          (if (null? s2) s1
202 |               (if (member? (car s1) s2)
203 |                    (diff (cdr s1) s2)
204 |                    (cons (car s1) (diff (cdr s1) s2))))))
205 | (define UNION (r s)
206 |      (if (not (equal (car r) (car s)))
207 |           (print 'error)
208 |           (cons (car r) (union (cdr r) (cdr s)))))
209 | (define INTER (r s)
210 |      (if (not (equal (car r) (car s)))
211 |           (print 'error)
212 |           (cons (car r) (inter (cdr r) (cdr s)))))
213 | (define DIFF (r s)
214 |      (if (not (equal (car r) (car s)))
215 |           (print 'error)
216 |           (cons (car r) (diff (cdr r) (cdr s)))))
217 | (define SELECT (A v r)
218 |      (cons (car r) (include-rows v (col-num A (car r)) (cdr r))))
219 | (define col-num (A A-list)
220 |      (if (= A (car A-list)) 0
221 |           (+1 (col-num A (cdr A-list)))))
222 | (define include-rows (v n rows)
223 |      (if (null? rows) '()
224 |          (if (= v (nth n (car rows)))
225 |               (cons (car rows) (include-rows v n (cdr rows)))
226 |               (include-rows v n (cdr rows)))))
227 | (define nth (n l)
228 |      (if (= n 0) (car l) (nth (- n 1) (cdr l))))
229 | (define PROJECT (X r)
230 |      (cons X (include-cols* (col-num* X (car r)) (cdr r))))
231 | (define col-num* (X A-list)
232 |      (if (null? X) '()
233 |           (cons (col-num (car X) A-list) (col-num* (cdr X) A-list))))
234 | (define include-cols* (col-nums rows)
235 |      (if (null? rows) nullset
236 |           (addelt (include-cols col-nums (car rows))
237 |                     (include-cols* col-nums (cdr rows)))))
238 | (define include-cols (col-nums row)
239 |      (if (null? col-nums) '()
240 |           (cons (nth (car col-nums) row)
241 |                   (include-cols (cdr col-nums) row))))
242 | (define append (x y)
243 |     (if (null? x) y (cons (car x) (append (cdr x) y))))
244 | (define JOIN (r s)
245 |      (begin
246 |            (set intersection (inter (car r) (car s)))
247 |            (set r-intersection (col-num* intersection (car r)))
248 |            (set s-intersection (col-num* intersection (car s)))
249 |            (set r-diff-s (diff (car r) intersection))
250 |            (set r-diff-s-cols (col-num* r-diff-s (car r)))
251 |            (set s-diff-r (diff (car s) intersection))
252 |            (set s-diff-r-cols (col-num* s-diff-r (car s)))
253 |        (cons (append intersection (append r-diff-s s-diff-r))
254 |                (join-cols* r-intersection r-diff-s-cols s-intersection
255 |                        s-diff-r-cols (cdr r) (cdr s)))))
256 | (define join-cols* (X-r r-cols X-s s-cols r-rows s-rows)
257 |     (begin
258 |         (set new-rows '())
259 |         (while (not (null? r-rows))
260 |             (begin
261 |                 (set s-tmp s-rows)
262 |                 (while (not (null? s-tmp))
263 |                     (begin
264 |                         (if (equal (include-cols X-r (car r-rows))
265 |                                  (include-cols X-s (car s-tmp)))
266 |                              (set new-rows (cons (join-cols X-r r-cols s-cols
267 |                              (car r-rows) (car s-tmp))
268 |                                   new-rows))
269 |                              '())
270 |                         (set s-tmp (cdr s-tmp))))
271 |                  (set r-rows (cdr r-rows))))
272 |          new-rows))
273 | (define join-cols (X-r r-cols s-cols r-row s-row)
274 |     (append (include-cols X-r r-row)
275 |          (append (include-cols r-cols r-row)
276 |                 (include-cols s-cols s-row))))
277 | (set CRIMES
278 |        '((Victim Crime Criminal Location)
279 |            (Phelps robbery Harrison London)
280 |            (Drebber murder Hope London)
281 |            (Sir-Charles murder Stapleton Devonshire)
282 |            (Lady-Eva blackmail Milverton London)
283 |            (Brunton murder Howells West-Sussex)))
284 | (set MURDERS
285 |        '((Victim Weapon Motive)
286 |            (Drebber  poison  revenge)
287 |            (Sir-Charles  hound  greed)
288 |            (Brunton  burial-alive  passion)))
289 | (JOIN MURDERS
290 |           (PROJECT '(Victim Criminal)
291 |                 (SELECT 'Location 'London
292 |                      (SELECT 'Crime 'murder CRIMES))))
293 | '((Victim Weapon Motive Criminal) (Drebber poison revenge Hope))
294 | ; Section 2.4
295 | (define eval (exp)
296 |         (if  (number? exp) exp
297 |                 (apply-op
298 |                   (car exp)
299 |                         (eval (cadr exp))
300 |                         (eval (caddr exp)))))
301 | (define apply-op (f x y)
302 |         (if (= f '+) (+ x y)
303 |         (if (= f '-) (- x y)
304 |         (if (= f '*) (* x y)
305 |         (if (= f '/) (/ x y) 'error!)))))
306 | (eval '(+ 3 (* 4 5)))
307 | 23
308 | (eval '(+ 3 4))
309 | 7
310 | (eval '(+ (* 4 (/ 10 2)) (- 7 3)))
311 | 24
312 |  (define eval (exp rho)
313 |         (if  (number? exp) exp
314 |           (if  (symbol? exp) (assoc exp rho)
315 |                 (apply-op  
316 |                       (car exp)
317 |                       (eval (cadr exp) rho)
318 |                       (eval (caddr exp) rho)))))
319 | (eval '(+ i (/ 9 i)) (mkassoc 'i 3 '()))
320 | 6
321 | (define eval (exp rho)
322 |         (if (number? exp) exp
323 |         (if (symbol? exp) (assoc exp rho)
324 |         (if (= (car exp) 'quote) (cadr exp)
325 |         (if  (= (length exp) 2)
326 |           (apply-unary-op (car exp) (eval (cadr exp) rho))
327 |           (apply-binary-op  (car exp)
328 |               (eval (cadr exp) rho)
329 |               (eval (caddr exp) rho))
330 |         )))))
331 | (define apply-binary-op (f x y)
332 |       (if (= f 'cons) (cons x y)
333 |       (if (= f '+) (+ x y)
334 |       (if (= f '-) (- x y)
335 |       (if (= f '*) (* x y)
336 |       (if (= f '/) (/ x y)
337 |       (if (= f '<) (< x y)
338 |       (if (= f '>) (> x y)
339 |       (if (= f '=) (= x y) 'error!)))))))))
340 | (define apply-unary-op (f x)
341 |       (if (= f 'car) (car x)
342 |       (if (= f 'cdr) (cdr x)
343 |       (if (= f 'number?) (number? x)
344 |       (if (= f 'list?) (list? x)
345 |       (if (= f 'symbol?) (symbol? x)
346 |       (if (= f 'null?) (null? x) 'error!)))))))
347 | (eval '(car (quote (a b))) '())
348 | 'a 
349 | (eval '(cons 3 (cons (+ 4 5) (quote ()))) '())
350 | '(3 9) 
351 | (define eval (exp rho fundefs)
352 |           (if (number? exp) exp
353 |           (if (symbol? exp) (assoc exp rho)
354 |           (if (= (car exp) 'quote) (cadr exp)
355 |           (if  (= (car exp) 'if)
356 |                   (if  (null? (eval (cadr exp) rho fundefs))
357 |                           (eval (cadddr exp) rho fundefs)
358 |                           (eval (caddr exp) rho fundefs))
359 |           (if (userfun? (car exp) fundefs)
360 |                (apply-userfun (assoc (car exp) fundefs)
361 |                                 (evallist (cdr exp) rho fundefs)
362 |                                 fundefs)
363 |              (if (= (length exp) 2)
364 |                      (apply-unary-op  (car exp)
365 |                              (eval (cadr exp) rho fundefs))
366 |                      (apply-binary-op (car exp)
367 |                                (eval (cadr exp) rho fundefs)
368 |                                     (eval (caddr exp) rho fundefs))))))))))
369 | (define userfun? (f fundefs) (assoc f fundefs))
370 | (define apply-userfun (fundef args fundefs)
371 |           (eval (cadr fundef) ; body of function
372 |                   (mkassoc* (car fundef) args '()) ; local env
373 |                   fundefs))
374 | (define evallist (el rho fundefs)
375 |      (if (null? el) '()
376 |           (cons (eval (car el) rho fundefs)
377 |                   (evallist (cdr el) rho fundefs))))
378 | (define mkassoc* (keys values al)
379 |      (if (null? keys) al
380 |           (mkassoc* (cdr keys) (cdr values)
381 |                   (mkassoc (car keys) (car values) al))))
382 | (set E (mkassoc 'double '((a) (+ a a)) '()))
383 | '((double ((a) (+ a a))))
384 | (eval '(double (car (quote (4 5)))) '() E)
385 | 8
386 | (set E (mkassoc  'exp
387 |                '((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))
388 |                '()))
389 | '((exp ((m n) (if (= n 0) 1 (* m (exp m (- n 1)))))))
390 | (eval '(exp 4 3) '() E)
391 | 64
392 | (define r-e-p-loop (inputs) (r-e-p-loop* inputs '()))
393 | (define r-e-p-loop* (inputs fundefs)
394 |     (if (null? inputs) '() ; session done
395 |          (if (atom? (car inputs)) ; input is variable or number
396 |               (process-exp (car inputs) (cdr inputs) fundefs)
397 |               (if (= (caar inputs) 'define) ; input is function definition
398 |                    (process-def (car inputs) (cdr inputs) fundefs)
399 |                    (process-exp (car inputs) (cdr inputs) fundefs)))))
400 | (define process-def (e inputs fundefs)
401 |        (cons (cadr e) ; echo function name
402 |                (r-e-p-loop* inputs
403 |                     (mkassoc (cadr e) (cddr e) fundefs))))
404 | (define process-exp (e inputs fundefs)
405 |        (cons (eval e '() fundefs) ; print value of expression
406 |                (r-e-p-loop* inputs fundefs)))
407 | (r-e-p-loop '(
408 |       (define double (a) (+ a a))
409 |       (double (car (quote (4 5))))
410 |       (define exp (m n) (if (= n 0) 1 (* m (exp m (- n 1)))))
411 |       (exp 4 3)
412 |       ))
413 | '(double 8 exp 64)
414 | quit
415 | 


--------------------------------------------------------------------------------