001: package sisc.modules;
002:
003: import sisc.data.*;
004: import sisc.exprs.*;
005: import sisc.interpreter.*;
006: import sisc.nativefun.*;
007:
008: import sisc.util.FreeReference;
009: import sisc.util.UndefinedVarException;
010:
011: public class Debugging extends IndexedProcedure {
012:
013: //NEXT: 15
014: protected static final int EXPRESSV = 0, CONT_VLR = 2,
015: CONT_NXP = 3, CONT_ENV = 4, CONT_FK = 5, CONT_VLK = 6,
016: CONT_PARENT = 7, CONT_STK = 14, ERROR_CONT_K = 8,
017: FILLRIBQ = 9, FILLRIBEXP = 10, FREEXPQ = 11, FRESYM = 12,
018: QTYPE = 13, UNRESOLVEDREFS = 1;
019:
020: public static class Index extends IndexedLibraryAdapter {
021:
022: public Value construct(Object context, int id) {
023: return new Debugging(id);
024: }
025:
026: public Index() {
027: define("express", EXPRESSV);
028: define("error-continuation-k", ERROR_CONT_K);
029: define("continuation-vlk", CONT_VLK);
030: define("continuation-vlr", CONT_VLR);
031: define("continuation-nxp", CONT_NXP);
032: define("continuation-env", CONT_ENV);
033: define("continuation-fk", CONT_FK);
034: define("continuation-stk", CONT_PARENT);
035: define("continuation-stack-trace", CONT_STK);
036: define("_fill-rib?", FILLRIBQ);
037: define("_fill-rib-exp", FILLRIBEXP);
038: define("_free-reference-exp?", FREEXPQ);
039: define("_free-reference-symbol", FRESYM);
040: define("quantity-type", QTYPE);
041: define("unresolved-references", UNRESOLVEDREFS);
042: }
043: }
044:
045: public Debugging(int id) {
046: super (id);
047: }
048:
049: public Debugging() {
050: }
051:
052: CallFrame getCont(Value v) {
053: if (v instanceof ApplyParentFrame)
054: return ((ApplyParentFrame) v).c;
055: else
056: return cont(v);
057: }
058:
059: public Value doApply(Interpreter f) throws ContinuationException {
060: switch (f.vlr.length) {
061: case 0:
062: switch (id) {
063: case UNRESOLVEDREFS:
064: FreeReference[] refs = FreeReference.allReferences();
065: Pair res = EMPTYLIST;
066: for (int i = 0; i < refs.length; i++) {
067: FreeReference ref = refs[i];
068: try {
069: ref.resolve();
070: } catch (UndefinedVarException ex) {
071: res = new Pair(ref.getName(), res);
072: }
073: }
074: return res;
075: default:
076: throwArgSizeException();
077: }
078: case 1:
079: switch (id) {
080: case QTYPE:
081: return Quantity.valueOf(num(f.vlr[0]).type);
082: case FREEXPQ:
083: return truth(expr(f.vlr[0]) instanceof FreeReferenceExp);
084: case FRESYM:
085: return ((FreeReferenceExp) expr(f.vlr[0])).getSym();
086: case FILLRIBQ:
087: return truth(f.vlr[0] instanceof ExpressionValue
088: && expr(f.vlr[0]) instanceof FillRibExp);
089: case FILLRIBEXP:
090: return new ExpressionValue(
091: ((FillRibExp) expr(f.vlr[0])).exp);
092: case EXPRESSV:
093: if (f.vlr[0] instanceof ExpressionValue) {
094: return expr(f.vlr[0]).express();
095: } else {
096: return f.vlr[0].express();
097: }
098: case ERROR_CONT_K:
099: return getCont(f.vlr[0]);
100: case CONT_VLK:
101: return truth(getCont(f.vlr[0]).vlk);
102: case CONT_NXP:
103: CallFrame cn = getCont(f.vlr[0]);
104: if (cn.nxp == null)
105: return FALSE;
106: return new ExpressionValue(cn.nxp);
107: case CONT_VLR:
108: return new SchemeVector(getCont(f.vlr[0]).vlr);
109: case CONT_ENV:
110: return new Values(getCont(f.vlr[0]).env);
111: case CONT_PARENT:
112: cn = getCont(f.vlr[0]);
113: if (cn.parent == null)
114: return FALSE;
115: return cn.parent;
116: case CONT_STK:
117: cn = getCont(f.vlr[0]);
118: return (cn.tracer == null) ? FALSE : cn.tracer
119: .toValue();
120: default:
121: throwArgSizeException();
122: }
123: default:
124: throwArgSizeException();
125: }
126: return VOID;
127: }
128: }
129: /*
130: * The contents of this file are subject to the Mozilla Public
131: * License Version 1.1 (the "License"); you may not use this file
132: * except in compliance with the License. You may obtain a copy of
133: * the License at http://www.mozilla.org/MPL/
134: *
135: * Software distributed under the License is distributed on an "AS
136: * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
137: * implied. See the License for the specific language governing
138: * rights and limitations under the License.
139: *
140: * The Original Code is the Second Interpreter of Scheme Code (SISC).
141: *
142: * The Initial Developer of the Original Code is Scott G. Miller.
143: * Portions created by Scott G. Miller are Copyright (C) 2000-2007
144: * Scott G. Miller. All Rights Reserved.
145: *
146: * Contributor(s):
147: * Matthias Radestock
148: *
149: * Alternatively, the contents of this file may be used under the
150: * terms of the GNU General Public License Version 2 or later (the
151: * "GPL"), in which case the provisions of the GPL are applicable
152: * instead of those above. If you wish to allow use of your
153: * version of this file only under the terms of the GPL and not to
154: * allow others to use your version of this file under the MPL,
155: * indicate your decision by deleting the provisions above and
156: * replace them with the notice and other provisions required by
157: * the GPL. If you do not delete the provisions above, a recipient
158: * may use your version of this file under either the MPL or the
159: * GPL.
160: */
|