Changeset 12561


Ignore:
Timestamp:
03/18/10 11:59:59 (13 years ago)
Author:
Mark Evenson
Message:

Convert to stack-friendly primitives; add missing grovel tags.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/Java.java

    r12513 r12561  
    6161
    6262    // ### register-java-exception exception-name condition-symbol => T
    63     private static final Primitive REGISTER_JAVA_EXCEPTION =
    64         new Primitive("register-java-exception", PACKAGE_JAVA, true,
    65                       "exception-name condition-symbol")
    66     {
     63    private static final Primitive REGISTER_JAVA_EXCEPTION = new pf_register_java_exception();
     64    private static final class pf_register_java_exception extends Primitive
     65    {
     66        pf_register_java_exception()
     67        {
     68            super("register-java-exception", PACKAGE_JAVA, true,
     69                  "exception-name condition-symbol");
     70        }
     71
    6772        @Override
    6873        public LispObject execute(LispObject className, LispObject symbol)
    … …  
    8186
    8287    // ### unregister-java-exception exception-name => T or NIL
    83     private static final Primitive UNREGISTER_JAVA_EXCEPTION =
    84         new Primitive("unregister-java-exception", PACKAGE_JAVA, true,
    85                       "exception-name")
    86     {
     88    private static final Primitive UNREGISTER_JAVA_EXCEPTION = new pf_unregister_java_exception();
     89    private static final class pf_unregister_java_exception extends Primitive
     90    {
     91        pf_unregister_java_exception()
     92        {
     93            super("unregister-java-exception", PACKAGE_JAVA, true,
     94                  "exception-name");
     95        }
     96
    8797        @Override
    8898        public LispObject execute(LispObject className)
    … …  
    107117
    108118    // ### jclass name-or-class-ref => class-ref
    109     private static final Primitive JCLASS =
    110         new Primitive(Symbol.JCLASS, "name-or-class-ref",
    111 "Returns a reference to the Java class designated by NAME-OR-CLASS-REF.")
    112     {
     119    private static final Primitive JCLASS = new pf_jclass();
     120    private static final class pf_jclass extends Primitive
     121    {
     122        pf_jclass()
     123        {
     124            super(Symbol.JCLASS, "name-or-class-ref",
     125                  "Returns a reference to the Java class designated by NAME-OR-CLASS-REF.");
     126        }
     127
    113128        @Override
    114129        public LispObject execute(LispObject arg)
    … …  
    222237    }
    223238
    224     private static final Primitive JFIELD =
    225         new Primitive("jfield", PACKAGE_JAVA, true,
    226                       "class-ref-or-field field-or-instance &optional instance value")
    227     {
     239    // ### jfield class-ref-or-field field-or-instance &optional instance value
     240    private static final Primitive JFIELD = new pf_jfield();
     241    private static final class pf_jfield extends Primitive
     242    {
     243        pf_jfield()
     244        {
     245            super("jfield", PACKAGE_JAVA, true,
     246                  "class-ref-or-field field-or-instance &optional instance value");
     247        }
     248
    228249        @Override
    229250        public LispObject execute(LispObject[] args)
    … …  
    234255
    235256    // ### jfield-raw - retrieve or modify a field in a Java class or instance.
    236     private static final Primitive JFIELD_RAW =
    237         new Primitive("jfield-raw", PACKAGE_JAVA, true,
    238                       "class-ref-or-field field-or-instance &optional instance value")
    239     {
     257    private static final Primitive JFIELD_RAW = new pf_jfield_raw();
     258    private static final class pf_jfield_raw extends Primitive
     259    {
     260        pf_jfield_raw()
     261        {
     262            super("jfield-raw", PACKAGE_JAVA, true,
     263                  "class-ref-or-field field-or-instance &optional instance value");
     264        }
     265
    240266        @Override
    241267        public LispObject execute(LispObject[] args)
    … …  
    246272
    247273    // ### jconstructor class-ref &rest parameter-class-refs
    248     private static final Primitive JCONSTRUCTOR =
    249         new Primitive("jconstructor", PACKAGE_JAVA, true,
    250                       "class-ref &rest parameter-class-refs")
    251     {
     274    private static final Primitive JCONSTRUCTOR = new pf_jconstructor();
     275    private static final class pf_jconstructor extends Primitive
     276    {
     277        pf_jconstructor()
     278        {
     279            super("jconstructor", PACKAGE_JAVA, true,
     280                  "class-ref &rest parameter-class-refs");
     281        }
     282
    252283        @Override
    253284        public LispObject execute(LispObject[] args)
    … …  
    291322
    292323    // ### jmethod class-ref name &rest parameter-class-refs
    293     private static final Primitive JMETHOD =
    294         new Primitive("jmethod", PACKAGE_JAVA, true,
    295                       "class-ref name &rest parameter-class-refs")
    296     {
     324    private static final Primitive JMETHOD = new pf_jmethod();
     325    private static final class pf_jmethod extends Primitive
     326    {
     327        pf_jmethod()
     328        {
     329            super("jmethod", PACKAGE_JAVA, true,
     330                  "class-ref name &rest parameter-class-refs");
     331        }
     332
    297333        @Override
    298334        public LispObject execute(LispObject[] args)
    … …  
    414450
    415451    // ### jstatic method class &rest args
    416     private static final Primitive JSTATIC =
    417         new Primitive("jstatic", PACKAGE_JAVA, true, "method class &rest args")
    418     {
     452    private static final Primitive JSTATIC = new pf_jstatic();
     453    private static final class pf_jstatic extends Primitive
     454    {
     455        pf_jstatic()
     456        {
     457            super("jstatic", PACKAGE_JAVA, true, "method class &rest args");
     458        }
     459
    419460        @Override
    420461        public LispObject execute(LispObject[] args)
    … …  
    425466
    426467    // ### jstatic-raw method class &rest args
    427     private static final Primitive JSTATIC_RAW =
    428         new Primitive("jstatic-raw", PACKAGE_JAVA, true,
    429                       "method class &rest args")
    430     {
     468    private static final Primitive JSTATIC_RAW = new pf_jstatic_raw();
     469    private static final class pf_jstatic_raw extends Primitive
     470    {
     471        pf_jstatic_raw()
     472        {
     473            super("jstatic-raw", PACKAGE_JAVA, true,
     474                  "method class &rest args");
     475        }
     476
    431477        @Override
    432478        public LispObject execute(LispObject[] args)
    … …  
    437483
    438484    // ### jnew constructor &rest args
    439     private static final Primitive JNEW =
    440         new Primitive("jnew", PACKAGE_JAVA, true, "constructor &rest args")
    441     {
     485    private static final Primitive JNEW = new pf_jnew();
     486    private static final class pf_jnew extends Primitive
     487    {
     488        pf_jnew()
     489        {
     490            super("jnew", PACKAGE_JAVA, true, "constructor &rest args");
     491        }
     492
    442493        @Override
    443494        public LispObject execute(LispObject[] args)
    … …  
    488539
    489540    // ### jnew-array element-type &rest dimensions
    490     private static final Primitive JNEW_ARRAY =
    491         new Primitive("jnew-array", PACKAGE_JAVA, true,
    492                       "element-type &rest dimensions")
    493     {
     541    private static final Primitive JNEW_ARRAY = new pf_jnew_array();
     542    private static final class pf_jnew_array extends Primitive
     543    {
     544        pf_jnew_array()
     545        {
     546            super("jnew-array", PACKAGE_JAVA, true,
     547                  "element-type &rest dimensions");
     548        }
     549
    494550        @Override
    495551        public LispObject execute(LispObject[] args)
    … …  
    541597
    542598    // ### jarray-ref java-array &rest indices
    543     private static final Primitive JARRAY_REF =
    544         new Primitive("jarray-ref", PACKAGE_JAVA, true,
    545                       "java-array &rest indices")
    546     {
     599    private static final Primitive JARRAY_REF = new pf_jarray_ref();
     600    private static final class pf_jarray_ref extends Primitive
     601    {
     602        pf_jarray_ref()
     603        {
     604            super("jarray-ref", PACKAGE_JAVA, true,
     605                  "java-array &rest indices");
     606        }
     607
    547608        @Override
    548609        public LispObject execute(LispObject[] args)
    … …  
    553614
    554615    // ### jarray-ref-raw java-array &rest indices
    555     private static final Primitive JARRAY_REF_RAW =
    556         new Primitive("jarray-ref-raw", PACKAGE_JAVA, true,
    557                       "java-array &rest indices")
    558     {
     616    private static final Primitive JARRAY_REF_RAW = new pf_jarray_ref_raw();
     617    private static final class pf_jarray_ref_raw extends Primitive
     618    {
     619        pf_jarray_ref_raw()
     620        {
     621            super("jarray-ref-raw", PACKAGE_JAVA, true,
     622                  "java-array &rest indices");
     623        }
     624
    559625        @Override
    560626        public LispObject execute(LispObject[] args)
    … …  
    565631
    566632    // ### jarray-set java-array new-value &rest indices
    567     private static final Primitive JARRAY_SET =
    568         new Primitive("jarray-set", PACKAGE_JAVA, true,
    569                       "java-array new-value &rest indices")
    570     {
     633    private static final Primitive JARRAY_SET = new pf_jarray_set();
     634    private static final class pf_jarray_set extends Primitive
     635    {
     636        pf_jarray_set()
     637        {
     638            super("jarray-set", PACKAGE_JAVA, true,
     639                  "java-array new-value &rest indices");
     640        }
     641
    571642        @Override
    572643        public LispObject execute(LispObject[] args)
    … …  
    600671
    601672    // ### jcall method instance &rest args
    602     // Calls makeLispObject() to convert the result to an appropriate Lisp type.
    603     private static final Primitive JCALL =
    604         new Primitive(Symbol.JCALL, "method-ref instance &rest args")
    605     {
     673    /**  Calls makeLispObject() to convert the result to an appropriate Lisp type. */
     674    private static final Primitive JCALL = new pf_jcall();
     675    private static final class pf_jcall extends Primitive
     676    {
     677        pf_jcall()
     678        {
     679            super(Symbol.JCALL, "method-ref instance &rest args");
     680        }
     681
    606682        @Override
    607683        public LispObject execute(LispObject[] args)
    … …  
    612688
    613689    // ### jcall-raw method instance &rest args
    614     // Does no type conversion. The result of the call is simply wrapped in a
    615     // JavaObject.
    616     private static final Primitive JCALL_RAW =
    617         new Primitive(Symbol.JCALL_RAW, "method-ref instance &rest args")
    618     {
     690    /**
     691     * Does no type conversion. The result of the call is simply wrapped in a
     692     *   JavaObject.
     693     */
     694    private static final Primitive JCALL_RAW = new pf_jcall_raw();
     695    private static final class pf_jcall_raw extends Primitive
     696    {
     697        pf_jcall_raw()
     698        {
     699            super(Symbol.JCALL_RAW, "method-ref instance &rest args");
     700        }
     701
    619702        @Override
    620703        public LispObject execute(LispObject[] args)
    … …  
    873956
    874957    // ### make-immediate-object object &optional type
    875     private static final Primitive MAKE_IMMEDIATE_OBJECT =
    876         new Primitive("make-immediate-object", PACKAGE_JAVA, true,
    877                       "object &optional type")
    878     {
     958    private static final Primitive MAKE_IMMEDIATE_OBJECT = new pf_make_immediate_object();
     959    private static final class pf_make_immediate_object extends Primitive
     960    {
     961        pf_make_immediate_object()
     962        {
     963            super("make-immediate-object", PACKAGE_JAVA, true,
     964                  "object &optional type");
     965        }
     966
    879967        @Override
    880968        public LispObject execute(LispObject[] args)
    … …  
    904992
    905993    // ### java-object-p
    906     private static final Primitive JAVA_OBJECT_P =
    907         new Primitive("java-object-p", PACKAGE_JAVA, true, "object")
    908     {
     994    private static final Primitive JAVA_OBJECT_P = new pf_java_object_p();
     995    private static final class pf_java_object_p extends Primitive
     996    {
     997        pf_java_object_p()
     998        {
     999            super("java-object-p", PACKAGE_JAVA, true, "object");
     1000        }
     1001
    9091002        @Override
    9101003        public LispObject execute(LispObject arg)
    … …  
    9151008
    9161009    // ### jobject-lisp-value java-object
    917     private static final Primitive JOBJECT_LISP_VALUE =
    918         new Primitive("jobject-lisp-value", PACKAGE_JAVA, true, "java-object")
    919     {
     1010    private static final Primitive JOBJECT_LISP_VALUE = new pf_jobject_lisp_value();
     1011    private static final class pf_jobject_lisp_value extends Primitive
     1012    {
     1013        pf_jobject_lisp_value()
     1014        {
     1015            super("jobject-lisp-value", PACKAGE_JAVA, true, "java-object");
     1016        }
     1017
    9201018        @Override
    9211019        public LispObject execute(LispObject arg)
    … …  
    9261024
    9271025    // ### jcoerce java-object intended-class
    928     private static final Primitive JCOERCE =
    929         new Primitive("jcoerce", PACKAGE_JAVA, true, "java-object intended-class")
    930     {
     1026    private static final Primitive JCOERCE = new pf_jcoerce();
     1027    private static final class pf_jcoerce extends Primitive
     1028    {
     1029        pf_jcoerce()
     1030        {
     1031            super("jcoerce", PACKAGE_JAVA, true, "java-object intended-class");
     1032        }
     1033
    9311034        @Override
    9321035        public LispObject execute(LispObject javaObject, LispObject intendedClass)
    … …  
    9411044        }
    9421045    };
    943    
    944     private static final Primitive JGET_PROPERTY_VALUE =
    945       new Primitive("%jget-property-value", PACKAGE_JAVA, true,
    946                     "java-object property-name") {
     1046
     1047    // ### %jget-property-value java-object property-name
     1048    private static final Primitive JGET_PROPERTY_VALUE = new pf__jget_property_value();
     1049    private static final class pf__jget_property_value extends Primitive
     1050    {
     1051        pf__jget_property_value()
     1052        {
     1053      super("%jget-property-value", PACKAGE_JAVA, true,
     1054                  "java-object property-name");
     1055        }
    9471056     
    9481057        @Override
    … …  
    9651074    };
    9661075   
    967     private static final Primitive JSET_PROPERTY_VALUE =
    968       new Primitive("%jset-property-value", PACKAGE_JAVA, true,
    969                     "java-object property-name value") {
     1076    // ### %jset-property-value java-object property-name value
     1077    private static final Primitive JSET_PROPERTY_VALUE = new pf__jset_property_value();
     1078    private static final class pf__jset_property_value extends Primitive
     1079    {
     1080        pf__jset_property_value()
     1081        {
     1082      super("%jset-property-value", PACKAGE_JAVA, true,
     1083                  "java-object property-name value");
     1084        }
    9701085     
    9711086        @Override
    … …  
    9961111
    9971112
    998     private static final Primitive JRUN_EXCEPTION_PROTECTED =
    999         new Primitive("jrun-exception-protected", PACKAGE_JAVA, true,
    1000                       "closure") {
    1001 
    1002       @Override
    1003       public LispObject execute(LispObject closure) {
    1004           Function fun = checkFunction(closure);
    1005 
    1006           try {
    1007               return LispThread.currentThread().execute(closure);
    1008           }
    1009           catch (OutOfMemoryError oom) {
    1010               return error(new StorageCondition("Out of memory."));
    1011           }
    1012           catch (StackOverflowError oos) {
    1013               return error(new StorageCondition("Stack overflow."));
    1014           }
    1015       }
     1113    // ### jrun-exception-protected closure
     1114    private static final Primitive JRUN_EXCEPTION_PROTECTED = new pf_jrun_exception_protection();
     1115    private static final class pf_jrun_exception_protection extends Primitive
     1116    {
     1117        pf_jrun_exception_protection()
     1118        {
     1119            super("jrun-exception-protected", PACKAGE_JAVA, true,
     1120                  "closure");
     1121        }
     1122
     1123        @Override
     1124        public LispObject execute(LispObject closure) {
     1125            Function fun = checkFunction(closure);
     1126
     1127            try {
     1128                return LispThread.currentThread().execute(closure);
     1129            }
     1130            catch (OutOfMemoryError oom) {
     1131                return error(new StorageCondition("Out of memory."));
     1132            }
     1133            catch (StackOverflowError oos) {
     1134                return error(new StorageCondition("Stack overflow."));
     1135            }
     1136        }
    10161137    };
    10171138
Note: See TracChangeset for help on using the changeset viewer.