/[guile]/guile/guile-core/libguile/eval.c
ViewVC logotype

Diff of /guile/guile-core/libguile/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.341 by dirk, Sun Nov 9 08:10:57 2003 UTC revision 1.342 by dirk, Sun Nov 9 08:47:19 2003 UTC
# Line 694  SCM_GLOBAL_SYMBOL (scm_sym_trace, "trace Line 694  SCM_GLOBAL_SYMBOL (scm_sym_trace, "trace
694   * It is assumed that the calling expression has already made sure that the   * It is assumed that the calling expression has already made sure that the
695   * body is a proper list.  */   * body is a proper list.  */
696  static SCM  static SCM
697  scm_m_body (SCM op, SCM exprs)  m_body (SCM op, SCM exprs)
698  {  {
699    /* Don't add another ISYM if one is present already. */    /* Don't add another ISYM if one is present already. */
700    if (SCM_ISYMP (SCM_CAR (exprs)))    if (SCM_ISYMP (SCM_CAR (exprs)))
# Line 1161  scm_m_lambda (SCM expr, SCM env SCM_UNUS Line 1161  scm_m_lambda (SCM expr, SCM env SCM_UNUS
1161    cddr_expr = SCM_CDR (cdr_expr);    cddr_expr = SCM_CDR (cdr_expr);
1162    documentation = (length >= 3 && SCM_STRINGP (SCM_CAR (cddr_expr)));    documentation = (length >= 3 && SCM_STRINGP (SCM_CAR (cddr_expr)));
1163    body = documentation ? SCM_CDR (cddr_expr) : cddr_expr;    body = documentation ? SCM_CDR (cddr_expr) : cddr_expr;
1164    new_body = scm_m_body (SCM_IM_LAMBDA, body);    new_body = m_body (SCM_IM_LAMBDA, body);
1165    
1166    SCM_SETCAR (expr, SCM_IM_LAMBDA);    SCM_SETCAR (expr, SCM_IM_LAMBDA);
1167    if (documentation)    if (documentation)
# Line 1251  memoize_named_let (const SCM expr, const Line 1251  memoize_named_let (const SCM expr, const
1251    
1252    {    {
1253      const SCM let_body = SCM_CDR (cddr_expr);      const SCM let_body = SCM_CDR (cddr_expr);
1254      const SCM lambda_body = scm_m_body (SCM_IM_LET, let_body);      const SCM lambda_body = m_body (SCM_IM_LET, let_body);
1255      const SCM lambda_tail = scm_cons (variables, lambda_body);      const SCM lambda_tail = scm_cons (variables, lambda_body);
1256      const SCM lambda_form = scm_cons_source (expr, scm_sym_lambda, lambda_tail);      const SCM lambda_form = scm_cons_source (expr, scm_sym_lambda, lambda_tail);
1257    
1258      const SCM rvar = scm_list_1 (name);      const SCM rvar = scm_list_1 (name);
1259      const SCM init = scm_list_1 (lambda_form);      const SCM init = scm_list_1 (lambda_form);
1260      const SCM body = scm_m_body (SCM_IM_LET, scm_list_1 (name));      const SCM body = m_body (SCM_IM_LET, scm_list_1 (name));
1261      const SCM letrec_tail = scm_cons (rvar, scm_cons (init, body));      const SCM letrec_tail = scm_cons (rvar, scm_cons (init, body));
1262      const SCM letrec_form = scm_cons_source (expr, SCM_IM_LETREC, letrec_tail);      const SCM letrec_form = scm_cons_source (expr, SCM_IM_LETREC, letrec_tail);
1263      return scm_cons_source (expr, letrec_form, inits);      return scm_cons_source (expr, letrec_form, inits);
# Line 1287  scm_m_let (SCM expr, SCM env) Line 1287  scm_m_let (SCM expr, SCM env)
1287    if (SCM_NULLP (bindings) || SCM_NULLP (SCM_CDR (bindings)))    if (SCM_NULLP (bindings) || SCM_NULLP (SCM_CDR (bindings)))
1288      {      {
1289        /* Special case: no bindings or single binding => let* is faster. */        /* Special case: no bindings or single binding => let* is faster. */
1290        const SCM body = scm_m_body (SCM_IM_LET, SCM_CDR (cdr_expr));        const SCM body = m_body (SCM_IM_LET, SCM_CDR (cdr_expr));
1291        return scm_m_letstar (scm_cons2 (SCM_CAR (expr), bindings, body), env);        return scm_m_letstar (scm_cons2 (SCM_CAR (expr), bindings, body), env);
1292      }      }
1293    else    else
# Line 1298  scm_m_let (SCM expr, SCM env) Line 1298  scm_m_let (SCM expr, SCM env)
1298        transform_bindings (bindings, expr, &rvariables, &inits);        transform_bindings (bindings, expr, &rvariables, &inits);
1299    
1300        {        {
1301          const SCM new_body = scm_m_body (SCM_IM_LET, SCM_CDR (cdr_expr));          const SCM new_body = m_body (SCM_IM_LET, SCM_CDR (cdr_expr));
1302          const SCM new_tail = scm_cons2 (rvariables, inits, new_body);          const SCM new_tail = scm_cons2 (rvariables, inits, new_body);
1303          SCM_SETCAR (expr, SCM_IM_LET);          SCM_SETCAR (expr, SCM_IM_LET);
1304          SCM_SETCDR (expr, new_tail);          SCM_SETCDR (expr, new_tail);
# Line 1336  scm_m_letstar (SCM expr, SCM env SCM_UNU Line 1336  scm_m_letstar (SCM expr, SCM env SCM_UNU
1336      }      }
1337    new_bindings = scm_reverse_x (new_bindings, SCM_UNDEFINED);    new_bindings = scm_reverse_x (new_bindings, SCM_UNDEFINED);
1338    
1339    new_body = scm_m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr));    new_body = m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr));
1340    return scm_cons2 (SCM_IM_LETSTAR, new_bindings, new_body);    return scm_cons2 (SCM_IM_LETSTAR, new_bindings, new_body);
1341  }  }
1342    
# Line 1357  scm_m_letrec (SCM expr, SCM env) Line 1357  scm_m_letrec (SCM expr, SCM env)
1357    if (SCM_NULLP (bindings))    if (SCM_NULLP (bindings))
1358      {      {
1359        /* no bindings, let* is executed faster */        /* no bindings, let* is executed faster */
1360        SCM body = scm_m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));        SCM body = m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));
1361        return scm_m_letstar (scm_cons2 (SCM_CAR (expr), SCM_EOL, body), env);        return scm_m_letstar (scm_cons2 (SCM_CAR (expr), SCM_EOL, body), env);
1362      }      }
1363    else    else
# Line 1368  scm_m_letrec (SCM expr, SCM env) Line 1368  scm_m_letrec (SCM expr, SCM env)
1368    
1369        check_bindings (bindings, expr);        check_bindings (bindings, expr);
1370        transform_bindings (bindings, expr, &rvariables, &inits);        transform_bindings (bindings, expr, &rvariables, &inits);
1371        new_body = scm_m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));        new_body = m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));
1372        return scm_cons2 (SCM_IM_LETREC, rvariables, scm_cons (inits, new_body));        return scm_cons2 (SCM_IM_LETREC, rvariables, scm_cons (inits, new_body));
1373      }      }
1374  }  }
# Line 1875  m_expand_body (const SCM xorig, const SC Line 1875  m_expand_body (const SCM xorig, const SC
1875        SCM rvars, inits, body, letrec;        SCM rvars, inits, body, letrec;
1876        check_bindings (defs, xorig);        check_bindings (defs, xorig);
1877        transform_bindings (defs, xorig, &rvars, &inits);        transform_bindings (defs, xorig, &rvars, &inits);
1878        body = scm_m_body (SCM_IM_DEFINE, x);        body = m_body (SCM_IM_DEFINE, x);
1879        letrec = scm_cons2 (SCM_IM_LETREC, rvars, scm_cons (inits, body));        letrec = scm_cons2 (SCM_IM_LETREC, rvars, scm_cons (inits, body));
1880        SCM_SETCAR (xorig, letrec);        SCM_SETCAR (xorig, letrec);
1881        SCM_SETCDR (xorig, SCM_EOL);        SCM_SETCDR (xorig, SCM_EOL);

Legend:
Removed from v.1.341  
changed lines
  Added in v.1.342

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26