// --------------------------------------------------------------------------- // - Block.cpp - // - afnix engine - builtin block function implementation - // --------------------------------------------------------------------------- // - This program is free software; you can redistribute it and/or modify - // - it provided that this copyright notice is kept intact. - // - - // - This program is distributed in the hope that it will be useful, but - // - without any warranty; without even the implied warranty of - // - merchantability or fitness for a particular purpose. In no event shall - // - the copyright holder be liable for any direct, indirect, incidental or - // - special damages arising in any way out of the use of this software. - // --------------------------------------------------------------------------- // - copyright (c) 1999-2007 amaury darsch - // --------------------------------------------------------------------------- #include "Cons.hpp" #include "Builtin.hpp" #include "Runnable.hpp" #include "Globalset.hpp" #include "Exception.hpp" namespace afnix { // block reserved function implementation Object* builtin_block (Runnable* robj, Nameset* nset, Cons* args) { long len = (args == nilp) ? 0 : args->length (); if (len == 0) return nilp; if (len != 1) throw Exception ("argument-error", "missing or too many argument with block"); // extract the form Object* form = args->getcar (); if (form == nilp) return nilp; // create a nameset - link it with the parent and execute the form Nameset* lset = new Globalset (nset); Object* result = nilp; try { result = form->eval (robj, lset); Object::iref (result); lset->reset (); delete lset; } catch (...) { lset->reset (); delete lset; throw; } robj->post (result); Object::tref (result); return result; } }