1 package org.mathpiper.mpreduce.functions.lisp;
2
3 //
4 // This file is part of the Jlisp implementation of Standard Lisp
5 // Copyright \u00a9 (C) Codemist Ltd, 1998-2000.
6 //
7
8 /**************************************************************************
9 * Copyright (C) 1998-2011, Codemist Ltd. A C Norman *
10 * also contributions from Vijay Chauhan, 2002 *
11 * *
12 * Redistribution and use in source and binary forms, with or without *
13 * modification, are permitted provided that the following conditions are *
14 * met: *
15 * *
16 * * Redistributions of source code must retain the relevant *
17 * copyright notice, this list of conditions and the following *
18 * disclaimer. *
19 * * Redistributions in binary form must reproduce the above *
20 * copyright notice, this list of conditions and the following *
21 * disclaimer in the documentation and/or other materials provided *
22 * with the distribution. *
23 * *
24 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *
25 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *
26 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS *
27 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE *
28 * COPYRIGHT OWNERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, *
29 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, *
30 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS *
31 * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *
32 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR *
33 * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF *
34 * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH *
35 * DAMAGE. *
36 *************************************************************************/
37 import org.mathpiper.mpreduce.Environment;
38 import org.mathpiper.mpreduce.LispObject;
39
40 import org.mathpiper.mpreduce.Jlisp;
41 import org.mathpiper.mpreduce.LispReader;
42 import org.mathpiper.mpreduce.exceptions.ResourceException;
43 import org.mathpiper.mpreduce.symbols.Symbol;
44
45 public class CallAs extends LispFunction
46 {
47
48 public LispObject body;
49 int nargs;
50
CallAs(int nIn, LispObject target, int nPass)51 public CallAs(int nIn, LispObject target, int nPass)
52 {
53 body = target;
54 nargs = (nIn<<4) + nPass;
55 }
56
CallAs(int packed)57 public CallAs(int packed)
58 {
59 nargs = packed;
60 }
61
print()62 public void print() throws ResourceException
63 {
64 print(0);
65 }
66
print(int fg)67 public void print(int fg) throws ResourceException
68 { Jlisp.print("#CALL" + (nargs & 0xf) + "as" +
69 ((nargs>>4) & 0xf) + "<");
70 body.print(fg);
71 Jlisp.print(">");
72 }
73
op0()74 public LispObject op0() throws Exception
75 {
76 if (((nargs>>4) & 0xf) != 0)
77 error("Call with wrong number of arguments", body);
78 return ((Symbol)body).fn.op0();
79 }
80
op1(LispObject a1)81 public LispObject op1(LispObject a1) throws Exception
82 {
83 if (((nargs>>4) & 0xf) != 1)
84 error("Call with wrong number of arguments", body);
85 if ((nargs & 0xf) == 0) return ((Symbol)body).fn.op0();
86 else return ((Symbol)body).fn.op1(a1);
87 }
88
op2(LispObject a1, LispObject a2)89 public LispObject op2(LispObject a1, LispObject a2) throws Exception
90 {
91 if (((nargs>>4) & 0xf) != 2)
92 error("Call with wrong number of arguments", body);
93 switch ((nargs & 0xf))
94 {
95 case 0: return ((Symbol)body).fn.op0();
96 case 1: return ((Symbol)body).fn.op1(a1);
97 default:return ((Symbol)body).fn.op2(a1, a2);
98 }
99 }
100
opn(LispObject [] args)101 public LispObject opn(LispObject [] args) throws Exception
102 {
103 if (((nargs>>4) & 0xf) != args.length)
104 error("Call with wrong number of arguments", body);
105 switch ((nargs & 0xf))
106 {
107 case 0: return ((Symbol)body).fn.op0();
108 case 1: return ((Symbol)body).fn.op1(args[0]);
109 case 2: return ((Symbol)body).fn.op2(args[0], args[1]);
110 default:return ((Symbol)body).fn.opn(
111 new LispObject [] { args[0], args[1], args[2] });
112 }
113 }
114
scan()115 public void scan()
116 {
117 if (LispReader.objects.contains(this)) // seen before?
118 { if (!LispReader.repeatedObjects.containsKey(this))
119 { LispReader.repeatedObjects.put(
120 this,
121 Environment.nil); // value is junk at this stage
122 }
123 }
124 else LispReader.objects.add(this);
125 LispReader.stack.push(body);
126 }
127
128
129 }
130
131 // End of CallAs.java
132
133