smalltalk-tng

view etng-r2/metaeval.tng @ 321:c4a0718c2d3c

find changesets by author, revision, files, or words in the commit message
Sketch of dependencies
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
date Sat Oct 08 15:36:03 2011 -0400 (7 months ago)
parents 072745b48add
children
line source
1 namespace s = "http://eighty-twenty.org/etng/r1/ns/stream#";
2 namespace core = "http://eighty-twenty.org/etng/r1/ns/abstract-syntax/core#";
3 namespace reflection = "http://eighty-twenty.org/etng/r1/ns/interpreter/meta-representation#";
4 namespace interpreter = "http://eighty-twenty.org/etng/r1/ns/interpreter#";
5
6 ---------------------------------------------------------------------------
7
8 define :TExtendable = rec {
9 .:with extension ->
10 reflection:reflect(self).reflection:extendWith(reflection:reflect(extension)).reflection:reify;
11 };
12
13 ---------------------------------------------------------------------------
14 namespace "http://eighty-twenty.org/etng/r1/ns/interpreter/meta-representation#";
15
16 define makeQName uri localName -> {
17 .uri = uri;
18 .localName = localName;
19 };
20
21 define emptyEnvironment = {};
22
23 define searchEnvironment env name ->
24 1;
25
26 define extendEnvironment env1 env2 ->
27 1;
28
29 define match pattern value env ->
30 1;
31
32 define Object = {
33 .lookup message k ->
34 1;
35 };
36
37 define makeObject methods ->
38 1;
39
40 define Function = {
41 .lookup message k ->
42 1;
43 };
44
45 define makeFunction methods ->
46 1;
47
48 define makeMessage parts ->
49 1;
50
51 define Tuple = {
52 };
53
54 define makeTuple values ->
55 1;
56
57 ---------------------------------------------------------------------------
58 namespace "http://eighty-twenty.org/etng/r1/ns/interpreter#";
59
60 define InterpreterState = :TExtendable.:with {
61 .env = reflection:emptyEnvironment;
62 .k = < >;
63 .self_ = {};
64 .nextMethod_ = {exit(<.internalError>);} -- ??
65 };
66
67 define Interpreter = rec {
68 .globals = 1;
69
70 .unboundVariable state name ->
71 exit(<.unboundVariable state name>);
72
73 .doesNotUnderstand state receiver message ->
74 exit(<.doesNotUnderstand state receiver message>);
75
76 .noNextMethod state ->
77 exit(<.noNextMethod state>);
78
79 .lookup state name k ->
80 reflection:searchEnvironment (state.env) name {
81 .:ok(v) -> k v;
82 _ -> self.globals name {
83 .:ok(v)-> k v;
84 _ -> self.unboundVariable state name;
85 };
86 };
87
88 .apply state (closure, bindings, newSelf, newNextMethod) k ->
89 let env = reflection:extendEnvironment (closure.reflection:env) bindings;
90 self.eval (state.:with {.env = env; .nextMethod_ = newNextMethod; .self_ = newSelf;})
91 (closure.reflection:exp)
92 k;
93
94 .send state receiver message k ->
95 -- need to handle <...> messages here
96 receiver.reflection:lookup message {
97 .:ok result -> self.apply state result k;
98 _ -> self.doesNotUnderstand receiver message;
99 };
100
101 .evlis state elements k ->
102 let e = {(element, acc) continue -> self.eval state element {v -> continue [v | acc]}};
103 s:foldlK elements [] e {acc -> k (s:reverse acc)};
104
105 .eval state exp k ->
106 (<exp.core:kind>) {
107 .core:Namespace -> self.eval state (exp.core:value) k;
108 .core:Send ->
109 self.eval state (exp.core:receiver) {r ->
110 self.eval state (exp.core:message) {m ->
111 self.send r m k}};
112 .core:Object -> reflection:makeObject state (exp.core:methods);
113 .core:Function -> reflection:makeFunction state (exp.core:methods);
114 .core:Message -> self.evlis state (exp.core:parts) reflection:makeMessage;
115 .core:Do ->
116 self.eval state (exp.core:head) {v ->
117 self.eval state (exp.core:tail) k};
118 .core:Let ->
119 self.eval state (exp.core:value) {v ->
120 let newEnv = reflection:match (exp.core:pattern) v (state.env);
121 self.eval (state.:with {.env = newEnv}) (exp.core:body) k};
122 .core:Ref -> self.lookup state (exp.core:name) k;
123 .core:Tuple -> self.evlis state (exp.core:elements) {vals -> k (reflection:makeTuple vals)};
124 .core:Lit -> exp.core:value;
125 .core:Self -> state.self_;
126 .core:NextMethod ->
127 state.nextMethod_ {
128 .:ok result -> self.apply state result k;
129 _ -> self.noNextMethod state;
130 };
131 .core:Meta -> 1;
132 };
133 };