KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > Environment


1 /*
2  * Environment.java
3  *
4  * Copyright (C) 2002-2004 Peter Graves
5  * $Id: Environment.java,v 1.16 2004/08/19 18:14:46 piso Exp $
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
22 package org.armedbear.lisp;
23
24 public final class Environment extends LispObject
25 {
26     private Binding vars;
27     private Binding functions;
28     private Binding blocks;
29     private Binding tags;
30
31     public Environment() {}
32
33     public Environment(Environment parent)
34     {
35         if (parent != null) {
36             vars = parent.vars;
37             functions = parent.functions;
38             blocks = parent.blocks;
39             tags = parent.tags;
40         }
41     }
42
43     // Construct a new Environment extending parent with the specified symbol-
44
// value binding.
45
public Environment(Environment parent, Symbol symbol, LispObject value)
46     {
47         if (parent != null) {
48             vars = parent.vars;
49             functions = parent.functions;
50             blocks = parent.blocks;
51             tags = parent.tags;
52         }
53         vars = new Binding(symbol, value, vars);
54     }
55
56     public boolean isEmpty()
57     {
58         if (functions != null)
59             return false;
60         if (vars != null) {
61             for (Binding binding = vars; binding != null; binding = binding.next)
62                 if (!binding.specialp)
63                     return false;
64         }
65         return true;
66     }
67
68     public void bind(Symbol symbol, LispObject value)
69     {
70         vars = new Binding(symbol, value, vars);
71     }
72
73     public void rebind(Symbol symbol, LispObject value)
74     {
75         Binding binding = getBinding(symbol);
76         binding.value = value;
77     }
78
79     public LispObject lookup(LispObject symbol)
80     {
81         Binding binding = vars;
82         while (binding != null) {
83             if (binding.symbol == symbol)
84                 return binding.value;
85             binding = binding.next;
86         }
87         return null;
88     }
89
90     public Binding getBinding(LispObject symbol)
91     {
92         Binding binding = vars;
93         while (binding != null) {
94             if (binding.symbol == symbol)
95                 return binding;
96             binding = binding.next;
97         }
98         return null;
99     }
100
101     // Functional bindings.
102
public void bindFunctional(LispObject name, LispObject value)
103     {
104         functions = new Binding(name, value, functions);
105     }
106
107     public LispObject lookupFunctional(LispObject name)
108         throws ConditionThrowable
109     {
110         Binding binding = functions;
111         if (name instanceof Symbol) {
112             while (binding != null) {
113                 if (binding.symbol == name)
114                     return binding.value;
115                 binding = binding.next;
116             }
117             // Not found in environment.
118
return name.getSymbolFunction();
119         }
120         if (name instanceof Cons) {
121             while (binding != null) {
122                 if (binding.symbol.equal(name))
123                     return binding.value;
124                 binding = binding.next;
125             }
126         }
127         return null;
128     }
129
130     public void addBlock(LispObject tag, LispObject block)
131     {
132         blocks = new Binding(tag, block, blocks);
133     }
134
135     public LispObject lookupBlock(LispObject symbol)
136     {
137         Binding binding = blocks;
138         while (binding != null) {
139             if (binding.symbol == symbol)
140                 return binding.value;
141             binding = binding.next;
142         }
143         return null;
144     }
145
146     public void addTagBinding(LispObject tag, LispObject code)
147     {
148         tags = new Binding(tag, code, tags);
149     }
150
151     public Binding getTagBinding(LispObject tag)
152     {
153         Binding binding = tags;
154         while (binding != null) {
155             if (binding.symbol.eql(tag))
156                 return binding;
157             binding = binding.next;
158         }
159         return null;
160     }
161
162     // Returns body with declarations removed.
163
public LispObject processDeclarations(LispObject body)
164         throws ConditionThrowable
165     {
166         while (body != NIL) {
167             LispObject obj = body.car();
168             if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
169                 LispObject decls = obj.cdr();
170                 while (decls != NIL) {
171                     LispObject decl = decls.car();
172                     if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
173                         LispObject vars = decl.cdr();
174                         while (vars != NIL) {
175                             Symbol var = checkSymbol(vars.car());
176                             declareSpecial(var);
177                             vars = vars.cdr();
178                         }
179                     }
180                     decls = decls.cdr();
181                 }
182                 body = body.cdr();
183             } else
184                 break;
185         }
186         return body;
187     }
188
189     public void declareSpecial(Symbol var)
190     {
191             vars = new Binding(var, null, vars);
192             vars.specialp = true;
193     }
194
195     public boolean isDeclaredSpecial(Symbol var)
196     {
197         Binding binding = getBinding(var);
198         return binding != null ? binding.specialp : false;
199     }
200
201     public String JavaDoc writeToString()
202     {
203         return unreadableString("ENVIRONMENT");
204     }
205
206     // ### empty-environment-p
207
private static final Primitive1 EMPTY_ENVIRONMENT_P =
208         new Primitive1("empty-environment-p", PACKAGE_SYS, false, "environment")
209     {
210         public LispObject execute(LispObject arg) throws ConditionThrowable
211         {
212             try {
213                 return ((Environment)arg).isEmpty() ? T : NIL;
214             }
215             catch (ClassCastException JavaDoc e) {
216                 return signal(new TypeError(arg.writeToString() +
217                                             " is not an environment."));
218             }
219         }
220     };
221
222     // ### environment-vars
223
private static final Primitive1 ENVIRONMENT_VARS =
224         new Primitive1("environment-vars", PACKAGE_SYS, false, "environment")
225     {
226         public LispObject execute(LispObject arg) throws ConditionThrowable
227         {
228             try {
229                 Environment env = (Environment) arg;
230                 LispObject result = NIL;
231                 for (Binding binding = env.vars; binding != null; binding = binding.next)
232                     if (!binding.specialp)
233                         result = new Cons(binding.symbol, result);
234                 return result;
235             }
236             catch (ClassCastException JavaDoc e) {
237                 return signal(new TypeError(arg.writeToString() +
238                                             " is not an environment."));
239             }
240         }
241     };
242 }
243
Popular Tags