/interpreter/tags/at2dist090708/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.eval.Evaluator;
 31import edu.vub.at.exceptions.InterpreterException;
 32import edu.vub.at.exceptions.XIllegalOperation;
 33import edu.vub.at.exceptions.signals.SignalEscape;
 34import edu.vub.at.objects.ATBoolean;
 35import edu.vub.at.objects.ATClosure;
 36import edu.vub.at.objects.ATContext;
 37import edu.vub.at.objects.ATMethod;
 38import edu.vub.at.objects.ATObject;
 39import edu.vub.at.objects.ATTable;
 40import edu.vub.at.objects.coercion.NativeTypeTags;
 41import edu.vub.at.objects.mirrors.NativeClosure;
 42
 43/**
 44 * A NATClosure instance represents a first-class AmbientTalk closure.
 45 * A closure is modelled as a pair (method, context), where the method
 46 * contains the pure function (function name, arguments and body).
 47 *
 48 * The single most important operation to be performed on a closure is applying it.
 49 * This will give rise to the application of its underlying method within the context
 50 * wrapped by the closure.
 51 * 
 52 * @author smostinc
 53 */
 54public class NATClosure extends NATByRef implements ATClosure {
 55
 56	// these instance variables are inherited and used by a NativeClosure as well.
 57	protected ATMethod 	method_;
 58	protected ATContext	context_;
 59	
 60	/**
 61	 * This constructor creates a closure with a bound dynamic receiver, and it is
 62	 * called after the succesful lookup of a receiverful message.
 63	 * @param method the method being wrapped into a closure.
 64	 * @param implementor the object in which the definition is nested.
 65	 * @param receiver the object where the lookup was initiated.
 66	 */
 67	public NATClosure(ATMethod method, ATObject implementor, ATObject receiver) throws InterpreterException {
 68		this(method, new NATContext(
 69				/* scope = implementor (to be extended with a callframe upon closure application) */
 70				implementor, 
 71				/* self = ` start of lookup ` */
 72				receiver));
 73	}
 74	
 75	public NATClosure(ATMethod method, ATContext context) {
 76		method_	= method;
 77		context_ = context;
 78	}
 79
 80	/**
 81	 * To apply a closure, apply its underlying method with the context of the closure,
 82	 * rather than the runtime context of the invoker.
 83	 */
 84	public ATObject base_apply(ATTable arguments) throws InterpreterException {
 85		return method_.base_apply(arguments, this.base_context());
 86	}
 87
 88	/**
 89	 * To apply a closure in a given scope, apply its underlying method with a new context
 90	 * constructed from the scope object.
 91	 */
 92	public ATObject base_applyInScope(ATTable args, ATObject scope) throws InterpreterException {
 93		return method_.base_applyInScope(args, new NATContext(scope, scope));
 94	}
 95	
 96	/**
 97	 * receiver is a zero-argument block closure returning a boolean
 98	 * @param body a zero-argument block closure
 99	 * 
100	 * def whileTrue: body {
101	 *   self.apply().ifTrue: {
102	 *     body();
103	 *     self.whileTrue: body
104	 *   }
105	 * }
106	 */
107	public ATObject base_whileTrue_(final ATClosure body) throws InterpreterException {
108		/* ATObject result = NATNil._INSTANCE_;
109		while (this.meta_apply(NATTable.EMPTY).asNativeBoolean().javaValue) {
110			result = body.meta_apply(NATTable.EMPTY);
111		}
112		return result; */
113		
114		ATBoolean cond;
115		while (true) {
116			// cond = self.apply()
117			cond = this.base_apply(NATTable.EMPTY).asBoolean();
118			if(cond.isNativeBoolean()) {
119				// cond is a native boolean, perform the conditional ifTrue: test natively
120				if (cond.asNativeBoolean().javaValue) {
121					// execute body and continue while loop
122					body.base_apply(NATTable.EMPTY);
123					continue;
124				} else {
125					// return nil
126					return Evaluator.getNil();
127				}
128			} else {
129				// cond is a user-defined boolean, do a recursive send
130				return cond.base_ifTrue_(new NativeClosure(this) {
131					public ATObject base_apply(ATTable args) throws InterpreterException {
132						// if user-defined bool is true, execute body and recurse
133						body.base_apply(NATTable.EMPTY);
134						return base_whileTrue_(body);
135					}
136				});
137			}
138		}
139		
140	}
141	
142	/**
143	 * The following is a pseudo-code implementation of escape. The important difference
144	 * between the native implementation and this pseudo-code is that the 'escaping exception'
145	 * can *not* be caught at the AmbientTalk level. The SignalEscape is a truly native exception.
146	 * 
147	 * def block.escape() {
148	 *   def returned := false;
149	 *   def quit(@args) {
150	 *     if: (returned) then: {
151	 *       raise: XIllegalOperation.new("Cannot quit, escape activation already returned")
152	 *     } else: {
153	 *       raise: SignalEscape.new(block, if: (args.isEmpty()) then: nil else: args[1])
154	 *     }
155	 *   };
156	 *   
157	 *   try: {
158	 *    block(quit);
159	 *   } catch: SignalEscape using: {|e|
160	 *     if: (e.block == block) then: {
161	 *       e.val
162	 *     } else: {
163	 *       raise: e
164	 *     }
165	 *   } finally: {
166	 *     returned := true;
167	 *   }
168	 * }
169	 */
170	public ATObject base_escape() throws InterpreterException {		
171		final QuitClosureFrame f = new QuitClosureFrame();
172		NativeClosure quit = new NativeClosure(this) {
173			public ATObject base_apply(ATTable args) throws InterpreterException {
174				if (f.alreadyReturned) {
175					throw new XIllegalOperation("Cannot quit, escape activation already returned");
176				} else {
177					ATObject val;
178					if (args.base_isEmpty().asNativeBoolean().javaValue) {
179						val = Evaluator.getNil(); 
180					} else {
181						val = get(args, 1);
182					}
183					throw new SignalEscape(this.scope_.asClosure(), val);
184				}
185			}
186		};
187		
188		try {
189			return this.base_apply(NATTable.atValue(new ATObject[] { quit }));
190		} catch(SignalEscape e) {
191			if (e.originatingBlock == this) {
192				return e.returnedValue;
193			} else {
194				// propagate the signal, it did not originate from this block
195				throw e;
196			}
197		} finally {
198			f.alreadyReturned = true;
199		}
200	}
201	
202	// helper class to get around the fact that Java has no true closures and hence
203	// does not allow access to mutable lexically scoped free variables
204	static private class QuitClosureFrame {
205		/** if true, the escape block has already been exited */
206		public boolean alreadyReturned = false;
207	}
208
209	public ATContext base_context() throws InterpreterException {
210		return context_;
211	}
212
213	public ATMethod base_method() {
214		return method_;
215	}
216
217	public ATClosure asClosure() {
218		return this;
219	}
220	
221	public NATText meta_print() throws InterpreterException {
222		return NATText.atValue("<closure:"+method_.base_name()+">");
223	}
224	
225    public ATTable meta_typeTags() throws InterpreterException {
226    	return NATTable.of(NativeTypeTags._CLOSURE_);
227    }
228    
229	public ATObject meta_clone() throws InterpreterException {
230		return this;
231	}
232    
233}