Changeset 9216


Ignore:
Timestamp:
05/21/05 15:27:09 (16 years ago)
Author:
piso
Message:

GenericFunction? => StandardGenericFunction?

File:
1 edited

Legend:

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

    r9093 r9216  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: GenericFunction.java,v 1.22 2005-05-07 18:55:31 piso Exp $
     5 * $Id: GenericFunction.java,v 1.23 2005-05-21 15:27:09 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2424public final class GenericFunction extends StandardObject
    2525{
    26     private LispObject name;
    27     private LispObject lambdaList;
    28     private LispObject discriminatingFunction;
    29     private LispObject requiredArgs;
    30 
    31     public GenericFunction(LispClass cls, int length)
    32     {
    33         super(cls, length);
    34     }
    35 
    36     public LispObject typep(LispObject type) throws ConditionThrowable
    37     {
    38         if (type == Symbol.COMPILED_FUNCTION) {
    39             if (discriminatingFunction != null)
    40                 return discriminatingFunction.typep(type);
    41             else
    42                 return NIL;
    43         }
    44         return super.typep(type);
    45     }
    46 
    47     public LispObject getGenericFunctionName()
    48     {
    49         return name;
    50     }
    51 
    52     public void setGenericFunctionName(LispObject name)
    53     {
    54         this.name = name;
    55     }
    56 
    57     public LispObject execute() throws ConditionThrowable
    58     {
    59         return discriminatingFunction.execute();
    60     }
    61 
    62     public LispObject execute(LispObject arg) throws ConditionThrowable
    63     {
    64         return discriminatingFunction.execute(arg);
    65     }
    66 
    67     public LispObject execute(LispObject first, LispObject second)
    68         throws ConditionThrowable
    69     {
    70         return discriminatingFunction.execute(first, second);
    71     }
    72 
    73     public LispObject execute(LispObject first, LispObject second,
    74                               LispObject third)
    75         throws ConditionThrowable
    76     {
    77         return discriminatingFunction.execute(first, second, third);
    78     }
    79 
    80     public LispObject execute(LispObject first, LispObject second,
    81                               LispObject third, LispObject fourth)
    82         throws ConditionThrowable
    83     {
    84         return discriminatingFunction.execute(first, second, third, fourth);
    85     }
    86 
    87     public LispObject execute(LispObject first, LispObject second,
    88                               LispObject third, LispObject fourth,
    89                               LispObject fifth)
    90         throws ConditionThrowable
    91     {
    92         return discriminatingFunction.execute(first, second, third, fourth,
    93                                               fifth);
    94     }
    95 
    96     public LispObject execute(LispObject first, LispObject second,
    97                               LispObject third, LispObject fourth,
    98                               LispObject fifth, LispObject sixth)
    99         throws ConditionThrowable
    100     {
    101         return discriminatingFunction.execute(first, second, third, fourth,
    102                                               fifth, sixth);
    103     }
    104 
    105     public LispObject execute(LispObject[] args) throws ConditionThrowable
    106     {
    107         return discriminatingFunction.execute(args);
    108     }
    109 
    110     public String writeToString() throws ConditionThrowable
    111     {
    112         LispObject name = getGenericFunctionName();
    113         if (name != null) {
    114             StringBuffer sb = new StringBuffer("#<");
    115             sb.append(getLispClass().getSymbol().writeToString());
    116             sb.append(' ');
    117             sb.append(name.writeToString());
    118             sb.append('>');
    119             return sb.toString();
    120         }
    121         return super.writeToString();
    122     }
    123 
    124     // Profiling.
    125     private int callCount;
    126 
    127     public final int getCallCount()
    128     {
    129         return callCount;
    130     }
    131 
    132     public void setCallCount(int n)
    133     {
    134         callCount = n;
    135     }
    136 
    137     public final void incrementCallCount()
    138     {
    139         ++callCount;
    140     }
    141 
    142     // ### %generic-function-lambda-list
    143     private static final Primitive _GENERIC_FUNCTION_LAMBDA_LIST =
    144         new Primitive("%generic-function-lambda-list", PACKAGE_SYS, true)
    145     {
    146         public LispObject execute(LispObject arg) throws ConditionThrowable
    147         {
    148             try {
    149                 return ((GenericFunction)arg).lambdaList;
    150             }
    151             catch (ClassCastException e) {
    152                 return signal(new TypeError(arg, Symbol.GENERIC_FUNCTION));
    153             }
    154         }
    155     };
    156 
    157     // ### %set-generic-function-lambdaList
    158     private static final Primitive _SET_GENERIC_FUNCTION_LAMBDA_LIST =
    159         new Primitive("%set-generic-function-lambda-list", PACKAGE_SYS, true)
    160     {
    161         public LispObject execute(LispObject first, LispObject second)
    162             throws ConditionThrowable
    163         {
    164             try {
    165                 ((GenericFunction)first).lambdaList = second;
    166                 return second;
    167             }
    168             catch (ClassCastException e) {
    169                 return signal(new TypeError(first, Symbol.GENERIC_FUNCTION));
    170             }
    171         }
    172     };
    173 
    174     // ### %generic-function-name
    175     private static final Primitive _GENERIC_FUNCTION_NAME =
    176         new Primitive("%generic-function-name", PACKAGE_SYS, true)
    177     {
    178         public LispObject execute(LispObject arg) throws ConditionThrowable
    179         {
    180             try {
    181                 return ((GenericFunction)arg).name;
    182             }
    183             catch (ClassCastException e) {
    184                 return signal(new TypeError(arg, Symbol.GENERIC_FUNCTION));
    185             }
    186         }
    187     };
    188 
    189     // ### %set-generic-function-name
    190     private static final Primitive _SET_GENERIC_FUNCTION_NAME =
    191         new Primitive("%set-generic-function-name", PACKAGE_SYS, true)
    192     {
    193         public LispObject execute(LispObject first, LispObject second)
    194             throws ConditionThrowable
    195         {
    196             try {
    197                 ((GenericFunction)first).name = second;
    198                 return second;
    199             }
    200             catch (ClassCastException e) {
    201                 return signal(new TypeError(first, Symbol.GENERIC_FUNCTION));
    202             }
    203         }
    204     };
    205 
    206     // ### generic-function-discriminating-function
    207     private static final Primitive GENERIC_FUNCTION_DISCRIMINATING_FUNCTION =
    208         new Primitive("generic-function-discriminating-function", PACKAGE_SYS, true)
    209     {
    210         public LispObject execute(LispObject arg) throws ConditionThrowable
    211         {
    212             try {
    213                 return ((GenericFunction)arg).discriminatingFunction;
    214             }
    215             catch (ClassCastException e) {
    216                 return signal(new TypeError(arg, Symbol.GENERIC_FUNCTION));
    217             }
    218         }
    219     };
    220 
    221     // ### %set-generic-function-discriminating-function
    222     private static final Primitive _SET_GENERIC_FUNCTION_DISCRIMINATING_FUNCTION =
    223         new Primitive("%set-generic-function-discriminating-function", PACKAGE_SYS, true)
    224     {
    225         public LispObject execute(LispObject first, LispObject second)
    226             throws ConditionThrowable
    227         {
    228             try {
    229                 ((GenericFunction)first).discriminatingFunction = second;
    230                 return second;
    231             }
    232             catch (ClassCastException e) {
    233                 return signal(new TypeError(first, Symbol.GENERIC_FUNCTION));
    234             }
    235         }
    236     };
    237 
    238     // ### gf-required-args
    239     private static final Primitive GF_REQUIRED_ARGS =
    240         new Primitive("gf-required-args", PACKAGE_SYS, true)
    241     {
    242         public LispObject execute(LispObject arg) throws ConditionThrowable
    243         {
    244             try {
    245                 return ((GenericFunction)arg).requiredArgs;
    246             }
    247             catch (ClassCastException e) {
    248                 return signal(new TypeError(arg, Symbol.GENERIC_FUNCTION));
    249             }
    250         }
    251     };
    252 
    253     // ### %set-gf-required-args
    254     private static final Primitive _SET_GF_REQUIRED_ARGS =
    255         new Primitive("%set-gf-required-args", PACKAGE_SYS, true)
    256     {
    257         public LispObject execute(LispObject first, LispObject second)
    258             throws ConditionThrowable
    259         {
    260             try {
    261                 ((GenericFunction)first).requiredArgs = second;
    262                 return second;
    263             }
    264             catch (ClassCastException e) {
    265                 return signal(new TypeError(first, Symbol.GENERIC_FUNCTION));
    266             }
    267         }
    268     };
    26926}
Note: See TracChangeset for help on using the changeset viewer.