Changeset 8770


Ignore:
Timestamp:
03/14/05 17:50:28 (16 years ago)
Author:
piso
Message:

SYS:MAKE-EXPANDER-FOR-MACROLET

File:
1 edited

Legend:

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

    r8660 r8770  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves
    5  * $Id: Primitives.java,v 1.740 2005-02-28 02:50:03 piso Exp $
     5 * $Id: Primitives.java,v 1.741 2005-03-14 17:50:28 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3939            if (arg.numberp())
    4040                return arg;
    41             signal(new TypeError(arg, "number"));
     41            signal(new TypeError(arg, Symbol.NUMBER));
    4242            return NIL;
    4343        }
     
    788788                remprop(checkSymbol(arg.cadr()), Symbol._SETF_FUNCTION);
    789789            } else
    790                 signal(new TypeError(arg, "valid function name"));
     790                signal(new TypeError("The value " + arg.writeToString() +
     791                                     " is not a valid function name."));
    791792            return arg;
    792793        }
     
    14291430                    return NIL;
    14301431                }
    1431                 signal(new TypeError(destination, "character output stream"));
     1432                signal(new TypeError("The value " +
     1433                                     destination.writeToString() +
     1434                                     " is not a character output stream."));
    14321435            }
    14331436            if (destination instanceof Stream) {
     
    15151518                symbol = checkSymbol(first.cadr());
    15161519            } else
    1517                 return signal(new TypeError(first.writeToString() +
     1520                return signal(new TypeError("The value " +
     1521                                            first.writeToString() +
    15181522                                            " is not a valid function name."));
    15191523            LispObject arglist = checkList(second);
     
    16281632                symbol.setVariableDocumentation(third);
    16291633            else if (third != NIL)
    1630                 signal(new TypeError(third, "string"));
     1634                signal(new TypeError(third, Symbol.STRING));
    16311635            symbol.setSymbolValue(second);
    16321636            symbol.setSpecial(true);
     
    19291933                    return NIL;
    19301934                } else
    1931                     signal(new TypeError(arg, "integer"));
     1935                    signal(new TypeError(arg, Symbol.INTEGER));
    19321936            }
    19331937            return T;
     
    20512055            }
    20522056            catch (ClassCastException e) {
    2053                 return signal(new TypeError(first + " is not an array of rank 0."));
     2057                return signal(new TypeError("The value " +
     2058                                            first.writeToString() +
     2059                                            " is not an array of rank 0."));
    20542060            }
    20552061            array.setRowMajor(0, second);
     
    25112517            return result;
    25122518        }
    2513         public LispObject execute(final LispObject[] args) throws ConditionThrowable
     2519        public LispObject execute(final LispObject[] args)
     2520            throws ConditionThrowable
    25142521        {
    25152522            final int numArgs = args.length;
     
    25192526            for (int i = 1; i < numArgs; i++) {
    25202527                if (!args[i].listp())
    2521                     signal(new TypeError(args[i], "list"));
     2528                    signal(new TypeError(args[i], Symbol.LIST));
    25222529                int len = args[i].length();
    25232530                if (commonLength < 0)
     
    29742981                put(symbol, Symbol._SETF_FUNCTION, second);
    29752982            } else
    2976                 return signal(new TypeError(first.writeToString() +
     2983                return signal(new TypeError("The value " +
     2984                                            first.writeToString() +
    29772985                                            " is not a valid function name."));
    29782986            if (second instanceof Functional) {
     
    30793087                    LispObject def = checkList(defs.car());
    30803088                    Symbol symbol = checkSymbol(def.car());
    3081                     LispObject lambdaList = def.cadr();
    3082                     LispObject body = def.cddr();
    3083                     LispObject block =
    3084                         new Cons(Symbol.BLOCK, new Cons(symbol, body));
    3085                     LispObject toBeApplied =
    3086                         list3(Symbol.LAMBDA, lambdaList, block);
    3087                     LispObject formArg = gensym("FORM-");
    3088                     LispObject envArg = gensym("ENV-"); // Ignored.
     3089                    Symbol make_expander_for_macrolet =
     3090                        PACKAGE_SYS.intern("MAKE-EXPANDER-FOR-MACROLET");
    30893091                    LispObject expander =
    3090                         list3(Symbol.LAMBDA, list2(formArg, envArg),
    3091                               list3(Symbol.APPLY, toBeApplied,
    3092                                     list2(Symbol.CDR, formArg)));
     3092                        make_expander_for_macrolet.execute(def);
    30933093                    Closure expansionFunction =
    30943094                        new Closure(expander.cadr(), expander.cddr(), env);
     
    31023102                result = progn(args.cdr(), env, thread);
    31033103            return result;
     3104        }
     3105    };
     3106
     3107    private static final Primitive MAKE_EXPANDER_FOR_MACROLET =
     3108        new Primitive("make-expander-for-macrolet", PACKAGE_SYS, true,
     3109                      "definition")
     3110    {
     3111        public LispObject execute(LispObject definition)
     3112            throws ConditionThrowable
     3113        {
     3114            Symbol symbol = checkSymbol(definition.car());
     3115            LispObject lambdaList = definition.cadr();
     3116            LispObject body = definition.cddr();
     3117            LispObject block =
     3118                new Cons(Symbol.BLOCK, new Cons(symbol, body));
     3119            LispObject toBeApplied =
     3120                list3(Symbol.LAMBDA, lambdaList, block);
     3121            LispObject formArg = gensym("WHOLE-");
     3122            LispObject envArg = gensym("ENVIRONMENT-"); // Ignored.
     3123            LispObject expander =
     3124                list3(Symbol.LAMBDA, list2(formArg, envArg),
     3125                      list3(Symbol.APPLY, toBeApplied,
     3126                            list2(Symbol.CDR, formArg)));
     3127            return expander;
    31043128        }
    31053129    };
     
    36293653        }
    36303654        if (out == null)
    3631             signal(new TypeError(arg, "output stream"));
     3655            signal(new TypeError("The value " + arg.writeToString() +
     3656                                 " is not an output stream."));
    36323657        return out.finishOutput();
    36333658    }
     
    42574282
    42584283    // ### reverse
    4259     private static final Primitive REVERSE = new Primitive("reverse", "sequence")
     4284    private static final Primitive REVERSE =
     4285        new Primitive("reverse", "sequence")
    42604286    {
    42614287        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    42734299            if (arg == NIL)
    42744300                return NIL;
    4275             signal(new TypeError(arg, "proper sequence"));
    4276             return NIL;
     4301            return signal(new TypeError(arg.writeToString() +
     4302                                        " is not a proper sequence."));
    42774303        }
    42784304    };
     
    43084334                }
    43094335            }
    4310             signal(new TypeError(first, Symbol.SEQUENCE));
    4311             return NIL;
     4336            return signal(new TypeError(first, Symbol.SEQUENCE));
    43124337        }
    43134338    };
     
    43504375            int size = Fixnum.getValue(first);
    43514376            if (size < 0)
    4352                 signal(new TypeError(String.valueOf(size) +
     4377                signal(new TypeError("The value " + first.writeToString() +
    43534378                                     " is not a valid list length."));
    43544379            LispObject result = NIL;
     
    44574482                return new Closure(first.cadr(), first.cddr(), env);
    44584483            }
    4459             return signal(new TypeError("Argument to MAKE-CLOSURE is not a lambda form."));
     4484            return signal(new TypeError("The argument to MAKE-CLOSURE is not a lambda form."));
    44604485        }
    44614486    };
     
    45244549
    45254550    // ### complex
    4526     private static final Primitive COMPLEX = new Primitive("complex","realpart &optional imagpart") {
     4551    private static final Primitive COMPLEX =
     4552        new Primitive("complex", "realpart &optional imagpart")
     4553    {
    45274554        public LispObject execute(LispObject arg) throws ConditionThrowable
    45284555        {
     
    45314558            if (arg.realp())
    45324559                return arg;
    4533             signal(new TypeError(arg, "real number"));
     4560            signal(new TypeError(arg, Symbol.REAL));
    45344561            return NIL;
    45354562        }
     
    45424569
    45434570    // ### complexp
    4544     private static final Primitive COMPLEXP = new Primitive("complexp","object") {
     4571    private static final Primitive COMPLEXP =
     4572        new Primitive("complexp", "object")
     4573    {
    45454574        public LispObject execute(LispObject arg)
    45464575        {
     
    45504579
    45514580    // ### numerator
    4552     private static final Primitive NUMERATOR = new Primitive("numerator","rational") {
     4581    private static final Primitive NUMERATOR =
     4582        new Primitive("numerator", "rational")
     4583    {
    45534584        public LispObject execute(LispObject arg) throws ConditionThrowable
    45544585        {
     
    45584589
    45594590    // ### denominator
    4560     private static final Primitive DENOMINATOR = new Primitive("denominator","rational")
     4591    private static final Primitive DENOMINATOR =
     4592        new Primitive("denominator", "rational")
    45614593    {
    45624594        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    45674599
    45684600    // ### realpart
    4569     private static final Primitive REALPART = new Primitive("realpart","number")
     4601    private static final Primitive REALPART =
     4602        new Primitive("realpart", "number")
    45704603    {
    45714604        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    45754608            if (arg.numberp())
    45764609                return arg;
    4577             signal(new TypeError(arg, "number"));
     4610            signal(new TypeError(arg, Symbol.NUMBER));
    45784611            return NIL;
    45794612        }
     
    45814614
    45824615    // ### imagpart
    4583     private static final Primitive IMAGPART = new Primitive("imagpart", "number")
     4616    private static final Primitive IMAGPART =
     4617        new Primitive("imagpart", "number")
    45844618    {
    45854619        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    46104644            if (arg instanceof Bignum)
    46114645                return new Fixnum(((Bignum)arg).value.bitLength());
    4612             return signal(new TypeError(arg, "integer"));
     4646            return signal(new TypeError(arg, Symbol.INTEGER));
    46134647        }
    46144648    };
     
    46274661                n1 = ((Bignum)first).getValue();
    46284662            else {
    4629                 signal(new TypeError(first, "integer"));
     4663                signal(new TypeError(first, Symbol.INTEGER));
    46304664                return NIL;
    46314665            }
     
    46354669                n2 = ((Bignum)second).getValue();
    46364670            else {
    4637                 signal(new TypeError(second, "integer"));
     4671                signal(new TypeError(second, Symbol.INTEGER));
    46384672                return NIL;
    46394673            }
Note: See TracChangeset for help on using the changeset viewer.