/[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.291 by dirk, Sun Apr 20 07:19:38 2003 UTC revision 1.292 by dirk, Sun Apr 20 11:01:33 2003 UTC
# Line 1262  scm_macroexp (SCM x, SCM env) Line 1262  scm_macroexp (SCM x, SCM env)
1262   * This ought to change.   * This ought to change.
1263   */   */
1264    
1265  #define SCM_BIT8(x) (127 & SCM_UNPACK (x))  #define SCM_BIT7(x) (127 & SCM_UNPACK (x))
1266    
1267  static SCM  static SCM
1268  build_binding_list (SCM names, SCM inits)  build_binding_list (SCM names, SCM inits)
# Line 1288  unmemocopy (SCM x, SCM env) Line 1288  unmemocopy (SCM x, SCM env)
1288    p = scm_whash_lookup (scm_source_whash, x);    p = scm_whash_lookup (scm_source_whash, x);
1289    switch (SCM_ITAG7 (SCM_CAR (x)))    switch (SCM_ITAG7 (SCM_CAR (x)))
1290      {      {
1291      case SCM_BIT8(SCM_IM_AND):      case SCM_BIT7 (SCM_IM_AND):
1292        ls = z = scm_cons (scm_sym_and, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_and, SCM_UNSPECIFIED);
1293        break;        break;
1294      case SCM_BIT8(SCM_IM_BEGIN):      case SCM_BIT7 (SCM_IM_BEGIN):
1295        ls = z = scm_cons (scm_sym_begin, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_begin, SCM_UNSPECIFIED);
1296        break;        break;
1297      case SCM_BIT8(SCM_IM_CASE):      case SCM_BIT7 (SCM_IM_CASE):
1298        ls = z = scm_cons (scm_sym_case, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_case, SCM_UNSPECIFIED);
1299        break;        break;
1300      case SCM_BIT8(SCM_IM_COND):      case SCM_BIT7 (SCM_IM_COND):
1301        ls = z = scm_cons (scm_sym_cond, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_cond, SCM_UNSPECIFIED);
1302        break;        break;
1303      case SCM_BIT8 (SCM_IM_DO):      case SCM_BIT7 (SCM_IM_DO):
1304        {        {
1305          /* format: (#@do (nk nk-1 ...) (i1 ... ik) (test) (body) s1 ... sk),          /* format: (#@do (nk nk-1 ...) (i1 ... ik) (test) (body) s1 ... sk),
1306           * where nx is the name of a local variable, ix is an initializer for           * where nx is the name of a local variable, ix is an initializer for
# Line 1342  unmemocopy (SCM x, SCM env) Line 1342  unmemocopy (SCM x, SCM env)
1342          x = scm_cons (SCM_BOOL_F, memoized_body);          x = scm_cons (SCM_BOOL_F, memoized_body);
1343          break;          break;
1344        }        }
1345      case SCM_BIT8(SCM_IM_IF):      case SCM_BIT7 (SCM_IM_IF):
1346        ls = z = scm_cons (scm_sym_if, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_if, SCM_UNSPECIFIED);
1347        break;        break;
1348      case SCM_BIT8 (SCM_IM_LET):      case SCM_BIT7 (SCM_IM_LET):
1349        {        {
1350          /* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...),          /* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...),
1351           * where nx is the name of a local variable, ix is an initializer for           * where nx is the name of a local variable, ix is an initializer for
# Line 1363  unmemocopy (SCM x, SCM env) Line 1363  unmemocopy (SCM x, SCM env)
1363          ls = scm_cons (scm_sym_let, z);          ls = scm_cons (scm_sym_let, z);
1364          break;          break;
1365        }        }
1366      case SCM_BIT8 (SCM_IM_LETREC):      case SCM_BIT7 (SCM_IM_LETREC):
1367        {        {
1368          /* format: (#@letrec (nk nk-1 ...) (i1 ... ik) b1 ...),          /* format: (#@letrec (nk nk-1 ...) (i1 ... ik) b1 ...),
1369           * where nx is the name of a local variable, ix is an initializer for           * where nx is the name of a local variable, ix is an initializer for
# Line 1381  unmemocopy (SCM x, SCM env) Line 1381  unmemocopy (SCM x, SCM env)
1381          ls = scm_cons (scm_sym_letrec, z);          ls = scm_cons (scm_sym_letrec, z);
1382          break;          break;
1383        }        }
1384      case SCM_BIT8(SCM_IM_LETSTAR):      case SCM_BIT7 (SCM_IM_LETSTAR):
1385        {        {
1386          SCM b, y;          SCM b, y;
1387          x = SCM_CDR (x);          x = SCM_CDR (x);
# Line 1420  unmemocopy (SCM x, SCM env) Line 1420  unmemocopy (SCM x, SCM env)
1420          ls = scm_cons (scm_sym_letstar, z = scm_cons (y, SCM_UNSPECIFIED));          ls = scm_cons (scm_sym_letstar, z = scm_cons (y, SCM_UNSPECIFIED));
1421          break;          break;
1422        }        }
1423      case SCM_BIT8(SCM_IM_OR):      case SCM_BIT7 (SCM_IM_OR):
1424        ls = z = scm_cons (scm_sym_or, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_or, SCM_UNSPECIFIED);
1425        break;        break;
1426      case SCM_BIT8(SCM_IM_LAMBDA):      case SCM_BIT7 (SCM_IM_LAMBDA):
1427        x = SCM_CDR (x);        x = SCM_CDR (x);
1428        z = scm_cons (SCM_CAR (x), SCM_UNSPECIFIED);        z = scm_cons (SCM_CAR (x), SCM_UNSPECIFIED);
1429        ls = scm_cons (scm_sym_lambda, z);        ls = scm_cons (scm_sym_lambda, z);
1430        env = EXTEND_ENV (SCM_CAR (x), SCM_EOL, env);        env = EXTEND_ENV (SCM_CAR (x), SCM_EOL, env);
1431        break;        break;
1432      case SCM_BIT8(SCM_IM_QUOTE):      case SCM_BIT7 (SCM_IM_QUOTE):
1433        ls = z = scm_cons (scm_sym_quote, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_quote, SCM_UNSPECIFIED);
1434        break;        break;
1435      case SCM_BIT8(SCM_IM_SET_X):      case SCM_BIT7 (SCM_IM_SET_X):
1436        ls = z = scm_cons (scm_sym_set_x, SCM_UNSPECIFIED);        ls = z = scm_cons (scm_sym_set_x, SCM_UNSPECIFIED);
1437        break;        break;
1438      case SCM_BIT8(SCM_IM_DEFINE):      case SCM_BIT7 (SCM_IM_DEFINE):
1439        {        {
1440          SCM n;          SCM n;
1441          x = SCM_CDR (x);          x = SCM_CDR (x);
# Line 1448  unmemocopy (SCM x, SCM env) Line 1448  unmemocopy (SCM x, SCM env)
1448                            SCM_CDR (env));                            SCM_CDR (env));
1449          break;          break;
1450        }        }
1451      case SCM_BIT8(SCM_MAKISYM (0)):      case SCM_BIT7 (SCM_MAKISYM (0)):
1452        z = SCM_CAR (x);        z = SCM_CAR (x);
1453        if (!SCM_ISYMP (z))        if (!SCM_ISYMP (z))
1454          goto unmemo;          goto unmemo;
# Line 1932  dispatch: Line 1932  dispatch:
1932        x = scm_cons (x, SCM_UNDEFINED);        x = scm_cons (x, SCM_UNDEFINED);
1933        RETURN (*scm_lookupcar (x, env, 1));        RETURN (*scm_lookupcar (x, env, 1));
1934    
1935      case SCM_BIT8 (SCM_IM_AND):      case SCM_BIT7 (SCM_IM_AND):
1936        x = SCM_CDR (x);        x = SCM_CDR (x);
1937        while (!SCM_NULLP (SCM_CDR (x)))        while (!SCM_NULLP (SCM_CDR (x)))
1938          {          {
# Line 1945  dispatch: Line 1945  dispatch:
1945        PREP_APPLY (SCM_UNDEFINED, SCM_EOL);        PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
1946        goto carloop;        goto carloop;
1947    
1948      case SCM_BIT8 (SCM_IM_BEGIN):      case SCM_BIT7 (SCM_IM_BEGIN):
1949        x = SCM_CDR (x);        x = SCM_CDR (x);
1950        if (SCM_NULLP (x))        if (SCM_NULLP (x))
1951          RETURN (SCM_UNSPECIFIED);          RETURN (SCM_UNSPECIFIED);
# Line 2014  dispatch: Line 2014  dispatch:
2014        }        }
2015    
2016    
2017      case SCM_BIT8 (SCM_IM_CASE):      case SCM_BIT7 (SCM_IM_CASE):
2018        x = SCM_CDR (x);        x = SCM_CDR (x);
2019        {        {
2020          SCM key = EVALCAR (x, env);          SCM key = EVALCAR (x, env);
# Line 2046  dispatch: Line 2046  dispatch:
2046        RETURN (SCM_UNSPECIFIED);        RETURN (SCM_UNSPECIFIED);
2047    
2048    
2049      case SCM_BIT8 (SCM_IM_COND):      case SCM_BIT7 (SCM_IM_COND):
2050        x = SCM_CDR (x);        x = SCM_CDR (x);
2051        while (!SCM_NULLP (x))        while (!SCM_NULLP (x))
2052          {          {
# Line 2089  dispatch: Line 2089  dispatch:
2089        RETURN (SCM_UNSPECIFIED);        RETURN (SCM_UNSPECIFIED);
2090    
2091    
2092      case SCM_BIT8 (SCM_IM_DO):      case SCM_BIT7 (SCM_IM_DO):
2093        x = SCM_CDR (x);        x = SCM_CDR (x);
2094        {        {
2095          /* Compute the initialization values and the initial environment.  */          /* Compute the initialization values and the initial environment.  */
# Line 2158  dispatch: Line 2158  dispatch:
2158        goto nontoplevel_begin;        goto nontoplevel_begin;
2159    
2160    
2161      case SCM_BIT8 (SCM_IM_IF):      case SCM_BIT7 (SCM_IM_IF):
2162        x = SCM_CDR (x);        x = SCM_CDR (x);
2163        {        {
2164          SCM test_result = EVALCAR (x, env);          SCM test_result = EVALCAR (x, env);
# Line 2175  dispatch: Line 2175  dispatch:
2175        goto carloop;        goto carloop;
2176    
2177    
2178      case SCM_BIT8 (SCM_IM_LET):      case SCM_BIT7 (SCM_IM_LET):
2179        x = SCM_CDR (x);        x = SCM_CDR (x);
2180        {        {
2181          SCM init_forms = SCM_CADR (x);          SCM init_forms = SCM_CADR (x);
# Line 2193  dispatch: Line 2193  dispatch:
2193        goto nontoplevel_begin;        goto nontoplevel_begin;
2194    
2195    
2196      case SCM_BIT8 (SCM_IM_LETREC):      case SCM_BIT7 (SCM_IM_LETREC):
2197        x = SCM_CDR (x);        x = SCM_CDR (x);
2198        env = EXTEND_ENV (SCM_CAR (x), scm_undefineds, env);        env = EXTEND_ENV (SCM_CAR (x), scm_undefineds, env);
2199        x = SCM_CDR (x);        x = SCM_CDR (x);
# Line 2213  dispatch: Line 2213  dispatch:
2213        goto nontoplevel_begin;        goto nontoplevel_begin;
2214    
2215    
2216      case SCM_BIT8 (SCM_IM_LETSTAR):      case SCM_BIT7 (SCM_IM_LETSTAR):
2217        x = SCM_CDR (x);        x = SCM_CDR (x);
2218        {        {
2219          SCM bindings = SCM_CAR (x);          SCM bindings = SCM_CAR (x);
# Line 2236  dispatch: Line 2236  dispatch:
2236        goto nontoplevel_begin;        goto nontoplevel_begin;
2237    
2238    
2239      case SCM_BIT8 (SCM_IM_OR):      case SCM_BIT7 (SCM_IM_OR):
2240        x = SCM_CDR (x);        x = SCM_CDR (x);
2241        while (!SCM_NULLP (SCM_CDR (x)))        while (!SCM_NULLP (SCM_CDR (x)))
2242          {          {
# Line 2250  dispatch: Line 2250  dispatch:
2250        goto carloop;        goto carloop;
2251    
2252    
2253      case SCM_BIT8 (SCM_IM_LAMBDA):      case SCM_BIT7 (SCM_IM_LAMBDA):
2254        RETURN (scm_closure (SCM_CDR (x), env));        RETURN (scm_closure (SCM_CDR (x), env));
2255    
2256    
2257      case SCM_BIT8 (SCM_IM_QUOTE):      case SCM_BIT7 (SCM_IM_QUOTE):
2258        RETURN (SCM_CADR (x));        RETURN (SCM_CADR (x));
2259    
2260    
2261      case SCM_BIT8 (SCM_IM_SET_X):      case SCM_BIT7 (SCM_IM_SET_X):
2262        x = SCM_CDR (x);        x = SCM_CDR (x);
2263        {        {
2264          SCM *location;          SCM *location;
# Line 2275  dispatch: Line 2275  dispatch:
2275        RETURN (SCM_UNSPECIFIED);        RETURN (SCM_UNSPECIFIED);
2276    
2277    
2278      case SCM_BIT8(SCM_IM_DEFINE):       /* only for internal defines */      case SCM_BIT7 (SCM_IM_DEFINE):      /* only for internal defines */
2279        scm_misc_error (NULL, "Bad define placement", SCM_EOL);        scm_misc_error (NULL, "Bad define placement", SCM_EOL);
2280    
2281    
2282        /* new syntactic forms go here. */        /* new syntactic forms go here. */
2283      case SCM_BIT8 (SCM_MAKISYM (0)):      case SCM_BIT7 (SCM_MAKISYM (0)):
2284        proc = SCM_CAR (x);        proc = SCM_CAR (x);
2285        SCM_ASRTGO (SCM_ISYMP (proc), badfun);        SCM_ASRTGO (SCM_ISYMP (proc), badfun);
2286        switch (SCM_ISYMNUM (proc))        switch (SCM_ISYMNUM (proc))
# Line 2662  dispatch: Line 2662  dispatch:
2662      case scm_tc7_variable:      case scm_tc7_variable:
2663        RETURN (SCM_VARIABLE_REF(x));        RETURN (SCM_VARIABLE_REF(x));
2664    
2665      case SCM_BIT8(SCM_ILOC00):      case SCM_BIT7 (SCM_ILOC00):
2666        proc = *scm_ilookup (SCM_CAR (x), env);        proc = *scm_ilookup (SCM_CAR (x), env);
2667        SCM_ASRTGO (SCM_NIMP (proc), badfun);        SCM_ASRTGO (SCM_NIMP (proc), badfun);
2668        goto checkargs;        goto checkargs;

Legend:
Removed from v.1.291  
changed lines
  Added in v.1.292

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