smalltalk-tng
view etng-r2/boot.tng @ 321:c4a0718c2d3c
Sketch of dependencies
| author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
|---|---|
| date | Sat Oct 08 15:36:03 2011 -0400 (7 months ago) |
| parents | 4d06e035b80e |
| children |
line source
1 namespace s = "http://eighty-twenty.org/etng/r1/ns/stream#";
3 define raw_callcc fn ->
4 '%assemble' (fn = fn) { .scheme -> ('call-with-current-continuation'
5 (lambda (k) ('etng-send' fn (list k)))) };
6 define callcc fn ->
7 raw_callcc { k -> fn {v -> '%assemble' (v = v, k = k) { .scheme -> (k v) } } };
9 define extends extension base ->
10 '%assemble' (extension = extension, base = base) {
11 .scheme -> ('etng-merge-functions' extension base);
12 };
14 -- (someproxy |as somedelegate) somemessage
15 define as receiver via message ->
16 '%assemble' (receiver = receiver, via = via, message = message) {
17 -- FIXME: need some form of apply here, now we are n-ary instead of unary!
18 .scheme -> ('etng-send*' receiver via (list message))
19 };
21 define :booleanBehaviour = rec {
22 .not -> '%assemble' (x = self) { .scheme -> (not x) };
23 };
25 define :falseProxy = :booleanBehaviour |extends {v -> v.:false};
26 define :trueProxy = :booleanBehaviour |extends {v -> v.:true};
28 define case x options -> options x;
30 define < = .<;
31 define > = .>;
33 define :symbolProxy = rec {
34 msg -> case self {
35 .< -> :messageAccumulator {receiver -> receiver} msg;
36 _ -> error("Cannot send message to symbol", msg);
37 };
38 };
40 define :messageAccumulator firstSender -> {
41 .> receiver -> firstSender receiver;
42 secondMsg -> :messageAccumulator {receiver -> firstSender receiver secondMsg};
43 };
45 define <> = < >;
47 define false = '%assemble' () { .scheme -> (not (quote nonfalse)) };
48 define true = false.not;
50 define + = .+;
51 define * = .*;
52 define == = .==;
54 define eq x y -> '%assemble' (x = x, y = y) { .scheme -> ('eq?' x y) };
56 define write x -> '%assemble' (x = x) { .scheme -> (begin (write x) (newline)) };
58 define :eq = rec {
59 .== other -> '%assemble' (a = self, b = other) { .scheme -> ('eqv?' a b) };
60 };
62 define :numberProxy = rec {
63 .+ other -> '%assemble' (a = self, b = other) { .scheme -> (+ a b) };
64 .* other -> '%assemble' (a = self, b = other) { .scheme -> (* a b) };
65 .< other -> '%assemble' (a = self, b = other) { .scheme -> (< a b) };
66 };
68 define s:empty = { .s:case v -> v.s:empty };
69 define s:cons(head, tail) -> { .s:case v -> v.s:next(head, tail) };
71 define :tupleProxy = rec {
72 .length -> '%assemble' (v = self) { .scheme -> ('vector-length' v) };
73 .get(n) -> '%assemble' (v = self, n = n) { .scheme -> ('vector-ref' v n) };
74 .s:case v -> :tupleIterator(self, 0).s:case v;
75 };
77 define :tupleIterator(tuple, index) ->
78 (index < (tuple.length)) {
79 .:true -> {.s:case v -> v.s:next(tuple.get(index), :tupleIterator(tuple, index + 1))};
80 .:false -> {.s:case v -> v.s:empty};
81 };
83 define s:do stream fn ->
84 stream .s:case {
85 .s:empty -> .ok;
86 .s:next(head, tail) -> do fn(head); s:do tail fn;
87 };
89 define s:foldl stream knil kons ->
90 stream .s:case {
91 .s:empty -> knil;
92 .s:next(head, tail) -> s:foldl tail (kons(head, knil)) kons;
93 };
95 define s:foldr stream knil kons ->
96 stream .s:case {
97 .s:empty -> knil;
98 .s:next(head, tail) -> kons(head, s:foldr tail knil kons);
99 };
101 define s:reverse stream -> s:foldl stream s:empty s:cons;
102 define s:append s1 s2 -> s:foldr s1 s2 s:cons;
104 define s:foldlK stream knil kons k ->
105 stream .s:case {
106 .s:empty -> k(knil);
107 .s:next(head, tail) -> kons (head, knil) {newSeed -> s:foldlK tail newSeed kons k};
108 };
110 define s:foldrK stream knil kons k ->
111 stream .s:case {
112 .s:empty -> k(knil);
113 .s:next(head, tail) -> s:foldrK tail knil kons {newSeed -> kons (head, newSeed) k};
114 };
116 define s:concatenate stream -> s:foldr stream s:empty s:append;
118 define s:map stream fn -> s:foldr stream s:empty {elt, acc -> s:cons(fn(elt), acc)};
120 -- s:map (1, 2, 3) {x -> x};
121 -- (1, 2, 3) | s:foldr s:empty s:cons | s:do write;
122 -- (1, 2) | s:append (3, 4) | s:do write;
123 -- (| s:append (3, 4) | s:do write) (1, 2);
125 -- define xyz = { .x .y .z -> .w ;
126 -- .x .y .w -> .a ;
127 -- .x .a .z -> 345 };
128 -- define xx = xyz.x;
129 -- define xy = xx.y;
130 -- xx (xy (xy.z)) .z;