1 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 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 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 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 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 writeToString() 202 { 203 return unreadableString("ENVIRONMENT"); 204 } 205 206 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 e) { 216 return signal(new TypeError(arg.writeToString() + 217 " is not an environment.")); 218 } 219 } 220 }; 221 222 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 e) { 237 return signal(new TypeError(arg.writeToString() + 238 " is not an environment.")); 239 } 240 } 241 }; 242 } 243 | Popular Tags |