Re: How to detect a procedure

[Bruce Korb]

Lynn Winebarger wrote:

> I don't think this captures the spirit of the original question.  If you do 
> this,
> you rely on the evaluator checking for the existence of the binding - 
> procedure?
> gets the actual object (it never sees the name).  Or, if the name hasn't been
> bound it will error out (if the lookup throws an exception, that might be 
> used).

How about adding this procedure.  I confess to being uncertain if it actually
works, I get lost trying to decipher the maze of macros.


SCM_DEFINE (scm_defined_as_p, "defined-as?", 2, 1, 0,
            (SCM sym, SCM class, SCM env),
            "Return @code{#t} if @var{sym} is defined of class @var{class} in "
            "the lexical environment @var{env}.  When @var{env} is not "
            "specified, look in the top-level environment as defined by the "
            "current module.")
#define FUNC_NAME s_scm_defined_as_p
{
  SCM var;

  SCM_VALIDATE_SYMBOL (1,sym);

  if (SCM_UNBNDP (env))
    var = scm_sym2var (sym, scm_current_module_lookup_closure (),
                         SCM_BOOL_F);
  else
    {
      SCM frames = env;
      register SCM b;
      for (; SCM_NIMP (frames); frames = SCM_CDR (frames))
        {
          SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME);
          b = SCM_CAR (frames);
          if (SCM_NFALSEP (scm_procedure_p (b)))
            break;
          SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME);
          for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
            {
              if (SCM_NCONSP (b))
                {
                  if (SCM_EQ_P (b, sym))
                    return SCM_BOOL_T;
                  else
                    break;
                }
              if (SCM_EQ_P (SCM_CAR (b), sym))
                return SCM_BOOL_T;
            }
        }
      var = scm_sym2var (sym,
                         SCM_NIMP (frames) ? SCM_CAR (frames) : SCM_BOOL_F,
                         SCM_BOOL_F);
    }

  if (SCM_FALSEP (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var)))
    return SCM_BOOL_F;

  if (scm_class_of (SCM_VARIABLE_REF (var)) == class)
    return SCM_BOOL_T;
  return SCM_BOOL_F;
}
#undef FUNC_NAME

==

Bruce Korb <first initial + last name at gnu dot org>
AG URL: http://autogen.sourceforge.net