[pure-lang-svn] SF.net SVN: pure-lang: [295] pure/trunk

[<ag...@us...>]

Revision: 295
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=295&view=rev
Author:   agraef
Date:     2008-06-24 03:38:29 -0700 (Tue, 24 Jun 2008)

Log Message:
-----------
Add convenience functions to (de)construct a function application from/to a function object and a number of argument expressions.

Modified Paths:
--------------
    pure/trunk/runtime.cc
    pure/trunk/runtime.h

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-06-24 09:54:51 UTC (rev 294)
+++ pure/trunk/runtime.cc	2008-06-24 10:38:29 UTC (rev 295)
@@ -458,6 +458,27 @@
   return pure_apply2(fun, arg);
 }
 
+extern "C"
+pure_expr *pure_appl(pure_expr *fun, size_t argc, ...)
+{
+  if (argc == 0) return fun;
+  va_list ap;
+  va_start(ap, argc);
+  pure_expr **args = (pure_expr**)alloca(argc*sizeof(pure_expr*));
+  for (size_t i = 0; i < argc; i++)
+    args[i] = va_arg(ap, pure_expr*);
+  return pure_appv(fun, argc, args);
+}
+
+extern "C"
+pure_expr *pure_appv(pure_expr *fun, size_t argc, pure_expr **args)
+{
+  pure_expr *y = fun;
+  for (size_t i = 0; i < argc; i++)
+    y = pure_apply2(y, args[i]);
+  return y;
+}
+
 static inline pure_expr *mk_nil()
 {
   interpreter& interp = *interpreter::g_interp;
@@ -627,6 +648,35 @@
     return false;
 }
 
+extern "C"
+bool pure_is_appv(pure_expr *x, pure_expr **_fun,
+		  size_t *_argc, pure_expr ***_args)
+{
+  assert(x);
+  pure_expr *u = x, *y, *z;
+  size_t argc = 0;
+  while (pure_is_app(u, &y, &z)) {
+    argc++;
+    u = y;
+  }
+  if (_fun) *_fun = u;
+  if (_argc) *_argc = argc;
+  if (_args)
+    if (argc > 0) {
+      pure_expr **args = (pure_expr**)malloc(argc*sizeof(pure_expr*));
+      assert(args);
+      size_t i = argc;
+      u = x;
+      while (pure_is_app(u, &y, &z)) {
+	args[--i] = z;
+	u = y;
+      }
+      *_args = args;
+    } else
+      *_args = 0;
+  return true;
+}
+
 static inline bool is_nil(pure_expr *x)
 {
   interpreter& interp = *interpreter::g_interp;
@@ -666,6 +716,7 @@
 extern "C"
 bool pure_is_listv(pure_expr *x, size_t *_size, pure_expr ***_elems)
 {
+  assert(x);
   pure_expr *u = x, *y, *z;
   size_t size = 0;
   while (is_cons(u, y, z)) {
@@ -675,8 +726,9 @@
   if (!is_nil(u)) return false;
   if (_size) *_size = size;
   if (_elems)
-    if (size>0) {
+    if (size > 0) {
       pure_expr **elems = (pure_expr**)malloc(size*sizeof(pure_expr*));
+      assert(elems);
       size_t i = 0;
       u = x;
       while (is_cons(u, y, z)) {
@@ -692,6 +744,7 @@
 extern "C"
 bool pure_is_tuplev(pure_expr *x, size_t *_size, pure_expr ***_elems)
 {
+  assert(x);
   /* FIXME: This implementation assumes that tuples are right-recursive. If we
      change the tuple implementation in the prelude then this code has to be
      adapted accordingly. */
@@ -704,6 +757,7 @@
   if (_size) *_size = size;
   if (_elems) {
     pure_expr **elems = (pure_expr**)malloc(size*sizeof(pure_expr*));
+    assert(elems);
     size_t i = 0;
     u = x;
     while (is_pair(u, y, z)) {

Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h	2008-06-24 09:54:51 UTC (rev 294)
+++ pure/trunk/runtime.h	2008-06-24 10:38:29 UTC (rev 295)
@@ -116,6 +116,14 @@
 
 pure_expr *pure_app(pure_expr *fun, pure_expr *arg);
 
+/* Convenience functions to construct an application of the given function to
+   a vector or varargs list of argument expressions. The vectors are owned by
+   the caller and won't be freed. References on the argument expressions are
+   counted automatically. */
+
+pure_expr *pure_appl(pure_expr *fun, size_t argc, ...);
+pure_expr *pure_appv(pure_expr *fun, size_t argc, pure_expr **args);
+
 /* Convenience functions to construct Pure list and tuple values from a vector
    or a varargs list of element expressions. (Internally these are actually
    represented as function applications.) The vectors are owned by the caller
@@ -166,10 +174,23 @@
 
 bool pure_is_app(const pure_expr *x, pure_expr **fun, pure_expr **arg);
 
-/* Convenience functions to deconstruct lists and tuples. Returned element
-   vectors are malloc'd and must be freed by the caller. Note that
+/* Convenience function to decompose a function application into a function
+   and a vector of argument expressions. The returned element vectors are
+   malloc'ed and must be freed by the caller (unless the number of arguments
+   is zero in which case the returned vector will be NULL). Note that this
+   function always yields true, since a singleton expression which is not an
+   application is considered to be a function applied to zero arguments. In
+   such a case you can check the returned function object with pure_is_symbol
+   to see whether it actually is a symbol or closure. */
+
+bool pure_is_appv(pure_expr *x, pure_expr **fun,
+		  size_t *argc, pure_expr ***args);
+
+/* Convenience functions to deconstruct lists and tuples. The returned element
+   vectors are malloc'ed and must be freed by the caller (unless the number of
+   elements is zero in which case the returned vector will be NULL). Note that
    pure_is_tuplev will always return true, since a singleton expression, which
-   is not either a pair or (), is considered a tuple of size 1. */
+   is not either a pair or (), is considered to be a tuple of size 1. */
 
 bool pure_is_listv(pure_expr *x, size_t *size, pure_expr ***elems);
 bool pure_is_tuplev(pure_expr *x, size_t *size, pure_expr ***elems);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.