lib/core/eval.c
static atom_t
lisp_eval_func(const lisp_t lisp, const atom_t closure, const atom_t symb,
               const atom_t func, const atom_t vals)
{
  atom_t rslt;
  TRACE_CLOS_SEXP(closure);
  TRACE_EVAL_SEXP(func);
  /*
   * Grab the arguments.
   */
  atom_t args = lisp_car(lisp, func);
  /*
   * Check if the function can be applied.
   */
  if (!lisp_may_apply(args, vals)) {
    X(lisp, func, vals, args);
    return lisp_make_nil(lisp);
  }
  /*
   * Grab the definition-site closure and the body.
   */
  atom_t cdr0 = lisp_cdr(lisp, func);
  atom_t dscl = lisp_car(lisp, cdr0);
  atom_t body = lisp_cdr(lisp, cdr0);
  X(lisp, func, cdr0);
  /*
   * Bind the arguments and the values. The closure embedded in the lambda is
   * used as the run environment and augmented with the values of the arguments.
   * The call-site closure is used for the evaluation of the arguments.
   */
  atom_t bind = lisp_bind_args(lisp, closure, dscl, args, vals);
  /*
   * Extract the bound arguments, and remaining arguments and values,
   */
  atom_t bscl = lisp_car(lisp, bind);
  atom_t narg = lisp_cdr(lisp, bind);
  X(lisp, bind);
  /*
   * Evaluate the binary function.
   */
  if (IS_NULL(narg) && IS_NUMB(body)) {
    /*
     * Prepend the bind-site closure to the call-site closure.
     */
    atom_t dup = lisp_dup(lisp, bscl);
    atom_t cls = lisp_conc(lisp, dup, UP(closure));
    X(lisp, bscl);
    /*
     * Call the binary function.
     */
    function_t fun = (function_t)body->number;
    rslt = fun(lisp, cls);
    X(lisp, body, narg, cls);
  }
  /*
   * Evaluate the lisp function (tail call).
   */
  else if (IS_NULL(narg) && IS_TAIL_CALL(symb)) {
    rslt = lisp_cons(lisp, UP(symb), lisp_dup(lisp, bscl));
    rslt->flags = F_TAIL_CALL;
    X(lisp, body, narg, bscl);
  }
  /*
   * Evaluate the lisp function.
   */
  else if (IS_NULL(narg)) {
    /*
     * Prepend the bind-site closure to the call-site closure.
     */
    atom_t dup = lisp_dup(lisp, bscl);
    X(lisp, narg, bscl);
    /*
     * Tail-call evaluation loop.
     */
  tailcall_loop:;
    atom_t cls = lisp_conc(lisp, dup, UP(closure));
    atom_t res = lisp_prog(lisp, cls, UP(body), lisp_make_nil(lisp));
    X(lisp, cls);
    /*
     * If it's a tail call, evaluate the function with the new arguments.
     */
    if (IS_TAIL_CALL(res) && lisp_symbol_match(CAR(res), &symb->symbol)) {
      dup = lisp_cdr(lisp, res);
      X(lisp, res);
      goto tailcall_loop;
    }
    /*
     * Otherwise, leave the loop.
     */
    rslt = res;
    X(lisp, body);
  }
  /*
   * Else handle partial application.
   */
  else {
    atom_t con0 = lisp_cons(lisp, bscl, body);
    rslt = lisp_cons(lisp, narg, con0);
  }
  /*
   */
  TRACE_CLOS_SEXP(closure);
  TRACE_EVAL_SEXP(rslt);
  return rslt;
}
/*
 * Function evaluation. A function's closure contains its currently resolved
 * arguments during currying.
 */
Function evaluation. A function's closure contains its currently resolved
arguments during currying.
Function evaluation . A function ' s closure contains its currently resolved arguments during currying .
static atom_t
lisp_eval_func(const lisp_t lisp, const atom_t closure, const atom_t symb,
               const atom_t func, const atom_t vals)
{
  atom_t rslt;
  TRACE_CLOS_SEXP(closure);
  TRACE_EVAL_SEXP(func);
  atom_t args = lisp_car(lisp, func);
  if (!lisp_may_apply(args, vals)) {
    X(lisp, func, vals, args);
    return lisp_make_nil(lisp);
  }
  atom_t cdr0 = lisp_cdr(lisp, func);
  atom_t dscl = lisp_car(lisp, cdr0);
  atom_t body = lisp_cdr(lisp, cdr0);
  X(lisp, func, cdr0);
  atom_t bind = lisp_bind_args(lisp, closure, dscl, args, vals);
  atom_t bscl = lisp_car(lisp, bind);
  atom_t narg = lisp_cdr(lisp, bind);
  X(lisp, bind);
  if (IS_NULL(narg) && IS_NUMB(body)) {
    atom_t dup = lisp_dup(lisp, bscl);
    atom_t cls = lisp_conc(lisp, dup, UP(closure));
    X(lisp, bscl);
    function_t fun = (function_t)body->number;
    rslt = fun(lisp, cls);
    X(lisp, body, narg, cls);
  }
  else if (IS_NULL(narg) && IS_TAIL_CALL(symb)) {
    rslt = lisp_cons(lisp, UP(symb), lisp_dup(lisp, bscl));
    rslt->flags = F_TAIL_CALL;
    X(lisp, body, narg, bscl);
  }
  else if (IS_NULL(narg)) {
    atom_t dup = lisp_dup(lisp, bscl);
    X(lisp, narg, bscl);
  tailcall_loop:;
    atom_t cls = lisp_conc(lisp, dup, UP(closure));
    atom_t res = lisp_prog(lisp, cls, UP(body), lisp_make_nil(lisp));
    X(lisp, cls);
    if (IS_TAIL_CALL(res) && lisp_symbol_match(CAR(res), &symb->symbol)) {
      dup = lisp_cdr(lisp, res);
      X(lisp, res);
      goto tailcall_loop;
    }
    rslt = res;
    X(lisp, body);
  }
  else {
    atom_t con0 = lisp_cons(lisp, bscl, body);
    rslt = lisp_cons(lisp, narg, con0);
  }
  TRACE_CLOS_SEXP(closure);
  TRACE_EVAL_SEXP(rslt);
  return rslt;
}
static atom_t lisp_eval_func ( const lisp_t lisp , const atom_t closure , const atom_t symb , const atom_t func , const atom_t vals ) { atom_t rslt ; TRACE_CLOS_SEXP ( closure ) ; TRACE_EVAL_SEXP ( func ) ; atom_t args = lisp_car ( lisp , func ) ; if ( ! lisp_may_apply ( args , vals ) ) { X ( lisp , func , vals , args ) ; return lisp_make_nil ( lisp ) ; } atom_t cdr0 = lisp_cdr ( lisp , func ) ; atom_t dscl = lisp_car ( lisp , cdr0 ) ; atom_t body = lisp_cdr ( lisp , cdr0 ) ; X ( lisp , func , cdr0 ) ; atom_t bind = lisp_bind_args ( lisp , closure , dscl , args , vals ) ; atom_t bscl = lisp_car ( lisp , bind ) ; atom_t narg = lisp_cdr ( lisp , bind ) ; X ( lisp , bind ) ; if ( IS_NULL ( narg ) && IS_NUMB ( body ) ) { atom_t dup = lisp_dup ( lisp , bscl ) ; atom_t cls = lisp_conc ( lisp , dup , UP ( closure ) ) ; X ( lisp , bscl ) ; function_t fun = ( function_t ) body -> number ; rslt = fun ( lisp , cls ) ; X ( lisp , body , narg , cls ) ; } else if ( IS_NULL ( narg ) && IS_TAIL_CALL ( symb ) ) { rslt = lisp_cons ( lisp , UP ( symb ) , lisp_dup ( lisp , bscl ) ) ; rslt -> flags = F_TAIL_CALL ; X ( lisp , body , narg , bscl ) ; } else if ( IS_NULL ( narg ) ) { atom_t dup = lisp_dup ( lisp , bscl ) ; X ( lisp , narg , bscl ) ; tailcall_loop : ; atom_t cls = lisp_conc ( lisp , dup , UP ( closure ) ) ; atom_t res = lisp_prog ( lisp , cls , UP ( body ) , lisp_make_nil ( lisp ) ) ; X ( lisp , cls ) ; if ( IS_TAIL_CALL ( res ) && lisp_symbol_match ( CAR ( res ) , & symb -> symbol ) ) { dup = lisp_cdr ( lisp , res ) ; X ( lisp , res ) ; goto tailcall_loop ; } rslt = res ; X ( lisp , body ) ; } else { atom_t con0 = lisp_cons ( lisp , bscl , body ) ; rslt = lisp_cons ( lisp , narg , con0 ) ; } TRACE_CLOS_SEXP ( closure ) ; TRACE_EVAL_SEXP ( rslt ) ; return rslt ; }
Function evaluation.
Function evaluation .
/*
   * Grab the arguments.
   */ /*
   * Check if the function can be applied.
   */ /*
   * Grab the definition-site closure and the body.
   */ /*
   * Bind the arguments and the values. The closure embedded in the lambda is
   * used as the run environment and augmented with the values of the arguments.
   * The call-site closure is used for the evaluation of the arguments.
   */ /*
   * Extract the bound arguments, and remaining arguments and values,
   */ /*
   * Evaluate the binary function.
   */ /*
     * Prepend the bind-site closure to the call-site closure.
     */ /*
     * Call the binary function.
     */ /*
   * Evaluate the lisp function (tail call).
   */ /*
   * Evaluate the lisp function.
   */ /*
     * Prepend the bind-site closure to the call-site closure.
     */ /*
     * Tail-call evaluation loop.
     */ /*
     * If it's a tail call, evaluate the function with the new arguments.
     */ /*
     * Otherwise, leave the loop.
     */ /*
   * Else handle partial application.
   */ /*
   */