Changeset 5133


Ignore:
Timestamp:
12/14/03 17:18:22 (18 years ago)
Author:
piso
Message:

HANDLER-BIND, HANDLER-CASE, TAGBODY, GO

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/Primitives.java

    r5121 r5133  
    33 *
    44 * Copyright (C) 2002-2003 Peter Graves
    5  * $Id: Primitives.java,v 1.530 2003-12-13 20:52:36 piso Exp $
     5 * $Id: Primitives.java,v 1.531 2003-12-14 17:18:22 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    16501650    };
    16511651
    1652     // ### handler-bind
    1653     private static final SpecialOperator HANDLER_BIND =
    1654         new SpecialOperator("handler-bind")
    1655     {
    1656         public LispObject execute(LispObject args, Environment env)
    1657             throws ConditionThrowable
    1658         {
    1659             LispObject bindings = checkList(args.car());
    1660             final LispThread thread = LispThread.currentThread();
    1661             LispObject forms = args.cdr();
    1662             try {
    1663                 return progn(args.cdr(), env, thread);
    1664             }
    1665             catch (Return ret) {
    1666                 throw ret;
    1667             }
    1668             catch (ConditionThrowable throwable) {
    1669                 if (throwable instanceof Throw) {
    1670                     LispObject tag = ((Throw)throwable).getTag();
    1671                     if (thread.isValidCatchTag(tag))
    1672                         throw throwable;
    1673                 }
    1674                 LispObject condition = throwable.getCondition();
    1675                 while (bindings != NIL) {
    1676                     Cons binding = checkCons(bindings.car());
    1677                     LispObject type = binding.car();
    1678                     if (condition.typep(type) != NIL) {
    1679                         LispObject obj = eval(binding.cadr(), env, thread);
    1680                         LispObject handler;
    1681                         if (obj instanceof Symbol) {
    1682                             handler = obj.getSymbolFunction();
    1683                             if (handler == null)
    1684                                 signal(new UndefinedFunction(obj));
    1685                         } else
    1686                             handler = obj;
    1687                         LispObject[] handlerArgs = new LispObject[1];
    1688                         handlerArgs[0] = condition;
    1689                         // Might not return.
    1690                         funcall(handler, handlerArgs, thread);
    1691                     }
    1692                     bindings = bindings.cdr();
    1693                 }
    1694                 // Re-throw.
    1695                 throw throwable;
    1696             }
    1697         }
    1698     };
    1699 
    1700     // ### handler-case
    1701     // Should be a macro.
    1702     private static final SpecialOperator HANDLER_CASE =
    1703         new SpecialOperator("handler-case")
    1704     {
    1705         public LispObject execute(LispObject args, Environment env)
    1706             throws ConditionThrowable
    1707         {
    1708             LispObject form = args.car();
    1709             LispObject clauses = args.cdr();
    1710             final LispThread thread = LispThread.currentThread();
    1711             final int depth = thread.getStackDepth();
    1712             LispObject result;
    1713             try {
    1714                 result = eval(form, env, thread);
    1715             }
    1716             catch (Return ret) {
    1717                 throw ret;
    1718             }
    1719             catch (ConditionThrowable throwable) {
    1720                 if (throwable instanceof Throw) {
    1721                     LispObject tag = ((Throw)throwable).getTag();
    1722                     if (thread.isValidCatchTag(tag))
    1723                         throw throwable;
    1724                 }
    1725                 LispObject condition = throwable.getCondition();
    1726                 thread.setStackDepth(depth);
    1727                 while (clauses != NIL) {
    1728                     Cons clause = checkCons(clauses.car());
    1729                     LispObject type = clause.car();
    1730                     if (condition.typep(type) != NIL) {
    1731                         LispObject parameterList = clause.cadr();
    1732                         LispObject body = clause.cdr().cdr();
    1733                         Closure handler = new Closure(parameterList, body, env);
    1734                         int numArgs = parameterList.length();
    1735                         if (numArgs == 1) {
    1736                             LispObject[] handlerArgs = new LispObject[1];
    1737                             handlerArgs[0] = condition;
    1738                             return funcall(handler, handlerArgs, thread);
    1739                         }
    1740                         if (numArgs == 0) {
    1741                             LispObject[] handlerArgs = new LispObject[0];
    1742                             return funcall(handler, handlerArgs, thread);
    1743                         }
    1744                         signal(new LispError("HANDLER-CASE: invalid handler clause"));
    1745                     }
    1746                     clauses = clauses.cdr();
    1747                 }
    1748                 // Re-throw.
    1749                 throw throwable;
    1750             }
    1751             // No error.
    1752             while (clauses != NIL) {
    1753                 Cons clause = checkCons(clauses.car());
    1754                 if (clause.car() == Keyword.NO_ERROR) {
    1755                     Closure closure = new Closure(clause.cadr(), clause.cddr(),
    1756                                                   env);
    1757                     if (thread.getValues() != null)
    1758                         result = closure.execute(thread.getValues());
    1759                     else
    1760                         result = closure.execute(result);
    1761                     break;
    1762                 }
    1763                 clauses = clauses.cdr();
    1764             }
    1765             return result;
    1766         }
    1767     };
    1768 
    17691652    // ### upgraded-array-element-type
    17701653    // upgraded-array-element-type typespec &optional environment
     
    29322815            throws ConditionThrowable
    29332816        {
    2934             Binding tags = null;
     2817            Environment ext = new Environment(env);
    29352818            LispObject body = args;
    29362819            while (body != NIL) {
     
    29402823                    continue;
    29412824                // It's a tag.
    2942                 tags = new Binding(current, body, tags);
     2825                ext.addTagBinding(current, body);
    29432826            }
    29442827            final LispThread thread = LispThread.currentThread();
     
    29512834                        // Handle GO inline if possible.
    29522835                        if (current.car() == Symbol.GO) {
    2953                             LispObject code = null;
    29542836                            LispObject tag = current.cadr();
    2955                             for (Binding binding = tags; binding != null; binding = binding.next) {
    2956                                 if (binding.symbol.eql(tag)) {
    2957                                     code = binding.value;
    2958                                     break;
    2959                                 }
    2960                             }
    2961                             if (code != null) {
    2962                                 remaining = code;
     2837                            Binding binding = ext.getTagBinding(tag);
     2838                            if (binding != null && binding.value != null) {
     2839                                remaining = binding.value;
    29632840                                continue;
    29642841                            }
    29652842                            throw new Go(tag);
    29662843                        }
    2967                         eval(current, env, thread);
     2844                        eval(current, ext, thread);
    29682845                    }
    29692846                    catch (Go go) {
    2970                         LispObject code = null;
    29712847                        LispObject tag = go.getTag();
    2972                         for (Binding binding = tags; binding != null; binding = binding.next) {
    2973                             if (binding.symbol.eql(tag)) {
    2974                                 code = binding.value;
    2975                                 break;
    2976                             }
    2977                         }
    2978                         if (code != null) {
    2979                             remaining = code;
     2848                        Binding binding = ext.getTagBinding(tag);
     2849                        if (binding != null && binding.value != null) {
     2850                            remaining = binding.value;
    29802851                            thread.setStackDepth(depth);
    29812852                            continue;
     
    29992870            if (args.length() != 1)
    30002871                signal(new WrongNumberOfArgumentsException(this));
     2872            Binding binding = env.getTagBinding(args.car());
     2873            if (binding == null)
     2874                return signal(new ControlError("no tag named " + args.car() +
     2875                                               " is currently visible"));
    30012876            throw new Go(args.car());
    30022877        }
Note: See TracChangeset for help on using the changeset viewer.