/interpreter/tags/at2-build270707/src/edu/vub/at/objects/natives/NATClosure.java

  1/**
  2 * AmbientTalk/2 Project
  3 * NATClosure.java created on Jul 23, 2006 at 3:22:23 PM
  4 * (c) Programming Technology Lab, 2006 - 2007
  5 * Authors: Tom Van Cutsem & Stijn Mostinckx
  6 * 
  7 * Permission is hereby granted, free of charge, to any person
  8 * obtaining a copy of this software and associated documentation
  9 * files (the "Software"), to deal in the Software without
 10 * restriction, including without limitation the rights to use,
 11 * copy, modify, merge, publish, distribute, sublicense, and/or
 12 * sell copies of the Software, and to permit persons to whom the
 13 * Software is furnished to do so, subject to the following
 14 * conditions:
 15 *
 16 * The above copyright notice and this permission notice shall be
 17 * included in all copies or substantial portions of the Software.
 18 *
 19 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 20 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 21 * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 22 * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 23 * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 24 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 25 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 26 * OTHER DEALINGS IN THE SOFTWARE.
 27 */
 28package edu.vub.at.objects.natives;
 29
 30import edu.vub.at.exceptions.InterpreterException;
 31import edu.vub.at.exceptions.XIllegalOperation;
 32import edu.vub.at.exceptions.signals.SignalEscape;
 33import edu.vub.at.objects.ATBoolean;
 34import edu.vub.at.objects.ATClosure;
 35import edu.vub.at.objects.ATContext;
 36import edu.vub.at.objects.ATMethod;
 37import edu.vub.at.objects.ATObject;
 38import edu.vub.at.objects.ATTable;
 39import edu.vub.at.objects.coercion.NativeTypeTags;
 40import edu.vub.at.objects.mirrors.NativeClosure;
 41
 42/**
 43 * A NATClosure instance represents a first-class AmbientTalk closure.
 44 * A closure is modelled as a pair (method, context), where the method
 45 * contains the pure function (function name, arguments and body).
 46 *
 47 * The single most important operation to be performed on a closure is applying it.
 48 * This will give rise to the application of its underlying method within the context
 49 * wrapped by the closure.
 50 * 
 51 * @author smostinc
 52 */
 53public class NATClosure extends NATByRef implements ATClosure {
 54
 55	// these instance variables are inherited and used by a NativeClosure as well.
 56	protected ATMethod 	method_;
 57	protected ATContext	context_;
 58	
 59	/**
 60	 * This constructor creates a closure with a bound dynamic receiver, and it is
 61	 * called after the succesful lookup of a receiverful message.
 62	 * @param method the method being wrapped into a closure.
 63	 * @param implementor the object in which the definition is nested.
 64	 * @param receiver the object where the lookup was initiated.
 65	 */
 66	public NATClosure(ATMethod method, ATObject implementor, ATObject receiver) throws InterpreterException {
 67		this(method, new NATContext(
 68				/* scope = implementor (to be extended with a callframe upon closure application) */
 69				implementor, 
 70				/* self = ` start of lookup ` */
 71				receiver));
 72	}
 73	
 74	public NATClosure(ATMethod method, ATContext context) {
 75		method_	= method;
 76		context_ = context;
 77	}
 78
 79	/**
 80	 * To apply a closure, apply its underlying method with the context of the closure,
 81	 * rather than the runtime context of the invoker.
 82	 */
 83	public ATObject base_apply(ATTable arguments) throws InterpreterException {
 84		return method_.base_apply(arguments, this.base_context());
 85	}
 86
 87	/**
 88	 * To apply a closure in a given scope, apply its underlying method with a new context
 89	 * constructed from the scope object.
 90	 */
 91	public ATObject base_applyInScope(ATTable args, ATObject scope) throws InterpreterException {
 92		return method_.base_applyInScope(args, new NATContext(scope, scope));
 93	}
 94	
 95	/**
 96	 * receiver is a zero-argument block closure returning a boolean
 97	 * @param body a zero-argument block closure
 98	 * 
 99	 * def whileTrue: body {
100	 *   self.apply().ifTrue: {
101	 *     body();
102	 *     self.whileTrue: body
103	 *   }
104	 * }
105	 */
106	public ATObject base_whileTrue_(final ATClosure body) throws InterpreterException {
107		/* ATObject result = NATNil._INSTANCE_;
108		while (this.meta_apply(NATTable.EMPTY).asNativeBoolean().javaValue) {
109			result = body.meta_apply(NATTable.EMPTY);
110		}
111		return result; */
112		
113		ATBoolean cond;
114		while (true) {
115			// cond = self.apply()
116			cond = this.base_apply(NATTable.EMPTY).asBoolean();
117			if(cond.isNativeBoolean()) {
118				// cond is a native boolean, perform the conditional ifTrue: test natively
119				if (cond.asNativeBoolean().javaValue) {
120					// execute body and continue while loop
121					body.base_apply(NATTable.EMPTY);
122					continue;
123				} else {
124					// return nil
125					return OBJNil._INSTANCE_;
126				}
127			} else {
128				// cond is a user-defined boolean, do a recursive send
129				return cond.base_ifTrue_(new NativeClosure(this) {
130					public ATObject base_apply(ATTable args) throws InterpreterException {
131						// if user-defined bool is true, execute body and recurse
132						body.base_apply(NATTable.EMPTY);
133						return base_whileTrue_(body);
134					}
135				});
136			}
137		}
138		
139	}
140	
141	/**
142	 * The following is a pseudo-code implementation of escape. The important difference
143	 * between the native implementation and this pseudo-code is that the 'escaping exception'
144	 * can *not* be caught at the AmbientTalk level. The SignalEscape is a truly native exception.
145	 * 
146	 * def block.escape() {
147	 *   def returned := false;
148	 *   def quit(@args) {
149	 *     if: (returned) then: {
150	 *       raise: XIllegalOperation.new("Cannot quit, escape activation already returned")
151	 *     } else: {
152	 *       raise: SignalEscape.new(block, if: (args.isEmpty()) then: nil else: args[1])
153	 *     }
154	 *   };
155	 *   
156	 *   try: {
157	 *    block(quit);
158	 *   } catch: SignalEscape using: {|e|
159	 *     if: (e.block == block) then: {
160	 *       e.val
161	 *     } else: {
162	 *       raise: e
163	 *     }
164	 *   } finally: { // doesn't yet exist in AT/2
165	 *     returned := true;
166	 *   }
167	 * }
168	 */
169	public ATObject base_escape() throws InterpreterException {		
170		final QuitClosureFrame f = new QuitClosureFrame();
171		NativeClosure quit = new NativeClosure(this) {
172			public ATObject base_apply(ATTable args) throws InterpreterException {
173				if (f.alreadyReturned) {
174					throw new XIllegalOperation("Cannot quit, escape activation already returned");
175				} else {
176					ATObject val;
177					if (args.base_isEmpty().asNativeBoolean().javaValue) {
178						val = OBJNil._INSTANCE_; 
179					} else {
180						val = get(args, 1);
181					}
182					throw new SignalEscape(this.scope_.asClosure(), val);
183				}
184			}
185		};
186		
187		try {
188			return this.base_apply(NATTable.atValue(new ATObject[] { quit }));
189		} catch(SignalEscape e) {
190			if (e.originatingBlock == this) {
191				return e.returnedValue;
192			} else {
193				// propagate the signal, it did not originate from this block
194				throw e;
195			}
196		} finally {
197			f.alreadyReturned = true;
198		}
199	}
200	
201	// helper class to get around the fact that Java has no true closures and hence
202	// does not allow access to mutable lexically scoped free variables
203	static private class QuitClosureFrame {
204		/** if true, the escape block has already been exited */
205		public boolean alreadyReturned = false;
206	}
207
208	public ATContext base_context() throws InterpreterException {
209		return context_;
210	}
211
212	public ATMethod base_method() {
213		return method_;
214	}
215
216	public ATClosure asClosure() {
217		return this;
218	}
219	
220	public NATText meta_print() throws InterpreterException {
221		return NATText.atValue("<closure:"+method_.base_name()+">");
222	}
223	
224    public ATTable meta_typeTags() throws InterpreterException {
225    	return NATTable.of(NativeTypeTags._CLOSURE_);
226    }
227    
228	public ATObject meta_clone() throws InterpreterException {
229		return this;
230	}
231    
232}