Changeset 4014


Ignore:
Timestamp:
09/23/03 13:02:02 (20 years ago)
Author:
piso
Message:

Moved DO and DO* to Do.java.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/j/src/org/armedbear/lisp/Primitives.java

    r4010 r4014  
    33 *
    44 * Copyright (C) 2002-2003 Peter Graves
    5  * $Id: Primitives.java,v 1.425 2003-09-23 12:42:27 piso Exp $
     5 * $Id: Primitives.java,v 1.426 2003-09-23 13:02:02 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
    … …  
    3131{
    3232    // SpecialOperator
    33     private static final int DO                         = 1;
    34     private static final int DO_                        = 2;
    35     private static final int FLET                       = 3;
    36     private static final int LABELS                     = 4;
    37     private static final int PROGN                      = 5;
     33    private static final int FLET                       = 1;
     34    private static final int LABELS                     = 2;
     35    private static final int PROGN                      = 3;
    3836
    3937    // Primitive
    40     private static final int DIVIDE                     = 6;
    41     private static final int EXIT                       = 7;
    42     private static final int MAX                        = 8;
    43     private static final int MIN                        = 9;
    44     private static final int MULTIPLY                   = 10;
    45     private static final int VALUES                     = 11;
     38    private static final int DIVIDE                     = 4;
     39    private static final int EXIT                       = 5;
     40    private static final int MAX                        = 6;
     41    private static final int MIN                        = 7;
     42    private static final int MULTIPLY                   = 8;
     43    private static final int VALUES                     = 9;
    4644
    4745    // Primitive1
    48     private static final int ABS                        = 12;
    49     private static final int ARRAYP                     = 13;
    50     private static final int ARRAY_HAS_FILL_POINTER_P   = 14;
    51     private static final int BIT_VECTOR_P               = 15;
    52     private static final int BOTH_CASE_P                = 16;
    53     private static final int CHARACTERP                 = 17;
    54     private static final int CHAR_CODE                  = 18;
    55     private static final int CHAR_DOWNCASE              = 19;
    56     private static final int CHAR_INT                   = 20;
    57     private static final int CHAR_UPCASE                = 21;
    58     private static final int CODE_CHAR                  = 22;
    59     private static final int COMPILED_FUNCTION_P        = 23;
    60     private static final int CONSP                      = 24;
    61     private static final int EVAL                       = 25;
    62     private static final int EVENP                      = 26;
    63     private static final int FBOUNDP                    = 27;
    64     private static final int FMAKUNBOUND                = 28;
    65     private static final int FOURTH                     = 29;
    66     private static final int FUNCTIONP                  = 30;
    67     private static final int IDENTITY                   = 31;
    68     private static final int KEYWORDP                   = 32;
    69     private static final int LENGTH                     = 33;
    70     private static final int LISTP                      = 34;
    71     private static final int LOWER_CASE_P               = 35;
    72     private static final int MAKE_SYMBOL                = 36;
    73     private static final int MAKUNBOUND                 = 37;
    74     private static final int NUMBERP                    = 38;
    75     private static final int ODDP                       = 39;
    76     private static final int PREDECESSOR                = 40;
    77     private static final int SECOND                     = 41;
    78     private static final int SIMPLE_BIT_VECTOR_P        = 42;
    79     private static final int SIMPLE_STRING_P            = 43;
    80     private static final int SIMPLE_VECTOR_P            = 44;
    81     private static final int SPECIAL_OPERATOR_P         = 45;
    82     private static final int STRINGP                    = 46;
    83     private static final int SUCCESSOR                  = 47;
    84     private static final int SYMBOL_FUNCTION            = 48;
    85     private static final int SYMBOL_NAME                = 49;
    86     private static final int SYMBOL_PACKAGE             = 50;
    87     private static final int SYMBOL_PLIST               = 51;
    88     private static final int SYMBOL_VALUE               = 52;
    89     private static final int THIRD                      = 53;
    90     private static final int UPPER_CASE_P               = 54;
    91     private static final int VALUES_LIST                = 55;
    92     private static final int VECTORP                    = 56;
     46    private static final int ABS                        = 10;
     47    private static final int ARRAYP                     = 11;
     48    private static final int ARRAY_HAS_FILL_POINTER_P   = 12;
     49    private static final int BIT_VECTOR_P               = 13;
     50    private static final int BOTH_CASE_P                = 14;
     51    private static final int CHARACTERP                 = 15;
     52    private static final int CHAR_CODE                  = 16;
     53    private static final int CHAR_DOWNCASE              = 17;
     54    private static final int CHAR_INT                   = 18;
     55    private static final int CHAR_UPCASE                = 19;
     56    private static final int CODE_CHAR                  = 20;
     57    private static final int COMPILED_FUNCTION_P        = 21;
     58    private static final int CONSP                      = 22;
     59    private static final int EVAL                       = 23;
     60    private static final int EVENP                      = 24;
     61    private static final int FBOUNDP                    = 25;
     62    private static final int FMAKUNBOUND                = 26;
     63    private static final int FOURTH                     = 27;
     64    private static final int FUNCTIONP                  = 28;
     65    private static final int IDENTITY                   = 29;
     66    private static final int KEYWORDP                   = 30;
     67    private static final int LENGTH                     = 31;
     68    private static final int LISTP                      = 32;
     69    private static final int LOWER_CASE_P               = 33;
     70    private static final int MAKE_SYMBOL                = 34;
     71    private static final int MAKUNBOUND                 = 35;
     72    private static final int NUMBERP                    = 36;
     73    private static final int ODDP                       = 37;
     74    private static final int PREDECESSOR                = 38;
     75    private static final int SECOND                     = 39;
     76    private static final int SIMPLE_BIT_VECTOR_P        = 40;
     77    private static final int SIMPLE_STRING_P            = 41;
     78    private static final int SIMPLE_VECTOR_P            = 42;
     79    private static final int SPECIAL_OPERATOR_P         = 43;
     80    private static final int STRINGP                    = 44;
     81    private static final int SUCCESSOR                  = 45;
     82    private static final int SYMBOL_FUNCTION            = 46;
     83    private static final int SYMBOL_NAME                = 47;
     84    private static final int SYMBOL_PACKAGE             = 48;
     85    private static final int SYMBOL_PLIST               = 49;
     86    private static final int SYMBOL_VALUE               = 50;
     87    private static final int THIRD                      = 51;
     88    private static final int UPPER_CASE_P               = 52;
     89    private static final int VALUES_LIST                = 53;
     90    private static final int VECTORP                    = 54;
    9391
    9492    // Primitive2
    95     private static final int MEMBER                     = 57;
    96     private static final int RPLACA                     = 58;
    97     private static final int RPLACD                     = 59;
    98     private static final int SET                        = 60;
     93    private static final int MEMBER                     = 55;
     94    private static final int RPLACA                     = 56;
     95    private static final int RPLACD                     = 57;
     96    private static final int SET                        = 58;
    9997
    10098    private Primitives()
    10199    {
    102         defineSpecialOperator("do", DO);
    103         defineSpecialOperator("do*", DO_);
    104100        defineSpecialOperator("flet", FLET);
    105101        defineSpecialOperator("labels", LABELS);
    … …  
    170166    {
    171167        switch (index) {
    172             case DO:
    173                 return _do(args, env, false);
    174             case DO_:
    175                 return _do(args, env, true);
    176168            case FLET:                          // ### flet
    177169                return _flet(args, env, false);
    … …  
    15351527    };
    15361528
    1537     private static final LispObject _do(LispObject args, Environment env,
    1538                                         boolean sequential)
    1539         throws ConditionThrowable
    1540     {
    1541         // Process variable specifications.
    1542         LispObject first = args.car();
    1543         args = args.cdr();
    1544         int length = first.length();
    1545         Symbol[] variables = new Symbol[length];
    1546         LispObject[] initials = new LispObject[length];
    1547         LispObject[] updates = new LispObject[length];
    1548         for (int i = 0; i < length; i++) {
    1549             LispObject obj = first.car();
    1550             if (obj instanceof Cons) {
    1551                 variables[i] = checkSymbol(obj.car());
    1552                 initials[i] = obj.cadr();
    1553                 // Is there a step form?
    1554                 if (obj.cdr().cdr() != NIL)
    1555                     updates[i] = obj.cdr().cdr().car();
    1556             } else {
    1557                 // Not a cons, must be a symbol.
    1558                 variables[i] = checkSymbol(obj);
    1559                 initials[i] = NIL;
    1560             }
    1561             first = first.cdr();
    1562         }
    1563         final LispThread thread = LispThread.currentThread();
    1564         Environment oldDynEnv = thread.getDynamicEnvironment();
    1565         Environment ext = new Environment(env);
    1566         for (int i = 0; i < length; i++) {
    1567             Symbol symbol = variables[i];
    1568             LispObject value =
    1569                 eval(initials[i], (sequential ? ext : env), thread);
    1570             bind(symbol, value, ext);
    1571         }
    1572         LispObject second = args.car();
    1573         LispObject test = second.car();
    1574         LispObject resultForms = second.cdr();
    1575         LispObject body = args.cdr();
    1576         final int depth = thread.getStackDepth();
    1577         // Look for tags.
    1578         Binding tags = null;
    1579         LispObject remaining = args;
    1580         while (remaining != NIL) {
    1581             LispObject current = remaining.car();
    1582             remaining = remaining.cdr();
    1583             if (current instanceof Cons)
    1584                 continue;
    1585             // It's a tag.
    1586             tags = new Binding(current, remaining, tags);
    1587         }
    1588         try {
    1589             // Implicit block.
    1590             while (true) {
    1591                 // Execute body.
    1592                 // Test for termination.
    1593                 if (eval(test, ext, thread) != NIL)
    1594                     break;
    1595                 remaining = body;
    1596                 while (remaining != NIL) {
    1597                     LispObject current = remaining.car();
    1598                     if (current instanceof Cons) {
    1599                         try {
    1600                             // Handle GO inline if possible.
    1601                             if (current.car() == Symbol.GO) {
    1602                                 LispObject code = null;
    1603                                 LispObject tag = current.cadr();
    1604                                 for (Binding binding = tags; binding != null; binding = binding.next) {
    1605                                     if (binding.symbol.eql(tag)) {
    1606                                         code = binding.value;
    1607                                         break;
    1608                                     }
    1609                                 }
    1610                                 if (code != null) {
    1611                                     remaining = code;
    1612                                     continue;
    1613                                 }
    1614                                 throw new Go(tag);
    1615                             }
    1616                             eval(current, ext, thread);
    1617                         }
    1618                         catch (Go go) {
    1619                             LispObject code = null;
    1620                             LispObject tag = go.getTag();
    1621                             for (Binding binding = tags; binding != null; binding = binding.next) {
    1622                                 if (binding.symbol.eql(tag)) {
    1623                                     code = binding.value;
    1624                                     break;
    1625                                 }
    1626                             }
    1627                             if (code != null) {
    1628                                 remaining = code;
    1629                                 thread.setStackDepth(depth);
    1630                                 continue;
    1631                             }
    1632                             throw go;
    1633                         }
    1634                     }
    1635                     remaining = remaining.cdr();
    1636                 }
    1637                 // Update variables.
    1638                 if (sequential) {
    1639                     for (int i = 0; i < length; i++) {
    1640                         LispObject update = updates[i];
    1641                         if (update != null)
    1642                             rebind(variables[i], eval(update, ext, thread), ext);
    1643                     }
    1644                 } else {
    1645                     // Evaluate step forms.
    1646                     LispObject results[] = new LispObject[length];
    1647                     for (int i = 0; i < length; i++) {
    1648                         LispObject update = updates[i];
    1649                         if (update != null) {
    1650                             LispObject result = eval(update, ext, thread);
    1651                             results[i] = result;
    1652                         }
    1653                     }
    1654                     // Update variables.
    1655                     for (int i = 0; i < length; i++) {
    1656                         if (results[i] != null) {
    1657                             Symbol symbol = variables[i];
    1658                             rebind(symbol, results[i], ext);
    1659                         }
    1660                     }
    1661                 }
    1662             }
    1663             LispObject result = progn(resultForms, ext, thread);
    1664             return result;
    1665         }
    1666         catch (Return ret) {
    1667             if (ret.getTag() == NIL) {
    1668                 thread.setStackDepth(depth);
    1669                 return ret.getResult();
    1670             }
    1671             throw ret;
    1672         }
    1673         finally {
    1674             thread.setDynamicEnvironment(oldDynEnv);
    1675         }
    1676     }
    1677 
    16781529    // ### dolist
    16791530    private static final SpecialOperator DOLIST = new SpecialOperator("dolist") {
Note: See TracChangeset for help on using the changeset viewer.