Changeset 4092


Ignore:
Timestamp:
09/28/03 01:16:25 (19 years ago)
Author:
piso
Message:

FLET, LABELS, PROGN

File:
1 edited

Legend:

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

    r4087 r4092  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: SpecialOperators.java,v 1.1 2003-09-28 00:44:44 piso Exp $
     5 * $Id: SpecialOperators.java,v 1.2 2003-09-28 01:16:25 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    149149    };
    150150
     151    // ### progn
     152    private static final SpecialOperator PROGN = new SpecialOperator("progn")
     153    {
     154        public LispObject execute(LispObject args, Environment env)
     155            throws ConditionThrowable
     156        {
     157            LispThread thread = LispThread.currentThread();
     158            LispObject result = NIL;
     159            while (args != NIL) {
     160                result = eval(args.car(), env, thread);
     161                args = args.cdr();
     162            }
     163            return result;
     164        }
     165    };
     166
     167    private static final SpecialOperator FLET = new SpecialOperator("flet")
     168    {
     169        public LispObject execute(LispObject args, Environment env)
     170            throws ConditionThrowable
     171        {
     172            return _flet(args, env, false);
     173        }
     174    };
     175
     176    private static final SpecialOperator LABELS = new SpecialOperator("labels")
     177    {
     178        public LispObject execute(LispObject args, Environment env)
     179            throws ConditionThrowable
     180        {
     181            return _flet(args, env, true);
     182        }
     183    };
     184
     185    private static final LispObject _flet(LispObject args, Environment env,
     186                                          boolean recursive)
     187        throws ConditionThrowable
     188    {
     189        // First argument is a list of local function definitions.
     190        LispObject defs = checkList(args.car());
     191        final LispThread thread = LispThread.currentThread();
     192        LispObject result;
     193        if (defs != NIL) {
     194            Environment oldDynEnv = thread.getDynamicEnvironment();
     195            Environment ext = new Environment(env);
     196            while (defs != NIL) {
     197                LispObject def = checkList(defs.car());
     198                Symbol symbol = checkSymbol(def.car());
     199                LispObject rest = def.cdr();
     200                LispObject parameters = rest.car();
     201                LispObject body = rest.cdr();
     202                body = new Cons(symbol, body);
     203                body = new Cons(Symbol.BLOCK, body);
     204                body = new Cons(body, NIL);
     205                Closure closure;
     206                if (recursive)
     207                    closure = new Closure(parameters, body, ext);
     208                else
     209                    closure = new Closure(parameters, body, env);
     210                closure.setLambdaName(list2(Symbol.FLET, symbol));
     211                ext.bindFunctional(symbol, closure);
     212                defs = defs.cdr();
     213            }
     214            result = progn(args.cdr(), ext, thread);
     215            thread.setDynamicEnvironment(oldDynEnv);
     216        } else
     217            result = progn(args.cdr(), env, thread);
     218        return result;
     219    }
     220
    151221    // ### symbol-macrolet
    152222    private static final SpecialOperator SYMBOL_MACROLET =
Note: See TracChangeset for help on using the changeset viewer.