Changeset 9227


Ignore:
Timestamp:
05/22/05 13:22:19 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

Location:
trunk/j/src/org/armedbear/lisp
Files:
3 edited

Legend:

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

    r9220 r9227  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: Autoload.java,v 1.229 2005-05-21 15:43:50 piso Exp $
     5 * $Id: Autoload.java,v 1.230 2005-05-22 13:22:19 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    462462        autoload(PACKAGE_JAVA, "%jregister-handler", "JHandler");
    463463        autoload(PACKAGE_JAVA, "%load-java-class-from-byte-array", "RuntimeClass");
     464        autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);
     465        autoload(PACKAGE_MOP, "method-qualifiers", "StandardMethod", true);
     466        autoload(PACKAGE_MOP, "method-specializers", "StandardMethod", true);
    464467        autoload(PACKAGE_PROF, "%start-profiler", "Profiler", true);
    465468        autoload(PACKAGE_PROF, "stop-profiler", "Profiler", true);
     
    573576        autoload(PACKAGE_SYS, "method-documentation", "StandardMethod", true);
    574577        autoload(PACKAGE_SYS, "method-lambda-list", "StandardMethod", true);
    575         autoload(PACKAGE_SYS, "method-qualifiers", "StandardMethod", true);
    576578        autoload(PACKAGE_SYS, "psxhash", "HashTableFunctions");
    577579        autoload(PACKAGE_SYS, "puthash", "HashTableFunctions");
  • trunk/j/src/org/armedbear/lisp/StandardGenericFunction.java

    r9219 r9227  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: StandardGenericFunction.java,v 1.1 2005-05-21 15:38:41 piso Exp $
     5 * $Id: StandardGenericFunction.java,v 1.2 2005-05-22 13:22:00 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3030    }
    3131
     32    public StandardGenericFunction(String name, Package pkg, boolean exported,
     33                                   Function function, LispObject lambdaList,
     34                                   LispObject specializers)
     35    {
     36        this();
     37        try {
     38            Symbol symbol;
     39            if (exported)
     40                symbol = pkg.internAndExport(name.toUpperCase());
     41            else
     42                symbol = pkg.intern(name.toUpperCase());
     43            symbol.setSymbolFunction(this);
     44            slots[StandardGenericFunctionClass.SLOT_INDEX_NAME] = symbol;
     45            slots[StandardGenericFunctionClass.SLOT_INDEX_LAMBDA_LIST] =
     46                lambdaList;
     47            slots[StandardGenericFunctionClass.SLOT_INDEX_DISCRIMINATING_FUNCTION] =
     48                function;
     49            slots[StandardGenericFunctionClass.SLOT_INDEX_REQUIRED_ARGS] =
     50                lambdaList;
     51            slots[StandardGenericFunctionClass.SLOT_INDEX_INITIAL_METHODS] =
     52                NIL;
     53            StandardMethod method =
     54                new StandardMethod(this, function, lambdaList, specializers);
     55            slots[StandardGenericFunctionClass.SLOT_INDEX_METHODS] = list1(method);
     56            slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_CLASS] =
     57                BuiltInClass.STANDARD_METHOD;
     58            slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_COMBINATION] =
     59                Symbol.STANDARD;
     60            slots[StandardGenericFunctionClass.SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER] =
     61                NIL;
     62            slots[StandardGenericFunctionClass.SLOT_INDEX_CLASSES_TO_EMF_TABLE] =
     63                new EqualHashTable(11, NIL, NIL);
     64            slots[StandardGenericFunctionClass.SLOT_INDEX_DOCUMENTATION] = NIL;
     65        }
     66        catch (ConditionThrowable t) {
     67            Debug.assertTrue(false);
     68        }
     69    }
     70
    3271    public LispObject typep(LispObject type) throws ConditionThrowable
    3372    {
     
    5392    }
    5493
     94    public void setDiscriminatingFunction(LispObject function)
     95    {
     96        slots[StandardGenericFunctionClass.SLOT_INDEX_DISCRIMINATING_FUNCTION] = function;
     97    }
     98
    5599    public LispObject execute() throws ConditionThrowable
    56100    {
     
    126170        LispObject name = getGenericFunctionName();
    127171        if (name != null) {
    128             StringBuffer sb = new StringBuffer("#<");
     172            StringBuffer sb = new StringBuffer();
    129173            sb.append(getLispClass().getSymbol().writeToString());
    130174            sb.append(' ');
    131175            sb.append(name.writeToString());
    132             sb.append('>');
    133             return sb.toString();
     176            return unreadableString(sb.toString());
    134177        }
    135178        return super.writeToString();
     
    154197    }
    155198
    156     // MOP (p. 216) specifies the following reader generic functions:
     199    // MOP (p. 216) specifies the following readers as generic functions:
    157200    //   generic-function-argument-precedence-order
    158201    //   generic-function-declarations
     
    164207
    165208    // ### %generic-function-name
    166     private static final Primitive _GENERIC_FUNCTION_NAME =
     209    public static final Primitive _GENERIC_FUNCTION_NAME =
    167210        new Primitive("%generic-function-name", PACKAGE_SYS, true)
    168211    {
     
    514557        }
    515558    };
     559
     560    private static final StandardGenericFunction GENERIC_FUNCTION_NAME =
     561        new StandardGenericFunction("generic-function-name",
     562                                    PACKAGE_MOP,
     563                                    true,
     564                                    _GENERIC_FUNCTION_NAME,
     565                                    list1(Symbol.GENERIC_FUNCTION),
     566                                    list1(BuiltInClass.STANDARD_GENERIC_FUNCTION));
    516567}
  • trunk/j/src/org/armedbear/lisp/StandardMethod.java

    r9225 r9227  
    33 *
    44 * Copyright (C) 2005 Peter Graves
    5  * $Id: StandardMethod.java,v 1.2 2005-05-21 15:53:31 piso Exp $
     5 * $Id: StandardMethod.java,v 1.3 2005-05-22 13:20:37 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3030    }
    3131
     32    public StandardMethod(StandardGenericFunction gf,
     33                          Function fastFunction,
     34                          LispObject lambdaList,
     35                          LispObject specializers)
     36    {
     37        this();
     38        slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION] = gf;
     39        slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = lambdaList;
     40        slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS] = specializers;
     41        slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS] = NIL;
     42        slots[StandardMethodClass.SLOT_INDEX_FUNCTION] = NIL;
     43        slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION] = fastFunction;
     44        slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION] = NIL;
     45    }
     46
    3247    // ### method-lambda-list
    3348    // generic function
     
    6580
    6681    // ### method-qualifiers
    67     private static final Primitive METHOD_QUALIFIERS =
    68         new Primitive("method-qualifiers", PACKAGE_SYS, true, "method")
     82    private static final Primitive _METHOD_QUALIFIERS =
     83        new Primitive("%method-qualifiers", PACKAGE_SYS, true, "method")
    6984    {
    7085        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    299314        }
    300315    };
     316
     317    private static final StandardGenericFunction METHOD_SPECIALIZERS =
     318        new StandardGenericFunction("method-specializers",
     319                                    PACKAGE_MOP,
     320                                    true,
     321                                    _METHOD_SPECIALIZERS,
     322                                    list1(Symbol.METHOD),
     323                                    list1(BuiltInClass.STANDARD_METHOD));
     324
     325    private static final StandardGenericFunction METHOD_QUALIFIERS =
     326        new StandardGenericFunction("method-qualifiers",
     327                                    PACKAGE_MOP,
     328                                    true,
     329                                    _METHOD_QUALIFIERS,
     330                                    list1(Symbol.METHOD),
     331                                    list1(BuiltInClass.STANDARD_METHOD));
     332
    301333}
Note: See TracChangeset for help on using the changeset viewer.