source: branches/streams/abcl/src/org/armedbear/lisp/LispStackFrame.java

Last change on this file was 14739, checked in by Mark Evenson, 10 years ago

Actually return an unreadable representation from printing a LISP-STACK-FRAME.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 4.8 KB
Line 
1/*
2 * LispStackFrame.java
3 *
4 * Copyright (C) 2009 Mark Evenson
5 * $Id: LispStackFrame.java 14739 2014-12-26 15:15:21Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38public class LispStackFrame 
39  extends StackFrame
40{
41  public final LispObject operator;
42  private final LispObject[] args;
43
44  private final static class UnavailableArgument extends LispObject
45  {
46    public UnavailableArgument () { }
47    @Override
48    public String printObject() { 
49      return unreadableString("unavailable arg", false); 
50    }
51  }
52
53  private final static LispObject UNAVAILABLE_ARG = new UnavailableArgument();
54
55  public LispStackFrame(Object[] stack, int framePos, int numArgs)
56  {
57    operator = (LispObject) stack[framePos];
58    args = new LispObject[numArgs];
59    for (int i = 0; i < numArgs; i++) 
60    {
61      args[i] = (LispObject) stack[framePos + 1 + i];
62    }
63  }
64
65   @Override
66   public LispObject typeOf() { 
67     return Symbol.LISP_STACK_FRAME; 
68   }
69 
70   @Override
71   public LispObject classOf() { 
72     return BuiltInClass.LISP_STACK_FRAME; 
73   }
74
75   @Override
76   public String printObject() 
77   { 
78     String result = "";
79     final String LISP_STACK_FRAME = "LISP-STACK-FRAME";
80     try {
81       result = unreadableString(LISP_STACK_FRAME + " " + toLispList().printObject());
82     } catch (Throwable t) { // error while printing stack
83       Debug.trace("Serious printing error: ");
84       Debug.trace(t);
85       result = unreadableString(LISP_STACK_FRAME);
86     }
87     return result;
88   }
89
90  @Override
91  public LispObject typep(LispObject typeSpecifier) 
92
93  {
94    if (typeSpecifier == Symbol.LISP_STACK_FRAME)
95      return T;
96    if (typeSpecifier == BuiltInClass.LISP_STACK_FRAME)
97      return T;
98    return super.typep(typeSpecifier);
99   }
100
101  public LispObject toLispList() 
102
103  {
104    LispObject result = argsToLispList();
105    if (operator instanceof Operator) {
106      LispObject lambdaName = ((Operator)operator).getLambdaName();
107      if (lambdaName != null && lambdaName != Lisp.NIL)
108  return result.push(lambdaName);
109    }
110    return result.push(operator);
111  }
112
113  private LispObject argsToLispList()
114
115  {
116    LispObject result = Lisp.NIL;
117    for (int i = 0; i < args.length; i++)
118      // `args' come here from LispThread.execute. I don't know
119      // how it comes that some callers pass NULL ptrs around but
120      // we better do not create conses with their CAR being NULL;
121      // it'll horribly break printing such a cons; and probably
122      // other bad things may happen, too. --TCR, 2009-09-17.
123      if (args[i] == null)
124        result = result.push(UNAVAILABLE_ARG);
125      else
126        result = result.push(args[i]);
127    return result.nreverse();
128  }
129
130  public SimpleString toLispString() 
131
132  {
133    String result;
134    try {
135      result = this.toLispList().printObject();
136    } catch (Throwable t) { // error while printing stack
137      Debug.trace("Serious printing error: ");
138      Debug.trace(t);
139      result = unreadableString("LISP-STACK-FRAME");
140    }
141    return new SimpleString(result);
142  }
143
144  public int getNumArgs()
145  {
146    return args.length;
147  }
148
149  public LispObject getOperator() {
150    return operator;
151  }
152
153  @Override 
154  public LispObject getParts() 
155
156  {
157    LispObject result = NIL;
158    result = result.push(new Cons("OPERATOR", getOperator()));
159    LispObject args = argsToLispList();
160    if (args != NIL) {
161      result = result.push(new Cons("ARGS", args));
162    }
163       
164    return result.nreverse();
165  }
166}
Note: See TracBrowser for help on using the repository browser.