Changeset 12440


Ignore:
Timestamp:
02/10/10 16:14:22 (12 years ago)
Author:
Mark Evenson
Message:

Documentation updates and conversion to stack trace friendly Primitive declarations.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Extensions.java

    r12290 r12440  
    4747
    4848  // ### truly-the value-type form => result*
    49   private static final SpecialOperator TRULY_THE =
    50     new SpecialOperator("truly-the", PACKAGE_EXT, true, "type value")
    51     {
    52       @Override
    53       public LispObject execute(LispObject args, Environment env)
    54 
    55       {
    56         if (args.length() != 2)
    57           return error(new WrongNumberOfArgumentsException(this));
    58         return eval(args.cadr(), env, LispThread.currentThread());
    59       }
    60     };
     49  private static final SpecialOperator TRULY_THE = new truly_the();
     50  private static class truly_the extends SpecialOperator {
     51    truly_the() {
     52      super("truly-the", PACKAGE_EXT, true, "type value");
     53    }
     54    @Override
     55    public LispObject execute(LispObject args, Environment env)
     56    {
     57      if (args.length() != 2)
     58        return error(new WrongNumberOfArgumentsException(this));
     59      return eval(args.cadr(), env, LispThread.currentThread());
     60    }
     61  }
    6162
    6263  // ### neq
    63   private static final Primitive NEQ =
    64     new Primitive(Symbol.NEQ, "obj1 obj2")
    65     {
    66       @Override
    67       public LispObject execute(LispObject first, LispObject second)
    68 
    69       {
     64  private static final Primitive NEQ = new neq();
     65  private static class neq extends Primitive
     66  {
     67    neq()
     68    {
     69      super(Symbol.NEQ, "obj1 obj2");
     70    }
     71    @Override
     72    public LispObject execute(LispObject first, LispObject second)
     73    {
    7074        return first != second ? T : NIL;
    71       }
    72     };
     75    }
     76  }
    7377
    7478  // ### memq item list => tail
    75   private static final Primitive MEMQ =
    76     new Primitive(Symbol.MEMQ, "item list")
    77     {
    78       @Override
    79       public LispObject execute(LispObject item, LispObject list)
    80 
    81       {
    82         while (list instanceof Cons)
    83           {
    84             if (item == ((Cons)list).car)
    85               return list;
    86             list = ((Cons)list).cdr;
    87           }
    88         if (list != NIL)
    89           type_error(list, Symbol.LIST);
    90         return NIL;
    91       }
    92     };
     79  private static final Primitive MEMQ = new memq();
     80  private static class memq extends Primitive
     81  {
     82    memq()
     83    {
     84      super(Symbol.MEMQ, "item list");
     85    }
     86    @Override
     87    public LispObject execute(LispObject item, LispObject list)
     88    {
     89      while (list instanceof Cons)
     90        {
     91          if (item == ((Cons)list).car)
     92            return list;
     93          list = ((Cons)list).cdr;
     94        }
     95      if (list != NIL)
     96        type_error(list, Symbol.LIST);
     97      return NIL;
     98    }
     99  }
    93100
    94101  // ### memql item list => tail
    95   private static final Primitive MEMQL =
    96     new Primitive(Symbol.MEMQL, "item list")
    97     {
    98       @Override
    99       public LispObject execute(LispObject item, LispObject list)
    100 
    101       {
    102         while (list instanceof Cons)
    103           {
    104             if (item.eql(((Cons)list).car))
    105               return list;
    106             list = ((Cons)list).cdr;
    107           }
    108         if (list != NIL)
    109           type_error(list, Symbol.LIST);
    110         return NIL;
    111       }
    112     };
     102  private static final Primitive MEMQL = new memql();
     103  private static class memql extends Primitive
     104  {
     105    memql() {
     106      super(Symbol.MEMQL, "item list");
     107    }
     108    @Override
     109    public LispObject execute(LispObject item, LispObject list)
     110    {
     111      while (list instanceof Cons)
     112        {
     113          if (item.eql(((Cons)list).car))
     114            return list;
     115          list = ((Cons)list).cdr;
     116        }
     117      if (list != NIL)
     118        type_error(list, Symbol.LIST);
     119      return NIL;
     120    }
     121  }
    113122
    114123  // ### adjoin-eql item list => new-list
    115   private static final Primitive ADJOIN_EQL =
    116     new Primitive(Symbol.ADJOIN_EQL, "item list")
    117     {
    118       @Override
    119       public LispObject execute(LispObject item, LispObject list)
    120 
    121       {
    122         return memql(item, list) ? list : new Cons(item, list);
    123       }
    124     };
     124  private static final Primitive ADJOIN_EQL = new adjoin_eql();
     125  private static class adjoin_eql extends Primitive {
     126    adjoin_eql() {
     127      super(Symbol.ADJOIN_EQL, "item list");
     128    }
     129    @Override
     130    public LispObject execute(LispObject item, LispObject list)
     131    {
     132      return memql(item, list) ? list : new Cons(item, list);
     133    }
     134  }
    125135
    126136  // ### special-variable-p
    127   private static final Primitive SPECIAL_VARIABLE_P =
    128     new Primitive("special-variable-p", PACKAGE_EXT, true)
    129     {
    130       @Override
    131       public LispObject execute(LispObject arg)
    132       {
    133         return arg.isSpecialVariable() ? T : NIL;
    134       }
    135     };
    136 
    137   // ### source
    138   private static final Primitive SOURCE =
    139     new Primitive("source", PACKAGE_EXT, true)
    140     {
    141       @Override
    142       public LispObject execute(LispObject arg)
    143       {
    144         return get(arg, Symbol._SOURCE, NIL);
    145       }
    146     };
    147 
    148   // ### source-file-position
    149   private static final Primitive SOURCE_FILE_POSITION =
    150     new Primitive("source-file-position", PACKAGE_EXT, true)
    151     {
    152       @Override
    153       public LispObject execute(LispObject arg)
    154       {
    155         LispObject obj = get(arg, Symbol._SOURCE, NIL);
    156         if (obj instanceof Cons)
    157           return obj.cdr();
    158         return NIL;
    159       }
    160     };
     137  private static final Primitive SPECIAL_VARIABLE_P = new special_variable_p();
     138  private static class special_variable_p extends Primitive {
     139    special_variable_p() {
     140      super("special-variable-p", PACKAGE_EXT, true);
     141    }
     142    @Override
     143    public LispObject execute(LispObject arg)
     144    {
     145      return arg.isSpecialVariable() ? T : NIL;
     146    }
     147  }
     148
     149  // ### source symbol
     150  private static final Primitive SOURCE = new source();
     151  private static class source extends Primitive {
     152    source() {
     153      super("source", PACKAGE_EXT, true);
     154    }
     155    @Override
     156    public LispObject execute(LispObject arg)
     157    {
     158      return get(arg, Symbol._SOURCE, NIL);
     159    }
     160  }
     161
     162  // ### source-file-position symbol
     163  private static final Primitive SOURCE_FILE_POSITION = new source_file_position();
     164  private static class source_file_position extends Primitive {
     165    source_file_position() {
     166      super("source-file-position", PACKAGE_EXT, true);
     167    }
     168    @Override
     169    public LispObject execute(LispObject arg)
     170    {
     171      LispObject obj = get(arg, Symbol._SOURCE, NIL);
     172      if (obj instanceof Cons)
     173        return obj.cdr();
     174      return NIL;
     175    }
     176  }
    161177
    162178  // ### source-pathname
    163   public static final Primitive SOURCE_PATHNAME =
    164     new Primitive("source-pathname", PACKAGE_EXT, true)
    165     {
    166       @Override
    167       public LispObject execute(LispObject arg)
    168       {
    169         LispObject obj = get(arg, Symbol._SOURCE, NIL);
    170         if (obj instanceof Cons)
    171           return obj.car();
    172         return obj;
    173       }
    174     };
     179  public static final Primitive SOURCE_PATHNAME = new source_pathname();
     180  private static class source_pathname extends Primitive {
     181    source_pathname() {
     182      super("source-pathname", PACKAGE_EXT, true);
     183    }
     184    @Override
     185    public LispObject execute(LispObject arg)
     186    {
     187      LispObject obj = get(arg, Symbol._SOURCE, NIL);
     188      if (obj instanceof Cons)
     189        return obj.car();
     190      return obj;
     191    }
     192  }
    175193
    176194  // ### exit
    177   private static final Primitive EXIT =
    178     new Primitive("exit", PACKAGE_EXT, true, "&key status")
    179     {
    180       @Override
    181       public LispObject execute()
    182       {
    183         exit(0);
    184         return LispThread.currentThread().nothing();
    185       }
    186       @Override
    187       public LispObject execute(LispObject first, LispObject second)
    188 
    189       {
    190         int status = 0;
    191         if (first == Keyword.STATUS)
    192           {
    193             if (second instanceof Fixnum)
    194               status = ((Fixnum)second).value;
    195           }
    196         exit(status);
    197         return LispThread.currentThread().nothing();
    198       }
    199     };
     195  private static final Primitive EXIT = new exit();
     196  private static class exit extends Primitive {
     197    exit() {
     198      super("exit", PACKAGE_EXT, true, "&key status");
     199    }
     200    @Override
     201    public LispObject execute()
     202    {
     203      exit(0);
     204      return LispThread.currentThread().nothing();
     205    }
     206    @Override
     207    public LispObject execute(LispObject first, LispObject second)
     208     
     209    {
     210      int status = 0;
     211      if (first == Keyword.STATUS)
     212        {
     213          if (second instanceof Fixnum)
     214            status = ((Fixnum)second).value;
     215        }
     216      exit(status);
     217      return LispThread.currentThread().nothing();
     218    }
     219  }
    200220
    201221  // ### quit
    202   private static final Primitive QUIT =
    203     new Primitive("quit", PACKAGE_EXT, true, "&key status")
    204     {
    205       @Override
    206       public LispObject execute()
    207       {
    208         exit(0);
    209         return LispThread.currentThread().nothing();
    210       }
    211       @Override
    212       public LispObject execute(LispObject first, LispObject second)
    213 
    214       {
    215         int status = 0;
    216         if (first == Keyword.STATUS)
    217           {
    218             if (second instanceof Fixnum)
    219               status = ((Fixnum)second).value;
    220           }
    221         exit(status);
    222         return LispThread.currentThread().nothing();
    223       }
    224     };
     222  private static final Primitive QUIT = new quit();
     223  private static class quit extends Primitive {
     224    quit() {
     225      super("quit", PACKAGE_EXT, true, "&key status");
     226    }
     227    @Override
     228    public LispObject execute()
     229    {
     230      exit(0);
     231      return LispThread.currentThread().nothing();
     232    }
     233    @Override
     234    public LispObject execute(LispObject first, LispObject second)
     235    {
     236      int status = 0;
     237      if (first == Keyword.STATUS)
     238        {
     239          if (second instanceof Fixnum)
     240            status = ((Fixnum)second).value;
     241        }
     242      exit(status);
     243      return LispThread.currentThread().nothing();
     244    }
     245  }
    225246
    226247  // ### dump-java-stack
    227   private static final Primitive DUMP_JAVA_STACK =
    228     new Primitive("dump-java-stack", PACKAGE_EXT, true)
    229     {
    230       @Override
    231       public LispObject execute()
    232       {
    233         Thread.dumpStack();
    234         return LispThread.currentThread().nothing();
    235       }
    236     };
    237 
    238   // ### make-temp-file => namestring
    239   private static final Primitive MAKE_TEMP_FILE =
    240     new Primitive("make-temp-file", PACKAGE_EXT, true, "")
    241     {
    242       @Override
    243       public LispObject execute()
    244       {
    245         try
    246           {
    247             File file = File.createTempFile("abcl", null, null);
    248             if (file != null)
    249               return new Pathname(file.getPath());
    250           }
    251         catch (IOException e)
    252           {
    253             Debug.trace(e);
    254           }
    255         return NIL;
    256       }
    257     };
     248  private static final Primitive DUMP_JAVA_STACK = new dump_java_stack();
     249  private static class dump_java_stack extends Primitive {
     250    dump_java_stack() {
     251      super("dump-java-stack", PACKAGE_EXT, true);
     252    }
     253    @Override
     254    public LispObject execute()
     255    {
     256      Thread.dumpStack();
     257      return LispThread.currentThread().nothing();
     258    }
     259  }
     260
     261  // ### make-temp-file => pathname
     262  private static final Primitive MAKE_TEMP_FILE = new make_temp_file();
     263  private static class make_temp_file extends Primitive {
     264    make_temp_file() {
     265      super("make-temp-file", PACKAGE_EXT, true, "");
     266    }
     267    @Override
     268    public LispObject execute()
     269    {
     270      try
     271        {
     272          File file = File.createTempFile("abcl", null, null);
     273          if (file != null)
     274            return new Pathname(file.getPath());
     275        }
     276      catch (IOException e)
     277        {
     278          Debug.trace(e);
     279        }
     280      return NIL;
     281    }
     282  }
    258283
    259284  // ### interrupt-lisp
    260   private static final Primitive INTERRUPT_LISP =
    261     new Primitive("interrupt-lisp", PACKAGE_EXT, true, "")
    262     {
    263       @Override
    264       public LispObject execute()
    265       {
    266         setInterrupted(true);
    267         return T;
    268       }
    269     };
    270 
    271   // ### getenv
    272   private static final Primitive GETENV =
    273       new Primitive("getenv", PACKAGE_EXT, true)
     285  private static final Primitive INTERRUPT_LISP = new interrupt_lisp();
     286  private static class interrupt_lisp extends Primitive {
     287    interrupt_lisp() {
     288      super("interrupt-lisp", PACKAGE_EXT, true, "");
     289    }
     290    @Override
     291    public LispObject execute()
     292    {
     293      setInterrupted(true);
     294      return T;
     295    }
     296  }
     297
     298  // ### getenv variable => string
     299  private static final Primitive GETENV = new getenv();
     300  private static class getenv extends Primitive
    274301  {
     302    getenv()
     303    {
     304      super("getenv", PACKAGE_EXT, true, "variable",
     305             "Return the value of the environment VARIABLE if it exists, otherwise return NIL.");
     306    }
    275307    @Override
    276308    public LispObject execute(LispObject arg)
     
    287319        return NIL;
    288320    }
    289   };
     321  }
    290322}
Note: See TracChangeset for help on using the changeset viewer.